M_strings Module

NAME

M_strings(3f) - [M_strings::INTRO] Fortran string module

DESCRIPTION

The M_strings(3fm) module is a collection of Fortran procedures
that supplement the built-in intrinsic string routines. Routines
for parsing, tokenizing, changing case, substituting new strings for
substrings, locating strings with simple wildcard expressions, removing
tabs and line terminators and other string manipulations are included.

M_strings_oop(3fm) is a companion module that provides an OOP interface
to the M_strings module.

SYNOPSIS

public entities:

  use M_strings,only : split, sep, delim, chomp, strtok
  use M_strings,only : split2020, find_field
  use M_strings,only : substitute, change, modif, transliterate, &
          & reverse, squeeze
  use M_strings,only : replace, join
  use M_strings,only : upper, lower, upper_quoted
  use M_strings,only : rotate13
  use M_strings,only : adjustc, compact, nospace, indent
  use M_strings,only : crop, clip, unquote, quote, matching_delimiter
  use M_strings,only : len_white, pad, lpad, cpad, rpad, zpad, &
          & stretch, lenset, merge_str
  use M_strings,only : switch, s2c, c2s
  use M_strings,only : noesc, notabs, dilate, expand, visible
  use M_strings,only : longest_common_substring
  use M_strings,only : string_to_value, string_to_values, s2v, s2vs
  use M_strings,only : int, real, dble, nint
  use M_strings,only : atoi, atol, aton
  use M_strings,only : value_to_string, v2s, msg
  use M_strings,only : listout, getvals
  use M_strings,only : glob, ends_with
  use M_strings,only : paragraph
  use M_strings,only : base, decodebase, codebase, base2
  use M_strings,only : isalnum, isalpha, iscntrl, isdigit
  use M_strings,only : isgraph, islower, isprint, ispunct
  use M_strings,only : isspace, isupper, isascii, isblank, isxdigit
  use M_strings,only : isnumber
  use M_strings,only : fortran_name
  use M_strings,only : describe
  use M_strings,only : edit_distance
  use M_strings,only : bundle

TOKENS

   split  subroutine parses string using specified delimiter characters
          and stores tokens into an array
   sep    function interface to split(3f)
   delim  subroutine parses string using specified delimiter characters
          and store tokens into an array
   chomp  function consumes input line as it returns next token in a
          string using specified delimiters
   paragraph    convert a string into a paragraph
   strtok tokenize a string like C strtok(3c) routine

   CONTRIBUTIONS

   split2020   split a string using prototype of proposed standard
               procedure
   find_field  token a string

EDITING

   substitute     subroutine non-recursively globally replaces old
                  substring with new substring
   replace        function non-recursively globally replaces old
                  substring with new substring using allocatable string
                  (version of substitute(3f) without limitation on
                  length of output string)
   change         subroutine non-recursively globally replaces old
                  substring with new substring with a directive like
                  line editor
   modif          subroutine modifies a string with a directive like the
                  XEDIT line editor MODIFY command
   transliterate  replace characters found in set one with characters
                  from set two
   reverse        reverse character order in a string
   join           join an array of CHARACTER variables with specified
                  separator
   rotate13       apply trivial encryption algorithm ROT13 to a string
   squeeze        delete adjacent duplicate characters from a string

CASE

   upper          function converts string to uppercase
   lower          function converts string to miniscule
   upper_quoted   function converts string to uppercase skipping strings
                  quoted per Fortran rules

STRING LENGTH AND PADDING

   len_white  find location of last non-whitespace character
   lenset     return a string of specified length
   pad        return a string of at least specified length
   zpad       pad integer or string to length with zero characters
              on left
   lpad       convert scalar intrinsic to a string padded on left to
              specified length
   cpad       convert scalar intrinsic to a centered string of the
              specified length
   rpad       convert scalar intrinsic to a string padded on right to
              specified length
   stretch    return a string of at least specified length with suffix
   merge_str  make strings of equal length and then call MERGE(3f)
              intrinsic

WHITE SPACE

   adjustc  elemental function centers text within the length of the
            input string
   compact  left justify string and replace duplicate whitespace with
            single characters or nothing
   nospace  function replaces whitespace with nothing
   indent   find number of leading spaces
   crop     function trims leading and trailing spaces and control
            characters
   clip     function trims leading and trailing spaces

   See Also: squeeze

QUOTES

   matching_delimiter  find position of matching delimiter
   unquote  remove quotes from string as if read with list-directed input
   quote    add quotes to string as if written with list-directed input

CHARACTER ARRAY VERSUS STRING

   switch  switch between a string and an array of single characters
   s2c     convert string to array of single characters and add null
           terminator for passing to C
   c2s     convert null-terminated array of single characters to
           string for converting strings returned from C

NONALPHA

   noesc    convert non-printable ASCII8 characters to a space
   notabs   convert tabs to spaces while maintaining columns,
            assuming tabs are set every 8 characters
   dilate   function to convert tabs to spaces assuming tabs are set
            every 8 characters
   expand   expand escape sequences in a string
   visible  expand escape sequences in a string to "control" and
            meta-control representations

NUMERIC STRINGS

   string_to_value   generic subroutine returns numeric value (REAL,
                     DOUBLEPRECISION, INTEGER) from string
   string_to_values  subroutine reads an array of numbers from a string
   getvals           subroutine reads a relatively arbitrary number
                     of values from a string using list-directed read
   s2v               function returns DOUBLEPRECISION numeric value
                     from string
   s2vs              function returns a DOUBLEPRECISION array of numbers
                     from a string
   s2vs              function returns a DOUBLEPRECISION array of numbers
                     from a string
   atoi              function returns INTEGER(kind=int32)  from a string
   atol              function returns INTEGER(kind=int64)  from a string
   aton              changes string to numeric value
   msg               append the values of up to nine values into a string

   value_to_string   generic subroutine returns string given numeric value
                     (REAL, DOUBLEPRECISION, INTEGER, LOGICAL )
   v2s               generic function returns string from numeric value
                     (REAL, DOUBLEPRECISION, INTEGER )
   listout           expand a list of numbers where negative numbers
                     denote range ends (1 -10 means 1 thru 10)
   isnumber          determine if string represents a number

