Skip to content

Commit

Permalink
update interface str2num > to_num( ) using mold
Browse files Browse the repository at this point in the history
  • Loading branch information
@jalvesz
jalvesz committed Nov 2, 2023
1 parent 94cc5df commit 001ef27
Show file tree
Hide file tree
Showing 3 changed files with 142 additions and 129 deletions.
6 changes: 3 additions & 3 deletions example/strings/example_str2num.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,13 @@ program example_str2num

chain = " 1.234 1.E1 1e0 0.1234E0 12.21e+001 -34.5E1"
allocate( r(6), p(6) )
!> Example for streamline conversion using `str2float_p`
!> Example for streamline conversion using `to_num_p`
cptr => chain
do i =1, 6
r(i) = str2float_p( cptr ) !> the pointer is shifted within the function
r(i) = to_num_p( cptr , r(i) ) !> the pointer is shifted within the function
end do
read(chain,*) p
print *, "Reading with str2num"
print *, "Reading with to_num"
print *, r
print *, "Reading with formatted read"
print *, p
Expand Down
229 changes: 117 additions & 112 deletions src/stdlib_str2num.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,12 +9,7 @@ module stdlib_str2num
use iso_fortran_env, only: int32, int64, sp => real32, dp => real64
implicit none
private
!> easy to use function interfaces
public :: str2int, str2int_p
public :: str2float, str2float_p
public :: str2double, str2double_p
!> generic subroutine interface
public :: str2num
public :: to_num, to_num_p

integer, parameter :: ikind = selected_int_kind(2)
integer(kind=ikind), parameter :: digit_0 = ichar('0',kind=ikind)
Expand All @@ -30,46 +25,119 @@ module stdlib_str2num
integer(kind=ikind), parameter :: BD = ichar('D',kind=ikind) - digit_0
integer(kind=ikind), parameter :: LF = 10, CR = 13, WS = 32

interface str2num
!> version: experimental
module procedure str2int_32
module procedure str2real_sp
module procedure str2real_dp
interface to_num
module procedure to_int
module procedure to_float
module procedure to_double
end interface

interface to_num_p
module procedure to_int_p
module procedure to_float_p
module procedure to_double_p
end interface

interface to_num_base
module procedure to_int_32
module procedure to_real_sp
module procedure to_real_dp
end interface

contains

!---------------------------------------------
! String To Integer interfaces
! String To Number interfaces
!---------------------------------------------

elemental function str2int(s) result(int)
function to_int(s,mold) result(v)
! -- In/out Variables
character(*), intent(in) :: s !> input string
integer :: int !> Output integer 32 value
integer, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
integer :: v !> Output integer 32 value
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: stat !> error status
!----------------------------------------------
call str2num(s,int,p,stat)
call to_num_base(s,v,p,stat)
end function

function to_int_p(s,mold,stat) result(v)
! -- In/out Variables
character(len=:), pointer :: s !> input string
integer, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
integer :: v !> Output integer 32 value
integer(1),intent(inout), optional :: stat
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: err
!----------------------------------------------
call to_num_base(s,v,p,err)
p = min( p , len(s) )
s => s(p:)
if(present(stat)) stat = err
end function

