From JLS@liverpool.ac.uk Wed Mar 11 11:56:14 1992
Received: from danpost2.uni-c.dk by dkuug.dk via EUnet with SMTP (5.64+/8+bit/IDA-1.2.8)
	id AA09914; Wed, 11 Mar 92 11:56:14 +0100
Received: from vm.uni-c.dk by danpost2.uni-c.dk (5.65/1.34)
	id AA20510; Wed, 11 Mar 92 10:55:03 GMT
Message-Id: <9203111055.AA20510@danpost2.uni-c.dk>
Received: from vm.uni-c.dk by vm.uni-c.dk (IBM VM SMTP V2R1) with BSMTP id 3418;
   Wed, 11 Mar 92 11:56:30 DNT
Received: from UKACRL.BITNET by vm.uni-c.dk (Mailer R2.07) with BSMTP id 6564;
 Wed, 11 Mar 92 11:56:26 DNT
Received: from RL.IB by UKACRL.BITNET (Mailer R2.07) with BSMTP id 5065; Wed,
 11 Mar 92 10:53:13 GMT
Received: from RL.IB by UK.AC.RL.IB (Mailer R2.07) with BSMTP id 1597; Wed, 11
          Mar 92 10:52:47 GMT
Via:      UK.AC.LIV.IBM; 11 MAR 92 10:51:19 GMT
Received: from JLS@UK.AC.LIVERPOOL by MAILER(4.2.a);  11 Mar 1992 10:46:53 GM
Date:     Wed, 11 Mar 92 10:45:46 GMT
From: Lawrie Schonfelder <JLS@liverpool.ac.uk>
Subject:  String Module A
To: SC22/WG5 members <SC22WG5@dkuug.dk>
X-Charset: ASCII
X-Char-Esc: 29

MODULE ISO_VARYING_STRING

! Written by J.L.Schonfelder
! Incorporating suggestions by C.Tanasescu, C.Weber, J.Wagener and W.Walter,
! and corrections due to L.Moss, M.Cohen, P.Griffiths, B.T.Smith
! and many other members of the committee ISO/IEC JTC1/SC22/WG5

! Version produced (10-Mar-92)

!-----------------------------------------------------------------------------!
! This module defines the interface and one possible implementation for a     !
! dynamic length character string facility in Fortran 90. The Fortran 90      !
! language is defined by the standard ISO/IEC 1539 : 1991.                    !
! The publicly accessible interface defined by this module is conformant      !
! with the collateral standard, ISO/IEC 1539-1 : 1993.                        !
! The detailed implementation may be considered as an informal definition of  !
! the required semantics, and may also be used as a guide to the production   !
! of a portable implementation.                                               !
! N.B. Although every care has been taken to produce valid Fortran code in    !
!      construction of this module no guarantee is given or implied that this !
!      code will work correctly without error on any specific processor.      !
!-----------------------------------------------------------------------------!

PRIVATE

!-----------------------------------------------------------------------------!
! By default all entities declared or defined in this module are private to   !
! the module. Only those entities declared explicitly as being public are     !
! accessible to programs using the module. In particular, the procedures and  !
! operators defined herein are made accessible via their generic identifiers  !
! only; their specific names are private.                                     !
!-----------------------------------------------------------------------------!

TYPE VARYING_STRING
 PRIVATE
 CHARACTER,DIMENSION(:),POINTER :: chars
ENDTYPE VARYING_STRING

!-----------------------------------------------------------------------------!
! The representation chosen for this definition of the module is of a string  !
! type consisting of a single component that is a pointer to a rank one array !
! of characters.                                                              !
! Note: this Module is defined only for characters of default kind. A similar !
! module could be defined for non-default characters if these are supported   !
! on a processor by adding a KIND parameter to the component in the type      !
! definition, and to all delarations of objects of CHARACTER type.            !
!-----------------------------------------------------------------------------!

CHARACTER,PARAMETER :: blank = " "
INTEGER,PARAMETER   :: ichar0 = ICHAR("0")

!----- GENERIC PROCEDURE INTERFACE DEFINITIONS -------------------------------!

!----- LEN interface ---------------------------------------------------------!
INTERFACE LEN
  MODULE PROCEDURE len_s   ! length of string
ENDINTERFACE

!----- Conversion procedure interfaces ---------------------------------------!
INTERFACE VAR_STR
  MODULE PROCEDURE c_to_s   ! character to string
