TABLE OF CONTENTS

ABINIT/m_fstrings [ Modules ]

[ Top ] [ Modules ]

NAME

  m_fstrings

FUNCTION

  This module contains basic tools to operate on Fortran strings.

COPYRIGHT

 Copyright (C) 2008-2024 ABINIT group (MG, XG, MT, DC)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .

SOURCE

 16 #if defined HAVE_CONFIG_H
 17 #include "config.h"
 18 #endif
 19 
 20 #include "abi_common.h"
 21 
 22 MODULE m_fstrings
 23 
 24  use, intrinsic :: iso_c_binding
 25 
 26  use defs_basis, only : dp, std_out, ch10
 27 
 28  implicit none
 29 
 30  private
 31 
 32  public :: is_letter       ! Returns .TRUE. if ch is a letter and .FALSE. otherwise
 33  public :: is_digit        ! Returns .TRUE. if ch is a digit (0,1,...,9) and .FALSE. otherwise
 34  public :: find_digit      ! Returns the position of the first digit in string. 0 if not found.
 35  public :: upper           ! Convert lower case letters to UPPER CASE
 36  public :: toupper         ! Convert lower case letters to UPPER CASE (function version)
 37  public :: lower           ! Convert UPPER CASE letters to lower case
 38  public :: tolower         ! Convert UPPER CASE letters to lower case  (function version)
 39  public :: removesp        ! Removes spaces, tabs, and control characters in string str
 40  public :: replace_ch0     ! Replace final '\0' with whitespaces
 41  public :: lstrip          ! Remove leading spaces from string
 42  public :: replace         ! Replace chars in string.
 43  public :: ljust           ! Return a left-justified string of length width.
 44  public :: lpad            ! Pad a string adding repeat characters fillchar on the left side.
 45  public :: round_brackets  ! Return a new string enclosed in parentheses if not already present.
 46  public :: quote           ! Return a new string enclosed by quotation marks.
 47  public :: rmquotes        ! Remove quotation marks from a string. Return new string
 48  public :: write_num       ! Writes a number to a string using format fmt
 49  public :: trimzero        ! Deletes nonsignificant trailing zeroes from a number string.
 50  public :: writeq          ! Writes a string of the form <name> = value to unit
 51  public :: strcat          ! Concatenate strings (function version)
 52  public :: sjoin           ! Joins strings with a space separator.
 53  public :: yesno           ! Convert boolean to "yes", "no"
 54  public :: itoa            ! Convert an integer into a string
 55  public :: ftoa            ! Convert a float into a string
 56  public :: ktoa            ! Convert a k-point into a string.
 57  public :: stoa            ! Convert a spin index into a string
 58  public :: ltoa            ! Convert a list into a string.
 59  public :: atoi            ! Convert a string into a integer
 60  public :: atof            ! Convert a string into a floating-point number.
 61  public :: basename        ! Returns the final component of a pathname.
 62  public :: firstchar       ! Returns .TRUE. is the first character in a string belongs to a gives set.
 63  public :: startswith      ! Returns .TRUE. is the string starts with the specified prefix.
 64  public :: endswith        ! Returns .True if the string ends with the specified suffix.
 65  public :: indent          ! Indent text
 66  public :: string_in       ! Compare input str with a list of comma-separated strings
 67  public :: prep_char       ! Prepend `char` to each line in a string.
 68  public :: int2char4       ! Convert a positive integer number (zero included) to a character(len=*)
 69                            ! with trailing zeros if the number is <=9999
 70  public :: int2char10      ! Convert a positive integer number (zero included) to a character(len=10)
 71                            ! with trailing blanks
 72  public :: char_count      ! Count the occurrences of a character in a string.
 73  public :: next_token      ! Tokenize a string made of whitespace-separated tokens.
 74  public :: inupper         ! Maps all characters in string to uppercase except for tokens between quotation marks.
 75  public :: find_and_select ! Find substring and select value in list depending on substring
 76 
 77  !TODO method to center a string
 78  interface itoa
 79    module procedure itoa_1b
 80    module procedure itoa_4b
 81  end interface itoa
 82 
 83  interface write_num
 84    module procedure write_rdp_0D
 85    module procedure write_int_0D
 86  end interface write_num
 87 
 88  interface writeq
 89    module procedure writeq_rdp_0D
 90    module procedure writeq_int_0D
 91  end interface writeq
 92 
 93  interface is_digit
 94    module procedure is_digit_0D
 95  end interface is_digit
 96 
 97  interface firstchar
 98    module procedure firstchar_0d
 99    module procedure firstchar_1d
100  end interface firstchar
101 
102  interface sjoin
103    module procedure sjoin_2
104    module procedure sjoin_3
105    module procedure sjoin_4
106    module procedure sjoin_5
107    module procedure sjoin_6
108    module procedure sjoin_7
109  end interface sjoin
110 
111  interface strcat
112    module procedure strcat_2
113    module procedure strcat_3
114    module procedure strcat_4
115    module procedure strcat_5
116  end interface strcat
117 
118  interface ltoa
119    module procedure ltoa_int
120    module procedure ltoa_dp
121  end interface ltoa
122 
123  character(len=1),parameter :: BLANK=' '
124  character(len=1),parameter :: NCHAR = char(10)
125  character(len=1),parameter :: DIR_SEPARATOR = '/'
126 
127  integer,parameter :: ASCII_A=ICHAR('A')
128  integer,parameter :: ASCII_Z=ICHAR('Z')
129  integer,parameter :: ASCII_aa=ICHAR('a')
130  integer,parameter :: ASCII_zz=ICHAR('z')
131  integer,parameter :: SHIFT=ASCII_aa-ASCII_A ! Capital letters have smaller Dec value in the ASCII table.
132  integer,parameter :: ASCII_0=ICHAR('0')
133  integer,parameter :: ASCII_9=ICHAR('9')
134 
135  integer,parameter :: MAX_SLEN = 500
136 
137 
138 CONTAINS  !===========================================================

