Data Types
interface	value

interface	writenum

interface	writeq

Functions/Subroutines
subroutine	parse (str, delims, args, nargs)

subroutine	compact (str)

subroutine	removesp (str)

subroutine, private	value_dr (str, rnum, ios)

subroutine, private	value_sr (str, rnum, ios)

subroutine, private	value_di (str, inum, ios)

subroutine, private	value_si (str, inum, ios)

subroutine	shiftstr (str, n)

subroutine	insertstr (str, strins, loc)

subroutine	delsubstr (str, substr)

subroutine	delall (str, substr)

character(len=len_trim(str)) function	uppercase (str)

character(len=len_trim(str)) function	lowercase (str)

subroutine	readline (nunitr, line, ios)

subroutine	match (str, ipos, imatch)

subroutine, private	write_dr (rnum, str, fmt)

subroutine, private	write_sr (rnum, str, fmt)

subroutine, private	write_di (inum, str, fmt)

subroutine, private	write_si (inum, str, fmt)

subroutine	trimzero (str)

subroutine, private	writeq_dr (unit, namestr, value, fmt)

subroutine, private	writeq_sr (unit, namestr, value, fmt)

subroutine, private	writeq_di (unit, namestr, ivalue, fmt)

subroutine, private	writeq_si (unit, namestr, ivalue, fmt)

logical function	is_letter (ch)

logical function	is_digit (ch)

subroutine	split (str, delims, before, sep)

Function/Subroutine Documentation

◆ compact()

subroutine strings::compact ( character(len=*) str )

Definition at line 105 of file suews_util_stringmod.f95.

Referenced by parse(), and split().

 
 ! Converts multiple spaces and tabs to single spaces; deletes control characters;
 ! removes initial spaces.
 
       character(len=*):: str
       character(len=1):: ch
       character(len=len_trim(str)):: outstr
 
       str = adjustl(str)
       lenstr = len_trim(str)
       outstr = ' '
       isp = 0
       k = 0
 
       do i = 1, lenstr
          ch = str(i:i)
          ich = iachar(ch)
 
          select case (ich)
 
          case (9, 32)     ! space or tab character
             if (isp == 0) then
                k = k + 1
                outstr(k:k) = ' '
             end if
             isp = 1
 
          case (33:)      ! not a space, quote, or control character
             k = k + 1
             outstr(k:k) = ch
             isp = 0
 
          end select
 
       end do
 
       str = adjustl(outstr)
 

Here is the caller graph for this function:

◆ delall()

subroutine strings::delall	(	character(len=*)	str,
		character(len=*)	substr
	)

Definition at line 323 of file suews_util_stringmod.f95.

 
 ! Deletes all occurrences of substring 'substr' from string 'str' and
 ! shifts characters left to fill holes.
 
       character(len=*):: str, substr
 
       lensubstr = len_trim(substr)
       do
          ipos = index(str, substr)
          if (ipos == 0) exit
          if (ipos == 1) then
             str = str(lensubstr + 1:)
          else
             str = str(:ipos - 1)//str(ipos + lensubstr:)
          end if
       end do
       return
 

◆ delsubstr()

subroutine strings::delsubstr	(	character(len=*)	str,
		character(len=*)	substr
	)

Definition at line 301 of file suews_util_stringmod.f95.

 
 ! Deletes first occurrence of substring 'substr' from string 'str' and
 ! shifts characters left to fill hole. Trailing spaces or blanks are
 ! not considered part of 'substr'.
 
       character(len=*):: str, substr
 
       lensubstr = len_trim(substr)
       ipos = index(str, substr)
       if (ipos == 0) return
       if (ipos == 1) then
          str = str(lensubstr + 1:)
       else
          str = str(:ipos - 1)//str(ipos + lensubstr:)
       end if
       return
 

◆ insertstr()

subroutine strings::insertstr	(	character(len=*)	str,
		character(len=*)	strins,
			loc
	)

Definition at line 280 of file suews_util_stringmod.f95.