CHARACTER TESTS

   glob        compares given string for match to pattern which may
               contain wildcard characters
   ends_with   test whether strings ends with one of the specified suffixes

   o isalnum   returns .true. if character is a letter or digit
   o isalpha   returns .true. if character is a letter and
               .false. otherwise
   o iscntrl   returns .true. if character is a delete character or
               ordinary control character
   o isdigit   returns .true. if character is a digit (0,1,...,9)
               and .false. otherwise
   o isgraph   returns .true. if character is a printable character
               except a space is considered non-printable
   o islower   returns .true. if character is a miniscule letter (a-z)
   o isprint   returns .true. if character is an ASCII printable
               character
   o ispunct   returns .true. if character is a printable punctuation
               character
   o isspace   returns .true. if character is a null, space, tab,
               carriage return, new line, vertical tab, or formfeed
   o isupper   returns .true. if character is an uppercase letter (A-Z)
   o isascii   returns .true. if the character is in the range char(0)
               to char(127)
   o isblank   returns .true. if character is a blank character
               (space or horizontal tab.
   o isxdigit  returns .true. if character is a hexadecimal digit
               (0-9, a-f, or A-F).

   fortran_name   returns .true. if input string is a valid Fortran name

BASE CONVERSION

   base       convert whole number string in base [2-36] to string
              in alternate base [2-36]
   base2      convert INTEGER to a string representing a binary value
   codebase   convert whole number string in base [2-36] to base
              10 number
   decodebase convert whole number in base 10 to string in base [2-36]

MISCELLANEOUS

   bundle     return up to twenty strings of arbitrary length as an array
   describe   returns a string describing the name of a single character
   edit_distance  returns a naive edit distance using the Levenshtein
                  distance algorithm
   longest_common_substring  function that returns the longest common
                             substring of two strings.

INTRINSICS

The M_strings(3fm) module supplements and works in combination with
the Fortran built-in intrinsics. Stand-alone Fortran lets you access
the characters in a string using ranges much like they are character
arrays, assignment, comparisons with standard operators, supports
dynamically allocatable strings and supports concatenation using the //
operator, as well as a number of intrinsic string routines:

    adjustl             Left adjust a string
    adjustr             Right adjust a string
    index               Position of a substring within a string
    repeat              Repeated string concatenation
    scan                Scan a string for the presence of a set
                        of characters
    trim                Remove trailing blank characters of a string
    verify              Scan a string for the absence of a set of
                        characters
    len                 It returns the length of a character string
    achar               converts an integer into a character
    iachar              converts a character into an integer
    len_trim            finds length of string with trailing spaces
                        ignored
    new_line            Newline character
    selected_char_kind  Choose character kind
    lge                 Lexical greater than or equal
    lgt                 Lexical greater than
    lle                 Lexical less than or equal
    llt                 Lexical less than

OOPS INTERFACE

The M_strings_oop(3fm) module (included with the M_strings(3fm)
module) provides an OOP (Object-Oriented Programming) interface to
the M_strings(3fm) module.

SEE ALSO

There are additional routines in other GPF modules for working with
expressions (M_calculator), time strings (M_time), random strings
(M_random, M_uuid), lists (M_list), and interfacing with the C regular
expression library (M_regex).

EXAMPLES

Each of the procedural functions includes an example program in the
corresponding man(1) page for the function. The object-oriented
interface does not have individual man(1) pages, but is instead
demonstrated using the following example program:

 program demo_M_strings
 use M_strings,only : split, sep, delim, chomp, strtok
 use M_strings,only : split2020, find_field
 use M_strings,only : substitute, change, modif, transliterate, &
         & reverse, squeeze
 use M_strings,only : replace, join
 use M_strings,only : upper, lower, upper_quoted
 use M_strings,only : rotate13
 use M_strings,only : adjustc, compact, nospace, indent
 use M_strings,only : crop, clip, unquote, quote, matching_delimiter
 use M_strings,only : len_white, pad, lpad, cpad, rpad, zpad, &
         & stretch, lenset, merge_str
 use M_strings,only : switch, s2c, c2s
 use M_strings,only : noesc, notabs, dilate, expand, visible
 use M_strings,only : longest_common_substring
 use M_strings,only : string_to_value, string_to_values, s2v, s2vs
 use M_strings,only : int, real, dble, nint
 use M_strings,only : atoi, atol, aton
 use M_strings,only : value_to_string, v2s, msg
 use M_strings,only : listout, getvals
 use M_strings,only : glob, ends_with
 use M_strings,only : paragraph
 use M_strings,only : base, decodebase, codebase, base2
 use M_strings,only : isalnum, isalpha, iscntrl, isdigit
 use M_strings,only : isgraph, islower, isprint, ispunct
 use M_strings,only : isspace, isupper, isascii, isblank, isxdigit
 use M_strings,only : isnumber
 use M_strings,only : fortran_name
 use M_strings,only : describe
 use M_strings,only : edit_distance
 use M_strings,only : bundle
 end program demo_M_strings

Expected output

AUTHOR

John S. Urban

LICENSE

Public Domain


Contents


Variables

Type Visibility Attributes Name Initial
character, public, parameter :: ascii_bel = char(7)
character, public, parameter :: ascii_bs = char(8)
character, public, parameter :: ascii_cr = char(13)
character, public, parameter :: ascii_esc = char(27)
character, public, parameter :: ascii_ff = char(12)
character, public, parameter :: ascii_ht = char(9)
character, public, parameter :: ascii_lf = char(10)
character, public, parameter :: ascii_nul = char(0)

Interfaces

public interface atleast

  • public function pad(line, length, pattern, right, clip) result(strout)

    NAME

    pad(3f) - [M_strings:LENGTH] return string padded to at least specified length (LICENSE:PD)

    SYNOPSIS

    function pad(str,length,pattern,right,clip) result(strout)

    character(len=*)                           :: str
    integer,intent(in)                         :: length
    character(len=max(length,len(trim(line)))) :: strout
    character(len=*),intent(in),optional       :: pattern
    logical,intent(in),optional                :: right
    logical,intent(in),optional                :: clip
    

    DESCRIPTION

    pad(3f) pads a string with a pattern to at least the specified length. If the trimmed input string is longer than the requested length the trimmed string is returned.

    OPTIONS

    str the input string to return trimmed, but then padded to the specified length if shorter than length length The minimum string length to return pattern optional string to use as padding. Defaults to a space. right if true pads string on the right, else on the left clip trim spaces from input string but otherwise retain length. Except for simple cases you typically would trim the input yourself.

    RETURNS

    strout The input string padded to the requested length or the trimmed input string if the input string is longer than the requested length.

    EXAMPLE

    Sample Program:

    program demo_pad
     use M_strings, only : pad
     implicit none
     character(len=10)            :: string='abcdefghij'
     character(len=:),allocatable :: answer
     integer                      :: i
     character(len=*),parameter   :: g='(*(g0))'
        answer=pad(string,5)
        write(*,'("[",a,"]")') answer
        answer=pad(string,20)
        write(*,'("[",a,"]")') answer
        i=30
        write(*,g)
        write(*,'(1x,a,1x,i0)') &
         & pad('CHAPTER 1 : The beginning ',i,'.'), 1   , &
         & pad('CHAPTER 2 : The end ',i,'.'),       1234, &
         & pad('APPENDIX ',i,'.'),                  1235
        write(*,*)
        write(*,'(1x,a,i7)') &
         & pad('CHAPTER 1 : The beginning ',i,'.'), 1   , &
         & pad('CHAPTER 2 : The end ',i,'.'),       1234, &
         & pad('APPENDIX ',i,'.'),                  1235
    
         write(*,g)pad('12',5,'0',right=.false.)
    
         write(*,g)pad('12345 ',30,'_',right=.false.)
         write(*,g)pad('12345 ',30,'_',right=.false.,clip=.true.)
         write(*,g)pad('12345 ',7,'_',right=.false.)
         write(*,g)pad('12345 ',7,'_',right=.false.,clip=.true.)
         write(*,g)pad('12345 ',6,'_',right=.false.)
         write(*,g)pad('12345 ',6,'_',right=.false.,clip=.true.)
         write(*,g)pad('12345 ',5,'_',right=.false.)
         write(*,g)pad('12345 ',5,'_',right=.false.,clip=.true.)
         write(*,g)pad('12345 ',4,'_',right=.false.)
         write(*,g)pad('12345 ',4,'_',right=.false.,clip=.true.)
    end program demo_pad
    

    Results:

    [abcdefghij] [abcdefghij ]

    CHAPTER 1 : The beginning .... 1 CHAPTER 2 : The end .......... 1234 APPENDIX ..................... 1235

    CHAPTER 1 : The beginning .... 1 CHAPTER 2 : The end .......... 1234 APPENDIX ..................... 1235 00012 ___12345 ____12345 _12345 __12345 12345 _12345 12345 12345 12345 12345

    SEE ALSO

     adjustl(3f), adjustr(3f), repeat(3f), trim(3f), len_trim(3f), len(3f)
    
     adjustc(3f), stretch(3f), lpad(3f), rpad(3f), cpad(3f), zpad(3f), lenset(3f)
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: line
    integer, intent(in) :: length
    character(len=*), intent(in), optional :: pattern
    logical, intent(in), optional :: right
    logical, intent(in), optional :: clip

    Return Value character(len=:), allocatable

public interface aton

  • private function ator_real32(str, val, msg)

    NAME

    aton(3f) - [M_strings:TYPE] function returns argument as a numeric
    value from a string
    (LICENSE:PD)
    

    SYNOPSIS

    logical function aton(str,val[,msg])
    
     character(len=*),intent(in)       :: str
     type(TYPE(kind=KIND)),intent(out) :: val
     character(len=:),allocatable,intent(out) :: msg
    

    DESCRIPTION

    This function converts a string to a numeric value.
    

    OPTIONS

     str      holds string assumed to represent a numeric value
     val      returned value. May be REAL or INTEGER.
     msg      message describing error when ATON returns .false.
    

    RETURNS

     aton     .true. if the conversion was successful, .false. otherwise
    

    EXAMPLE

    Sample Program:

      program demo_aton
    
       use M_strings, only: aton
       implicit none
       character(len=14),allocatable :: strings(:)
       doubleprecision               :: dv
       integer                       :: iv
       real                          :: rv
       integer                       :: i
    
       ! different strings representing INTEGER, REAL, and DOUBLEPRECISION
       strings=[&
       &' 10.345       ',&
       &'+10           ',&
       &'    -3        ',&
       &'    -4.94e-2  ',&
       &'0.1           ',&
       &'12345.678910d0',&
       &'              ',& ! Note: will return zero without an error message
       &'1 2 1 2 1 . 0 ',& ! Note: spaces will be ignored
       &'WHAT?         ']  ! Note: error messages will appear, zero returned
    
       do i=1,size(strings)
          write(*,'(a)',advance='no')'STRING:',strings(i)
          if(aton(strings(i),iv)) write(*,'(g0)',advance='no')':INTEGER ',iv
          if(aton(strings(i),rv)) write(*,'(g0)',advance='no')':INTEGER ',rv
          if(aton(strings(i),dv)) write(*,'(g0)',advance='no')':INTEGER ',dv
       enddo
    
       end program demo_aton
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: str
    real(kind=wp) :: val
    character(len=:), intent(out), optional, allocatable :: msg

    Return Value logical

  • private function ator_real64(str, val, msg)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: str
    real(kind=wp) :: val
    character(len=:), intent(out), optional, allocatable :: msg

    Return Value logical

  • private function atoi_int8(str, val, msg)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: str
    integer(kind=int8) :: val
    character(len=:), intent(out), optional, allocatable :: msg

    Return Value logical

  • private function atoi_int16(str, val, msg)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: str
    integer(kind=int16) :: val
    character(len=:), intent(out), optional, allocatable :: msg

    Return Value logical

  • private function atoi_int32(str, val, msg)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: str
    integer(kind=int32) :: val
    character(len=:), intent(out), optional, allocatable :: msg

    Return Value logical

  • private function atoi_int64(str, val, msg)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: str
    integer(kind=int64) :: val
    character(len=:), intent(out), optional, allocatable :: msg

    Return Value logical

public interface cc

  • public function bundle(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, len) result(vec)

    NAME

    bundle(3f) - [M_strings:ARRAY] return up to twenty strings of arbitrary length
                 as an array
    (LICENSE:PD)
    

    SYNOPSIS

    function bundle(str1,str2,...str20,len) result (vec)
    
     character(len=*),intent(in),optional   :: str1, str2 ... str20
     integer,intent(in),optional            :: len
    

    DESCRIPTION

    Given a list of up to twenty strings create a string array. The
    length of the variables with be the same as the maximum length
    of the input strings unless explicitly specified via LEN.
    
    This is an alternative to the syntax
    
      [ CHARACTER(LEN=NN) :: str1, str2, ... ]
    
    that by default additionally calculates the minimum length required
    to prevent truncation.
    

    OPTIONS

    str1,str2, ... str20  input strings to combine into a vector
    len   length of returned array variables
    

    EXAMPLES

    Sample Program:

    program demo_bundle
    use M_strings, only: bundle
    implicit none
       print "(*('""',a,'""':,',',1x))", bundle("one")
       print "(*('""',a,'""':,',',1x))", bundle("one","two")
       print "(*('""',a,'""':,',',1x))", bundle("one","two","three")
       print "(*('""',a,'""':,',',1x))", bundle("one","two","three",&
               & "four","five","six","seven")
    end program demo_bundle
    

    Expected output

    "one"
    "one", "two"
    "one  ", "two  ", "three"
    "one  ", "two  ", "three", "four ", "five ", "six  ", "seven"
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in), optional :: x1
    character(len=*), intent(in), optional :: x2
    character(len=*), intent(in), optional :: x3
    character(len=*), intent(in), optional :: x4
    character(len=*), intent(in), optional :: x5
    character(len=*), intent(in), optional :: x6
    character(len=*), intent(in), optional :: x7
    character(len=*), intent(in), optional :: x8
    character(len=*), intent(in), optional :: x9
    character(len=*), intent(in), optional :: x10
    character(len=*), intent(in), optional :: x11
    character(len=*), intent(in), optional :: x12
    character(len=*), intent(in), optional :: x13
    character(len=*), intent(in), optional :: x14
    character(len=*), intent(in), optional :: x15
    character(len=*), intent(in), optional :: x16
    character(len=*), intent(in), optional :: x17
    character(len=*), intent(in), optional :: x18
    character(len=*), intent(in), optional :: x19
    character(len=*), intent(in), optional :: x20
    integer, intent(in), optional :: len

    Return Value character(len=:), allocatable, (:)

