stringtools.f90

Go to the documentation of this file.

module stringtools

  use iso_c_binding, only: c_double

  implicit none

  interface num2str
     module procedure num2str_int, num2str_real, &
          num2str_int_array, num2str_real_array
  end interface num2str

  interface alloc2str
     module procedure alloc2str_str, alloc2str_int_array, alloc2str_real_array
  end interface alloc2str

  interface pointer2str
     module procedure pointer2str_str, pointer2str_str_array, pointer2str_int_array, pointer2str_real_array, pointer2str_real_2darray
  end interface pointer2str

  interface append_string
     module procedure append_to_char132pointer, append_to_char_pointer, append_string_to_string
  end interface append_string

contains

  function num2str_int(arg) result(str)
    integer, intent(in) :: arg
    character(:), allocatable :: str
    character(64) :: stmp
    write(stmp,*)arg
    str=trim(adjustl(stmp))
  end function num2str_int

  function num2str_real(arg) result(str)
    real(c_double), intent(in) :: arg
    character(:), allocatable :: str
    character(64) :: stmp
    write(stmp,*)arg
    str=trim(adjustl(stmp))
  end function num2str_real

  function num2str_int_array(arg,separator) result(str)
    integer, intent(in) :: arg(:)
    character(*), intent(in), optional :: separator
    character(:), allocatable :: str
    integer :: j
    str=""
    do j=1,size(arg)
       if (j > 1) then
          if (present(separator)) then
             str = str//separator
          else
             str = str//" "
          end if
       end if
       str=str//num2str_int(arg(j))
    end do
  end function num2str_int_array

  function num2str_real_array(arg,separator) result(str)
    real(c_double), intent(in) :: arg(:)
    character(*), intent(in), optional :: separator
    character(:), allocatable :: str
    ! Internal
    integer :: j
    str=""
    do j=1,size(arg)
       if (j > 1) then
          if (present(separator)) then
             str = str//separator
          else
             str = str//" "
          end if
       end if
       str=str//num2str_real(arg(j))
    end do
  end function num2str_real_array


  function alloc2str_str(arg) result(str)
    character(:), allocatable, intent(in) :: arg
    character(:), allocatable :: str
    if (allocated(arg)) then
       str = arg
    else
       str = ""
    end if
  end function alloc2str_str

  function alloc2str_int_array(arg,separator) result(str)
    integer, allocatable, intent(in) :: arg(:)
    character(*), intent(in), optional :: separator
    character(:), allocatable :: str
    character(16) :: stmp
    if (allocated(arg)) then
       if (present(separator)) then
          str = num2str_int_array(arg,separator)
       else
          str = num2str_int_array(arg)
       end if
    else
       str = ""
    end if
  end function alloc2str_int_array

  function alloc2str_real_array(arg,separator) result(str)
    real(c_double), allocatable, intent(in) :: arg(:)
    character(*), intent(in), optional :: separator
    character(:), allocatable :: str
    if (allocated(arg)) then
       if (present(separator)) then
          str = num2str_real_array(arg,separator)
       else
          str = num2str_real_array(arg)
       end if
    else
       str = ""
    end if
  end function alloc2str_real_array


  function pointer2str_str(arg) result(str)
    character(:), pointer, intent(in) :: arg
    character(:), allocatable :: str
    if (associated(arg)) then
       str = arg
    else
       str = ""
    end if
  end function pointer2str_str

  function pointer2str_str_array(arg) result(str)
    character(132), pointer, intent(in) :: arg(:)
    character(:), allocatable :: str
    integer :: ind
    if (associated(arg)) then
       str = ""
       do ind=1,size(arg)
          str = str//trim(arg(ind))
       end do
    else
       str = ""
    end if
  end function pointer2str_str_array

  function pointer2str_int_array(arg,separator) result(str)
    integer, pointer, intent(in) :: arg(:)
    character(*), intent(in), optional :: separator
    character(:), allocatable :: str
    character(16) :: stmp
    if (associated(arg)) then
       if (present(separator)) then
          str = num2str_int_array(arg,separator)
       else
          str = num2str_int_array(arg)
       end if
    else
       str = ""
    end if
  end function pointer2str_int_array

  function pointer2str_real_array(arg,separator) result(str)
    real(c_double), pointer, intent(in) :: arg(:)
    character(*), intent(in), optional :: separator
    character(:), allocatable :: str
    if (associated(arg)) then
       if (present(separator)) then
          str = num2str_real_array(arg,separator)
       else
          str = num2str_real_array(arg)
       end if
    else
       str = ""
    end if
  end function pointer2str_real_array

  function pointer2str_real_2darray(arg,separator) result(str)
    real(c_double), pointer, intent(in) :: arg(:,:)
    character(*), intent(in), optional :: separator
    character(:), allocatable :: str
    integer :: ind
    str = ""
    if (associated(arg)) then
       do ind=1,size(arg,2)
          if (present(separator)) then
             if (ind==1) then
                str = num2str_real_array(arg(:,ind),separator)
             else
                str = str//separator//num2str_real_array(arg(:,ind),separator)
             end if
          else
             str = str//num2str_real_array(arg(:,ind))
          end if
       end do
    end if
  end function pointer2str_real_2darray


  subroutine string_to_char132pointer(in,out)
    character(*), intent(in) :: in
    character(132), pointer, intent(out) :: out(:)

    ! Internal
    integer :: nout, jout, jcount, jend

    nout = ceiling( real(len(in)) / real(132) )
    allocate(out(nout))
    jcount = 0
    do jout=1,nout
       jend = min( jcount+132 , len(in) )
       out(jout) = in(jcount+1:jend)
    end do
  end subroutine string_to_char132pointer


  subroutine char132pointer_to_string(out,in,linebreak)
    character(*),            intent(out) :: out
    character(132), pointer, intent(in)  :: in(:)
    character(*),            intent(in)  :: linebreak

    ! Internal
    integer :: count, step
    integer :: j

    out=''
    if (.not. associated(in)) return

    count = 0
    loop_lines: do j=1,size(in)
        if (count < len(out)) then
            step = len(trim(in(j))) + len(linebreak)
            if (count + step < len(out)) then
                out(count+1:count+step) = trim(in(j)) // linebreak
                count = count + step
            elseif (count + len(trim(in(j))) + 3 < len(out)) then
                step = len(trim(in(j)) // '...')
                out(count+1:count+step) = trim(in(j)) // '...'
                exit loop_lines
            else
                step = len(out) - count
                out(count+1:count+step) = in(j)(1:step-3) // '...'
                exit loop_lines
            end if
        end if
    end do loop_lines
  end subroutine char132pointer_to_string

  subroutine append_string_to_string(outString,valueString,separator)
    character(*), intent(inout) :: outstring
    character(*), intent(in)    :: valuestring
    character(*), intent(in)    :: separator
    character(:), allocatable   :: tmp
    integer :: string_len

    string_len = len( trim(outstring)//separator//trim(valuestring) )
    allocate(character(string_len) :: tmp)
    tmp = trim(outstring)//separator//trim(valuestring)
    if (len(tmp) > len(outstring)) then
        outstring = tmp(1:len(outstring))
    else
        outstring = tmp
    end if
    deallocate(tmp)
  end subroutine append_string_to_string


  recursive subroutine append_to_char132pointer(outString,valueString)
    character(*),            intent(in)    :: valuestring
    character(132), pointer, intent(inout) :: outstring(:)

    ! Internal
    character(132), pointer                :: tmpstring(:)
    integer                                :: count
    integer                                :: step

    if (len(valuestring) > 132) then
        count = 0
        do while (count < len(valuestring))
            step = min(132 , len(valuestring)-count)
            call append_to_char132pointer(outstring, valuestring(count+1:count+step))
            count = count + step
        end do
        return
    end if

    if (associated(outstring)) then
        ! Resize outString
        allocate(tmpstring(size(outstring)))
        tmpstring = outstring
        deallocate(outstring)
        allocate(outstring(size(tmpstring)+1))
        outstring(1:size(tmpstring)) = tmpstring(:)
        deallocate(tmpstring)
    else
        allocate(outstring(1))
    end if

    ! Add valueString to outString
    outstring(size(outstring)) = valuestring
  end subroutine append_to_char132pointer


  recursive subroutine append_to_char_pointer(out,val)
    character(*),          intent(in)    :: val
    character(:), pointer, intent(inout) :: out

    ! Internal
    character(:), pointer                :: tmp

    nullify(tmp)
    if (associated(out)) then
        allocate(character( len(out) ) :: tmp)
        tmp = out
        deallocate(out)
        allocate(character( len(tmp) + len(val) )  :: out)
        out = tmp // val
        deallocate(tmp)
    else
        allocate(character( len(val) )  :: out)
        out = val
    end if
  end subroutine append_to_char_pointer

end module stringtools