ENDINTERFACE

INTERFACE CHAR
  MODULE PROCEDURE s_to_c, &   ! string to character
                   s_to_fix_c  ! string to specified length character
ENDINTERFACE

!----- ASSIGNMENT interfaces -------------------------------------------------!
INTERFACE ASSIGNMENT(=)
  MODULE PROCEDURE s_ass_s, &   ! string    = string
                   c_ass_s, &   ! character = string
                   s_ass_c      ! string    = character
ENDINTERFACE

!----- Concatenation operator interfaces -------------------------------------!
INTERFACE OPERATOR(//)
  MODULE PROCEDURE s_concat_s, &  ! string//string
                   s_concat_c, &  ! string//character
                   c_concat_s     ! character//string
ENDINTERFACE

!----- Repeated Concatenation interfaces -------------------------------------!
INTERFACE REPEAT
  MODULE PROCEDURE repeat_s
ENDINTERFACE

!------ Equality comparison operator interfaces-------------------------------!
INTERFACE OPERATOR(==)
  MODULE PROCEDURE s_eq_s, &  ! string==string
                   s_eq_c, &  ! string==character
                   c_eq_s     ! character==string
ENDINTERFACE

!----- not-equality comparison operator interfaces ---------------------------!
INTERFACE OPERATOR(/=)
  MODULE PROCEDURE s_ne_s, &  ! string/=string
                   s_ne_c, &  ! string/=character
                   c_ne_s     ! character/=string
ENDINTERFACE

!----- less-than comparison operator interfaces ------------------------------!
INTERFACE OPERATOR(<)
  MODULE PROCEDURE s_lt_s, &  ! string<string
                   s_lt_c, &  ! string<character
                   c_lt_s     ! character<string
ENDINTERFACE

!----- less-than-or-equal comparison operator interfaces ---------------------!
INTERFACE OPERATOR(<=)
  MODULE PROCEDURE s_le_s, &  ! string<=string
                   s_le_c, &  ! string<=character
                   c_le_s     ! character<=string
ENDINTERFACE

!----- greater-than-or-equal comparison operator interfaces ------------------!
INTERFACE OPERATOR(>=)
  MODULE PROCEDURE s_ge_s, &  ! string>=string
                   s_ge_c, &  ! string>=character
                   c_ge_s     ! character>=string
ENDINTERFACE

!----- greater-than comparison operator interfaces ---------------------------!
INTERFACE OPERATOR(>)
  MODULE PROCEDURE s_gt_s, &  ! string>string
                   s_gt_c, &  ! string>character
                   c_gt_s     ! character>string
ENDINTERFACE

!----- LLT procedure interfaces ----------------------------------------------!
INTERFACE LLT
  MODULE PROCEDURE s_llt_s, &  ! LLT(string,string)
                   s_llt_c, &  ! LLT(string,character)
                   c_llt_s     ! LLT(character,string)
ENDINTERFACE

!----- LLE procedure interfaces ----------------------------------------------!
INTERFACE LLE
  MODULE PROCEDURE s_lle_s, &  ! LLE(string,string)
                   s_lle_c, &  ! LLE(string,character)
                   c_lle_s     ! LLE(character,string)
ENDINTERFACE

!----- LGE procedure interfaces ----------------------------------------------!
INTERFACE LGE
  MODULE PROCEDURE s_lge_s, &  ! LGE(string,string)
                   s_lge_c, &  ! LGE(string,character)
                   c_lge_s     ! LGE(character,string)
ENDINTERFACE

!----- LGT procedure interfaces ----------------------------------------------!
INTERFACE LGT
  MODULE PROCEDURE s_lgt_s, &  ! LGT(string,string)
                   s_lgt_c, &  ! LGT(string,character)
                   c_lgt_s     ! LGT(character,string)
ENDINTERFACE

!----- Input function interface ---------------------------------------------!
INTERFACE READ_STRING
  MODULE PROCEDURE get_d_eor, &    ! default unit, EoR termination
                   get_u_eor, &    ! specified unit, EoR termination
                   get_d_tset_s, & ! default unit, string set termination
                   get_u_tset_s, & ! specified unit, string set termination
                   get_d_tset_c, & ! default unit, char set termination
                   get_u_tset_c    ! specified unit, char set termination
ENDINTERFACE

!----- Output procedure interfaces -------------------------------------------!
INTERFACE WRITE_STRING
  MODULE PROCEDURE put_d_s, & ! string to default unit
                   put_u_s, & ! string to specified unit
                   put_d_c, & ! char to default unit
                   put_u_c    ! char to specified unit
ENDINTERFACE

INTERFACE WRITE_LINE
  MODULE PROCEDURE putline_d_s, & ! string to default unit
                   putline_u_s, & ! string to specified unit
                   putline_d_c, & ! char to default unit
                   putline_u_c    ! char to specified unit
ENDINTERFACE

!----- Insert procedure interfaces -------------------------------------------!
INTERFACE INSERT
  MODULE PROCEDURE insert_ss, & ! string in string
                   insert_sc, & ! char in string
                   insert_cs, & ! string in char
                   insert_cc    ! char in char
ENDINTERFACE

!----- Replace procedure interfaces ------------------------------------------!
INTERFACE REPLACE
  MODULE PROCEDURE replace_ss, &   ! string by string, at specified
                   replace_sc, &   ! string by char  , starting
                   replace_cs, &   ! char by string  , point
                   replace_cc, &   ! char by char
                   replace_ss_sf,& ! string by string, between
                   replace_sc_sf,& ! string by char  , specified
                   replace_cs_sf,& ! char by string  , starting and
                   replace_cc_sf,& ! char by char    , finishing points
                   replace_sss, &  ! in string replace string by string
                   replace_ssc, &  ! in string replace string by char
                   replace_scs, &  ! in string replace char by string
                   replace_scc, &  ! in string replace char by char
                   replace_css, &  ! in char replace string by string
                   replace_csc, &  ! in char replace string by char
                   replace_ccs, &  ! in char replace char by string
                   replace_ccc     ! in char replace char by char
ENDINTERFACE

!----- Remove procedure interface --------------------------------------------!
INTERFACE REMOVE
  MODULE PROCEDURE remove_s, & ! characters from string, between start
                   remove_c    ! characters from char  , and finish
ENDINTERFACE

!----- Extract procedure interface -------------------------------------------!
INTERFACE EXTRACT
  MODULE PROCEDURE extract_s, & ! from string extract string, between start
                   extract_c    ! from char   extract string, and finish
ENDINTERFACE

!----- Index procedure interfaces --------------------------------------------!
INTERFACE INDEX
  MODULE PROCEDURE index_ss, index_sc, index_cs
ENDINTERFACE

!----- Scan procedure interfaces ---------------------------------------------!
INTERFACE SCAN
  MODULE PROCEDURE scan_ss, scan_sc, scan_cs
ENDINTERFACE

!----- Verify procedure interfaces -------------------------------------------!
INTERFACE VERIFY
  MODULE PROCEDURE verify_ss, verify_sc, verify_cs
ENDINTERFACE

INTERFACE LEN_TRIM
  MODULE PROCEDURE len_trim_s
ENDINTERFACE

INTERFACE TRIM
  MODULE PROCEDURE trim_s
ENDINTERFACE

INTERFACE IACHAR
  MODULE PROCEDURE iachar_s
ENDINTERFACE

INTERFACE ICHAR
  MODULE PROCEDURE ichar_s
ENDINTERFACE

INTERFACE ADJUSTL
  MODULE PROCEDURE adjustl_s
ENDINTERFACE

INTERFACE ADJUSTR
  MODULE PROCEDURE adjustr_s
ENDINTERFACE

!----- specification of publically accessible entities -----------------------!
PUBLIC ::
VARYING_STRING,VAR_STR,CHAR,LEN,READ_STRING,WRITE_STRING,WRITE_LINE,INSERT,REPLA
CE,REMOVE, &
          REPEAT,EXTRACT,INDEX,SCAN,VERIFY,LLT,LLE,LGE,LGT,ASSIGNMENT(=),    &
          OPERATOR(//),OPERATOR(==),OPERATOR(/=),OPERATOR(<),OPERATOR(<=),   &
          OPERATOR(>=),OPERATOR(>),LEN_TRIM,TRIM,IACHAR,ICHAR,ADJUSTL,ADJUSTR

CONTAINS

!----- LEN Procedure ---------------------------------------------------------!
 FUNCTION len_s(string)
  type(VARYING_STRING),INTENT(IN) :: string
  INTEGER                         :: len_s
  ! returns the length of the string argument or zero if there is no current
  ! string value
  IF(.NOT.ASSOCIATED(string%chars))THEN
    len_s = 0
  ELSE
    len_s = SIZE(string%chars)
  ENDIF
 ENDFUNCTION len_s

!----- Conversion Procedures ------------------------------------------------!
 FUNCTION c_to_s(chr)
  type(VARYING_STRING)        :: c_to_s
  CHARACTER(LEN=*),INTENT(IN) :: chr
  ! returns the string consisting of the characters char
  INTEGER                     :: lc
  lc=LEN(chr)
  ALLOCATE(c_to_s%chars(1:lc))
  DO i=1,lc
    c_to_s%chars(i) = chr(i:i)
  ENDDO
 ENDFUNCTION c_to_s

 FUNCTION s_to_c(string)
  type(VARYING_STRING),INTENT(IN)   :: string
  CHARACTER(LEN=SIZE(string%chars)) :: s_to_c
  ! returns the characters of string as an automatically sized character
  INTEGER                           :: lc
  lc=SIZE(string%chars)
  DO i=1,lc
    s_to_c(i:i) = string%chars(i)
  ENDDO
 ENDFUNCTION s_to_c

 FUNCTION s_to_fix_c(string,length)
  type(VARYING_STRING),INTENT(IN) :: string
  INTEGER,INTENT(IN)              :: length
  CHARACTER(LEN=length)           :: s_to_fix_c
  ! returns the character of fixed length, length, containing the characters
  ! of string either padded with blanks or truncated on the right to fit
  INTEGER                         :: lc
  lc=MIN(SIZE(string%chars),length)
  DO i=1,lc
    s_to_fix_c(i:i) = string%chars(i)
  ENDDO
  IF(lc < length)THEN  ! result longer than string padding needed
    s_to_fix_c(lc+1:length) = blank
  ENDIF
 ENDFUNCTION s_to_fix_c

!----- ASSIGNMENT Procedures -------------------------------------------------!
 SUBROUTINE s_ass_s(var,expr)
  type(VARYING_STRING),INTENT(OUT) :: var
  type(VARYING_STRING),INTENT(IN)  :: expr
  !  assign a string value to a string variable overriding default assignement
  !  reallocates string variable to size of string value and copies characters
  ALLOCATE(var%chars(1:LEN(expr)))
  var%chars = expr%chars
 ENDSUBROUTINE s_ass_s

 SUBROUTINE c_ass_s(var,expr)
  CHARACTER(LEN=*),INTENT(OUT)    :: var
  type(VARYING_STRING),INTENT(IN) :: expr
  ! assign a string value to a character variable
  ! if the string is longer than the character truncate the string on the right
  ! if the string is shorter the character is blank padded on the right
  INTEGER                         :: lc,ls
  lc = LEN(var); ls = MIN(LEN(expr),lc)
  DO i = 1,ls
   var(i:i) = expr%chars(i)
  ENDDO
  DO i = ls+1,lc
   var(i:i) = blank
  ENDDO
 ENDSUBROUTINE c_ass_s

 SUBROUTINE s_ass_c(var,expr)
  type(VARYING_STRING),INTENT(OUT) :: var
  CHARACTER(LEN=*),INTENT(IN)      :: expr
  !  assign a character value to a string variable
  !  disassociates the string variable from its current value, allocates new
  !  space to hold the characters and copies them from the character value
  !  into this space.
  INTEGER                          :: lc
  lc = LEN(expr)
  ALLOCATE(var%chars(1:lc))
  DO i = 1,lc
    var%chars(i) = expr(i:i)
  ENDDO
 ENDSUBROUTINE s_ass_c

!----- Concatenation operator procedures ------------------------------------!
 FUNCTION s_concat_s(string_a,string_b)  ! string//string
  type(VARYING_STRING),INTENT(IN) :: string_a,string_b
  type(VARYING_STRING)            :: s_concat_s
  INTEGER                         :: la,lb
  la = LEN(string_a); lb = LEN(string_b)
  ALLOCATE(s_concat_s%chars(1:la+lb))
  s_concat_s%chars(1:la) = string_a%chars
  s_concat_s%chars(1+la:la+lb) = string_b%chars
 ENDFUNCTION s_concat_s

 FUNCTION s_concat_c(string_a,string_b)  ! string//character
  type(VARYING_STRING),INTENT(IN) :: string_a
  CHARACTER(LEN=*),INTENT(IN)     :: string_b
  type(VARYING_STRING)            :: s_concat_c
  INTEGER                         :: la,lb
  la = LEN(string_a); lb = LEN(string_b)
  ALLOCATE(s_concat_c%chars(1:la+lb))
  s_concat_c%chars(1:la) = string_a%chars
  DO i = 1,lb
    s_concat_c%chars(la+i) = string_b(i:i)
  ENDDO
 ENDFUNCTION s_concat_c

 FUNCTION c_concat_s(string_a,string_b)  ! character//string
  CHARACTER(LEN=*),INTENT(IN)     :: string_a
  type(VARYING_STRING),INTENT(IN) :: string_b
  type(VARYING_STRING)            :: c_concat_s
  INTEGER                         :: la,lb
  la = LEN(string_a); lb = LEN(string_b)
  ALLOCATE(c_concat_s%chars(1:la+lb))
  DO i = 1,la
     c_concat_s%chars(i) = string_a(i:i)
  ENDDO
  c_concat_s%chars(1+la:la+lb) = string_b%chars
 ENDFUNCTION c_concat_s

!----- Reapeated concatenation procedures -----------------------------------!
FUNCTION repeat_s(string,ncopies)
 type(VARYING_STRING),INTENT(IN) :: string
 INTEGER,INTENT(IN)              :: ncopies
 type(VARYING_STRING)            :: repeat_s
 ! Returns a string produced by the concatenation of ncopies of the
 ! argument string
 INTEGER                         :: lr,ls
 IF (ncopies < 0) THEN
     WRITE(*,*) " Negative ncopies requested in REPEAT"
     STOP
 ENDIF
 ls = LEN(string); lr = ls*ncopies
 ALLOCATE(repeat_s%chars(1:lr))
 DO i = 1,ncopies
    repeat_s%chars(1+(i-1)*ls:i*ls) = string%chars
 ENDDO
ENDFUNCTION repeat_s

!------ Equality comparison operators ----------------------------------------!
 FUNCTION s_eq_s(string_a,string_b)  ! string==string
  type(VARYING_STRING),INTENT(IN) :: string_a,string_b
  LOGICAL                         :: s_eq_s
  INTEGER                         :: la,lb
  la = LEN(string_a); lb = LEN(string_b)
  IF (la > lb) THEN
     s_eq_s = ALL(string_a%chars(1:lb) == string_b%chars) .AND. &
              ALL(string_a%chars(lb+1:la) == blank)
  ELSEIF (la < lb) THEN
     s_eq_s = ALL(string_a%chars == string_b%chars(1:la)) .AND. &
              ALL(blank == string_b%chars(la+1:lb))
  ELSE
     s_eq_s = ALL(string_a%chars == string_b%chars)
  ENDIF
 ENDFUNCTION s_eq_s

 FUNCTION s_eq_c(string_a,string_b)  ! string==character
  type(VARYING_STRING),INTENT(IN) :: string_a
  CHARACTER(LEN=*),INTENT(IN)     :: string_b
  LOGICAL                         :: s_eq_c
  INTEGER                         :: la,lb,ls
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) /= string_b(i:i) )THEN
      s_eq_c = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la > lb .AND. ANY( string_a%chars(lb+1:la) /= blank ) )THEN
    s_eq_c = .FALSE.; RETURN
  ELSEIF( la < lb .AND. blank /= string_b(la+1:lb) )THEN
    s_eq_c = .FALSE.; RETURN
  ENDIF
  s_eq_c = .TRUE.
 ENDFUNCTION s_eq_c

 FUNCTION c_eq_s(string_a,string_b)  ! character==string
  CHARACTER(LEN=*),INTENT(IN)     :: string_a
  type(VARYING_STRING),INTENT(IN) :: string_b
  LOGICAL                         :: c_eq_s
  INTEGER                         :: la,lb,ls
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a(i:i) /= string_b%chars(i) )THEN
      c_eq_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la > lb .AND. string_a(lb+1:la) /= blank )THEN
    c_eq_s = .FALSE.; RETURN
  ELSEIF( la < lb .AND. ANY( blank /= string_b%chars(la+1:lb) ) )THEN
    c_eq_s = .FALSE.; RETURN
  ENDIF
  c_eq_s = .TRUE.
 ENDFUNCTION c_eq_s