public interface cpad

  • private function cpad_scalar(valuein, length) result(strout)

    NAME

    cpad(3f) - [M_strings:LENGTH] convert to a cropped string and then
    centers the string to specified length
    (LICENSE:PD)
    

    SYNOPSIS

    function cpad(valuein,length) result(strout)
    
     class*,intent(in)       :: valuein(..)
     integer,intent(in)      :: length
    

    DESCRIPTION

    cpad(3f) converts a scalar value to a cropped string and then pads
    it with spaces to center it to at least the specified length. If
    the trimmed input is longer than the requested length the string is
    returned trimmed of leading and trailing spaces.
    

    OPTIONS

    str      The input may be scalar or a vector.
             the input value to return as a string, padded with spaces to
             center it at the the specified length if shorter than
             length. The input may be any intrinsic scalar which is
             converted to a cropped string much as if written with
             list-directed output.
    length   The minimum string length to return
    

    RETURNS

    strout  The input string center-padded to the requested length
            with spaces.
    

    EXAMPLE

    Sample Program:

      program demo_cpad
       use M_strings, only : cpad
       implicit none
          write(*,'("[",a,"]")') cpad( 'my string', 20)
          write(*,'("[",a,"]")') cpad( 'my string   ', 20)
          write(*,'("[",a,"]")') cpad( '   my string', 20)
          write(*,'("[",a,"]")') cpad( '   my string   ', 20)
          write(*,'("[",a,"]")') cpad( valuein=42 , length=7)
          write(*,'("[",a,"]")') cpad( valuein=1.0/9.0 , length=20)
      end program demo_cpad
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: valuein
    integer, intent(in), optional :: length

    Return Value character(len=:), allocatable

  • private function cpad_vector(valuein, length) result(strout)

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: valuein(:)
    integer, intent(in), optional :: length

    Return Value character(len=:), allocatable, (:)

public interface dble

  • private impure elemental function dble_s2v(chars)

    NAME

      dble(3f) - [M_strings:TYPE] overloads DBLE(3f) so it can handle character arguments
      (LICENSE:PD)
    

    SYNOPSIS

    impure elemental function dble(string)
    
     character(len=*) :: string
     integer          :: dble
    

    DESCRIPTION

    dble(3f) returns a DOUBLE value when given a numeric representation of a
    numeric value. This overloads the DBLE(3f) intrinsic so that CHARACTER
    arguments assumed to represent a numeric value may be input.
    

    OPTIONS

       STRING  input string to be converted to a dble value
    

    RETURNS

    DBLE  double precision value represented by input string
    

    EXAMPLE

    Sample program:
    
      program demo_dble
      use M_strings, only: dble
      implicit none
      write(*,*)dble('100'),dble('20.4')
      write(*,*)'dble still works',dble(20),dble(20.4)
      write(*,*)'elemental',&
      & dble([character(len=23) :: '10','20.3','20.5','20.6'])
      end program demo_dble
    

    Results:

      >    100.00000000000000        20.399999999999999
      >  dble still works   20.000000000000000 20.399999618530273
      >  elemental   10.00000000000000  20.30000000000000
      >  20.50000000000000 20.60000000000000
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: chars

    Return Value doubleprecision

public interface ends_with

  • private pure function ends_with_str(string, ending) result(matched)

    NAME

    ends_with(3f) - [M_strings:COMPARE] test if string ends with specified
                    suffix(es)
    (LICENSE:PD)
    

    SYNOPSIS

    function ends_with(source_string,suffix)
    
     or
    
    function ends_with(source_string,[suffix])
    
     character(len=*),intent(in)          :: source_string
     character(len=*),intent(in)          :: suffix(..)
     logical                              :: ends_with
    

    DESCRIPTION

    OPTIONS

     SOURCE_STRING  string to tokenize
     SUFFIX         list of separator strings. May be scalar or an array.
                    Trailing spaces are ignored.
    

    RETURNS

     ENDS_WITH      returns .TRUE. if one of the suffix match the end
                    of SOURCE_STRING.
    

    EXAMPLES

    Sample program:

    program demo_ends_with
    use M_strings, only : ends_with
    use, intrinsic :: iso_fortran_env, only : stdout=>output_unit
    implicit none
       write(stdout,*)ends_with('prog.a',['.o','.i','.s'])
       write(stdout,*)ends_with('prog.f90',['.F90','.f90','.f  ','.F  '])
       write(stdout,*)ends_with('prog.pdf','.pdf')
       write(stdout,*)ends_with('prog.doc','.txt')
    end program demo_ends_with
    

    Results:

     F
     T
     T
     F
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character, intent(in) :: string
    character, intent(in) :: ending

    Return Value logical

  • private pure function ends_with_any(string, endings) result(matched)

    Arguments

    Type IntentOptional Attributes Name
    character, intent(in) :: string
    character, intent(in) :: endings(:)

    Return Value logical

public interface int

  • public pure elemental function atoi(string) result(val)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: string

    Return Value integer(kind=int32)

public interface lpad

  • private function lpad_scalar(valuein, length) result(strout)

    NAME

    lpad(3f) - [M_strings:LENGTH] convert to a cropped string and then
    blank-pad on the left to requested length
    (LICENSE:PD)
    

    SYNOPSIS

    function lpad(valuein,length) result(strout)
    
     class*,intent(in)       :: valuein(..)
     integer,intent(in)      :: length
    

    DESCRIPTION

    lpad(3f) converts a scalar value to a cropped string and then pads
    it on the left with spaces to at least the specified length. If
    the trimmed input is longer than the requested length the string is
    returned trimmed of leading and trailing spaces.
    

    OPTIONS

    str      The input may be scalar or a vector.
             the input value to return as a string, padded on the left to
             the specified length if shorter than length. The input may be
             any intrinsic scalar which is converted to a cropped string
             much as if written with list-directed output.
    length   The minimum string length to return
    

    RETURNS

    strout  The input string padded to the requested length
            on the left with spaces.
    

    EXAMPLE

    Sample Program:

      program demo_lpad
       use M_strings, only : lpad
       implicit none
          write(*,'("[",a,"]")') lpad( 'my string', 20)
          write(*,'("[",a,"]")') lpad( 'my string   ', 20)
          write(*,'("[",a,"]")') lpad( '   my string', 20)
          write(*,'("[",a,"]")') lpad( '   my string   ', 20)
          write(*,'("[",a,"]")') lpad( valuein=42 , length=7)
          write(*,'("[",a,"]")') lpad( valuein=1.0/9.0 , length=20)
      end program demo_lpad
    

    Results:

     > [           my string]
     > [           my string]
     > [           my string]
     > [           my string]
     > [     42]
     > [         0.111111112]
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: valuein
    integer, intent(in), optional :: length

    Return Value character(len=:), allocatable

  • private function lpad_vector(valuein, length) result(strout)

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: valuein(:)
    integer, intent(in), optional :: length

    Return Value character(len=:), allocatable, (:)