m_fstring/basename [ Functions ]

[ Top ] [ Functions ]

NAME

 basename

FUNCTION

  Returns the final component of a pathname.

INPUTS

  string=The input string

NOTES

  * If the input string in not a valid path to a file (i.e not in the form foo/name)
    a blank strink is returned
  * We do a backward search becase we want to optimize the algorithm for Fortran strings.

SOURCE

1402 pure function basename(string)
1403 
1404  character(len=*),intent(in) :: string
1405  character(len=LEN_TRIM(string)) :: basename
1406 
1407 !Local variables-------------------------------
1408  integer :: ic,nch_trim,nch
1409 !************************************************************************
1410 
1411  nch     =LEN     (string)
1412  nch_trim=LEN_TRIM(string)
1413 
1414  ic = INDEX (TRIM(string), DIR_SEPARATOR, back=.TRUE.)
1415  !write(*,*)'DEBUG ',TRIM(string),ic
1416 
1417  if (ic >= 1 .and. ic <= nch_trim-1) then ! there is stuff after the separator.
1418   basename = string(ic+1:nch_trim)
1419   return
1420  else if (ic==0 .or. ic == nch_trim+1) then ! no separator in string or zero length string,
1421   basename = TRIM(string)                   ! return trimmed string.
1422   return
1423  else              ! (ic == nch_trim) separator is the last char.
1424   basename= BLANK  ! This is not a valid path to a file, return blank.
1425   return
1426  end if
1427 
1428 end function basename

m_fstring/endswith [ Functions ]

[ Top ] [ Functions ]

NAME

 endswith

FUNCTION

  Returns .TRUE. is the string ends with the specified suffix

SOURCE

1562 pure function endswith(string, suffix) result(ans)
1563 
1564  logical :: ans
1565  character(len=*),intent(in) :: string
1566  character(len=*),intent(in) :: suffix
1567 
1568 !Local variables-------------------------------
1569  integer :: ii,p,lenstr,lensuf
1570 !************************************************************************
1571 
1572  ans = .False.
1573  lenstr = len_trim(string); lensuf = len_trim(suffix)
1574  if (lensuf > lenstr) return
1575 
1576  do ii=1,lensuf
1577    p = lenstr - lensuf + ii
1578    if (suffix(ii:ii) /= string(p:p)) return
1579  end do
1580  ans = .True.
1581 
1582 end function endswith

m_fstring/firstchar_0d [ Functions ]

[ Top ] [ Functions ]

NAME

 firstchar_0d

FUNCTION

   Return True if string starts with the specified character

INPUTS

  string=The string whose first character has to be cheched
  ch=Character
  [csens]=.TRUE. if comparison is done regardless of case. Defaults to .FALSE.

SOURCE

1448 pure function firstchar_0d(string,ch,csens) result(ans)
1449 
1450  logical :: ans
1451  logical,optional,intent(in) :: csens
1452  character(len=*),intent(in) :: string
1453  character(len=1),intent(in) :: ch
1454 
1455 !Local variables-------------------------------
1456  logical :: my_csens
1457 !************************************************************************
1458 
1459  my_csens=.FALSE.; if (PRESENT(csens)) my_csens = csens
1460 
1461  if (.not.my_csens) then
1462    ans = ( string(1:1) == ch)
1463  else
1464    ans = ( toupper(string(1:1)) == toupper(ch))
1465  end if
1466 
1467 end function firstchar_0d

m_fstring/firstchar_1d [ Functions ]

[ Top ] [ Functions ]

NAME

 firstchar_1d

FUNCTION

  Returns .TRUE. is the first character of the string belongs to a given list.

INPUTS

  string=The string whose first character has to be cheched
  char_list=The list of characters.
  [csens]=.TRUE. if comparison is done regardless of case. Defaults to .FALSE.

SOURCE

1487 pure function firstchar_1d(string,char_list,csens) result(ans)
1488 
1489  logical :: ans
1490  logical,optional,intent(in) :: csens
1491  character(len=*),intent(in) :: string
1492  character(len=1),intent(in) :: char_list(:)
1493 
1494 !Local variables-------------------------------
1495  integer :: ii
1496  logical :: my_csens
1497  character(len=1) :: first_ch
1498 !************************************************************************
1499 
1500  my_csens=.FALSE.; if (PRESENT(csens)) my_csens = csens
1501 
1502  first_ch = string(1:1)
1503 
1504  ans=.FALSE.
1505 
1506  if (.not.my_csens) then
1507    do ii=1,SIZE(char_list)
1508      ans = ( first_ch == char_list(ii) ); if (ans) EXIT
1509    end do
1510  else
1511    do ii=1,SIZE(char_list)
1512      ans = ( toupper(first_ch) == toupper(char_list(ii)) ); if (ans) EXIT
1513    end do
1514  end if
1515 
1516 end function firstchar_1d

m_fstring/startswith [ Functions ]

[ Top ] [ Functions ]

NAME

 startswith

FUNCTION

  Returns .TRUE. is the string starts with the specified prefix.

SOURCE