References shiftstr().

 
 ! Inserts the string 'strins' into the string 'str' at position 'loc'.
 ! Characters in 'str' starting at position 'loc' are shifted right to
 ! make room for the inserted string. Trailing spaces of 'strins' are
 ! removed prior to insertion
 
       character(len=*):: str, strins
       character(len=len(str))::tempstr
 
       lenstrins = len_trim(strins)
       tempstr = str(loc:)
       call shiftstr(tempstr, lenstrins)
       tempstr(1:lenstrins) = strins(1:lenstrins)
       str(loc:) = tempstr
       return
 

Here is the call graph for this function:

◆ is_digit()

logical function strings::is_digit ( character ch )

Definition at line 680 of file suews_util_stringmod.f95.

Referenced by value_dr().

 
 ! Returns .true. if ch is a digit (0,1,...,9) and .false. otherwise
 
       character :: ch
       logical :: res
 
       select case (ch)
       case ('0':'9')
          res = .true.
       case default
          res = .false.
       end select
       return
 

Here is the caller graph for this function:

◆ is_letter()

logical function strings::is_letter ( character ch )

Definition at line 661 of file suews_util_stringmod.f95.

 
 ! Returns .true. if ch is a letter and .false. otherwise
 
       character :: ch
       logical :: res
 
       select case (ch)
       case ('A':'Z', 'a':'z')
          res = .true.
       case default
          res = .false.
       end select
       return
 

◆ lowercase()

character(len=len_trim(str)) function strings::lowercase ( character(len=*) str )

Definition at line 381 of file suews_util_stringmod.f95.

 
 ! convert string to lower case
 
       character(len=*):: str
       character(len=len_trim(str)):: lcstr
 
       ilen = len_trim(str)
       ioffset = iachar('A') - iachar('a')
       iquote = 0
       lcstr = str
       do i = 1, ilen
          iav = iachar(str(i:i))
          if (iquote == 0 .and. (iav == 34 .or. iav == 39)) then
             iquote = 1
             iqc = iav
             cycle
          end if
          if (iquote == 1 .and. iav == iqc) then
             iquote = 0
             cycle
          end if
          if (iquote == 1) cycle
          if (iav >= iachar('A') .and. iav <= iachar('Z')) then
             lcstr(i:i) = achar(iav - ioffset)
          else
             lcstr(i:i) = str(i:i)
          end if
       end do
       return
 

◆ match()

subroutine strings::match	(	character(len=*)	str,
			ipos,
			imatch
	)

Definition at line 438 of file suews_util_stringmod.f95.

 
 ! Sets imatch to the position in string of the delimiter matching the delimiter
 ! in position ipos. Allowable delimiters are (), [], {}, <>.
 
       character(len=*) :: str
       character :: delim1, delim2, ch
 
       lenstr = len_trim(str)
       delim1 = str(ipos:ipos)
       select case (delim1)
       case ('(')
          idelim2 = iachar(delim1) + 1
          istart = ipos + 1
          iend = lenstr
          inc = 1
       case (')')
          idelim2 = iachar(delim1) - 1
          istart = ipos - 1
          iend = 1
          inc = -1
       case ('[', '{', '<')
          idelim2 = iachar(delim1) + 2
          istart = ipos + 1
          iend = lenstr
          inc = 1
       case (']', '}', '>')
          idelim2 = iachar(delim1) - 2
          istart = ipos - 1
          iend = 1
          inc = -1
       case default
          write (*, *) delim1, ' is not a valid delimiter'
          return
       end select
       if (istart < 1 .or. istart > lenstr) then
          write (*, *) delim1, ' has no matching delimiter'
          return
       end if
       delim2 = achar(idelim2) ! matching delimiter
 
       isum = 1
       do i = istart, iend, inc
          ch = str(i:i)
          if (ch /= delim1 .and. ch /= delim2) cycle
          if (ch == delim1) isum = isum + 1
          if (ch == delim2) isum = isum - 1
          if (isum == 0) exit
       end do
       if (isum /= 0) then
          write (*, *) delim1, ' has no matching delimiter'
          return
       end if
       imatch = i
 
       return
 

◆ parse()