public interface matchw

  • public function glob(tame, wild)

    NAME

    glob(3f) - [M_strings:COMPARE] compare given string for match to
    a pattern which may contain globbing wildcard characters
    (LICENSE:PD)
    

    SYNOPSIS

    logical function glob(string, pattern )
    
     character(len=*),intent(in) :: string
     character(len=*),intent(in) :: pattern
    

    DESCRIPTION

    glob(3f) compares given (entire) STRING for a match to PATTERN which may
    contain basic wildcard "globbing" characters.
    
    In this version to get a match the entire string must be described
    by PATTERN. Trailing whitespace is significant, so trim the input
    string to have trailing whitespace ignored.
    
    Patterns like "b*ba" fail on a string like "babababa" because the
    algorithm finds an early match. To skip over the early matches insert
    an extra character at the end of the string and pattern that does
    not occur in the pattern. Typically a NULL is used (char(0)).
    

    OPTIONS

    string   the input string to test to see if it contains the pattern.
    pattern  the following simple globbing options are available
    
             o "?" matching any one character
             o "*" matching zero or more characters.
               Do NOT use adjacent asterisks.
             o spaces are significant and must be matched or pretrimmed
             o There is no escape character, so matching strings with
               literal question mark and asterisk is problematic.
    

    EXAMPLES

    Example program

    program demo_glob
    implicit none
    ! This main() routine passes a bunch of test strings
    ! into the above code.  In performance comparison mode,
    ! it does that over and over. Otherwise, it does it just
    ! once. Either way, it outputs a passed/failed result.
    !
    integer :: nReps
    logical :: allpassed
    integer :: i
    allpassed = .true.
    
    nReps = 10000
    ! Can choose as many repetitions as you're expecting
    ! in the real world.
    nReps = 1
    
    do i=1,nReps
       ! Cases with repeating character sequences.
       allpassed= test("a*abab",      "a*b",   .true.)  .and. allpassed
       allpassed= test("ab",          "*?",    .true.)  .and. allpassed
       allpassed= test("abc",         "*?",    .true.)  .and. allpassed
       allpassed= test("abcccd",      "*ccd",  .true.)  .and. allpassed
       allpassed= test("bLah",        "bLaH",  .false.) .and. allpassed
       allpassed= test("mississippi", "*sip*", .true.)  .and. allpassed
       allpassed= &
        & test("xxxx*zzzzzzzzy*f", "xxx*zzy*f", .true.) .and. allpassed
       allpassed= &
        & test("xxxx*zzzzzzzzy*f", "xxxx*zzy*fffff", .false.) .and. allpassed
       allpassed= &
        & test("mississipissippi", "*issip*ss*", .true.) .and. allpassed
       allpassed= &
        & test("xxxxzzzzzzzzyf", "xxxx*zzy*fffff", .false.) .and. allpassed
       allpassed= &
        & test("xxxxzzzzzzzzyf", "xxxx*zzy*f", .true.) .and. allpassed
       allpassed= test("xyxyxyzyxyz", "xy*z*xyz", .true.)  .and. allpassed
       allpassed= test("xyxyxyxyz",   "xy*xyz",   .true.)  .and. allpassed
       allpassed= test("mississippi", "mi*sip*",  .true.)  .and. allpassed
       allpassed= test("ababac",      "*abac*",   .true.)  .and. allpassed
       allpassed= test("aaazz",       "a*zz*",    .true.)  .and. allpassed
       allpassed= test("a12b12",      "*12*23",   .false.) .and. allpassed
       allpassed= test("a12b12",      "a12b",     .false.) .and. allpassed
       allpassed= test("a12b12",      "*12*12*",  .true.)  .and. allpassed
    
       ! Additional cases where the '*' char appears in the tame string.
       allpassed= test("*",     "*",      .true.)  .and. allpassed
       allpassed= test("a*r",   "a*",     .true.)  .and. allpassed
       allpassed= test("a*ar",  "a*aar",  .false.) .and. allpassed
    
       ! More double wildcard scenarios.
       allpassed= test("XYXYXYZYXYz", "XY*Z*XYz",  .true.)  .and. allpassed
       allpassed= test("missisSIPpi", "*SIP*",     .true.)  .and. allpassed
       allpassed= test("mississipPI", "*issip*PI", .true.)  .and. allpassed
       allpassed= test("xyxyxyxyz",   "xy*xyz",    .true.)  .and. allpassed
       allpassed= test("miSsissippi", "mi*sip*",   .true.)  .and. allpassed
       allpassed= test("miSsissippi", "mi*Sip*",   .false.) .and. allpassed
       allpassed= test("abAbac",      "*Abac*",    .true.)  .and. allpassed
       allpassed= test("aAazz",       "a*zz*",     .true.)  .and. allpassed
       allpassed= test("A12b12",      "*12*23",    .false.) .and. allpassed
       allpassed= test("a12B12",      "*12*12*",   .true.)  .and. allpassed
       allpassed= test("oWn",         "*oWn*",     .true.)  .and. allpassed
    
       ! Completely tame (no wildcards) cases.
       allpassed= test("bLah", "bLah", .true.) .and. allpassed
    
       ! Simple mixed wildcard tests suggested by IBMer Marlin Deckert.
       allpassed= test("a", "*?", .true.) .and. allpassed
    
       ! More mixed wildcard tests including coverage for false positives.
       allpassed= test("a",      "??",         .false.) .and. allpassed
       allpassed= test("ab",     "?*?",        .true.)  .and. allpassed
       allpassed= test("ab",     "*?*?*",      .true.)  .and. allpassed
       allpassed= test("abc",    "?**?*?",     .true.)  .and. allpassed
       allpassed= test("abc",    "?**?*&?",    .false.) .and. allpassed
       allpassed= test("abcd",   "?b*??",      .true.)  .and. allpassed
       allpassed= test("abcd",   "?a*??",      .false.) .and. allpassed
       allpassed= test("abcd",   "?**?c?",     .true.)  .and. allpassed
       allpassed= test("abcd",   "?**?d?",     .false.) .and. allpassed
       allpassed= test("abcde",  "?*b*?*d*?",  .true.)  .and. allpassed
    
       ! Single-character-match cases.
       allpassed= test("bLah",   "bL?h",  .true.)  .and. allpassed
       allpassed= test("bLaaa",  "bLa?",  .false.) .and. allpassed
       allpassed= test("bLah",   "bLa?",  .true.)  .and. allpassed
       allpassed= test("bLaH",   "?Lah",  .false.) .and. allpassed
       allpassed= test("bLaH",   "?LaH",  .true.)  .and. allpassed
    
       allpassed= test('abcdefghijk' ,  '?b*',     .true.)  .and. allpassed
       allpassed= test('abcdefghijk' ,  '*c*',     .true.)  .and. allpassed
       allpassed= test('abcdefghijk' ,  '*c',      .false.) .and.  allpassed
       allpassed= test('abcdefghijk' ,  '*c*k',    .true.)  .and. allpassed
       allpassed= test('LS'          ,  '?OW',     .false.) .and.  allpassed
       allpassed= test('teztit'      ,  'tez*t*t', .true.)  .and. allpassed
         ! Two pattern match problems that might pose difficulties
       allpassed= test('e '           , '*e* ',      .true.) .and. allpassed
       allpassed= test('abcde       ' , '*e      *', .true.) .and. allpassed
       allpassed= test('bababa'       , 'b*ba',      .true.) .and. allpassed
       allpassed= test('baaaaax'      , 'b*ax',      .true.) .and. allpassed
       allpassed= test('baaaaa'       , 'b*ax',      .false.) .and. allpassed
       allpassed= test('baaaaax'      , 'b*a',       .false.) .and. allpassed
       allpassed= test(''             , 'b*',        .false.) .and. allpassed
       allpassed= test(''             , '*',         .true.) .and.  allpassed
       allpassed= test('b'            , '',          .false.) .and. allpassed
       allpassed= test('3'            , '??',        .false.) .and. allpassed
       ! known flaws
       allpassed= test(''             , '',          .true.) .and. allpassed
       allpassed= test('baaaaa'       , 'b*a',       .true.) .and. allpassed
       ! add unused character to work around
       allpassed= test(''//char(0),      ''//char(0),   .true.).and.allpassed
       allpassed= test('baaaaa'//char(0),'b*a'//char(0),.true.).and.allpassed
    
       ! Many-wildcard scenarios.
       allpassed= test(&
       &"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa&
       &aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaab",&
       &"a*a*a*a*a*a*aa*aaa*a*a*b",&
       &.true.) .and. allpassed
       allpassed= test(&
       &"abababababababababababababababababababaacacacacacacac&
       &adaeafagahaiajakalaaaaaaaaaaaaaaaaaffafagaagggagaaaaaaaab",&
       &"*a*b*ba*ca*a*aa*aaa*fa*ga*b*",&
       &.true.) .and. allpassed
       allpassed= test(&
       &"abababababababababababababababababababaacacacacacaca&
       &cadaeafagahaiajakalaaaaaaaaaaaaaaaaaffafagaagggagaaaaaaaab",&
       &"*a*b*ba*ca*a*x*aaa*fa*ga*b*",&
       &.false.) .and. allpassed
       allpassed= test(&
       &"abababababababababababababababababababaacacacacacacacad&
       &aeafagahaiajakalaaaaaaaaaaaaaaaaaffafagaagggagaaaaaaaab",&
       &"*a*b*ba*ca*aaaa*fa*ga*gggg*b*",&
       &.false.) .and. allpassed
       allpassed= test(&
       &"abababababababababababababababababababaacacacacacacacad&
       &aeafagahaiajakalaaaaaaaaaaaaaaaaaffafagaagggagaaaaaaaab",&
       &"*a*b*ba*ca*aaaa*fa*ga*ggg*b*",&
       &.true.) .and. allpassed
       allpassed= test("aaabbaabbaab","*aabbaa*a*",.true.).and.allpassed
       allpassed= &
       test("a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*",&
       &"a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*", .true.) .and. allpassed
       allpassed= test("aaaaaaaaaaaaaaaaa",&
       &"*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*", .true.) .and. allpassed
       allpassed= test("aaaaaaaaaaaaaaaa",&
       &"*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*a*", .false.) .and. allpassed
       allpassed= test(&
       &"abc*abcd*abcde*abcdef*abcdefg*abcdefgh*abcdefghi*abcdefghij&
       &*abcdefghijk*abcdefghijkl*abcdefghijklm*abcdefghijklmn",&
       & "abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc&
       &*abc*abc*abc*",&
       &.false.) .and. allpassed
       allpassed= test(&
       &"abc*abcd*abcde*abcdef*abcdefg*abcdefgh*abcdefghi*abcdefghij&
       &*abcdefghijk*abcdefghijkl*abcdefghijklm*abcdefghijklmn",&
       &"abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*",&
       &.true.) .and. allpassed
       allpassed= test("abc*abcd*abcd*abc*abcd",&
       &"abc*abc*abc*abc*abc", .false.) .and. allpassed
       allpassed= test( "abc*abcd*abcd*abc*abcd*abcd&
       &*abc*abcd*abc*abc*abcd", &
       &"abc*abc*abc*abc*abc*abc*abc*abc*abc*abc*abcd",&
       &.true.) .and. allpassed
       allpassed= test("abc",&
       &"********a********b********c********", .true.) .and. allpassed
       allpassed=&
       &test("********a********b********c********", "abc",.false.)&
       & .and.allpassed
       allpassed= &
       &test("abc", "********a********b********b********",.false.)&
       & .and.allpassed
       allpassed= test("*abc*", "***a*b*c***", .true.) .and. allpassed
    
       ! A case-insensitive algorithm test.
       ! allpassed=test("mississippi", "*issip*PI", .true.) .and. allpassed
     enddo
    
     if (allpassed)then
        write(*,'(*(g0,1x))')"Passed",nReps
     else
        write(*,'(a)')"Failed"
     endif
    contains
    ! This is a test program for wildcard matching routines.
    ! It can be used either to test a single routine for correctness,
    ! or to compare the timings of two (or more) different wildcard
    ! matching routines.
    !
    function test(tame, wild, bExpectedResult) result(bPassed)
    use M_strings, only : glob
       character(len=*) :: tame
       character(len=*) :: wild
       logical          :: bExpectedResult
       logical          :: bResult
       logical          :: bPassed
       bResult = .true.    ! We'll do "&=" cumulative checking.
       bPassed = .false.   ! Assume the worst.
       write(*,*)repeat('=',79)
       bResult = glob(tame, wild) ! Call a wildcard matching routine.
    
       ! To assist correctness checking, output the two strings in any
       ! failing scenarios.
       if (bExpectedResult .eqv. bResult) then
          bPassed = .true.
          if(nReps == 1) write(*,*)"Passed match on ",tame," vs. ", wild
       else
          if(nReps == 1) write(*,*)"Failed match on ",tame," vs. ", wild
       endif
    
    end function test
    end program demo_glob
    

    Expected output

    AUTHOR

    John S. Urban

    REFERENCE

    The article “Matching Wildcards: An Empirical Way to Tame an Algorithm” in Dr Dobb’s Journal, By Kirk J. Krauss, October 07, 2014

    LICENSE

    Public Domain

    Arguments

    Type IntentOptional Attributes Name
    character(len=*) :: tame
    character(len=*) :: wild

    Return Value logical

public interface msg

  • private function msg_scalar(generic1, generic2, generic3, generic4, generic5, generic6, generic7, generic8, generic9, sep)

    NAME

     msg(3f) - [M_strings:TYPE] converts any standard scalar type to a string
     (LICENSE:PD)
    

    SYNOPSIS

     function msg(g1,g2g3,g4,g5,g6,g7,g8,g9,sep)
    
      class(*),intent(in),optional  :: g1,g2,g3,g4,g5,g6,g7,g8,g9
      character(len=*),intent(in),optional :: sep
      character(len=:),allocatable :: msg
    

    DESCRIPTION

     msg(3f) builds a space-separated string from up to nine scalar values.
    

    OPTIONS

     g[1-9]  optional value to print the value of after the message. May
             be of type INTEGER, LOGICAL, REAL, DOUBLEPRECISION, COMPLEX,
             or CHARACTER.
     sep     separator between values. Defaults to a space
    

    RETURNS

     msg     description to print
    

    EXAMPLES

    Sample program:

        program demo_msg
        use M_strings, only : msg
        implicit none
        character(len=:),allocatable :: pr
        character(len=:),allocatable :: frmt
        integer                      :: biggest
    
        pr=msg('HUGE(3f) integers',huge(0),&
        & 'and real',huge(0.0),'and double',huge(0.0d0))
        write(*,'(a)')pr
        pr=msg('real            :',&
         & huge(0.0),0.0,12345.6789,tiny(0.0) )
        write(*,'(a)')pr
        pr=msg('doubleprecision :',&
         & huge(0.0d0),0.0d0,12345.6789d0,tiny(0.0d0) )
        write(*,'(a)')pr
        pr=msg('complex         :',&
         & cmplx(huge(0.0),tiny(0.0)) )
        write(*,'(a)')pr
    
        ! create a format on the fly
        biggest=huge(0)
        frmt=msg('(*(i',int(log10(real(biggest))),':,1x))',sep='')
        write(*,*)'format=',frmt
    
        ! although it will often work, using msg(3f) in an I/O statement
        ! is not recommended
        write(*,*)msg('program will now stop')
    
        end program demo_msg
    

    Output

       HUGE(3f) integers 2147483647 and real 3.40282347E+38
       and double 1.7976931348623157E+308
       real            : 3.40282347E+38 0.00000000
       12345.6787 1.17549435E-38
       doubleprecision : 1.7976931348623157E+308 0.0000000000000000
       12345.678900000001 2.2250738585072014E-308
       complex         : (3.40282347E+38,1.17549435E-38)
        format=(*(i9:,1x))
        program will now stop
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in), optional :: generic1
    class(*), intent(in), optional :: generic2
    class(*), intent(in), optional :: generic3
    class(*), intent(in), optional :: generic4
    class(*), intent(in), optional :: generic5
    class(*), intent(in), optional :: generic6
    class(*), intent(in), optional :: generic7
    class(*), intent(in), optional :: generic8
    class(*), intent(in), optional :: generic9
    character(len=*), intent(in), optional :: sep

    Return Value character(len=:), allocatable

  • private function msg_one(generic1, generic2, generic3, generic4, generic5, generic6, generic7, generic8, generic9, sep)

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: generic1(:)
    class(*), intent(in), optional :: generic2(:)
    class(*), intent(in), optional :: generic3(:)
    class(*), intent(in), optional :: generic4(:)
    class(*), intent(in), optional :: generic5(:)
    class(*), intent(in), optional :: generic6(:)
    class(*), intent(in), optional :: generic7(:)
    class(*), intent(in), optional :: generic8(:)
    class(*), intent(in), optional :: generic9(:)
    character(len=*), intent(in), optional :: sep

    Return Value character(len=:), allocatable

public interface nint

  • private impure elemental function nint_s2v(chars)

    NAME

      int(3f) - [M_strings:TYPE] overloads INT(3f) so it can handle character arguments
      (LICENSE:PD)
    

    SYNOPSIS

    impure elemental function int(string)
    
     character(len=*) :: string
     integer(kind=int32) :: int
    

    DESCRIPTION

    int(3f) returns an integer when given a numeric representation of a
    numeric value. This overloads the INT(3f) intrinsic so that CHARACTER
    arguments assumed to represent a numeric value may be input.
    

    OPTIONS

       STRING  input string to be converted to an INT32 integer
    

    RETURNS

       INT  integer represented by input string
    

    EXAMPLE

    Sample program:
    
      program demo_int
      use M_strings, only: int
      implicit none
      write(*,*)int('100'),int('20.4')
      write(*,*)'int still works',int(20.4)
      write(*,*)'elemental',&
      & int([character(len=23) :: '10','20.3','20.5','20.6'])
      end program demo_int
    

    Results:

      >          100          20
      >  int still works          20
      >  elemental          10          20          20          20
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    NAME

      nint(3f) - [M_strings:TYPE] overloads NINT(3f) so it can handle character arguments
      (LICENSE:PD)
    

    SYNOPSIS

    impure elemental function nint(string)
    
     character(len=*) :: string
     integer          :: nint
    

    DESCRIPTION

    nint(3f) returns an integer when given a numeric representation of a
    numeric value. This overloads the NINT(3f) intrinsic so that CHARACTER
    arguments assumed to represent a numeric value may be input.
    

    OPTIONS

       STRING  input string to be converted to an integer
    

    RETURNS

       NINT  integer represented by input string
    

    EXAMPLE

    Sample program:
    
      program demo_nint
      use M_strings, only: nint
      implicit none
      write(*,*)nint('100'),nint('20.4')
      write(*,*)'nint still works',nint(20.4)
      write(*,*)'elemental',&
      & nint([character(len=23) :: '10','20.3','20.5','20.6'])
      end program demo_nint
    

    Results:

      >          100          20
      >  nint still works          20
      >  elemental          10          20          21          21
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: chars

    Return Value integer

public interface real

  • private impure elemental function real_s2v(chars)

    NAME

      real(3f) - [M_strings:TYPE] overloads REAL(3f) so it can handle character arguments
      (LICENSE:PD)
    

    SYNOPSIS

    impure elemental function real(string)
    
     character(len=*) :: string
     integer          :: real
    

    DESCRIPTION

    real(3f) returns a REAL value when given a numeric representation of a
    numeric value. This overloads the REAL(3f) intrinsic so that CHARACTER
    arguments assumed to represent a numeric value may be input.
    

    OPTIONS

       STRING  input string to be converted to a real value
    

    RETURNS

       REAL  real value represented by input string
    

    EXAMPLE

    Sample program:
    
      program demo_real
      use M_strings, only: real
      implicit none
      write(*,*)real('100'),real('20.4')
      write(*,*)'real still works',real(20)
      write(*,*)'elemental',&
      & real([character(len=23) :: '10','20.3','20.5','20.6'])
      end program demo_real
    

    Results:

      >    100.000000       20.3999996
      >  real still works   20.0000000
      >  elemental   10.0000000  20.2999992  20.5000000  20.6000004
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: chars

    Return Value real

public interface rpad

  • private function rpad_scalar(valuein, length) result(strout)

    NAME

    rpad(3f) - [M_strings:LENGTH] convert to a string and pad on the right
    to requested length
    (LICENSE:PD)
    

    SYNOPSIS

    function rpad(valuein,length) result(strout)
    
     class*,intent(in)       :: valuein(..)
     integer,intent(in)      :: length
    

    DESCRIPTION

    rpad(3f) converts a scalar intrinsic value to a string and then pads
    it on the right with spaces to at least the specified length. If the
    trimmed input string is longer than the requested length the string
    is returned trimmed of leading and trailing spaces.
    

    OPTIONS

    str      The input may be scalar or a vector.
             the input value to return as a string, padded on the left to
             the specified length if shorter than length. The input may be
             any intrinsic scalar which is converted to a cropped string
             much as if written with list-directed output.
    length   The minimum string length to return
    

    RETURNS

    strout  The input string padded to the requested length
            on the right with spaces.
    

    EXAMPLE

    Sample Program:

      program demo_rpad
       use M_strings, only : rpad
       implicit none
          write(*,'("[",a,"]")') rpad( 'my string', 20)
          write(*,'("[",a,"]")') rpad( 'my string   ', 20)
          write(*,'("[",a,"]")') rpad( '   my string', 20)
          write(*,'("[",a,"]")') rpad( '   my string   ', 20)
          write(*,'("[",a,"]")') rpad( valuein=42 , length=7)
          write(*,'("[",a,"]")') rpad( valuein=1.0/9.0 , length=20)
      end program demo_rpad
    

    Results:

      > [my string           ]
      > [my string           ]
      > [my string           ]
      > [my string           ]
      > [42     ]
      > [0.111111112         ]
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: valuein
    integer, intent(in), optional :: length

    Return Value character(len=:), allocatable

  • private function rpad_vector(valuein, length) result(strout)

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: valuein(:)
    integer, intent(in), optional :: length

    Return Value character(len=:), allocatable, (:)

public interface split2020

  • private pure subroutine split_tokens(string, set, tokens, separator)

    NAME

    split2020(3f) - [M_strings:TOKENS] parse a string into tokens using
    proposed f2023 method
    (LICENSE:PD)
    

    SYNOPSIS

    TOKEN form

    subroutine split2020 (string, set, tokens, separator)
    character(len=*),intent(in) :: string
    character(len=*),intent(in) :: set
    character(len=:),allocatable,intent(out) :: tokens(:)
    character(len=1),allocatable,intent(out),optional :: separator(:)
    

    BOUNDS ARRAY form

    subroutine split2020 (string, set, first, last)
    character(len=*),intent(in) :: string
    character(len=*),intent(in) :: set
    integer,allocatable,intent(out) :: first(:)
    integer,allocatable,intent(out) :: last(:)
    

    STEP THROUGH BY POSITION form

    subroutine split2020 (string, set, pos [, back])
    character(len=*),intent(in) :: string
    character(len=*),intent(in) :: set
    integer,intent(inout)       :: pos
    logical,intent(in),optional :: back
    

    DESCRIPTION

    Parse a string into tokens. STRING, SET, TOKENS and SEPARATOR must
    all be of the same CHARACTER kind type parameter.
    

    OPTIONS

    STRING      string to break into tokens
    
    SET         Each character in SET is a token delimiter. A
                sequence of zero or more characters in STRING delimited by
                any token delimiter, or the beginning or end of STRING,
                comprise a token. Thus, two consecutive token delimiters
                in STRING, or a token delimiter in the first or last
                character of STRING, indicate a token with zero length.
    
                ??? how about if null defaults to all whitespace characters
    
    TOKENS      It is allocated with the lower bound equal to
                one and the upper bound equal to the number of tokens in
                STRING, and with character length equal to the length of
                the longest token. The tokens in STRING are assigned by
                intrinsic assignment, in the order found, to the elements
                of TOKENS, in array element order.
    
                ???If input is null it still must be of size 1?
    
    SEPARATOR   Each element in SEPARATOR(i) is assigned the value of
                the ith token delimiter in STRING.
                It is allocated with the lower bound equal to
                one and the upper bound equal to one less than the number
                of tokens in STRING, and with character length equal to
                one.
    
                ???one less than? '' ' '
    
    FIRST     It is allocated with the lower bound equal to one and the
              upper bound equal to the number of tokens in STRING. Each
              element is assigned, in array element order, the starting
              position of each token in STRING, in the order found. If a
              token has zero length, the starting position is equal to one
              if the token is at the beginning of STRING, and one greater
              than the position of the preceding delimiter otherwise.
    
    LAST      It is allocated with the lower bound equal to one and the
              upper bound equal to the number of tokens in STRING. Each
              element is assigned, in array element order, the ending
              position of each token in STRING, in the order found. If
              a token has zero length, the ending position is one less
              than the starting position.
    
    POS       If BACK is present with the value .TRUE., the value
              of POS shall be in the range 0 < POS     LEN (STRING)+1;
              otherwise it shall be in the range 0     POS LEN (STRING).
    
              If BACK is absent or is present with the value .FALSE., POS
              is assigned the position of the leftmost token delimiter in
              STRING whose position is greater than POS, or if there is
              no such character, it is assigned a value one greater than
              the length of STRING. This identifies a token with starting
              position one greater than the value of POS on invocation,
              and ending position one less than the value of POS on return.
    
              If BACK is present with the value true, POS is assigned the
              position of the rightmost token delimiter in STRING whose
              position is less than POS, or if there is no such character,
              it is assigned the value zero. This identifies a token with
              ending position one less than the value of POS on invocation,
              and starting position one greater than the value of POS
              on return.
    
              When SPLIT is invoked with a value for POS of
              1 <= POS <= LEN(STRING) and STRING(POS:POS) is not a
              token delimiter present in SET, the token identified by
              SPLIT does not comprise a complete token as described in the
              description of the SET argument, but rather a partial token.
    
    BACK      shall be a logical scalar. It is an INTENT (IN) argument. If
              POS does not appear and BACK is present with the value true,
              STRING is scanned backwards for tokens starting from the
              end. If POS does not appear and BACK is absent or present
              with the value false, STRING is scanned forwards for tokens
              starting from the beginning.
    

    EXAMPLES

    Sample of uses

    program demo_sort2020
    use M_strings, only : split2020
    implicit none
    character(len=*),parameter :: gen='(*("[",g0,"]":,","))'
    
     ! Execution of TOKEN form
     block
       character (len=:), allocatable :: string
       character (len=:), allocatable :: tokens(:)
       character (len=*),parameter :: set = " ,"
       string = 'first,second,third'
       call split2020(string, set, tokens )
       write(*,gen)tokens
    
     ! assigns the value ['first ','second','third ' ]
     ! to TOKENS.
     endblock
    
     ! Execution of BOUNDS form
    
     block
       character (len=:), allocatable :: string
       character (len=*),parameter :: set = " ,"
       integer, allocatable        :: first(:), last(:)
       string =    'first,second,,forth'
       call split2020 (string, set, first, last)
       write(*,gen)first
       write(*,gen)last
    
     ! will assign the value [ 1, 7, 14, 15 ] to FIRST,
     ! and the value [ 5, 12, 13, 19 ] to LAST.
     endblock
    
     ! Execution of STEP form
     block
       character (len=:), allocatable :: string
       character (len=*),parameter :: set = " ,"
       integer :: p, istart, iend
       string = " one,   last  example  "
       do while (p < len(string))
         istart = p + 1
         call split2020 (string, set, p)
         iend=p-1
         if(iend > istart)then
            print '(t3,a,1x,i0,1x,i0)', string (istart:iend),istart,iend
         endif
       enddo
     endblock
    end program demo_sort2020
    

    Results:

    [first ],[second],[third ]
    [1],[7],[14],[15]
    [5],[12],[13],[19]
      one 2 4
      last 9 12
      example 15 21
    
      > ??? option to skip adjacent delimiters (not return null tokens)
      >     common with whitespace
      > ??? quoted strings, especially CSV both " and ', Fortran adjacent
      >     is insert versus other rules
      > ??? escape character like \\ .
      > ??? multi-character delimiters like \\n, \\t,
      > ??? regular expression separator
    

    AUTHOR

    Milan Curcic, "milancurcic@hey.com"
    

    LICENSE

    MIT
    

    VERSION

    version 0.1.0, copyright 2020, Milan Curcic
    

    Arguments

    Type IntentOptional Attributes Name
    character, intent(in) :: string
    character, intent(in) :: set
    character, intent(out), allocatable :: tokens(:)
    character, intent(out), optional, allocatable :: separator(:)
  • private pure subroutine split_first_last(string, set, first, last)

    Arguments

    Type IntentOptional Attributes Name
    character, intent(in) :: string
    character, intent(in) :: set
    integer, intent(out), allocatable :: first(:)
    integer, intent(out), allocatable :: last(:)
  • private pure subroutine split_pos(string, set, pos, back)

    Arguments

    Type IntentOptional Attributes Name
    character, intent(in) :: string
    character, intent(in) :: set
    integer, intent(inout) :: pos
    logical, intent(in), optional :: back

public interface string_to_value

  • private subroutine a2d(chars, valu, ierr, onerr)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: chars
    doubleprecision, intent(out) :: valu
    integer, intent(out) :: ierr
    class(*), intent(in), optional :: onerr
  • private subroutine a2r(chars, valu, ierr)

    NAME

      string_to_value(3f) - [M_strings:TYPE] subroutine returns numeric
      value from string
      (LICENSE:PD)
    

    SYNOPSIS

    subroutine string_to_value(chars,valu,ierr)
    
     character(len=*),intent(in)              :: chars   ! input string
     integer|real|doubleprecision,intent(out) :: valu
     integer,intent(out)                      :: ierr
    

    DESCRIPTION

    Returns a numeric value from a numeric character string.
    
    Works with any g-format input, including integer, real, and
    exponential. If the input string begins with "B", "Z", or "O"
    and otherwise represents a positive whole number it is assumed to
    be a binary, hexadecimal, or octal value. If the string contains
    commas they are removed. If the string is of the form NN:MMM... or
    NN#MMM then NN is assumed to be the base of the whole number.
    
    If an error occurs in the READ, IOSTAT is returned in IERR and
    value is set to zero. if no error occurs, IERR=0.
    

    OPTIONS

       CHARS  input string to read numeric value from
    

    RETURNS

    VALU   numeric value returned. May be INTEGER, REAL, or
              DOUBLEPRECISION.
    IERR   error flag (0 == no error)
    

    EXAMPLE

    Sample Program:

    program demo_string_to_value
     use M_strings, only: string_to_value
     implicit none
     real :: value
     integer :: ierr
     character(len=80) :: string
        string=' -40.5e-2 '
        call string_to_value(string,value,ierr)
        write(*,*) 'value of string ['//trim(string)//'] is ',value
    end program demo_string_to_value
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: chars
    real, intent(out) :: valu
    integer, intent(out) :: ierr
  • private subroutine a2i(chars, valu, ierr)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: chars
    integer, intent(out) :: valu
    integer, intent(out) :: ierr

public interface switch

  • private pure function a2s(array) result(string)

    NAME

    switch(3f) - [M_strings:ARRAY] converts between CHARACTER scalar and
    array of single characters
    (LICENSE:PD)
    

    SYNOPSIS

    pure function switch(array) result (string)
    
     character(len=1),intent(in) :: array(:)
     character(len=SIZE(array))  :: string
    
      or
    
    pure function switch(string) result (array)
    
     character(len=1),intent(in) :: array(:)
     character(len=SIZE(array))  :: string
    

    DESCRIPTION

    SWITCH(3f): generic function that switches CHARACTER string to an array
    of single characters or an array of single characters to a CHARACTER
    string. Useful in passing strings to C. New Fortran features may
    supersede these routines.
    

    EXAMPLES

    Sample program:

    program demo_switch
    use M_strings, only : switch, isalpha, islower, nospace
    character(len=*),parameter :: &
    & dashes='-----------------------------------'
    character(len=*),parameter :: string='This is a string'
    character(len=1024)        :: line
    
    ! First, examples of standard Fortran features
    ! returns array [F,T,T,T,T,T]
    write(*,*)['A','=','=','=','=','='] == '='
    ! this would return T
    write(*,*)all(['=','=','=','=','=','='] == '=')
    ! this would return F
    write(*,*)all(['A','=','=','=','=','='] == '=')
    
    ! so to test if the string DASHES is all dashes
    ! using SWITCH(3f) is
    if(all(switch(dashes) == '-'))then
       write(*,*)'DASHES is all dashes'
    endif
    
    ! so to test is a string is all letters
    ! isalpha(3f) returns .true. only if character is a letter
    ! false because dashes are not a letter
    write(*,*) all(isalpha(switch(dashes)))
    ! false because of spaces
    write(*,*) all(isalpha(switch(string)))
    ! true because removed whitespace
    write(*,*) all(isalpha(switch(nospace(string))))
    
    ! to see if a string is all uppercase
    ! show the string
    write(*,*) string
    ! converted to character array
    write(*,'(1x,*("[",a,"]":))') switch(string)
    write(*,'(*(l3))') islower(switch(string))
    
    ! we need a string that is all letters
    line=nospace(string)
    write(*,*)'LINE=',trim(line)
    ! all true except first character
    write(*,*) islower(switch(nospace(string)))
    ! should be false
    write(*,*) all(islower(switch(nospace(string))))
    ! should be true
    write(*,*) all(islower(switch(nospace(string(2:)))))
    
    end program demo_switch
    

    Expected output

     F T T T T T
     T
     F
     DASHES is all dashes
     F
     F
     T
     This is a string
     [T][h][i][s][ ][i][s][ ][a][ ][s][t][r][i][n][g]
      F  T  T  T  F  T  T  F  T  F  T  T  T  T  T  T
     LINE=Thisisastring
     F T T T T T T T T T T T T
     F
     T
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    character(len=1), intent(in) :: array(:)

    Return Value character(len=SIZE)

  • private pure function s2a(string) result(array)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: string

    Return Value character(len=1), (len(string))

public interface v2s

  • private function d2s(dvalue, fmt) result(outstr)

    NAME

      v2s(3f) - [M_strings:TYPE] return numeric string from a numeric value
      (LICENSE:PD)
    

    SYNOPSIS

       function v2s(value) result(outstr)
    
        integer|real|doubleprecision|logical,intent(in ) :: value
        character(len=:),allocatable :: outstr
        character(len=*),optional,intent(in) :: fmt
    

    DESCRIPTION

    v2s(3f) returns a representation of a numeric value as a
    string when given a numeric value of type REAL, DOUBLEPRECISION,
    INTEGER or LOGICAL. It creates the strings using internal WRITE()
    statements. Trailing zeros are removed from non-zero values, and the
    string is left-justified.
    

    OPTIONS

    VALUE   input value to be converted to a string
    FMT     format can be explicitly given, but is limited to
            generating a string of eighty or less characters.
    

    RETURNS

    OUTSTR  returned string representing input value,
    

    EXAMPLE

    Sample Program:

    program demo_v2s
    use M_strings, only: v2s
    write(*,*) 'The value of 3.0/4.0 is ['//v2s(3.0/4.0)//']'
    write(*,*) 'The value of 1234    is ['//v2s(1234)//']'
    write(*,*) 'The value of 0d0     is ['//v2s(0d0)//']'
    write(*,*) 'The value of .false. is ['//v2s(.false.)//']'
    write(*,*) 'The value of .true. is  ['//v2s(.true.)//']'
    end program demo_v2s
    

    Expected output

     The value of 3.0/4.0 is [0.75]
     The value of 1234    is [1234]
     The value of 0d0     is [0]
     The value of .false. is [F]
     The value of .true. is  [T]
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    doubleprecision, intent(in) :: dvalue
    character(len=*), intent(in), optional :: fmt

    Return Value character(len=:), allocatable

  • private function r2s(rvalue, fmt) result(outstr)

    Arguments

    Type IntentOptional Attributes Name
    real, intent(in) :: rvalue
    character(len=*), intent(in), optional :: fmt

    Return Value character(len=:), allocatable

  • private function i2s(ivalue, fmt) result(outstr)

    Arguments

    Type IntentOptional Attributes Name
    integer, intent(in) :: ivalue
    character(len=*), intent(in), optional :: fmt

    Return Value character(len=:), allocatable

  • private function l2s(lvalue, fmt) result(outstr)

    Arguments

    Type IntentOptional Attributes Name
    logical, intent(in) :: lvalue
    character(len=*), intent(in), optional :: fmt

    Return Value character(len=:), allocatable

public interface zpad

  • private function zpad_scalar(valuein, length) result(strout)

    NAME

    zpad(3f) - [M_strings:LENGTH] pad a string on the left with zeros to
    specified length
    (LICENSE:PD)
    

    SYNOPSIS

    function zpad(valuein,length) result(strout)
    
     class*,intent(in)           :: valuein(..)
     integer,intent(in),optional :: length
    

    DESCRIPTION

    zpad(3f) crops the input string or integer (which will be converted
    to a string) and then pads it on the left with zeros to at least
    the specified length. If the trimmed input string is longer than the
    requested length the original string is returned trimmed of leading
    and trailing spaces.
    
    For strings representing unsigned numbers this is basically an alias for
    
        strout=pad(str,length,'0',clip=.true.,right=.false.)
    
    For integers the same is often done with internal WRITE(3f) statements
    such as
    
        write(strout,'(i5.5)')ivalue
    
    but unlike internal I/O the function call can be used in expressions
    or passed as a procedure argument. If the requested length is exceeded
    the returned string is untruncated but cropped of leading and trailing
    spaces.
    

    OPTIONS

    str      May be a scalor or vector string or integer. The input string
             to return trimmed, but then padded to the specified length
             if shorter than length. If an integer is input it is first
             converted to a string. If the leftmost non-blank character
             is a sign character it is moved to the left-most position
             of the output.
    length   The minimum string length to return. If not present, the
             length of the input parameter STR is used. If the input value
             STR is not a string no zero padding occurs if LENGTH is not
             supplied.
    

    RETURNS

    strout  The input string padded to the requested length or the trimmed
            input string if the input string is longer than the requested
            length.
    

    EXAMPLE

    Sample Program:

      program demo_zpad
       use M_strings, only : zpad
       implicit none
       integer :: lun, i
          write(*,'("[",a,"]")') zpad( '111', 5)
          write(*,'("[",a,"]")') zpad( '123456789', 5)
          write(*,'("[",a,"]")') zpad( '  34567  ', 7)
          write(*,'("[",a,"]")') zpad( valuein=42 , length=7)
          write(*,'("[",a,"]")') zpad( '  +34567  ', 7)
          write(*,'("[",a,"]")') zpad( '  -34567  ', 7)
          write(*,'("[",a,"]")') zpad(1234)
          write(*,'("[",a,"]")') zpad(-1234)
          write(*,'("[",a,"]")') zpad(1234,8)
          write(*,'("[",a,"]")') zpad(-1234,8)
          write(*,'("[",a,"]")') zpad('')
          write(*,'("[",a,"]")') zpad('0')
          write(*,'("[",a,"]")') zpad('0    ')
          write(*,'("[",a,"]")') zpad('     ')
          write(*,'("[",a,"]")') zpad([1,10,100,1000,10000,100000],8)
    
          ! open output_00085.dat
          i=85
          open(newunit=lun,file='output_'//zpad(i,5)//'.dat')
          close(unit=lun,status='delete')
    
      end program demo_zpad
    

    Results:

       [00111]
       [123456789]
       [0034567]
       [0000042]
       [+0034567]
       [-0034567]
       [1234]
       [-1234]
       [00001234]
       [-00001234]
       []
       [0]
       [00000]
       [00000]
       [00000001]
       [00000010]
       [00000100]
       [00001000]
       [00010000]
       [00100000]
    

    AUTHOR

    John S. Urban
    

    LICENSE

    Public Domain
    

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: valuein
    integer, intent(in), optional :: length

    Return Value character(len=:), allocatable

  • private function zpad_vector(valuein, length) result(strout)

    Arguments

    Type IntentOptional Attributes Name
    class(*), intent(in) :: valuein(:)
    integer, intent(in), optional :: length

    Return Value character(len=:), allocatable, (:)


Functions

public pure function adjustc(string, length)

pure function adjustc(string[,length])

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string

PROCEDURE adjustc(3f) DESCRIPTION center text using implicit or explicit length

Read more…
integer, intent(in), optional :: length

Return Value character(len=:), allocatable

public pure elemental function atoi(string) result(val)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string

Return Value integer(kind=int32)

public pure elemental function atol(string) result(val)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string

Return Value integer(kind=int64)

public function base(x, b, y, a)

logical function base(x,b,y,a)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: x
integer, intent(in) :: b
character(len=*), intent(out) :: y
integer, intent(in) :: a

Return Value logical

public function base2(x) result(str)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: x

Return Value character(len=max)

public function bundle(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, len) result(vec)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in), optional :: x1
character(len=*), intent(in), optional :: x2
character(len=*), intent(in), optional :: x3
character(len=*), intent(in), optional :: x4
character(len=*), intent(in), optional :: x5
character(len=*), intent(in), optional :: x6
character(len=*), intent(in), optional :: x7
character(len=*), intent(in), optional :: x8
character(len=*), intent(in), optional :: x9
character(len=*), intent(in), optional :: x10
character(len=*), intent(in), optional :: x11
character(len=*), intent(in), optional :: x12
character(len=*), intent(in), optional :: x13
character(len=*), intent(in), optional :: x14
character(len=*), intent(in), optional :: x15
character(len=*), intent(in), optional :: x16
character(len=*), intent(in), optional :: x17
character(len=*), intent(in), optional :: x18
character(len=*), intent(in), optional :: x19
character(len=*), intent(in), optional :: x20
integer, intent(in), optional :: len

Return Value character(len=:), allocatable, (:)

public function c2s(c_string_pointer) result(f_string)

Read more…

Arguments

Type IntentOptional Attributes Name
type(c_ptr), intent(in) :: c_string_pointer

Return Value character(len=:), allocatable

public function chomp(source_string, token, delimiters)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*) :: source_string
character(len=:), intent(out), allocatable :: token
character(len=*), intent(in), optional :: delimiters