!------ Non-equality operators -----------------------------------------------!
 FUNCTION s_ne_s(string_a,string_b)  ! string/=string
  type(VARYING_STRING),INTENT(IN) :: string_a,string_b
  LOGICAL                         :: s_ne_s
  INTEGER                         :: la,lb
  la = LEN(string_a); lb = LEN(string_b)
  IF (la > lb) THEN
     s_ne_s = ANY(string_a%chars(1:lb) /= string_b%chars) .OR. &
              ANY(string_a%chars(lb+1:la) /= blank)
  ELSEIF (la < lb) THEN
     s_ne_s = ANY(string_a%chars /= string_b%chars(1:la)) .OR. &
              ANY(blank /= string_b%chars(la+1:lb))
  ELSE
     s_ne_s = ANY(string_a%chars /= string_b%chars)
  ENDIF
 ENDFUNCTION s_ne_s

 FUNCTION s_ne_c(string_a,string_b)  ! string/=character
  type(VARYING_STRING),INTENT(IN) :: string_a
  CHARACTER(LEN=*),INTENT(IN)     :: string_b
  LOGICAL                         :: s_ne_c
  INTEGER                         :: la,lb,ls
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) /= string_b(i:i) )THEN
      s_ne_c = .TRUE.; RETURN
    ENDIF
  ENDDO
  IF( la > lb .AND. ANY( string_a%chars(lb+1:la) /= blank ) )THEN
    s_ne_c = .TRUE.; RETURN
  ELSEIF( la < lb .AND. blank /= string_b(la+1:lb) )THEN
    s_ne_c = .TRUE.; RETURN
  ENDIF
  s_ne_c = .FALSE.
 ENDFUNCTION s_ne_c

 FUNCTION c_ne_s(string_a,string_b)  ! character/=string
  CHARACTER(LEN=*),INTENT(IN)     :: string_a
  type(VARYING_STRING),INTENT(IN) :: string_b
  LOGICAL                         :: c_ne_s
  INTEGER                         :: la,lb,ls
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a(i:i) /= string_b%chars(i) )THEN
      c_ne_s = .TRUE.; RETURN
    ENDIF
  ENDDO
  IF( la > lb .AND. string_a(lb+1:la) /= blank )THEN
    c_ne_s = .TRUE.; RETURN
  ELSEIF( la < lb .AND. ANY( blank /= string_b%chars(la+1:lb) ) )THEN
    c_ne_s = .TRUE.; RETURN
  ENDIF
  c_ne_s = .FALSE.
 ENDFUNCTION c_ne_s

