From JLS@liverpool.ac.uk Mon Mar  9 14:42:04 1992
Received: from danpost2.uni-c.dk by dkuug.dk via EUnet with SMTP (5.64+/8+bit/IDA-1.2.8)
	id AA20806; Mon, 9 Mar 92 14:42:04 +0100
Received: from vm.uni-c.dk by danpost2.uni-c.dk (5.65/1.34)
	id AA16876; Mon, 9 Mar 92 13:40:52 GMT
Message-Id: <9203091340.AA16876@danpost2.uni-c.dk>
Received: from vm.uni-c.dk by vm.uni-c.dk (IBM VM SMTP V2R1) with BSMTP id 0661;
   Mon, 09 Mar 92 14:42:18 DNT
Received: from UKACRL.BITNET by vm.uni-c.dk (Mailer R2.07) with BSMTP id 6534;
 Mon, 09 Mar 92 14:42:14 DNT
Received: from RL.IB by UKACRL.BITNET (Mailer R2.07) with BSMTP id 4745; Mon,
 09 Mar 92 13:34:51 GMT
Received: from RL.IB by UK.AC.RL.IB (Mailer R2.07) with BSMTP id 5211; Mon, 09
          Mar 92 13:34:39 GMT
Via:      UK.AC.LIV.IBM;  9 MAR 92 13:33:12 GMT
Received: from JLS@UK.AC.LIVERPOOL by MAILER(4.2.a);  9 Mar 1992 13:30:39 GM
Date:     Mon, 09 Mar 92 13:30:00 GMT
From: Lawrie Schonfelder <JLS@liverpool.ac.uk>
Subject:  is1539_1 b
To: SC22/WG5 members <SC22WG5@dkuug.dk>
X-Charset: ASCII
X-Char-Esc: 29

   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)
  IF(ASSOCIATED(var%chars))DEALLOCATE(var%chars)
  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
  ELSEIF( la > lb )THEN
    IF( string_a(lb+1:la) > blank )THEN
      c_gt_s = .TRUE.; RETURN
    ELSEIF( string_a(lb+1:la) < blank )THEN
      c_gt_s = .FALSE.; RETURN
    ENDIF
  ENDIF
  c_gt_s = .FALSE.
 ENDFUNCTION c_gt_s

!----- LLT procedures -------------------------------------------------------!
FUNCTION s_llt_s(string_a,string_b)  ! string_a<string_b ISO-646 ordering
 type(VARYING_STRING),INTENT(IN) :: string_a,string_b
 LOGICAL                         :: s_llt_s
 ! Returns TRUE if string_a preceeds string_b in the ISO 646 collating
 ! sequence. Otherwise the result is FALSE. The result is FALSE if both
 ! string_a and string_b are zero length.
 INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( LLT(string_a%chars(i),string_b%chars(i)) )THEN
      s_llt_s = .TRUE.; RETURN
    ELSEIF( LGT(string_a%chars(i),string_b%chars(i)) )THEN
      s_llt_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( LLT(blank,string_b%chars(i)) )THEN
        s_llt_s = .TRUE.; RETURN
      ELSEIF( LGT(blank,string_b%chars(i)) )THEN
        s_llt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( LLT(string_a%chars(i),blank) )THEN
        s_llt_s = .TRUE.; RETURN
      ELSEIF( LGT(string_a%chars(i),blank) )THEN
        s_llt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_llt_s = .FALSE.
ENDFUNCTION s_llt_s

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

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

!----- LLE procedures -------------------------------------------------------!
FUNCTION s_lle_s(string_a,string_b)  ! string_a<=string_b ISO-646 ordering
 type(VARYING_STRING),INTENT(IN) :: string_a,string_b
 LOGICAL                         :: s_lle_s
 ! Returns TRUE if strings are equal or if string_a preceeds string_b in the
 ! ISO 646 collating sequence.  Otherwise the result is FALSE.
 INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( LLT(string_a%chars(i),string_b%chars(i)) )THEN
      s_lle_s = .TRUE.; RETURN
    ELSEIF( LGT(string_a%chars(i),string_b%chars(i)) )THEN
      s_lle_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( LLT(blank,string_b%chars(i)) )THEN
        s_lle_s = .TRUE.; RETURN
      ELSEIF( LGT(blank,string_b%chars(i)) )THEN
        s_lle_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( LLT(string_a%chars(i),blank) )THEN
        s_lle_s = .TRUE.; RETURN
      ELSEIF( LGT(string_a%chars(i),blank) )THEN
        s_lle_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_lle_s = .TRUE.
ENDFUNCTION s_lle_s