Return Value integer

public function clip(string) result(lopped)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string

Return Value character(len=:), allocatable

public function codebase(inval10, outbase, answer)

logical function codebase(in_base10,out_base,answer)

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: inval10
integer, intent(in) :: outbase
character(len=*), intent(out) :: answer

Return Value logical

public function compact(str, char) result(outstr)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
character(len=*), intent(in), optional :: char

Return Value character(len=len)

public function crop(strin) result(strout)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: strin

Return Value character(len=:), allocatable

public function decodebase(string, basein, out_baseten)

logical function decodebase(string,basein,out10)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string
integer, intent(in) :: basein
integer, intent(out) :: out_baseten

Return Value logical

public function describe(ch) result(string)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=1), intent(in) :: ch

Return Value character(len=:), allocatable

public function dilate(instr) result(outstr)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: instr

Return Value character(len=:), allocatable

public pure elemental function edit_distance(a, b)

The Levenshtein distance function returns how many edits (deletions, insertions, transposition) are required to turn one string into another.

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: a
character(len=*), intent(in) :: b

Return Value integer

public function expand(line, escape) result(lineout)

function expand(line,escape) result(lineout)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line
character(len=1), intent(in), optional :: escape

Return Value character(len=:), allocatable

public elemental function fortran_name(line) result(lout)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line