!------ Less-than operators --------------------------------------------------!
 FUNCTION s_lt_s(string_a,string_b)  ! string<string
  type(VARYING_STRING),INTENT(IN) :: string_a,string_b
  LOGICAL                         :: s_lt_s
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) < string_b%chars(i) )THEN
      s_lt_s = .TRUE.; RETURN
    ELSEIF( string_a%chars(i) > string_b%chars(i) )THEN
      s_lt_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( blank < string_b%chars(i) )THEN
        s_lt_s = .TRUE.; RETURN
      ELSEIF( blank > string_b%chars(i) )THEN
        s_lt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( string_a%chars(i) < blank )THEN
        s_lt_s = .TRUE.; RETURN
      ELSEIF( string_a%chars(i) > blank )THEN
        s_lt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_lt_s = .FALSE.
 ENDFUNCTION s_lt_s

 FUNCTION s_lt_c(string_a,string_b)  ! string<character
  type(VARYING_STRING),INTENT(IN) :: string_a
  CHARACTER(LEN=*),INTENT(IN)     :: string_b
  LOGICAL                         :: s_lt_c
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) < string_b(i:i) )THEN
      s_lt_c = .TRUE.; RETURN
    ELSEIF( string_a%chars(i) > string_b(i:i) )THEN
      s_lt_c = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    IF( blank < string_b(la+1:lb) )THEN
      s_lt_c = .TRUE.; RETURN
    ELSEIF( blank > string_b(la+1:lb) )THEN
      s_lt_c = .FALSE.; RETURN
    ENDIF
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( string_a%chars(i) < blank )THEN
        s_lt_c = .TRUE.; RETURN
      ELSEIF( string_a%chars(i) > blank )THEN
        s_lt_c = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_lt_c = .FALSE.
 ENDFUNCTION s_lt_c

 FUNCTION c_lt_s(string_a,string_b)  ! character<string
  CHARACTER(LEN=*),INTENT(IN)     :: string_a
  type(VARYING_STRING),INTENT(IN) :: string_b
  LOGICAL                         :: c_lt_s
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a(i:i) < string_b%chars(i) )THEN
      c_lt_s = .TRUE.; RETURN
    ELSEIF( string_a(i:i) > string_b%chars(i) )THEN
      c_lt_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( blank < string_b%chars(i) )THEN
        c_lt_s = .TRUE.; RETURN
      ELSEIF( blank > string_b%chars(i) )THEN
        c_lt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    IF( string_a(lb+1:la) < blank )THEN
      c_lt_s = .TRUE.; RETURN
    ELSEIF( string_a(lb+1:la) > blank )THEN
      c_lt_s = .FALSE.; RETURN
    ENDIF
  ENDIF
  c_lt_s = .FALSE.
 ENDFUNCTION c_lt_s