1530 pure logical function startswith(string, prefix) result(ans)
1531 
1532  character(len=*),intent(in) :: string
1533  character(len=*),intent(in) :: prefix
1534 
1535 !Local variables-------------------------------
1536  integer :: ii,lenstr,lenpre
1537 !************************************************************************
1538 
1539  ans = .False.
1540  lenstr = len_trim(string); lenpre = len_trim(prefix)
1541  if (lenpre > lenstr) return
1542 
1543  do ii=1,lenpre
1544    if (prefix(ii:ii) /= string(ii:ii)) return
1545  end do
1546  ans = .True.
1547 
1548 end function startswith

m_fstrings/atof [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 atof

FUNCTION

  Convert a string into a floating-point number

m_fstrings/atoi [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 atoi

FUNCTION

  Convert a string into a integer

m_fstrings/char_count [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 chcount

FUNCTION

   Count the occurrences of a character in a string.

SOURCE

1858 integer pure function char_count(string, char)
1859 
1860 !Arguments ------------------------------------
1861 !scalars
1862  character(len=*),intent(in) :: string
1863  character(len=1),intent(in) :: char
1864  integer :: i
1865 
1866 ! *************************************************************************
1867 
1868  char_count = 0
1869  do i=1,len(string)
1870    if (string(i:i) == char) char_count = char_count + 1
1871  end do
1872 
1873 end function char_count

m_fstrings/find_and_select [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  find_and_select

FUNCTION

 Find substring and select value in list depending on substring.

 Usage example:

   istop = find_and_select(arg, &
                           ["K", "M", "G", "T"], &
                           [one/1024._dp, one, 1024._dp, 1024._dp ** 2], fact, err_msg, default=one)

   ABI_CHECK(istop /= -1, err_msg)

SOURCE

2031 integer function find_and_select(string, choices, values, out_val, err_msg, default, back) result(iend)
2032 
2033 !Arguments ------------------------------------
2034  character(len=*),intent(in) :: string
2035  character(len=*),intent(in) :: choices(:)
2036  real(dp),intent(in) :: values(:)
2037  real(dp),optional,intent(in) :: default
2038  real(dp),intent(out) :: out_val
2039  character(len=*),intent(out) :: err_msg
2040  logical,optional,intent(in) :: back
2041 
2042 !Local variables-------------------------------
2043  integer :: ic
2044  logical :: back__
2045 ! *************************************************************************
2046 
2047  if (size(values) /= size(choices)) then
2048    err_msg = "BUG in API call: size(values) /= size(choices))"
2049    iend = -1; return
2050  end if
2051 
2052  back__ = .True.; if (present(back)) back__ = back
2053  do ic=1,size(choices)
2054    iend = index(string, trim(choices(ic)), back=back__)
2055    if (iend /= 0) then
2056      if (trim(string(iend:)) /= choices(ic)) then
2057        err_msg = sjoin("Invalid token:", trim(string(iend:)))
2058        iend = -1; return
2059      end if
2060      out_val = values(ic); return
2061    end if
2062  end do
2063 
2064  if (present(default)) then
2065    iend = 0
2066    out_val = default
2067  else
2068    iend = -1
2069    err_msg = "Cannot find `choices` in string and `default` optional argument is not set!"
2070  end if
2071 
2072 end function find_and_select

m_fstrings/find_digit [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  find_digit

FUNCTION

  Returns the position of the first digit in string. 0 if not found.

SOURCE

201 integer pure function find_digit(string) result(ii)
202 
203 !Arguments ------------------------------------
204  character(len=*),intent(in) :: string
205 
206 ! *********************************************************************
207 
208  do ii=1,len_trim(string)
209    if (is_digit(string(ii:ii))) return
210  end do
211  ii = 0
212 
213 end function find_digit

m_fstrings/ftoa [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 ftoa

FUNCTION

  Convert an float into a string using format fmt  (es16.6 if fmt is not given).

m_fstrings/indent [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  indent

FUNCTION

  Indent text

INPUTS

   istr=Input string

PARENTS

CHILDREN

SOURCE

1601 pure function indent(istr) result(ostr)
1602 
1603  character(len=*),intent(in) :: istr
1604  character(len=len(istr)*4+4) :: ostr
1605 
1606 !Local variables-------------------------------
1607  integer,parameter :: n=4 ! ostr is large enough to allocate all the possible indentations.
1608  integer :: ii,jj,kk
1609  character(len=1) :: ch
1610 
1611 ! *********************************************************************
1612 
1613  ostr = " "
1614  jj = n
1615  do ii=1,LEN_TRIM(istr)
1616    ch = istr(ii:ii)
1617    jj = jj + 1
1618    if (ch == NCHAR) then
1619       ostr(jj:jj) = NCHAR
1620       do kk=jj+1,jj+n
1621         ostr(kk:kk) = " "
1622       end do
1623       jj = jj+n
1624    else
1625      ostr(jj:jj) = ch
1626    end if
1627  end do
1628  !ostr(jj+1:) = "H"
1629 
1630 end function indent

m_fstrings/int2char10 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 int2char10

FUNCTION

 Convert a positive integer number (zero included) to a character(len=10),
 with blanks to COMPLETE the string.
 Exemple : 1234 will be mapped to "1234      "
 Makes sure that the integer is between 0 and 9 999 999 999
 Should be enough for integer*4

INPUTS

  iint=integer to be converted

OUTPUT

  string=character string ('##########' if error)

SOURCE

1808 pure subroutine int2char10(iint,string)
1809 
1810 !Arguments ------------------------------------
1811 !scalars
1812  integer,intent(in) :: iint
1813  character(len=10),intent(out) :: string
1814 
1815 ! *************************************************************************
1816 
1817 !Note the use of floating numbers instead of large integers, for portability
1818  if(iint<0 .or. iint>=1.d10)then
1819    string='####'
1820    return
1821  end if
1822  if(iint<10)then
1823    write(string,'(i1,9x)')iint
1824  else if(iint<100)then
1825    write(string,'(i2,8x)')iint
1826  else if(iint<1.0d3)then
1827    write(string,'(i3,7x)')iint
1828  else if(iint<1.0d4)then
1829    write(string,'(i4,6x)')iint
1830  else if(iint<1.0d5)then
1831    write(string,'(i5,5x)')iint
1832  else if(iint<1.0d6)then
1833    write(string,'(i6,4x)')iint
1834  else if(iint<1.0d7)then
1835    write(string,'(i7,3x)')iint
1836  else if(iint<1.0d8)then
1837    write(string,'(i8,2x)')iint
1838  else if(iint<1.0d9)then
1839    write(string,'(i9,1x)')iint
1840  else
1841    write(string,'(i10)')iint
1842  end if
1843 
1844 end subroutine int2char10

m_fstrings/int2char4 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 int2char4

FUNCTION

 Convert an integer number to ("2") a character(len=*)
 with trailing zeros if the number is <=9999.
 Exemple : 123 will be mapped to "0123" ; 12345 will be mapped to "12345"
 Makes sure that the integer fits the string length
 (ex.: between 0 and 99999 if the string is a character(len=5)).

INPUTS

  iint=integer to be converted

OUTPUT

  string=character string ('####...' if error)

SOURCE

1743 pure subroutine int2char4(iint,string)
1744 
1745 !Arguments ------------------------------------
1746 !scalars
1747  integer,intent(in) :: iint
1748  character(len=*),intent(out) :: string
1749 
1750 !Local variables-------------------------------
1751  integer :: lenstr
1752 
1753 ! *************************************************************************
1754 
1755  lenstr=min(len(string),25)
1756  if(iint<0 .or. iint>10._dp**(lenstr-1))then
1757    string=repeat('#',lenstr)
1758    return
1759  end if
1760  if(iint<10)then
1761    write(string,'("000",i1)')iint
1762  else if(iint<100)then
1763    write(string,'("00",i2)')iint
1764  else if(iint<1000)then
1765    write(string,'("0",i3)')iint
1766  else if(iint<10000)then
1767    write(string,'(i4)')iint
1768  else if(iint<1.0d5)then
1769    write(string,'(i5)')iint
1770  else if(iint<1.0d6)then
1771    write(string,'(i6)')iint
1772  else if(iint<1.0d7)then
1773    write(string,'(i7)')iint
1774  else if(iint<1.0d8)then
1775    write(string,'(i8)')iint
1776  else if(iint<1.0d9)then
1777    write(string,'(i9)')iint
1778  else if(iint<1.0d9)then
1779    write(string,'(i10)')iint
1780  else
1781    string=repeat('#',lenstr)
1782  end if
1783 
1784 end subroutine int2char4

m_fstrings/inupper [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 inupper

FUNCTION

 Maps all characters in string to uppercase except for tokens between quotation marks.
 Uses fortran90 character string manipulation but should work
 independent of EBCDIC or ASCII assumptions--only relies on
 'index' intrinsic character string matching function.
 Makes sure that the string 'lolett' remains defined as the lower
 case 26-character alphabet string and 'uplett' remains upper case.

INPUTS

  string= character string with arbitrary case

OUTPUT

  string= same character string mapped to upper case

SIDE EFFECTS

  string= (input) character string with arbitrary case
          (output) same character string mapped to upper case

SOURCE

1956 subroutine inupper(string)
1957 
1958 !Arguments ------------------------------------
1959 !scalars
1960  character(len=*),intent(inout) :: string
1961 
1962 !Local variables-------------------------------
1963 !scalars
1964  integer :: ii,indx,inquotes
1965  logical,save :: first=.true.
1966  character(len=1) :: cc
1967  !character(len=500) :: message
1968  character(len=26), parameter :: uplett='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
1969  character(len=26), parameter :: lolett='abcdefghijklmnopqrstuvwxyz'
1970 
1971 ! *************************************************************************
1972 !
1973 !On first entry make sure lower case letters stayed
1974 !lower case and upper case letters stayed upper case
1975  if (first) then
1976    do ii=1,26
1977      ! Look for occurrence of each upper case character
1978      ! anywhere in string of all lower case letters
1979      indx=index(lolett,uplett(ii:ii))
1980      ! If found then print error message and quit
1981      if (indx>0) then
1982        write(std_out, '(a,a,a,a,a,a,a,a,a)' )&
1983         'Upper case string = ',uplett,ch10,&
1984         'Lower case string = ',lolett,ch10,&
1985         'Upper case character ',uplett(ii:ii),'found in supposedly lower case string.'
1986        stop
1987      end if
1988    end do
1989    first=.false.
1990  end if
1991 
1992  inquotes = 0
1993  do ii=1,len_trim(string)
1994    !  Pick off single character of string (one byte):
1995    cc=string(ii:ii)
1996 
1997    ! Ignore tokens between quotation marks.
1998    if (cc == "'" .or. cc == '"') inquotes = inquotes + 1
1999    if (inquotes == 1) cycle
2000    if (inquotes == 2) then
2001      inquotes = 0; cycle
2002    end if
2003    ! determine whether a lowercase letter:
2004    indx=index(lolett,cc)
2005    ! Map to uppercase:
2006    if (indx>0) string(ii:ii)=uplett(indx:indx)
2007  end do
2008 
2009 end subroutine inupper

m_fstrings/is_digit_0D [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  is_digit_0D

FUNCTION

  Returns .TRUE. if ch is a digit (0,1,...,9) and .FALSE. otherwise.

SOURCE

175 pure function is_digit_0D(ch) result(ans)
176 
177 !Arguments ------------------------------------
178  character(len=1),intent(in) :: ch
179  logical :: ans
180 ! *********************************************************************
181 
182  select case (ICHAR(ch))
183  case(ASCII_0:ASCII_9)
184    ans=.TRUE.
185  case default
186    ans=.FALSE.
187  end select
188 
189 end function is_digit_0D

m_fstrings/is_letter [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  is_letter

FUNCTION

  Returns .TRUE. if ch is a letter and .FALSE. otherwise.

SOURCE

150 pure function is_letter(ch) result(ans)
151 
152  character(len=1),intent(in) :: ch
153  logical :: ans
154 ! *********************************************************************
155 
156  select case (ICHAR(ch))
157  case (ASCII_A:ASCII_Z,ASCII_aa:ASCII_zz)
158    ans=.TRUE.
159  case DEFAULT
160    ans=.FALSE.
161  end select
162 
163 end function is_letter

m_fstrings/itoa_1b [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 itoa_1b

FUNCTION

  Convert an integer into a string

m_fstrings/itoa_4b [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 itoa_4b

FUNCTION

  Convert an integer into a string

m_fstrings/ktoa [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 ktoa

FUNCTION

  Convert an k-point into a string using format fmt  (es.16.6 if fmt is not given).

m_fstrings/ljust [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  ljust

FUNCTION

  Return S left-justified in a string of length width. Padding is
  done using the specified fill character (default is a space).

SOURCE

486 pure function ljust(istr, width, fillchar) result(ostr)
487 
488  character(len=*),intent(in) :: istr
489  integer,intent(in) :: width
490  character(len=width) :: ostr
491  character(len=1),optional,intent(in) :: fillchar
492 
493 !Local variables-------------------------------
494  integer :: ii
495 ! *********************************************************************
496 
497  ostr = ADJUSTL(istr)
498 
499  if (PRESENT(fillchar)) then
500    do ii=LEN_TRIM(ostr)+1,width
501      ostr(ii:ii) = fillchar
502    end do
503  end if
504 
505 end function ljust

m_fstrings/lower [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  lower

FUNCTION

  Convert UPPER CASE letters to lower case.

SOURCE

284 pure subroutine lower(str)
285 
286  character(len=*),intent(inout) :: str
287 
288 !Local variables-------------------------------
289  integer :: ic,iasc
290 ! *********************************************************************
291 
292  do ic=1,LEN_TRIM(str)
293    iasc=IACHAR(str(ic:ic))
294    if (iasc>=ASCII_A.and.iasc<=ASCII_Z) str(ic:ic)=ACHAR(iasc+SHIFT)
295  end do
296 
297 end subroutine lower

m_fstrings/lpad [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  lpad

FUNCTION

  Pad a string adding repeat characters fillchar on the left side.
  Padding is done using the specified fill character (default is a blanck character).

INPUTS

OUTPUT

SOURCE

524 pure function lpad(istr, repeat, fillchar) result(ostr)
525 
526  character(len=*),intent(in) :: istr
527  integer,intent(in) :: repeat
528  character(len=LEN_TRIM(istr) + repeat) :: ostr
529  character(len=1),optional,intent(in) :: fillchar
530 
531 !Local variables-------------------------------
532  integer :: ii
533  character(len=1) :: ch
534 ! *********************************************************************
535 
536  ostr(repeat+1:) = TRIM(istr)
537 
538  ch = " "; if (PRESENT(fillchar)) ch = fillchar
539  do ii=1,repeat
540    ostr(ii:ii) = ch
541  end do
542 
543 end function lpad

m_fstrings/lstrip [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  lstrip

FUNCTION

  Removes leading spaces from the input string.

SOURCE

451 pure function lstrip(istr) result(ostr)
452 
453  character(len=*),intent(in) :: istr
454  character(len=len(istr)) :: ostr
455 
456 !Local variables-------------------------------
457  integer :: ii,jj,lg
458 ! *********************************************************************
459 
460  lg=LEN(istr)
461  do ii=1,lg
462    if (istr(ii:ii)/=BLANK) EXIT
463  end do
464 
465  ostr = " "
466  do jj=1,lg-ii+1
467    ostr(jj:jj) = istr(ii:ii)
468    ii=ii+1
469  end do
470 
471 end function lstrip

m_fstrings/ltoa_dp [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 ltoa_dp

FUNCTION

  Convert a list of double precision numbers into a string.
  fmt specifies the format to be used ("es13.4" by default)

CHILDREN

m_fstrings/ltoa_int [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 ltoa_int

FUNCTION

  Convert a list of integers into a string.

CHILDREN

m_fstrings/next_token [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 next_token

FUNCTION

  Assume a string with whitespace-separated tokens.
  Find the next token starting from `start`, return it in `ostr` and update `start`
  so that one can call the function inside a loop.
  Return exit status.

SOURCE

1890 integer function next_token(string, start, ostr) result(ierr)
1891 
1892 !Arguments ------------------------------------
1893 !scalars
1894  character(len=*),intent(in) :: string
1895  character(len=*),intent(out) :: ostr
1896  integer,intent(inout) :: start
1897 
1898 !Local variables-------------------------------
1899  integer :: ii,beg
1900 
1901 ! *************************************************************************
1902  !print *, "string:", trim(string(start:)), ", start:", start
1903 
1904  ierr = 1; beg = 0
1905  ! Find first non-empty char.
1906  do ii=start,len_trim(string)
1907    if (string(ii:ii) /= " ") then
1908      beg = ii; exit
1909    end if
1910  end do
1911  if (beg == 0) return
1912 
1913  ! Find end of token.
1914  start = 0
1915  do ii=beg,len_trim(string)
1916    if (string(ii:ii) == " ") then
1917      start = ii; exit
1918    end if
1919  end do
1920  ! Handle end of string.
1921  if (start == 0) start = len_trim(string) + 1
1922 
1923  ierr = 0
1924  !print *, "string(beg:):", trim(string(beg:))
1925  ostr = string(beg:start-1)
1926 
1927 end function next_token

m_fstrings/prep_char [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  prep_char

FUNCTION

  Prepend `char` to each line in a string.

INPUTS

   istr=Input string

SOURCE

1691 pure function prep_char(istr, one_char) result(ostr)
1692 
1693  character(len=*),intent(in) :: istr
1694  character(len=2*len(istr)) :: ostr
1695  character(len=1),intent(in) :: one_char
1696 
1697 !Local variables-------------------------------
1698  integer :: ii,jj
1699  character(len=1) :: ch
1700 
1701 ! *********************************************************************
1702  ostr = ""
1703  jj = 1; ostr(jj:jj) = one_char
1704  !jj = 0
1705 
1706  do ii=1,LEN_TRIM(istr)
1707    ch = istr(ii:ii)
1708    jj = jj + 1
1709    if (ch == ch10) then
1710       ostr(jj:jj) = ch10
1711       ostr(jj+1:jj+1) = one_char
1712       jj = jj+1
1713    else
1714      ostr(jj:jj) = ch
1715    end if
1716  end do
1717  !ostr(jj+1:) = "H"
1718 
1719 end function prep_char

m_fstrings/quote [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  quote

FUNCTION

  Return a new string enclosed by quotation marks.

SOURCE

605 pure function quote(istr) result(ostr)
606 
607  character(len=*),intent(in) :: istr
608  character(len=LEN_TRIM(istr)+2) :: ostr
609 
610 !Local variables-------------------------------
611  integer :: ii
612  character(len=1) :: qq
613  character(len=LEN(istr)+2) :: tmp
614 
615 ! *********************************************************************
616 
617  do ii=1,LEN(istr)
618    if (istr(ii:ii)/=BLANK) EXIT
619  end do
620 
621  qq = istr(ii:ii)
622 
623  if (qq == "'" .or. qq == '"') then
624    ! Don't add quotation marks if they already present.
625    tmp = istr
626    ii = LEN_TRIM(tmp)
627    ! If the string is not closed, fix it.
628    if (tmp(ii:ii) /= qq) tmp(ii+1:ii+1) = qq
629    ostr = TRIM(tmp)
630 
631  else
632    qq = '"'
633    ostr(1:1) = qq
634    ostr(2:) = TRIM(istr)
635    ii = LEN_TRIM(ostr)+1
636    ostr(ii:ii) = qq
637  end if
638 
639 end function quote

m_fstrings/removesp [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  removesp

FUNCTION

  Removes spaces, tabs, and control characters in string str.

INPUTS

OUTPUT

SOURCE

347 subroutine removesp(str)
348 
349  character(len=*),intent(inout) :: str
350 
351 !Local variables-------------------------------
352  integer :: i,k,lenstr,ich
353  character(len=1):: ch
354  character(len=LEN_TRIM(str)):: outstr
355 ! *********************************************************************
356 
357  str=ADJUSTL(str) ; lenstr=LEN_TRIM(str)
358 
359  outstr=BLANK ; k=0
360  do i=1,lenstr
361    ch=str(i:i)
362    ich=IACHAR(ch)
363    select case(ich)
364    case(0:32)  ! space, tab, or control character
365      CYCLE
366    case(33:)
367      k=k+1
368      outstr(k:k)=ch
369    end select
370  end do
371 
372  str=ADJUSTL(outstr)
373 
374 end subroutine removesp

m_fstrings/replace [ Modules ]

[ Top ] [ m_fstrings ] [ Modules ]

NAME

  replace

FUNCTION

  Replace `text` with `rep` in string `s`. Return new string.

 NOTES:
  The length of the output string is increased by 500 but this could not be enough
  if len_trim(text) > len_trim(re) and there are several occurrences of `text` in s.

SOURCE

417 function replace(s, text, rep) result(outs)
418 
419  character(len=*),intent(in) :: s, text, rep
420  character(len(s)+500) :: outs     ! provide outs with extra 500 char len
421 
422 !Local variables-------------------------------
423  integer :: i, j, nt, nr, last
424 ! *********************************************************************
425 
426  outs = s; nt = len_trim(text); nr = len_trim(rep); last = 1
427  do
428    i = index(outs(last:), text(1:nt)); if (i == 0) exit
429    j = last + i - 1; last = j + nr
430    if (j - 1 < 1) then
431      outs = rep(:nr) // outs(j+nt:)
432    else
433      outs = outs(:j-1) // rep(:nr) // outs(j+nt:)
434    end if
435  end do
436 
437 end function replace

m_fstrings/replace_ch0 [ Modules ]

[ Top ] [ m_fstrings ] [ Modules ]

NAME

  replace_ch0

FUNCTION

  Little tool to change all final '\0' (end of string in C) characters to ' ' (space).

SIDE EFFECTS

  * string = the string to convert. It is done in-place.

SOURCE

389 elemental subroutine replace_ch0(string)
390 
391   character(len=*), intent(inout) :: string
392 
393   integer :: i, l
394 
395   i = index(string, char(0))
396   if (i > 0) then
397      l = len(string)
398      string(i:l) = repeat(" ", l - i + 1)
399   end if
400 
401 end subroutine replace_ch0

m_fstrings/rmquotes [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  rmquotes

FUNCTION

  Remove quotation marks from a string. Return new string

SOURCE

653 pure function rmquotes(istr) result(ostr)
654 
655  character(len=*),intent(in) :: istr
656  character(len=len(istr)) :: ostr
657 
658 !Local variables-------------------------------
659  integer :: ii,cnt
660 
661 ! *********************************************************************
662 
663  ostr = ""; cnt = 0
664  do ii=1,len_trim(istr)
665    if (any(istr(ii:ii) == ["'", '"'])) cycle
666    cnt = cnt + 1
667    ostr(cnt:cnt) = istr(ii:ii)
668  end do
669 
670 end function rmquotes

m_fstrings/round_brackets [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  round_brackets

FUNCTION

  Return a new string enclosed in parentheses if not already present.

SOURCE

557 pure function round_brackets(istr) result(ostr)
558 
559  character(len=*),intent(in) :: istr
560  character(len=LEN_TRIM(istr)+2) :: ostr
561 
562 !Local variables-------------------------------
563  integer :: ii
564  character(len=1) :: qq
565  character(len=LEN(istr)+2) :: tmp
566 
567 ! *********************************************************************
568 
569  do ii=1,LEN(istr)
570    if (istr(ii:ii)/=BLANK) EXIT
571  end do
572 
573  qq = istr(ii:ii)
574 
575  if (qq == "(") then
576    ! Don't add quotation marks if they already present.
577    tmp = istr
578    ii = LEN_TRIM(tmp)
579    ! If the string is not closed, fix it.
580    if (tmp(ii:ii) /= ")") tmp(ii+1:ii+1) = ")"
581    ostr = TRIM(tmp)
582 
583  else
584    qq = '('
585    ostr(1:1) = qq
586    ostr(2:) = TRIM(istr)
587    ii = LEN_TRIM(ostr)+1
588    ostr(ii:ii) = ")"
589  end if
590 
591 end function round_brackets

m_fstrings/sjoin_2 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 sjoin_2

FUNCTION

  Joins two strings with a space separator except if first string is empty.

m_fstrings/sjoin_3 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 sjoin_3

FUNCTION

  Joins three strings with a space separator.

m_fstrings/sjoin_4 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 sjoin_4

FUNCTION

  Joins four strings with a space separator.

m_fstrings/sjoin_5 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 sjoin_5

FUNCTION

  Joins five strings with a space separator.

m_fstrings/sjoin_6 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 sjoin_6

FUNCTION

  Joins six strings with a space separator.

m_fstrings/sjoin_7 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 sjoin_7

FUNCTION

  Joins six strings with a space separator.

m_fstrings/stoa [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 stoa

FUNCTION

  Convert a spin index into a string

m_fstrings/strcat_2 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 strcat_2

FUNCTION

  Returns two concatenated strings.

m_fstrings/strcat_3 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 strcat_3

FUNCTION

  Concatenate 3 strings

m_fstrings/strcat_4 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 strcat_3

FUNCTION

  Concatenate 4 strings

m_fstrings/strcat_5 [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 strcat_5

FUNCTION

  Concatenate 5 strings

m_fstrings/string_in [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  string_in

FUNCTION

 Compare input str with a list of comma-separated strings
 Example: string_in("foo", "foo, bar") --> True

INPUTS

   string=Input string

SOURCE

1646 pure logical function string_in(string, tokens) result(ans)
1647 
1648  character(len=*),intent(in) :: string, tokens
1649 
1650 !Local variables-------------------------------
1651  integer :: ii, prev, cnt
1652 
1653 ! *********************************************************************
1654 
1655  ans = .False.
1656  prev = 0; cnt = 0
1657  do ii=1,len_trim(tokens)
1658    if (tokens(ii:ii) == ",") then
1659      cnt = cnt + 1
1660      if (trim(lstrip(string)) == lstrip(tokens(prev+1:ii-1))) then
1661        ans = .True.; return
1662      end if
1663      prev = ii
1664    end if
1665  end do
1666 
1667  if (cnt == 0) then
1668    ans = trim(lstrip(string)) == trim(lstrip(tokens)); return
1669  end if
1670 
1671  ! Handle last item if "foo, bar"
1672  ans = trim(lstrip(string)) == lstrip(tokens(prev+1:ii-1))
1673 
1674 end function string_in

m_fstrings/tolower [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  tolower

FUNCTION

  Convert UPPER CASE letters to lower case (function version).

SOURCE

311 pure function tolower(str_in) result(str_out)
312 
313  character(len=*),intent(in) :: str_in
314  character(len=LEN_TRIM(str_in)) :: str_out
315 
316 !Local variables-------------------------------
317  integer :: ic,iasc
318 ! *********************************************************************
319 
320  do ic=1,LEN_TRIM(str_in)
321    iasc=IACHAR(str_in(ic:ic))
322    if (iasc>=ASCII_A.and.iasc<=ASCII_Z) then
323      str_out(ic:ic)=ACHAR(iasc+SHIFT)
324    else
325      str_out(ic:ic)=str_in(ic:ic)
326    end if
327  end do
328 
329 end function tolower

m_fstrings/toupper [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  toupper

FUNCTION

  Convert lower case letters to UPPER CASE (function version).

SOURCE

252 pure function toupper(str_in) result(str_out)
253 
254  character(len=*),intent(in) :: str_in
255  character(len=LEN_TRIM(str_in)) :: str_out
256 
257 !Local variables-------------------------------
258  integer :: ic,iasc
259 ! *********************************************************************
260 
261  do ic=1,LEN_TRIM(str_in)
262    iasc=IACHAR(str_in(ic:ic))
263    if (iasc>=ASCII_aa.and.iasc<=ASCII_zz) then
264      str_out(ic:ic)=ACHAR(iasc-SHIFT)
265    else
266      str_out(ic:ic)=str_in(ic:ic)
267    end if
268  end do
269 
270 end function toupper

m_fstrings/trimzero [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  trimzero

FUNCTION

 Deletes nonsignificant trailing zeroes from number string str. If number
 string ends in a decimal point, one trailing zero is added.

INPUTS

OUTPUT

SOURCE

746 ! NOT sure it will work
747 
748 subroutine trimzero(str)
749 
750  character(len=*),intent(inout) :: str
751 
752 !Local variables-------------------------------
753  integer :: i,ipos,lstr
754  character :: ch
755  character(len=10) :: sexp
756 ! *********************************************************************
757 
758  ipos=SCAN(str,'eE')
759  if (ipos>0) then
760   sexp=str(ipos:)
761   str=str(1:ipos-1)
762  end if
763  lstr=LEN_TRIM(str)
764  do i=lstr,1,-1
765   ch=str(i:i)
766   if (ch=='0') CYCLE
767   if (ch=='.') then
768    str=str(1:i)//'0'
769    if (ipos>0) str=TRIM(str)//TRIM(sexp)
770    EXIT
771   end if
772   str=str(1:i)
773   EXIT
774  end do
775 
776  if (ipos>0) str=TRIM(str)//TRIM(sexp)
777 
778 end subroutine trimzero

m_fstrings/upper [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  upper

FUNCTION

  Convert lower case letters to UPPER CASE.

SOURCE

225 pure subroutine upper(str)
226 
227  character(len=*),intent(inout) :: str
228 
229 !Local variables-------------------------------
230  integer :: ic,iasc
231 ! *********************************************************************
232 
233  do ic=1,LEN_TRIM(str)
234    iasc=IACHAR(str(ic:ic))
235    if (iasc>=ASCII_aa.and.iasc<=ASCII_zz) str(ic:ic)=ACHAR(iasc-SHIFT)
236  end do
237 
238 end subroutine upper

m_fstrings/write_int_0d [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  write_int_0d

FUNCTION

  Writes a number to a string using format fmt.

SOURCE

713 subroutine write_int_0D(inum,str,fmt)
714 
715 !Arguments ------------------------------------
716  integer,intent(in) :: inum
717  character(len=*),intent(in) :: fmt
718  character(len=*),intent(out) :: str
719 
720 !Local variables-------------------------------
721  character(len=LEN(fmt)+2) :: formt
722 ! *********************************************************************
723 
724  formt='('//TRIM(fmt)//')'
725  write(str,formt) inum
726  str=ADJUSTL(str)
727 
728 end subroutine write_int_0D

m_fstrings/write_rdp_0d [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  write_rdp_0d

FUNCTION

  Writes a number to a string using format fmt.

SOURCE

684 subroutine write_rdp_0d(rnum,str,fmt)
685 
686 !Arguments ------------------------------------
687  real(dp),intent(in) :: rnum
688  character(len=*),intent(in) :: fmt
689  character(len=*),intent(out) :: str
690 
691 !Local variables-------------------------------
692  character(len=LEN(fmt)+2) :: formt
693 ! *********************************************************************
694 
695  formt='('//TRIM(fmt)//')'
696  write(str,formt)rnum
697  str=ADJUSTL(str)
698 
699 end subroutine write_rdp_0D

m_fstrings/writeq_int_0D [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  writeq_int_0D

FUNCTION

  Writes a string of the form <name> = value to unit.

INPUTS

OUTPUT

SOURCE

828 subroutine writeq_int_0D(unit,namestr,ivalue,fmt)
829 
830  integer,intent(in) :: ivalue
831  integer,intent(in) :: unit
832  character(len=*),intent(in) :: namestr
833  character(len=*),intent(in) :: fmt
834 
835 !Local variables-------------------------------
836  character(len=32) :: tempstr
837 ! *********************************************************************
838 
839  call write_num(ivalue,tempstr,fmt)
840  call trimzero(tempstr)
841  write(unit,*)TRIM(namestr)//' = '//TRIM(tempstr)
842 
843 end subroutine writeq_int_0D

m_fstrings/writeq_rdp_0D [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

  writeq_rdp_0D

FUNCTION

  Writes a string of the form <name> = value to unit.

INPUTS

OUTPUT

SOURCE

795 subroutine writeq_rdp_0D(unit,namestr,value,fmt)
796 
797  real(dp),intent(in) :: value
798  integer,intent(in) :: unit
799  character(len=*),intent(in) :: fmt
800  character(len=*),intent(in) :: namestr
801 
802 !Local variables-------------------------------
803  character(len=32) :: tempstr
804 ! *********************************************************************
805 
806  call write_num(value,tempstr,fmt)
807  call trimzero(tempstr)
808  write(unit,*)TRIM(namestr)//' = '//TRIM(tempstr)
809 
810 end subroutine writeq_rdp_0D

m_fstrings/yesno [ Functions ]

[ Top ] [ m_fstrings ] [ Functions ]

NAME

 yesno

FUNCTION

  Convert boolean into "yes" or "no"