Return Value logical

public function glob(tame, wild)

Example program

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*) :: tame
character(len=*) :: wild

Return Value logical

public function indent(line)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line

Return Value integer

public function isNumber(string, msg, verbose) result(isnumber)

As the example shows, you can use an internal READ(3f) along with the IOSTAT= parameter to check (and read) a string as well.

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string
character(len=:), intent(out), optional, allocatable :: msg
logical, intent(in), optional :: verbose

Return Value integer

public elemental function isalnum(ch) result(res)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function isalpha(ch) result(res)

elemental function isalpha(onechar)

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function isascii(ch) result(res)

Sample program

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function isblank(ch) result(res)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function iscntrl(ch) result(res)

Sample program

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function isdigit(ch) result(res)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function isgraph(onechar)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: onechar

Return Value logical

public elemental function islower(ch) result(res)

Sample program

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function isprint(onechar)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: onechar

Return Value logical

public elemental function ispunct(ch) result(res)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function isspace(ch) result(res)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public pure elemental function isupper(ch) result(res)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public elemental function isxdigit(ch) result(res)

Sample program

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: ch

Return Value logical

public pure function join(str, sep, trm, left, right, start, end) result(string)

JOIN(3f) appends the elements of a CHARACTER array into a single CHARACTER variable, with elements 1 to N joined from left to right. By default each element is trimmed of trailing spaces and the default separator is a null string.

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str(:)
character(len=*), intent(in), optional :: sep
logical, intent(in), optional :: trm
character(len=*), intent(in), optional :: left
character(len=*), intent(in), optional :: right
character(len=*), intent(in), optional :: start
character(len=*), intent(in), optional :: end