!------ Less-than-or-equal-to operators --------------------------------------!
 FUNCTION s_le_s(string_a,string_b)  ! string<=string
  type(VARYING_STRING),INTENT(IN) :: string_a,string_b
  LOGICAL                         :: s_le_s
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) < string_b%chars(i) )THEN
      s_le_s = .TRUE.; RETURN
    ELSEIF( string_a%chars(i) > string_b%chars(i) )THEN
      s_le_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( blank < string_b%chars(i) )THEN
        s_le_s = .TRUE.; RETURN
      ELSEIF( blank > string_b%chars(i) )THEN
        s_le_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( string_a%chars(i) < blank )THEN
        s_le_s = .TRUE.; RETURN
      ELSEIF( string_a%chars(i) > blank )THEN
        s_le_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_le_s = .TRUE.
 ENDFUNCTION s_le_s

 FUNCTION s_le_c(string_a,string_b)  ! string<=character
  type(VARYING_STRING),INTENT(IN) :: string_a
  CHARACTER(LEN=*),INTENT(IN)     :: string_b
  LOGICAL                         :: s_le_c
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) < string_b(i:i) )THEN
      s_le_c = .TRUE.; RETURN
    ELSEIF( string_a%chars(i) > string_b(i:i) )THEN
      s_le_c = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    IF( blank < string_b(la+1:lb) )THEN
      s_le_c = .TRUE.; RETURN
    ELSEIF( blank > string_b(la+1:lb) )THEN
      s_le_c = .FALSE.; RETURN
    ENDIF
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( string_a%chars(i) < blank )THEN
        s_le_c = .TRUE.; RETURN
      ELSEIF( string_a%chars(i) > blank )THEN
        s_le_c = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_le_c = .TRUE.
 ENDFUNCTION s_le_c

 FUNCTION c_le_s(string_a,string_b)  ! character<=string
  CHARACTER(LEN=*),INTENT(IN)     :: string_a
  type(VARYING_STRING),INTENT(IN) :: string_b
  LOGICAL                         :: c_le_s
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a(i:i) < string_b%chars(i) )THEN
      c_le_s = .TRUE.; RETURN
    ELSEIF( string_a(i:i) > string_b%chars(i) )THEN
      c_le_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( blank < string_b%chars(i) )THEN
        c_le_s = .TRUE.; RETURN
      ELSEIF( blank > string_b%chars(i) )THEN
        c_le_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    IF( string_a(lb+1:la) < blank )THEN
      c_le_s = .TRUE.; RETURN
    ELSEIF( string_a(lb+1:la) > blank )THEN
      c_le_s = .FALSE.; RETURN
    ENDIF
  ENDIF
  c_le_s = .TRUE.
 ENDFUNCTION c_le_s