subroutine strings::parse	(	character(len=*)	str,
		character(len=*)	delims,
		character(len=*), dimension(:)	args,
			nargs
	)

Definition at line 71 of file suews_util_stringmod.f95.

References compact(), and split().

Referenced by ctrl_output::suews_output_init().

 
 ! Parses the string 'str' into arguments args(1), ..., args(nargs) based on
 ! the delimiters contained in the string 'delims'. Preceding a delimiter in
 ! 'str' by a backslash (\) makes this particular instance not a delimiter.
 ! The integer output variable nargs contains the number of arguments found.
 
       character(len=*) :: str, delims
       character(len=len_trim(str)) :: strsav
       character(len=*), dimension(:) :: args
 
       strsav = str
       call compact(str)
       na = size(args)
       do i = 1, na
          args(i) = ' '
       end do
       nargs = 0
       lenstr = len_trim(str)
       if (lenstr == 0) return
       k = 0
 
       do
          if (len_trim(str) == 0) exit
          nargs = nargs + 1
          call split(str, delims, args(nargs))
          call removebksl(args(nargs))
       end do
       str = strsav
 

Here is the call graph for this function:

Here is the caller graph for this function:

◆ readline()

subroutine strings::readline	(		nunitr,
		character(len=*)	line,
			ios
	)

Definition at line 416 of file suews_util_stringmod.f95.

 
 ! Reads line from unit=nunitr, ignoring blank lines
 ! and deleting comments beginning with an exclamation point(!)
 
       character(len=*):: line
 
       do
          read (nunitr, '(a)', iostat=ios) line      ! read input line
          if (ios /= 0) return
          line = adjustl(line)
          ipos = index(line, '!')
          if (ipos == 1) cycle
          if (ipos /= 0) line = line(:ipos - 1)
          if (len_trim(line) /= 0) exit
       end do
       return
 

◆ removesp()

subroutine strings::removesp ( character(len=*) str )

Definition at line 148 of file suews_util_stringmod.f95.

 
 ! Removes spaces, tabs, and control characters in string str
 
       character(len=*):: str
       character(len=1):: ch
       character(len=len_trim(str))::outstr
 
       str = adjustl(str)
       lenstr = len_trim(str)
       outstr = ' '
       k = 0
 
       do i = 1, lenstr
          ch = str(i:i)
          ich = iachar(ch)
          select case (ich)
          case (0:32)  ! space, tab, or control character
             cycle
          case (33:)
             k = k + 1
             outstr(k:k) = ch
          end select
       end do
 
       str = adjustl(outstr)
 

◆ shiftstr()

subroutine strings::shiftstr	(	character(len=*)	str,
			n
	)

Definition at line 257 of file suews_util_stringmod.f95.

Referenced by insertstr().

 
 ! Shifts characters in in the string 'str' n positions (positive values
 ! denote a right shift and negative values denote a left shift). Characters
 ! that are shifted off the end are lost. Positions opened up by the shift
 ! are replaced by spaces.
 
       character(len=*):: str
 
       lenstr = len(str)
       nabs = iabs(n)
       if (nabs >= lenstr) then
          str = repeat(' ', lenstr)
          return
       end if
       if (n < 0) str = str(nabs + 1:)//repeat(' ', nabs)  ! shift left
       if (n > 0) str = repeat(' ', nabs)//str(:lenstr - nabs)  ! shift right
       return
 

Here is the caller graph for this function:

◆ split()

subroutine strings::split	(	character(len=*)	str,
		character(len=*)	delims,
		character(len=*)	before,
		character, optional	sep
	)

Definition at line 699 of file suews_util_stringmod.f95.

References compact().