Return Value character(len=:), allocatable

public elemental function len_white(string)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string

Return Value integer

public function lenset(line, length) result(strout)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line
integer, intent(in) :: length

Return Value character(len=length)

public function longest_common_substring(a, b) result(match)

Sample program

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: a
character(len=*), intent(in) :: b

Return Value character(len=:), allocatable

public pure elemental function lower(str, begin, end) result(string)

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: str
integer, intent(in), optional :: begin
integer, intent(in), optional :: end

Return Value character

public function merge_str(str1, str2, expr) result(strout)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in), optional :: str1
character(len=*), intent(in), optional :: str2
logical, intent(in) :: expr

Return Value character(len=:), allocatable

public elemental function noesc(INSTR)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: INSTR

Return Value character(len=len)

public function nospace(line)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line

Return Value character(len=:), allocatable

public function pad(line, length, pattern, right, clip) result(strout)

pad(3f) - [M_strings:LENGTH] return string padded to at least specified length (LICENSE:PD)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line
integer, intent(in) :: length
character(len=*), intent(in), optional :: pattern
logical, intent(in), optional :: right
logical, intent(in), optional :: clip

Return Value character(len=:), allocatable

public function paragraph(source_string, length)

function paragraph(source_string,length)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: source_string
integer, intent(in) :: length