!------ Greater-than-or-equal-to operators -----------------------------------!
 FUNCTION s_ge_s(string_a,string_b)  ! string>=string
  type(VARYING_STRING),INTENT(IN) :: string_a,string_b
  LOGICAL                         :: s_ge_s
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) > string_b%chars(i) )THEN
      s_ge_s = .TRUE.; RETURN
    ELSEIF( string_a%chars(i) < string_b%chars(i) )THEN
      s_ge_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( blank > string_b%chars(i) )THEN
        s_ge_s = .TRUE.; RETURN
      ELSEIF( blank < string_b%chars(i) )THEN
        s_ge_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( string_a%chars(i) > blank )THEN
        s_ge_s = .TRUE.; RETURN
      ELSEIF( string_a%chars(i) < blank )THEN
        s_ge_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_ge_s = .TRUE.
 ENDFUNCTION s_ge_s

 FUNCTION s_ge_c(string_a,string_b)  ! string>=character
  type(VARYING_STRING),INTENT(IN) :: string_a
  CHARACTER(LEN=*),INTENT(IN)     :: string_b
  LOGICAL                         :: s_ge_c
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) > string_b(i:i) )THEN
      s_ge_c = .TRUE.; RETURN
    ELSEIF( string_a%chars(i) < string_b(i:i) )THEN
      s_ge_c = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    IF( blank > string_b(la+1:lb) )THEN
      s_ge_c = .TRUE.; RETURN
    ELSEIF( blank < string_b(la+1:lb) )THEN
      s_ge_c = .FALSE.; RETURN
    ENDIF
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( string_a%chars(i) > blank )THEN
        s_ge_c = .TRUE.; RETURN
      ELSEIF( string_a%chars(i) < blank )THEN
        s_ge_c = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_ge_c = .TRUE.
 ENDFUNCTION s_ge_c

 FUNCTION c_ge_s(string_a,string_b)  ! character>=string
  CHARACTER(LEN=*),INTENT(IN)     :: string_a
  type(VARYING_STRING),INTENT(IN) :: string_b
  LOGICAL                         :: c_ge_s
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a(i:i) > string_b%chars(i) )THEN
      c_ge_s = .TRUE.; RETURN
    ELSEIF( string_a(i:i) < string_b%chars(i) )THEN
      c_ge_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( blank > string_b%chars(i) )THEN
        c_ge_s = .TRUE.; RETURN
      ELSEIF( blank < string_b%chars(i) )THEN
        c_ge_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    IF( string_a(lb+1:la) > blank )THEN
      c_ge_s = .TRUE.; RETURN
    ELSEIF( string_a(lb+1:la) < blank )THEN
      c_ge_s = .FALSE.; RETURN
    ENDIF
  ENDIF
  c_ge_s = .TRUE.
 ENDFUNCTION c_ge_s