function to_float(s,mold) result(r)
! -- In/out Variables
character(*), intent(in) :: s !> input string
real(sp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
real(sp) :: r !> Output real value
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: stat ! error status
!----------------------------------------------
call to_num_base(s,r,p,stat)
end function

function str2int_p(s,stat) result(int)
function to_float_p(s,mold,stat) result(r)
! -- In/out Variables
character(len=:), pointer :: s !> input string
integer :: int !> Output integer 32 value
real(sp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
real(sp) :: r !> Output real value
integer(1),intent(inout), optional :: stat
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: err
!----------------------------------------------
call str2num(s,int,p,err)
call to_num_base(s,r,p,err)
p = min( p , len(s) )
s => s(p:)
if(present(stat)) stat = err
end function

elemental subroutine str2int_32(s,v,p,stat)
function to_double(s,mold) result(r)
! -- In/out Variables
character(*), intent(in) :: s !> input string
real(dp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
real(dp) :: r !> Output real value
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: stat ! error status
!----------------------------------------------
call to_num_base(s,r,p,stat)
end function

function to_double_p(s,mold,stat) result(r)
! -- In/out Variables
character(len=:), pointer :: s !> input string
real(dp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
real(dp) :: r !> Output real value
integer(1),intent(inout), optional :: stat
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: err
!----------------------------------------------
call to_num_base(s,r,p,err)
p = min( p , len(s) )
s => s(p:)
if(present(stat)) stat = err
end function

!---------------------------------------------
! String To Number Implementations
!---------------------------------------------

subroutine to_int_32(s,v,p,stat)
!> Return an unsigned 32-bit integer
! -- In/out Variables
character(*), intent(in) :: s !> input string
Expand All @@ -95,38 +163,8 @@ elemental subroutine str2int_32(s,v,p,stat)
end do
stat = 0
end subroutine

!---------------------------------------------
! String To Real function interfaces
!---------------------------------------------

elemental function str2float(s) result(r)
! -- In/out Variables
character(*), intent(in) :: s !> input string
real(sp) :: r !> Output real value
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: stat ! error status
!----------------------------------------------
call str2num(s,r,p,stat)
end function

function str2float_p(s,stat) result(r)
! -- In/out Variables
character(len=:), pointer :: s !> input string
real(sp) :: r !> Output real value
integer(1),intent(inout), optional :: stat
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: err
!----------------------------------------------
call str2num(s,r,p,err)
p = min( p , len(s) )
s => s(p:)
if(present(stat)) stat = err
end function

elemental subroutine str2real_sp(s,v,p,stat)
subroutine to_real_sp(s,v,p,stat)
integer, parameter :: wp = sp
!> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent
! -- In/out Variables
Expand All @@ -138,24 +176,16 @@ elemental subroutine str2real_sp(s,v,p,stat)
! -- Internal Variables
real(sp), parameter :: rnan = transfer(int(B'01111111101000000000000000000000',int32), 1._sp)
integer(kind=ikind), parameter :: nwnb = 39 !> number of whole number factors
integer(kind=ikind), parameter :: nfnb = 40 !> number of fractional number factors
real(wp), parameter :: whole_number_base(nwnb) = &
[ 1e38, 1e37, 1e36, 1e35, 1e34, 1e33, 1e32, &
1e31, 1e30, 1e29, 1e28, 1e27, 1e26, 1e25, 1e24, &
1e23, 1e22, 1e21, 1e20, 1e19, 1e18, 1e17, 1e16, &
1e15, 1e14, 1e13, 1e12, 1e11, 1e10, 1e9, 1e8, &
1e7, 1e6, 1e5, 1e4, 1e3, 1e2, 1e1, 1e0]
real(wp), parameter :: fractional_base(nfnb) = &
[1e-1, 1e-2, 1e-3, 1e-4, 1e-5, 1e-6, 1e-7, 1e-8, &
1e-9, 1e-10, 1e-11, 1e-12, 1e-13, 1e-14, 1e-15, 1e-16, &
1e-17, 1e-18, 1e-19, 1e-20, 1e-21, 1e-22, 1e-23, 1e-24, &
1e-25, 1e-26, 1e-27, 1e-28, 1e-29, 1e-30, 1e-31, 1e-32, &
1e-33, 1e-34, 1e-35, 1e-36, 1e-37, 1e-38, 1e-39, 1e-40 ]
integer(kind=ikind), parameter :: nfnb = 37 !> number of fractional number factors
integer :: e
real(wp), parameter :: whole_number_base(nwnb) = [(10._wp**(nwnb-e),e=1,nwnb)]
real(wp), parameter :: fractional_base(nfnb) = [(10._wp**(-e),e=1,nfnb)]
real(wp), parameter :: expbase(nwnb+nfnb) = [whole_number_base, fractional_base]

integer(1) :: sign, sige !> sign of integer number and exponential
integer(wp) :: int_wp !> long integer to capture fractional part
integer :: i_exp !> integer to capture whole number part
integer :: exp_aux
integer(1) :: i, pP, pE, val , resp
!----------------------------------------------
stat = 23 !> initialize error status with any number > 0
Expand Down Expand Up @@ -218,42 +248,19 @@ elemental subroutine str2real_sp(s,v,p,stat)
exit
end if
end do

v = sign*int_wp*expbase(nwnb-1+resp-sige*max(0,i_exp))

exp_aux = nwnb-1+resp-sige*max(0,i_exp)
if( exp_aux>0 .and. exp_aux<=nwnb+nfnb) then
v = sign*int_wp*expbase(exp_aux)
else if(exp_aux>nwnb+nfnb) then
v = sign*int_wp*fractional_base(exp_aux-(nwnb+nfnb))*expbase(nwnb+nfnb)
else
v = sign*int_wp*10._wp**(sige*max(0,i_exp)-resp)
end if
stat = 0
end subroutine

!---------------------------------------------
! String To Double function interfaces
!---------------------------------------------

elemental function str2double(s) result(r)
! -- In/out Variables
character(*), intent(in) :: s !> input string
real(dp) :: r !> Output real value
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: stat ! error status
!----------------------------------------------
call str2num(s,r,p,stat)
end function

function str2double_p(s,stat) result(r)
! -- In/out Variables
character(len=:), pointer :: s !> input string
real(dp) :: r !> Output real value
integer(1),intent(inout), optional :: stat
! -- Internal Variables
integer(1) :: p !> position within the number
integer(1) :: err
!----------------------------------------------
call str2num(s,r,p,err)
p = min( p , len(s) )
s => s(p:)
if(present(stat)) stat = err
end function

elemental subroutine str2real_dp(s,v,p,stat)
subroutine to_real_dp(s,v,p,stat)
integer, parameter :: wp = dp
!> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent
! -- In/out Variables
Expand All @@ -265,25 +272,16 @@ elemental subroutine str2real_dp(s,v,p,stat)
! -- Internal Variables
real(dp), parameter :: rNaN = TRANSFER(9218868437227405313_int64, 1._dp)
integer(kind=ikind), parameter :: nwnb = 40 !> number of whole number factors
integer(kind=ikind), parameter :: nfnb = 40 !> number of fractional number factors
real(wp), parameter :: whole_number_base(nwnb) = &
[1d39, 1d38, 1d37, 1d36, 1d35, 1d34, 1d33, 1d32, &
1d31, 1d30, 1d29, 1d28, 1d27, 1d26, 1d25, 1d24, &
1d23, 1d22, 1d21, 1d20, 1d19, 1d18, 1d17, 1d16, &
1d15, 1d14, 1d13, 1d12, 1d11, 1d10, 1d9, 1d8, &
1d7, 1d6, 1d5, 1d4, 1d3, 1d2, 1d1, 1d0]
real(wp), parameter :: fractional_base(nfnb) = &
[1d-1, 1d-2, 1d-3, 1d-4, 1d-5, 1d-6, 1d-7, 1d-8, &
1d-9, 1d-10, 1d-11, 1d-12, 1d-13, 1d-14, 1d-15, 1d-16, &
1d-17, 1d-18, 1d-19, 1d-20, 1d-21, 1d-22, 1d-23, 1d-24, &
1d-25, 1d-26, 1d-27, 1d-28, 1d-29, 1d-30, 1d-31, 1d-32, &
1d-33, 1d-34, 1d-35, 1d-36, 1d-37, 1d-38, 1d-39, 1d-40 ]
real(wp), parameter :: period_skip = 0d0
integer(kind=ikind), parameter :: nfnb = 64 !> number of fractional number factors
integer :: e
real(wp), parameter :: whole_number_base(nwnb) = [(10._wp**(nwnb-e),e=1,nwnb)]
real(wp), parameter :: fractional_base(nfnb) = [(10._wp**(-e),e=1,nfnb)]
real(wp), parameter :: expbase(nwnb+nfnb) = [whole_number_base, fractional_base]

integer(1) :: sign, sige !> sign of integer number and exponential
integer(wp) :: int_wp !> long integer to capture fractional part
integer :: i_exp !> integer to capture whole number part
integer :: exp_aux
integer(1) :: i, pP, pE, val , resp
!----------------------------------------------
stat = 23 !> initialize error status with any number > 0
Expand Down Expand Up @@ -346,8 +344,15 @@ elemental subroutine str2real_dp(s,v,p,stat)
exit
end if
end do

v = sign*int_wp*expbase(nwnb-1+resp-sige*max(0,i_exp))

exp_aux = nwnb-1+resp-sige*max(0,i_exp)
if( exp_aux>0 .and. exp_aux<=nwnb+nfnb) then
v = sign*int_wp*expbase(exp_aux)
else if(exp_aux>nwnb+nfnb) then
v = sign*int_wp*fractional_base(exp_aux-(nwnb+nfnb))*expbase(nwnb+nfnb)
else
v = sign*int_wp*10._wp**(sige*max(0,i_exp)-resp)
end if
stat = 0
end subroutine

Expand Down
Loading

0 comments on commit 001ef27

Please sign in to comment.