str2num

The stdlib_str2num module

This module proposes a function-style interface for string-to-number conversion. It also profits from Fortran's interfaces to implement precision-dependant algorithms to maximize runtime efficiency.

to_num - conversion of strings to numbers

Status

Experimental

Description

Convert a string or an array of strings to numerical types.

Syntax

number = to_num (string, mold)

Arguments

string: argument has intent(in) and is of type character(*).

mold: argument has intent(in) and is of numerical type (that is of integer or of real). Note: The type of the mold argument defines the type of the result.

Return value

Return a scalar of numerical type (i.e., integer, or real).

Example

program example_string_to_number
    use stdlib_kinds, only: dp
    use stdlib_str2num, only: to_num
    implicit none
    character(:), allocatable :: txt
    real(dp) :: x

    txt = ' 8.8541878128e−12 '
    x = to_num( txt , x )
  end program example_string_to_number

to_num_from_stream - conversion of a stream of values in a string to numbers

Status

Experimental

Description

Convert a stream of values in a string to an array of values.

Syntax

number = to_num_from_stream (string, mold)

Arguments

string: argument has intent(in) and is of type character(:), pointer.

mold: argument has intent(in) and is of numerical type (currently of integer or real). Note: The type of the mold argument defines the type of the result.

Return value

Return a scalar of numerical type (i.e., integer or real).

Example

program example_stream_of_strings_to_numbers
    use stdlib_kinds, only: dp
    use stdlib_str2num, only: to_num_from_stream
    implicit none
    character(:), allocatable, target :: chain
    character(len=:), pointer :: cptr
    real(dp), allocatable :: r(:), p(:)
    integer :: i 

    chain = " 1.234   1.E1 1e0     0.1234E0  12.21e+001 -34.5E1"
    allocate( r(6), p(6) )
    !> Example for streamline conversion using `to_num_from_stream`
    cptr => chain
    do i =1, 6
        r(i) = to_num_from_stream( cptr , r(i) ) !> the pointer is shifted within the function
    end do
    read(chain,*) p
    print *, "Reading with to_num_from_stream"
    print *, r
    print *, "Reading with formatted read"
    print *, p

end program example_stream_of_strings_to_numbers

Note

The accuracy of the conversion is implementation dependent; it is recommended that implementers guarantee precision down to the last 3 bits.

The current implementation has been tested to provide for :

sp : exact match

dp : precision up-to epsilon(0.0_dp)

qp : precision around 200*epsilon(0.0_qp)

Where precision refers to the relative difference between to_num and read. On the other hand, to_num provides speed-ups ranging from 4x to >10x compared to the intrinsic read.