Faster string to double

29

Also as defined assignment if one were so inclined.

Click for code

Simple Fortran String to Double

module str2r_m
! Simple Fortran string to real
   use, intrinsic :: iso_fortran_env, only : I8 => int64, real_kinds
   ! Integer constants
   integer, parameter :: ASCII_NEGATIVE = 45
   integer, parameter :: ASCII_PERIOD = 46
   integer, parameter :: ASCII_0 = 48
   integer, parameter :: ASCII_9 = 57
   integer(I8), parameter :: TEN_INT = 10_i8
   interface assignment(=)
      module procedure str2r_rk1
      module procedure str2r_rk2
      module procedure str2r_rk3
   end interface 
contains
   elemental subroutine str2r_rk1( r, str )
      character(len=*), intent(in) :: str
      real(real_kinds(1)), intent(out) :: r
      ! Local variables
      integer, parameter :: WP = real_kinds(1)
      include 'str2r.i90'
   end subroutine
   elemental subroutine str2r_rk2( r, str )
      character(len=*), intent(in) :: str
      real(real_kinds(2)), intent(out) :: r
      ! Local variables
      integer, parameter :: WP = real_kinds(2)
      include 'str2r.i90'
   end subroutine
   elemental subroutine str2r_rk3( r, str )
      character(len=*), intent(in) :: str
      real(real_kinds(3)), intent(out) :: r
      ! Local variables
      integer, parameter :: WP = real_kinds(3)
      include 'str2r.i90'
   end subroutine
   elemental subroutine str2dec( s, n, expnt )
      character(len=*), intent(in)   :: s
      integer(I8), intent(out)       :: n 
      integer, intent(out), optional :: expnt
      integer :: ipos, ic, pos_period, exponent
      n = 0_i8
      pos_period = 0
      exponent = -1
      if ( present(expnt) ) exponent = 0 
      do ipos = len(s), 1, -1
         ic = ichar( s(ipos:ipos) )
         if ( present(expnt) ) then 
            if ( ic == ASCII_PERIOD ) then
               pos_period = ipos
               cycle
            end if
         end if 
         if ( ic == ASCII_NEGATIVE ) then
            n = -n
            exit
         end if 
         if ( (ic < ASCII_0).or.(ic > ASCII_9) ) exit
         exponent = exponent + 1 
         n = n + TEN_INT**(exponent)*(ic - 48)
      end do
      if ( present(expnt) ) expnt = -len(s) + pos_period - 1
      return
   end subroutine 
end module
! include str2r.i90
      ! FP constants
      real(WP), parameter :: TEN = 10.0_wp
      integer(I8) :: n, n_exp
      integer :: lens, pos_exp, expnt
      r = 0.0_wp
      n_exp = 0
      lens = len_trim( str )
      pos_exp = index( str, "E", back=.true. )
      if ( pos_exp == 0 ) then
         pos_exp = index( str, "e", back=.true. )
      end if
      if ( pos_exp > 0 ) then
         call str2dec( str(pos_exp+1:lens), n_exp ) 
      else
         pos_exp = lens + 1
      end if
      call str2dec( str(1:pos_exp-1), n, expnt )
      r = real( n, kind=WP ) * (TEN**(n_exp + expnt)) 
      return