Referenced by parse().

 
 ! Routine finds the first instance of a character from 'delims' in the
 ! the string 'str'. The characters before the found delimiter are
 ! output in 'before'. The characters after the found delimiter are
 ! output in 'str'. The optional output character 'sep' contains the
 ! found delimiter. A delimiter in 'str' is treated like an ordinary
 ! character if it is preceded by a backslash (\). If the backslash
 ! character is desired in 'str', then precede it with another backslash.
 
       character(len=*) :: str, delims, before
       character, optional :: sep
       logical :: pres
       character :: ch, cha
 
       pres = present(sep)
       str = adjustl(str)
       call compact(str)
       lenstr = len_trim(str)
       if (lenstr == 0) return        ! string str is empty
       k = 0
       ibsl = 0                        ! backslash initially inactive
       before = ' '
       do i = 1, lenstr
          ch = str(i:i)
          if (ibsl == 1) then          ! backslash active
             k = k + 1
             before(k:k) = ch
             ibsl = 0
             cycle
          end if
          if (ch == '\') then          ! backslash with backslash inactive
             k = k + 1
             before(k:k) = ch
             ibsl = 1
             cycle
          end if
          ipos = index(delims, ch)
          if (ipos == 0) then          ! character is not a delimiter
             k = k + 1
             before(k:k) = ch
             cycle
          end if
          if (ch /= ' ') then          ! character is a delimiter that is not a space
             str = str(i + 1:)
             if (pres) sep = ch
             exit
          end if
          cha = str(i + 1:i + 1)            ! character is a space delimiter
          iposa = index(delims, cha)
          if (iposa > 0) then          ! next character is a delimiter
             str = str(i + 2:)
             if (pres) sep = cha
             exit
          else
             str = str(i + 1:)
             if (pres) sep = ch
             exit
          end if
       end do
       if (i >= lenstr) str = ''
       str = adjustl(str)              ! remove initial spaces
       return
 
    end subroutine split
 
 !**********************************************************************
 
    subroutine removebksl(str)
 
 ! Removes backslash (\) characters. Double backslashes (\\) are replaced
 ! by a single backslash.
 
       character(len=*):: str
       character(len=1):: ch
       character(len=len_trim(str))::outstr
 
       str = adjustl(str)
       lenstr = len_trim(str)
       outstr = ' '
       k = 0
       ibsl = 0                        ! backslash initially inactive
 
       do i = 1, lenstr
          ch = str(i:i)
          if (ibsl == 1) then          ! backslash active
             k = k + 1
             outstr(k:k) = ch
             ibsl = 0
             cycle
          end if
          if (ch == ') then          ! backslash with backslash inactive
             ibsl = 1
             cycle
          end if
          k = k + 1
          outstr(k:k) = ch              ! non-backslash with backslash inactive
       end do
 
       str = adjustl(outstr)
 

Here is the call graph for this function:

Here is the caller graph for this function:

◆ trimzero()

subroutine strings::trimzero ( character(len=*) str )

Definition at line 563 of file suews_util_stringmod.f95.

Referenced by writeq_di(), writeq_dr(), writeq_si(), and writeq_sr().

 
 ! Deletes nonsignificant trailing zeroes from number string str. If number
 ! string ends in a decimal point, one trailing zero is added.
 
       character(len=*) :: str
       character :: ch
       character(len=10) :: exp
 
       ipos = scan(str, 'eE')
       if (ipos > 0) then
          exp = str(ipos:)
          str = str(1:ipos - 1)
       endif
       lstr = len_trim(str)
       do i = lstr, 1, -1
          ch = str(i:i)
          if (ch == '0') cycle
          if (ch == '.') then
             str = str(1:i)//'0'
             if (ipos > 0) str = trim(str)//trim(exp)
             exit
          endif
          str = str(1:i)
          exit
       end do
       if (ipos > 0) str = trim(str)//trim(exp)
 

Here is the caller graph for this function:

◆ uppercase()

character(len=len_trim(str)) function strings::uppercase ( character(len=*) str )

Definition at line 346 of file suews_util_stringmod.f95.

 
 ! convert string to upper case
 
       character(len=*):: str
       character(len=len_trim(str)):: ucstr
 
       ilen = len_trim(str)
       ioffset = iachar('A') - iachar('a')
       iquote = 0
       ucstr = str
       do i = 1, ilen
          iav = iachar(str(i:i))
          if (iquote == 0 .and. (iav == 34 .or. iav == 39)) then
             iquote = 1
             iqc = iav
             cycle
          end if
          if (iquote == 1 .and. iav == iqc) then
             iquote = 0
             cycle
          end if
          if (iquote == 1) cycle
          if (iav >= iachar('a') .and. iav <= iachar('z')) then
             ucstr(i:i) = achar(iav + ioffset)
          else
             ucstr(i:i) = str(i:i)
          end if
       end do
       return
 

◆ value_di()

subroutine, private strings::value_di	(	character(len=*)	str,
		integer(ki8)	inum,
			ios
	)

private

Definition at line 219 of file suews_util_stringmod.f95.

References precision::ki8, and value_dr().

 
 ! Converts number string to a double precision integer value
 
       character(len=*)::str
       integer(ki8) :: inum
       real(kr8) :: rnum
 
       call value_dr(str, rnum, ios)
       if (abs(rnum) > huge(real(inum, kr8))) then
          ios = 15
          return
       end if
       inum = nint(rnum, ki8)
 

Here is the call graph for this function:

◆ value_dr()

subroutine, private strings::value_dr	(	character(len=*)	str,
		real(kr8)	rnum,
		integer	ios
	)

private

Definition at line 179 of file suews_util_stringmod.f95.

References is_digit().

Referenced by value_di(), value_si(), and value_sr().

 
 ! Converts number string to a double precision real number
 
       character(len=*)::str
       real(kr8)::rnum
       integer :: ios
 
       ilen = len_trim(str)
       ipos = scan(str, 'Ee')
       if (.not. is_digit(str(ilen:ilen)) .and. ipos /= 0) then
          ios = 3
          return
       end if
       read (str, *, iostat=ios) rnum
 

Here is the call graph for this function:

Here is the caller graph for this function:

◆ value_si()

subroutine, private strings::value_si	(	character(len=*)	str,
		integer(ki4)	inum,
			ios
	)

private

Definition at line 238 of file suews_util_stringmod.f95.

References precision::ki4, and value_dr().

 
 ! Converts number string to a single precision integer value
 
       character(len=*)::str
       integer(ki4) :: inum
       real(kr8) :: rnum
 
       call value_dr(str, rnum, ios)
       if (abs(rnum) > huge(inum)) then
          ios = 15
          return
       end if
       inum = nint(rnum, ki4)
 

Here is the call graph for this function:

◆ value_sr()

subroutine, private strings::value_sr	(	character(len=*)	str,
		real(kr4)	rnum,
			ios
	)

private

Definition at line 199 of file suews_util_stringmod.f95.

References value_dr().

 
 ! Converts number string to a single precision real number
 
       character(len=*)::str
       real(kr4) :: rnum
       real(kr8) :: rnumd
 
       call value_dr(str, rnumd, ios)
       if (abs(rnumd) > huge(rnum)) then
          ios = 15
          return
       end if
       if (abs(rnumd) < tiny(rnum)) rnum = 0.0_kr4
       rnum = real(rnumd, kr4)
 

Here is the call graph for this function:

◆ write_di()

subroutine, private strings::write_di	(	integer(ki8)	inum,
		character(len=*)	str,
		character(len=*)	fmt
	)

private

Definition at line 531 of file suews_util_stringmod.f95.

 
 ! Writes double precision integer inum to string str using format fmt
 
       integer(ki8) :: inum
       character(len=*) :: str, fmt
       character(len=80) :: formt
 
       formt = '('//trim(fmt)//')'
       write (str, formt) inum
       str = adjustl(str)
 

◆ write_dr()

subroutine, private strings::write_dr	(	real(kr8)	rnum,
		character(len=*)	str,
		character(len=*)	fmt
	)

private

Definition at line 499 of file suews_util_stringmod.f95.

 
 ! Writes double precision real number rnum to string str using format fmt
 
       real(kr8) :: rnum
       character(len=*) :: str, fmt
       character(len=80) :: formt
 
       formt = '('//trim(fmt)//')'
       write (str, formt) rnum
       str = adjustl(str)
 

◆ write_si()

subroutine, private strings::write_si	(	integer(ki4)	inum,
		character(len=*)	str,
		character(len=*)	fmt
	)

private

Definition at line 547 of file suews_util_stringmod.f95.

 
 ! Writes single precision integer inum to string str using format fmt
 
       integer(ki4) :: inum
       character(len=*) :: str, fmt
       character(len=80) :: formt
 
       formt = '('//trim(fmt)//')'
       write (str, formt) inum
       str = adjustl(str)
 

◆ write_sr()

subroutine, private strings::write_sr	(	real(kr4)	rnum,
		character(len=*)	str,
		character(len=*)	fmt
	)

private

Definition at line 515 of file suews_util_stringmod.f95.

 
 ! Writes single precision real number rnum to string str using format fmt
 
       real(kr4) :: rnum
       character(len=*) :: str, fmt
       character(len=80) :: formt
 
       formt = '('//trim(fmt)//')'
       write (str, formt) rnum
       str = adjustl(str)
 

◆ writeq_di()

subroutine, private strings::writeq_di	(	integer	unit,
		character(len=*)	namestr,
		integer(ki8)	ivalue,
		character(len=*)	fmt
	)

private

Definition at line 629 of file suews_util_stringmod.f95.

References trimzero().

 
 ! Writes a string of the form <name> = ivalue to unit
 
       integer(ki8) :: ivalue
       integer :: unit
       character(len=*) :: namestr, fmt
       character(len=32) :: tempstr
       call writenum(ivalue, tempstr, fmt)
       call trimzero(tempstr)
       write (unit, *) trim(namestr)//' = '//trim(tempstr)
 

Here is the call graph for this function:

◆ writeq_dr()

subroutine, private strings::writeq_dr	(	integer	unit,
		character(len=*)	namestr,
		real(kr8)	value,
		character(len=*)	fmt
	)

private

Definition at line 595 of file suews_util_stringmod.f95.

References trimzero().

 
 ! Writes a string of the form <name> = value to unit
 
       real(kr8) :: value
       integer :: unit
       character(len=*) :: namestr, fmt
       character(len=32) :: tempstr
 
       call writenum(value, tempstr, fmt)
       call trimzero(tempstr)
       write (unit, *) trim(namestr)//' = '//trim(tempstr)
 

Here is the call graph for this function:

◆ writeq_si()

subroutine, private strings::writeq_si	(	integer	unit,
		character(len=*)	namestr,
		integer(ki4)	ivalue,
		character(len=*)	fmt
	)

private

Definition at line 645 of file suews_util_stringmod.f95.

References trimzero().

 
 ! Writes a string of the form <name> = ivalue to unit
 
       integer(ki4) :: ivalue
       integer :: unit
       character(len=*) :: namestr, fmt
       character(len=32) :: tempstr
       call writenum(ivalue, tempstr, fmt)
       call trimzero(tempstr)
       write (unit, *) trim(namestr)//' = '//trim(tempstr)
 

Here is the call graph for this function:

◆ writeq_sr()

subroutine, private strings::writeq_sr	(	integer	unit,
		character(len=*)	namestr,
		real(kr4)	value,
		character(len=*)	fmt
	)

private

Definition at line 612 of file suews_util_stringmod.f95.

References trimzero().

 
 ! Writes a string of the form <name> = value to unit
 
       real(kr4) :: value
       integer :: unit
       character(len=*) :: namestr, fmt
       character(len=32) :: tempstr
 
       call writenum(value, tempstr, fmt)
       call trimzero(tempstr)
       write (unit, *) trim(namestr)//' = '//trim(tempstr)
 

Here is the call graph for this function:

Data Types

Functions/Subroutines

Function/Subroutine Documentation

◆ compact()

◆ delall()

◆ delsubstr()

◆ insertstr()

◆ is_digit()

◆ is_letter()

◆ lowercase()

◆ match()

◆ parse()

◆ readline()

◆ removesp()

◆ shiftstr()

◆ split()

◆ trimzero()

◆ uppercase()

◆ value_di()

◆ value_dr()

◆ value_si()

◆ value_sr()

◆ write_di()

◆ write_dr()

◆ write_si()

◆ write_sr()

◆ writeq_di()

◆ writeq_dr()

◆ writeq_si()

◆ writeq_sr()