FUNCTION s_lle_c(string_a,string_b)  ! strung_a<=string_b ISO-646 ordering
 type(VARYING_STRING),INTENT(IN) :: string_a
 CHARACTER(LEN=*),INTENT(IN)     :: string_b
 LOGICAL                         :: s_lle_c
 INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( LLT(string_a%chars(i),string_b(i:i)) )THEN
      s_lle_c = .TRUE.; RETURN
    ELSEIF( LGT(string_a%chars(i),string_b(i:i)) )THEN
      s_lle_c = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    IF( LLT(blank,string_b(la+1:lb)) )THEN
      s_lle_c = .TRUE.; RETURN
    ELSEIF( LGT(blank,string_b(la+1:lb)) )THEN
      s_lle_c = .FALSE.; RETURN
    ENDIF
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( LLT(string_a%chars(i),blank) )THEN
        s_lle_c = .TRUE.; RETURN
      ELSEIF( LGT(string_a%chars(i),blank) )THEN
        s_lle_c = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_lle_c = .TRUE.
ENDFUNCTION s_lle_c

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

!----- LGE procedures -------------------------------------------------------!
FUNCTION s_lge_s(string_a,string_b)  ! string_a>=string_b ISO-646 ordering
 type(VARYING_STRING),INTENT(IN) :: string_a,string_b
 LOGICAL                         :: s_lge_s
 ! Returns TRUE if strings are equal or if string_a follows string_b in the
 ! ISO 646 collating sequence. Otherwise the result is FALSE.
 INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( LGT(string_a%chars(i),string_b%chars(i)) )THEN
      s_lge_s = .TRUE.; RETURN
    ELSEIF( LLT(string_a%chars(i),string_b%chars(i)) )THEN
      s_lge_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( LGT(blank,string_b%chars(i)) )THEN
        s_lge_s = .TRUE.; RETURN
      ELSEIF( LLT(blank,string_b%chars(i)) )THEN
        s_lge_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( LGT(string_a%chars(i),blank) )THEN
        s_lge_s = .TRUE.; RETURN
      ELSEIF( LLT(string_a%chars(i),blank) )THEN
        s_lge_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_lge_s = .TRUE.
ENDFUNCTION s_lge_s

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

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

!----- LGT procedures -------------------------------------------------------!
FUNCTION s_lgt_s(string_a,string_b)  ! string_a>string_b ISO-646 ordering
 type(VARYING_STRING),INTENT(IN) :: string_a,string_b
 LOGICAL                         :: s_lgt_s
 ! Returns TRUE if string_a follows string_b in the ISO 646 collating sequence.
 ! Otherwise the result is FALSE. The result is FALSE if both string_a and
 ! string_b are zero length.
 INTEGER                         :: ls,la,lb
  la = LEN(string_a); lb = LEN(string_b); ls = MIN(la,lb)
  DO i = 1,ls
    IF( LGT(string_a%chars(i),string_b%chars(i)) )THEN
      s_lgt_s = .TRUE.; RETURN
    ELSEIF( LLT(string_a%chars(i),string_b%chars(i)) )THEN
      s_lgt_s = .FALSE.; RETURN
    ENDIF
  ENDDO
  IF( la < lb )THEN
    DO i = la+1,lb
      IF( LGT(blank,string_b%chars(i)) )THEN
        s_lgt_s = .TRUE.; RETURN
      ELSEIF( LLT(blank,string_b%chars(i)) )THEN
        s_lgt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ELSEIF( la > lb )THEN
    DO i = lb+1,la
      IF( LGT(string_a%chars(i),blank) )THEN
        s_lgt_s = .TRUE.; RETURN
      ELSEIF( LLT(string_a%chars(i),blank) )THEN
        s_lgt_s = .FALSE.; RETURN
      ENDIF
    ENDDO
  ENDIF
  s_lgt_s = .FALSE.
ENDFUNCTION s_lgt_s

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

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


!----- Input string procedure -----------------------------------------------!
SUBROUTINE get_d_eor(string,maxlen,iostat)
 type(VARYING_STRING),INTENT(OUT) :: string
                                  ! the string variable to be filled with
                                  ! characters read from the
                                  ! file connected to the default unit
 INTEGER,INTENT(IN),OPTIONAL      :: maxlen
                                  ! if present indicates the maximum
                                  ! number of characters that will be
                                  ! read from the file
 INTEGER,INTENT(OUT),OPTIONAL     :: iostat
                                  ! if present used to return the status
                                  ! of the data transfer
                                  ! if absent errors cause termination
! reads string from the default unit starting at next character in the file
! and terminating at the end of record or after maxlen characters.
 CHARACTER(LEN=80) :: buffer
 INTEGER           :: ist,nch,toread,nb
 IF(PRESENT(maxlen))THEN
   toread=maxlen
 ELSE
   toread=HUGE(1)
 ENDIF
 string = "" ! clears return string
 DO  ! repeatedly read buffer and add to string until EoR
     ! or maxlen reached
   IF(toread <= 0)EXIT
   nb=MIN(80,toread)
   READ(*,FMT='(A)',ADVANCE='NO',EOR=9999,SIZE=nch,IOSTAT=ist) buffer(1:nb)
   IF( ist /= 0 )THEN
     IF(PRESENT(iostat)) THEN
       iostat=ist
       RETURN
     ELSE
       WRITE(*,*) " Error No.",ist, &
                  " during READ_STRING of varying string on default unit"
       STOP
     ENDIF
   ENDIF
   string = string //buffer(1:nb)
   toread = toread - nb
 ENDDO
 IF(PRESENT(iostat)) iostat = 0