Return Value character(len=:), allocatable, (:)

public function quote(str, mode, clip) result(quoted_str)

function quote(str,mode,clip) result (quoted_str)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
character(len=*), intent(in), optional :: mode
logical, intent(in), optional :: clip

Return Value character(len=:), allocatable

public function replace(targetline, old, new, cmd, occurrence, repeat, ignorecase, ierr) result(newline)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: targetline
character(len=*), intent(in), optional :: old
character(len=*), intent(in), optional :: new
character(len=*), intent(in), optional :: cmd
integer, intent(in), optional :: occurrence
integer, intent(in), optional :: repeat
logical, intent(in), optional :: ignorecase
integer, intent(out), optional :: ierr

Return Value character(len=:), allocatable

public elemental function reverse(string) result(rev)

Results:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string

Return Value character(len=len)

public function rotate13(input)

Sample program

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: input

Return Value character(len=len)

public pure function s2c(string) result(array)

Expected output:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string

Return Value character(kind=C_CHAR, len=1), (len_trim(string)+1)

public function s2v(chars, ierr, onerr)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: chars
integer, optional :: ierr
class(*), intent(in), optional :: onerr

Return Value doubleprecision

public function s2vs(string, delim) result(darray)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string
character(len=*), optional :: delim

Return Value doubleprecision, allocatable, (:)

public function sep(input_line, delimiters, nulls, order)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: input_line
character(len=*), intent(in), optional :: delimiters
character(len=*), intent(in), optional :: nulls
character(len=*), intent(in), optional :: order

Return Value character(len=:), allocatable, (:)

public function setbits16(string) result(answer)

Arguments

Type IntentOptional Attributes Name
character(len=16), intent(in) :: string

Return Value integer(kind=int16)

public function setbits32(string) result(answer)

Arguments

Type IntentOptional Attributes Name
character(len=32), intent(in) :: string

Return Value integer(kind=int32)

public function setbits64(string) result(answer)

Arguments

Type IntentOptional Attributes Name
character(len=64), intent(in) :: string

Return Value integer(kind=int64)

public function setbits8(string) result(answer)

Arguments

Type IntentOptional Attributes Name
character(len=8), intent(in) :: string

Return Value integer(kind=int8)

public function squeeze(str, charp) result(outstr)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
character(len=1), intent(in) :: charp

Return Value character(len=:), allocatable

public function stretch(line, length, pattern, suffix) result(strout)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line
integer, intent(in) :: length
character(len=*), intent(in), optional :: pattern
character(len=*), intent(in), optional :: suffix

Return Value character(len=:), allocatable

public pure function string_tokens(string, set) result(tokens)

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: string
character, intent(in) :: set

Return Value character, allocatable, (:)

public function strtok(source_string, itoken, token_start, token_end, delimiters) result(strtok_status)

function strtok(source_string,itoken,token_start,token_end,delimiters) result(strtok_status)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: source_string
integer, intent(inout) :: itoken
integer, intent(out) :: token_start
integer, intent(inout) :: token_end
character(len=*), intent(in) :: delimiters

Return Value logical

public pure function transliterate(instr, old_set, new_set) result(outstr)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: instr
character(len=*), intent(in) :: old_set
character(len=*), intent(in) :: new_set

Return Value character(len=LEN)

public function unquote(quoted_str, esc) result(unquoted_str)

function unquote(quoted_str,esc) result (unquoted_str)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: quoted_str
character(len=1), intent(in), optional :: esc

Return Value character(len=:), allocatable

public pure elemental function upper(str, begin, end) result(string)

upper(3f) - [M_strings:CASE] changes a string to uppercase (LICENSE:PD)

Read more…

Arguments

Type IntentOptional Attributes Name
character, intent(in) :: str
integer, intent(in), optional :: begin
integer, intent(in), optional :: end

Return Value character

public pure elemental function upper_quoted(str) result(string)

upper_quoted(3f) - [M_strings:CASE] elemental function converts string to miniscule skipping strings quoted per Fortran syntax rules (LICENSE:PD)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str

Return Value character(len=len)

public function visible(input) result(output)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: input

Return Value character(len=:), allocatable


Subroutines

public subroutine change(target_string, cmd, ierr)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(inout) :: target_string
character(len=*), intent(in) :: cmd
integer :: ierr

public subroutine delim(line, array, n, icount, ibegin, iterm, lgth, dlim)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line
character(len=*) :: array(n)
integer, intent(in) :: n
integer, intent(out) :: icount
integer, intent(out) :: ibegin(n)
integer, intent(out) :: iterm(n)
integer, intent(out) :: lgth
character(len=*), intent(in) :: dlim

public subroutine find_field(string, field, position, delims, delim, found)

Sample of uses

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: string
character(len=*), intent(out) :: field
integer, intent(inout), optional :: position
character(len=*), intent(in), optional :: delims
character(len=*), intent(out), optional :: delim
logical, intent(out), optional :: found

public subroutine getvals(line, values, icount, ierr)

GETVALS(3f) reads a relatively arbitrary number of numeric values from a character variable into a REAL array using list-directed input.

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line
class(*), intent(out) :: values(:)
integer, intent(out) :: icount
integer, intent(out), optional :: ierr

public subroutine listout(icurve_lists, icurve_expanded, inums_out, ierr)

(LICENSE:PD)

Read more…

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: icurve_lists(:)
integer, intent(out) :: icurve_expanded(:)
integer, intent(out) :: inums_out
integer, intent(out) :: ierr

public impure elemental subroutine matching_delimiter(str, ipos, imatch)

impure elemental subroutine matching_delimiter(str,ipos,imatch)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: str
integer, intent(in) :: ipos
integer, intent(out) :: imatch

public subroutine modif(cline, mod)

MODIF(3f) Modifies the line currently pointed at using a directive that acts much like a line editor directive. Primarily used to create interactive utilities such as input history editors for interactive line-mode programs.

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*) :: cline
character(len=*), intent(in) :: mod

public impure elemental subroutine notabs(instr, outstr, lgth)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: instr
character(len=*), intent(out) :: outstr
integer, intent(out) :: lgth

public subroutine split(input_line, array, delimiters, order, nulls)

Sample program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: input_line
character(len=:), intent(out), allocatable :: array(:)
character(len=*), intent(in), optional :: delimiters
character(len=*), intent(in), optional :: order
character(len=*), intent(in), optional :: nulls

public subroutine string_to_values(line, iread, values, inums, delims, ierr)

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: line
integer, intent(in) :: iread
real, intent(inout) :: values(iread)
integer, intent(out) :: inums
character(len=*), intent(in) :: delims
integer, intent(out) :: ierr

public subroutine substitute(targetline, old, new, ierr, start, end)

Sample Program:

Read more…

Arguments

Type IntentOptional Attributes Name
character(len=*) :: targetline
character(len=*), intent(in) :: old
character(len=*), intent(in) :: new
integer, intent(out), optional :: ierr
integer, intent(in), optional :: start
integer, intent(in), optional :: end

public subroutine value_to_string(gval, chars, length, err, fmt, trimz)

Read more…

Arguments

Type IntentOptional Attributes Name
class(*), intent(in) :: gval
character(len=*), intent(out) :: chars
integer, intent(out), optional :: length
integer, optional :: err
character(len=*), intent(in), optional :: fmt
logical, intent(in), optional :: trimz