easy_string.f90 Source File

!> author: 左志华
!> date: 2022/5/5
!>
!> 字符串操作
module easy_string_m

    use, intrinsic :: iso_c_binding, only: c_null_char
    use, intrinsic :: iso_fortran_env, only: sp => real32, dp => real64
    implicit none
    private

    public :: to_string, to_lower, to_upper, f_c_string, operator(.fc.)

    !> 将其他类型转化为字符串
    interface to_string
        module procedure to_string_integer, to_string_logical, to_string_sp, to_string_dp
    end interface to_string

    !> 将 Fortran 字符串转换为 C 字符串
    interface operator(.fc.)
        module procedure f_c_string
    end interface operator(.fc.)

    character(*), parameter :: uppercase = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    character(*), parameter :: lowercase = "abcdefghijklmnopqrstuvwxyz"

contains

    !> Make a string lowercase
    elemental function to_lower(x) result(y)
        character(*), intent(in) :: x   !! Input string
        character(len(x)) y
        integer i, k

        do concurrent(i=1:len(x))
            k = index(uppercase, x(i:i))
            if (k > 0) then
                y(i:i) = lowercase(k:k)
            else
                y(i:i) = x(i:i)
            end if
        end do

    end function to_lower

    !> Make a string uppercase
    elemental function to_upper(x) result(y)
        character(*), intent(in) :: x   !! Input string
        character(len(x)) y
        integer i, k

        do concurrent(i=1:len(x))
            k = index(lowercase, x(i:i))
            if (k > 0) then
                y(i:i) = uppercase(k:k)
            else
                y(i:i) = x(i:i)
            end if
        end do

    end function to_upper

    !> Format an integer to a string
    pure function to_string_integer(i, fmt) result(s)
        integer, intent(in) :: i                    !! integer to format
        character(*), intent(in), optional :: fmt   !! format string
        character(:), allocatable :: s              !! resulting string
        character(20) :: s_

        if (present(fmt)) then
            write (s_, "("//fmt//")") i
        else
            write (s_, *) i
        end if
        s = trim(s_)
    end function to_string_integer

    !> Format a logical to a string
    pure function to_string_logical(l, fmt) result(s)
        logical, intent(in) :: l                    !! logical to format
        character(*), intent(in), optional :: fmt   !! format string
        character(10) :: s_
        character(:), allocatable :: s

        if (present(fmt)) then
            write (s_, "("//fmt//")") l
            s = trim(s_)
        else
            if (l) then
                s = "T"
            else
                s = "F"
            end if
        end if
    end function to_string_logical

    !> Format a single precision real to a string
    pure function to_string_sp(r, fmt) result(s)
        real(sp), intent(in) :: r                   !! real to format
        character(*), intent(in), optional :: fmt   !! format string
        character(:), allocatable :: s
        character(128) :: s_

        if (present(fmt)) then
            write (s_, "("//fmt//")") r
        else
            write (s_, *) r
        end if
        s = trim(s_)
    end function to_string_sp

    !> Format a double precision real to a string
    pure function to_string_dp(r, fmt) result(s)
        real(dp), intent(in) :: r                   !! real to format
        character(*), intent(in), optional :: fmt   !! format string
        character(:), allocatable :: s
        character(128) :: s_

        if (present(fmt)) then
            write (s_, "("//fmt//")") r
        else
            write (s_, *) r
        end if
        s = trim(s_)
    end function to_string_dp

    !> 将 Fortran 字符串转换为 C 字符串
    pure function f_c_string(f_string) result(c_string)
        character(*), intent(in) :: f_string       !! Fortran 字符串
        character(len(f_string) + 1) :: c_string

        c_string = f_string//c_null_char
    end function f_c_string

end module easy_string_m