!------ Greater-than operators -----------------------------------------------!
 FUNCTION s_gt_s(string_a,string_b)  ! string>string
  type(VARYING_STRING),INTENT(IN) :: string_a,string_b
  LOGICAL                         :: s_gt_s
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) > string_b%chars(i) )THEN
      s_gt_s = .TRUE.; RETURN
    ELSEIF( string_a%chars(i) < string_b%chars(i) )THEN
      s_gt_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( blank > string_b%chars(i) )THEN
        s_gt_s = .TRUE.; RETURN
      ELSEIF( blank < string_b%chars(i) )THEN
        s_gt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( string_a%chars(i) > blank )THEN
        s_gt_s = .TRUE.; RETURN
      ELSEIF( string_a%chars(i) < blank )THEN
        s_gt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_gt_s = .FALSE.
 ENDFUNCTION s_gt_s

 FUNCTION s_gt_c(string_a,string_b)  ! string>character
  type(VARYING_STRING),INTENT(IN) :: string_a
  CHARACTER(LEN=*),INTENT(IN)     :: string_b
  LOGICAL                         :: s_gt_c
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a%chars(i) > string_b(i:i) )THEN
      s_gt_c = .TRUE.; RETURN
    ELSEIF( string_a%chars(i) < string_b(i:i) )THEN
      s_gt_c = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    IF( blank > string_b(la+1:lb) )THEN
      s_gt_c = .TRUE.; RETURN
    ELSEIF( blank < string_b(la+1:lb) )THEN
      s_gt_c = .FALSE.; RETURN
    ENDIF
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( string_a%chars(i) > blank )THEN
        s_gt_c = .TRUE.; RETURN
      ELSEIF( string_a%chars(i) < blank )THEN
        s_gt_c = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_gt_c = .FALSE.
 ENDFUNCTION s_gt_c

 FUNCTION c_gt_s(string_a,string_b)  ! character>string
  CHARACTER(LEN=*),INTENT(IN)     :: string_a
  type(VARYING_STRING),INTENT(IN) :: string_b
  LOGICAL                         :: c_gt_s
  INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( string_a(i:i) > string_b%chars(i) )THEN
      c_gt_s = .TRUE.; RETURN
    ELSEIF( string_a(i:i) < string_b%chars(i) )THEN
      c_gt_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( blank > string_b%chars(i) )THEN
        c_gt_s = .TRUE.; RETURN
      ELSEIF( blank < string_b%chars(i) )THEN
        c_gt_s = .FALSE.; RETURN
      ENDIF
    ENDDO