From JLS@liverpool.ac.uk Wed Mar 11 11:59:25 1992
Received: from danpost2.uni-c.dk by dkuug.dk via EUnet with SMTP (5.64+/8+bit/IDA-1.2.8)
	id AA10030; Wed, 11 Mar 92 11:59:25 +0100
Received: from vm.uni-c.dk by danpost2.uni-c.dk (5.65/1.34)
	id AA20529; Wed, 11 Mar 92 10:58:13 GMT
Message-Id: <9203111058.AA20529@danpost2.uni-c.dk>
Received: from vm.uni-c.dk by vm.uni-c.dk (IBM VM SMTP V2R1) with BSMTP id 3426;
   Wed, 11 Mar 92 11:59:40 DNT
Received: from UKACRL.BITNET by vm.uni-c.dk (Mailer R2.07) with BSMTP id 6613;
 Wed, 11 Mar 92 11:59:37 DNT
Received: from RL.IB by UKACRL.BITNET (Mailer R2.07) with BSMTP id 5144; Wed,
 11 Mar 92 10:57:55 GMT
Received: from RL.IB by UK.AC.RL.IB (Mailer R2.07) with BSMTP id 1687; Wed, 11
          Mar 92 10:56:48 GMT
Via:      UK.AC.LIV.IBM; 11 MAR 92 10:53:31 GMT
Received: from JLS@UK.AC.LIVERPOOL by MAILER(4.2.a);  11 Mar 1992 10:49:17 GM
Date:     Wed, 11 Mar 92 10:48:11 GMT
From: Lawrie Schonfelder <JLS@liverpool.ac.uk>
Subject:  string module D
To: SC22/WG5 members <SC22WG5@dkuug.dk>
X-Charset: ASCII
X-Char-Esc: 29

 ENDIF
 IF( PRESENT(every) )THEN
   rep_search = every
 ELSE
   rep_search = .FALSE.
 ENDIF
 IF( dir_switch )THEN ! backwards search
   ipos = ls-lt+1
   DO
     IF( ipos < 1 )EXIT ! search past start of string
     ! test for occurance of target in string at this position
     IF( string(ipos:ipos+lt-1) == target )THEN
       ! match found allocate space for string with this occurance of
       ! target replaced by substring
       ALLOCATE(temp(1:SIZE(work)+lsub-lt))
       ! copy work into temp replacing this occurance of target by
       ! substring
       temp(1:ipos-1) = work(1:ipos-1)
       temp(ipos:ipos+lsub-1) = substring%chars
       temp(ipos+lsub:) = work(ipos+lt:)
       work => temp ! make new version of work point at the temp space
       IF(.NOT.rep_search)EXIT ! exit if only first replacement wanted
       ! move search and replacement positions over the effected positions
       ipos = ipos-lt+1
     ENDIF
     ipos=ipos-1
   ENDDO
 ELSE ! forward search
   ipos = 1; ipow = 1
   DO
     IF( ipos > ls-lt+1 )EXIT ! search past end of string
     ! test for occurance of target in string at this position
     IF( string(ipos:ipos+lt-1) == target )THEN
       ! match found allocate space for string with this occurance of
       ! target replaced by substring
       ALLOCATE(temp(1:SIZE(work)+lsub-lt))
       ! copy work into temp replacing this occurance of target by
       ! substring
       temp(1:ipow-1) = work(1:ipow-1)
       temp(ipow:ipow+lsub-1) = substring%chars
       temp(ipow+lsub:) = work(ipow+lt:)
       work => temp ! make new version of work point at the temp space
       IF(.NOT.rep_search)EXIT ! exit if only first replacement wanted
       ! move search and replacement positions over the effected positions
       ipos = ipos+lt-1; ipow = ipow+lsub-1
     ENDIF
     ipos=ipos+1; ipow=ipow+1
   ENDDO
 ENDIF
 replace_ccs%chars => work
ENDFUNCTION replace_ccs

FUNCTION replace_ccc(string,target,substring,every,back)
 type(VARYING_STRING)            :: replace_ccc
 CHARACTER(LEN=*),INTENT(IN)     :: string,target,substring
 LOGICAL,INTENT(IN),OPTIONAL     :: every,back
 !  calculates the result string by the following actions:
 !  searches for occurences of target in string, and replaces these with
 !  substring. if back present with value true search is backward otherwise
 !  search is done forward. if every present with value true all accurences
 !  of target in string are replaced, otherwise only the first found is
 !  replaced. if target is not found the result is the same as string.
 LOGICAL                        :: dir_switch, rep_search
 CHARACTER,DIMENSION(:),POINTER :: work,temp
 INTEGER                        :: ls,lt,lsub,ipos,ipow
 ls = LEN(string); lt = LEN(target); lsub = LEN(substring)
 IF(lt==0)THEN
   WRITE(*,*) " Zero length target in REPLACE"
   STOP
 ENDIF
 ALLOCATE(work(1:ls))
 DO i=1,ls
   work(i) = string(i:i)
 ENDDO
 IF( PRESENT(back) )THEN
   dir_switch = back
 ELSE
   dir_switch = .FALSE.
 ENDIF
 IF( PRESENT(every) )THEN
   rep_search = every
 ELSE
   rep_search = .FALSE.
 ENDIF
 IF( dir_switch )THEN ! backwards search
   ipos = ls-lt+1
   DO
     IF( ipos < 1 )EXIT ! search past start of string
     ! test for occurance of target in string at this position
     IF( string(ipos:ipos+lt-1) == target )THEN
       ! match found allocate space for string with this occurance of
       ! target replaced by substring
       ALLOCATE(temp(1:SIZE(work)+lsub-lt))
       ! copy work into temp replacing this occurance of target by
       ! substring
       temp(1:ipos-1) = work(1:ipos-1)
       DO i=1,lsub
         temp(i+ipos-1) = substring(i:i)
       ENDDO
       temp(ipos+lsub:) = work(ipos+lt:)
       work => temp ! make new version of work point at the temp space
       IF(.NOT.rep_search)EXIT ! exit if only first replacement wanted
       ! move search and replacement positions over the effected positions
       ipos = ipos-lt+1
     ENDIF
     ipos=ipos-1
   ENDDO
 ELSE ! forward search
   ipos = 1; ipow = 1
   DO
     IF( ipos > ls-lt+1 )EXIT ! search past end of string
     ! test for occurance of target in string at this position
     IF( string(ipos:ipos+lt-1) == target )THEN
       ! match found allocate space for string with this occurance of
       ! target replaced by substring
       ALLOCATE(temp(1:SIZE(work)+lsub-lt))
       ! copy work into temp replacing this occurance of target by
       ! substring
       temp(1:ipow-1) = work(1:ipow-1)
       DO i=1,lsub
         temp(i+ipow-1) = substring(i:i)
       ENDDO
       temp(ipow+lsub:) = work(ipow+lt:)
       work => temp ! make new version of work point at the temp space
       IF(.NOT.rep_search)EXIT ! exit if only first replacement wanted
       ! move search and replacement positions over the effected positions
       ipos = ipos+lt-1; ipow = ipow+lsub-1
     ENDIF
     ipos=ipos+1; ipow=ipow+1
   ENDDO
 ENDIF
 replace_ccc%chars => work
ENDFUNCTION replace_ccc

!----- Remove procedures ----------------------------------------------------!
FUNCTION remove_s(string,start,finish)
 type(VARYING_STRING)            :: remove_s
 type(VARYING_STRING),INTENT(IN) :: string
 INTEGER,INTENT(IN),OPTIONAL     :: start
 INTEGER,INTENT(IN),OPTIONAL     :: finish
 !  returns as result the string produced by the actions
 !  removes the characters between start and finish from string reducing it in
 !  size by MAX(0,ABS(finish-start+1))
 !  if start < 1 or is missing then assumes start=1
 !  if finish > LEN(string) or is missing then assumes finish=LEN(string)
 CHARACTER,DIMENSION(:),POINTER :: arg_str
 INTEGER                        :: is,if,ls
 ls = LEN(string)
 IF (PRESENT(start)) THEN
   is = MAX(1,start)
 ELSE
   is = 1
 ENDIF
 IF (PRESENT(finish)) THEN
   if = MIN(ls,finish)
 ELSE
   if = ls
 ENDIF
 IF( if < is ) THEN  ! zero characters to be removed, string is unchanged
   ALLOCATE(arg_str(1:ls))
   arg_str = string%chars
 ELSE
   ALLOCATE(arg_str(1:ls-if+is-1) )
   arg_str(1:is-1) = string%chars(1:is-1)
   arg_str(is:) = string%chars(if+1:)
 ENDIF
 remove_s%chars => arg_str
ENDFUNCTION remove_s

FUNCTION remove_c(string,start,finish)
 type(VARYING_STRING)        :: remove_c
 CHARACTER(LEN=*),INTENT(IN) :: string
 INTEGER,INTENT(IN),OPTIONAL :: start
 INTEGER,INTENT(IN),OPTIONAL :: finish
 !  returns as result the string produced by the actions
 !  removes the characters between start and finish from string reducing it in
 !  size by MAX(0,ABS(finish-start+1))
 !  if start < 1 or is missing then assumes start=1
 !  if finish > LEN(string) or is missing then assumes finish=LEN(string)
 CHARACTER,DIMENSION(:),POINTER :: arg_str
 INTEGER                        :: is,if,ls
 ls = LEN(string)
 IF (PRESENT(start)) THEN
   is = MAX(1,start)
 ELSE
   is = 1
 ENDIF
 IF (PRESENT(finish)) THEN
   if = MIN(ls,finish)
 ELSE
   if = ls
 ENDIF
 IF( if < is ) THEN  ! zero characters to be removed, string is unchanged
   ALLOCATE(arg_str(1:ls))
   DO i=1,ls
     arg_str(i) = string(i:i)
   ENDDO
 ELSE
   ALLOCATE(arg_str(1:ls-if+is-1) )
   DO i=1,is-1
     arg_str(i) = string(i:i)
   ENDDO
   DO i=is,ls-if+is-1
     arg_str(i) = string(i-is+if+1:i-is+if+1)
   ENDDO
 ENDIF
 remove_c%chars => arg_str
ENDFUNCTION remove_c

!----- Extract procedures ---------------------------------------------------!
 FUNCTION extract_s(string,start,finish)
  type(VARYING_STRING),INTENT(IN) :: string
  INTEGER,INTENT(IN),OPTIONAL     :: start
  INTEGER,INTENT(IN),OPTIONAL     :: finish
  type(VARYING_STRING)            :: extract_s
  ! extracts the characters between start and finish from string  and
  ! delivers these as the result of the function, string is unchanged
  ! if start < 1 or is missing then it is treated as 1
  ! if finish > LEN(string) or is missing then it is treated as LEN(string)
  INTEGER                         :: is,if
  IF (PRESENT(start)) THEN
     is = MAX(1,start)
  ELSE
     is = 1
  ENDIF
  IF (PRESENT(finish)) THEN
     if = MIN(LEN(string),finish)
  ELSE
     if = LEN(string)
  ENDIF
  ALLOCATE(extract_s%chars(1:if-is+1))
  extract_s%chars = string%chars(is:if)
 ENDFUNCTION extract_s

 FUNCTION extract_c(string,start,finish)
  CHARACTER(LEN=*),INTENT(IN) :: string
  INTEGER,INTENT(IN),OPTIONAL :: start
  INTEGER,INTENT(IN),OPTIONAL :: finish
  type(VARYING_STRING)        :: extract_c
  ! extracts the characters between start and finish from character string and
  ! delivers these as the result of the function, string is unchanged
  ! if start < 1 or is missing then it is treated as 1
  ! if finish > LEN(string) or is missing then it is treated as LEN(string)
  INTEGER                      :: is,if
  IF (PRESENT(start)) THEN
     is = MAX(1,start)
  ELSE
     is = 1
  ENDIF
  IF (PRESENT(finish)) THEN
     if = MIN(LEN(string),finish)
  ELSE
     if = LEN(string)
  ENDIF
  ALLOCATE(extract_c%chars(1:if-is+1))
  DO i=is,if
    extract_c%chars(i-is+1) = string(i:i)
  ENDDO
 ENDFUNCTION extract_c

!----- INDEX procedures ------------------------------------------------------!
 FUNCTION index_ss(string,substring,back)
  type(VARYING_STRING),INTENT(IN) :: string,substring
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: index_ss
  ! returns the starting position in string of the substring
  ! scanning from the front or back depending on the logical argument back
  LOGICAL                         :: dir_switch
  INTEGER                         :: ls,lsub
  ls = LEN(string); lsub = LEN(substring)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF(dir_switch)THEN ! backwards search
    DO i = ls-lsub+1,1,-1
      IF( ALL(string%chars(i:i+lsub-1) == substring%chars) )THEN
        index_ss = i
        RETURN
      ENDIF
    ENDDO
    index_ss = 0
  ELSE ! forward search
    DO i = 1,ls-lsub+1
      IF( ALL(string%chars(i:i+lsub-1) == substring%chars) )THEN
        index_ss = i
        RETURN
      ENDIF
    ENDDO
    index_ss = 0
  ENDIF
 ENDFUNCTION index_ss

 FUNCTION index_sc(string,substring,back)
  type(VARYING_STRING),INTENT(IN) :: string
  CHARACTER(LEN=*),INTENT(IN)     :: substring
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: index_sc
  ! returns the starting position in string of the substring
  ! scanning from the front or back depending on the logical argument back
  LOGICAL                         :: dir_switch,matched
  INTEGER                         :: ls,lsub
  ls = LEN(string); lsub = LEN(substring)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF (dir_switch) THEN ! backwards search
    DO i = ls-lsub+1,1,-1
      matched = .TRUE.
      DO j = 1,lsub
        IF( string%chars(i+j-1) /= substring(j:j) )THEN
          matched = .FALSE.
          EXIT
        ENDIF
      ENDDO
      IF( matched )THEN
        index_sc = i
        RETURN
      ENDIF
    ENDDO
    index_sc = 0
  ELSE ! forward search
    DO i = 1,ls-lsub+1
      matched = .TRUE.
      DO j = 1,lsub
        IF( string%chars(i+j-1) /= substring(j:j) )THEN
          matched = .FALSE.
          EXIT
        ENDIF
      ENDDO
      IF( matched )THEN
        index_sc = i
        RETURN
      ENDIF
    ENDDO
    index_sc = 0
  ENDIF
 ENDFUNCTION index_sc

 FUNCTION index_cs(string,substring,back)
  CHARACTER(LEN=*),INTENT(IN)     :: string
  type(VARYING_STRING),INTENT(IN) :: substring
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: index_cs
  ! returns the starting position in string of the substring
  ! scanning from the front or back depending on the logical argument back
  LOGICAL                         :: dir_switch,matched
  INTEGER                         :: ls,lsub
  ls = LEN(string); lsub = LEN(substring)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF(dir_switch)THEN ! backwards search
    DO i = ls-lsub+1,1,-1
      matched = .TRUE.
      DO j = 1,lsub
        IF( string(i+j-1:i+j-1) /= substring%chars(j) )THEN
          matched = .FALSE.
          EXIT
        ENDIF
      ENDDO
      IF( matched )THEN
        index_cs = i
        RETURN
      ENDIF
    ENDDO
    index_cs = 0
  ELSE ! forward search
    DO i = 1,ls-lsub+1
      matched = .TRUE.
      DO j = 1,lsub
        IF( string(i+j-1:i+j-1) /= substring%chars(j) )THEN
          matched = .FALSE.
          EXIT
        ENDIF
      ENDDO
      IF( matched )THEN
        index_cs = i
        RETURN
      ENDIF
    ENDDO
    index_cs = 0
  ENDIF
 ENDFUNCTION index_cs

!----- SCAN procedures ------------------------------------------------------!
 FUNCTION scan_ss(string,set,back)
  type(VARYING_STRING),INTENT(IN) :: string,set
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: scan_ss
  ! returns the first position in string occupied by a character from
  ! the characters in set, scanning is forward or backwards depending on back
  LOGICAL                         :: dir_switch
  INTEGER                         :: ls
  ls = LEN(string)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF(dir_switch)THEN ! backwards search
    DO i = ls,1,-1
      IF( ANY( set%chars == string%chars(i) ) )THEN
        scan_ss = i
        RETURN
      ENDIF
    ENDDO
    scan_ss = 0
  ELSE ! forward search
    DO i = 1,ls
      IF( ANY( set%chars == string%chars(i) ) )THEN
        scan_ss = i
        RETURN
      ENDIF
    ENDDO
    scan_ss = 0
  ENDIF
 ENDFUNCTION scan_ss

 FUNCTION scan_sc(string,set,back)
  type(VARYING_STRING),INTENT(IN) :: string
  CHARACTER(LEN=*),INTENT(IN)     :: set
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: scan_sc
  ! returns the first position in string occupied by a character from
  ! the characters in set, scanning is forward or backwards depending on back
  LOGICAL                         :: dir_switch,matched
  INTEGER                         :: ls
  ls = LEN(string)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF(dir_switch)THEN ! backwards search
    DO i = ls,1,-1
      matched = .FALSE.
      DO j = 1,LEN(set)
        IF( string%chars(i) == set(j:j) )THEN
          matched = .TRUE.
          EXIT
        ENDIF
      ENDDO
      IF( matched )THEN
        scan_sc = i
        RETURN
      ENDIF
    ENDDO
    scan_sc = 0
  ELSE ! forward search
    DO i = 1,ls
      matched = .FALSE.
      DO j = 1,LEN(set)
        IF( string%chars(i) == set(j:j) )THEN
          matched = .TRUE.
          EXIT
        ENDIF
      ENDDO
      IF( matched )THEN
        scan_sc = i
        RETURN
      ENDIF
    ENDDO
    scan_sc = 0
  ENDIF
 ENDFUNCTION scan_sc

 FUNCTION scan_cs(string,set,back)
  CHARACTER(LEN=*),INTENT(IN)     :: string
  type(VARYING_STRING),INTENT(IN) :: set
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: scan_cs
  ! returns the first position in character string occupied by a character from
  ! the characters in set, scanning is forward or backwards depending on back
  LOGICAL                         :: dir_switch,matched
  INTEGER                         :: ls
  ls = LEN(string)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF(dir_switch)THEN ! backwards search
    DO i = ls,1,-1
      matched = .FALSE.
      DO j = 1,LEN(set)
        IF( string(i:i) == set%chars(j) )THEN
          matched = .TRUE.
          EXIT
        ENDIF
      ENDDO
      IF( matched )THEN
        scan_cs = i
        RETURN
      ENDIF
    ENDDO
    scan_cs = 0
  ELSE ! forward search
    DO i = 1,ls
      matched = .FALSE.
      DO j = 1,LEN(set)
        IF( string(i:i) == set%chars(j) )THEN
          matched = .TRUE.
          EXIT
        ENDIF
      ENDDO
      IF( matched )THEN
        scan_cs = i
        RETURN
      ENDIF
    ENDDO
    scan_cs = 0
  ENDIF
 ENDFUNCTION scan_cs

!----- VERIFY procedures ----------------------------------------------------!
 FUNCTION verify_ss(string,set,back)
  type(VARYING_STRING),INTENT(IN) :: string,set
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: verify_ss
  ! returns the first position in string not occupied by a character from
  ! the characters in set, scanning is forward or backwards depending on back
  LOGICAL                     :: dir_switch
  INTEGER                     :: ls
  ls = LEN(string)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF(dir_switch)THEN ! backwards search
    DO i = ls,1,-1
      IF( .NOT.(ANY( set%chars == string%chars(i))) )THEN
        verify_ss = i
        RETURN
      ENDIF
    ENDDO
    verify_ss = 0
  ELSE ! forward search
    DO i = 1,ls
      IF( .NOT.(ANY( set%chars == string%chars(i))) )THEN
        verify_ss = i
        RETURN
      ENDIF
    ENDDO
    verify_ss = 0
  ENDIF
 ENDFUNCTION verify_ss

 FUNCTION verify_sc(string,set,back)
  type(VARYING_STRING),INTENT(IN) :: string
  CHARACTER(LEN=*),INTENT(IN)     :: set
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: verify_sc
  ! returns the first position in string not occupied by a character from
  ! the characters in set, scanning is forward or backwards depending on back
  LOGICAL                     :: dir_switch
  INTEGER                     :: ls
  ls = LEN(string)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF(dir_switch)THEN ! backwards search
    back_string_search:DO i = ls,1,-1
      DO j = 1,LEN(set)
        IF( string%chars(i) == set(j:j) )CYCLE back_string_search
        ! cycle string search if string character found in set
      ENDDO
      ! string character not found in set index i is result
        verify_sc = i
        RETURN
    ENDDO back_string_search
    ! each string character found in set
    verify_sc = 0
  ELSE ! forward search
    frwd_string_search:DO i = 1,ls
      DO j = 1,LEN(set)
        IF( string%chars(i) == set(j:j) )CYCLE frwd_string_search
      ENDDO
        verify_sc = i
        RETURN
    ENDDO frwd_string_search
    verify_sc = 0
  ENDIF
 ENDFUNCTION verify_sc

 FUNCTION verify_cs(string,set,back)
  CHARACTER(LEN=*),INTENT(IN)     :: string
  type(VARYING_STRING),INTENT(IN) :: set
  LOGICAL,INTENT(IN),OPTIONAL     :: back
  INTEGER                         :: verify_cs
  ! returns the first position in icharacter string not occupied by a character
  ! from the characters in set, scanning is forward or backwards depending on
  ! back
  LOGICAL                     :: dir_switch
  INTEGER                     :: ls
  ls = LEN(string)
  IF( PRESENT(back) )THEN
    dir_switch = back
  ELSE
    dir_switch = .FALSE.
  ENDIF
  IF(dir_switch)THEN ! backwards search
    back_string_search:DO i = ls,1,-1
      DO j = 1,LEN(set)
        IF( string(i:i) == set%chars(j) )CYCLE back_string_search
      ENDDO
        verify_cs = i
        RETURN
    ENDDO back_string_search
    verify_cs = 0
  ELSE ! forward search
    frwd_string_search:DO i = 1,ls
      DO j = 1,LEN(set)
        IF( string(i:i) == set%chars(j) )CYCLE frwd_string_search
      ENDDO
        verify_cs = i
        RETURN
    ENDDO frwd_string_search
    verify_cs = 0
  ENDIF
 ENDFUNCTION verify_cs

!----- LEN_TRIM procedure ----------------------------------------------------!
FUNCTION len_trim_s(string)
 type(VARYING_STRING),INTENT(IN) :: string
 INTEGER                         :: len_trim_s
 ! Returns the length of the string without counting trailing blanks
 INTEGER                         :: ls
 ls=LEN(string)
 len_trim_s = 0
 DO i = ls,1,-1
    IF (string%chars(i) /= BLANK) THEN
       len_trim_s = i
       EXIT
    ENDIF
 ENDDO
ENDFUNCTION len_trim_s

!----- TRIM procedure -------------------------------------------------------!
FUNCTION trim_s(string)
 type(VARYING_STRING),INTENT(IN)  :: string
 type(VARYING_STRING)             :: trim_s
 ! Returns the argument string with trailing blanks removed
 INTEGER                      :: ls,pos
 ls=LEN(string)
 pos=0
 DO i = ls,1,-1
    IF(string%chars(i) /= BLANK) THEN
       pos=i
       EXIT
    ENDIF
 ENDDO
 ALLOCATE(trim_s%chars(1:pos))
 trim_s%chars(1:pos) = string%chars(1:pos)
ENDFUNCTION trim_s

!----- IACHAR interface -----------------------------------------------------!
FUNCTION iachar_s(string)
 type(VARYING_STRING),INTENT(IN) :: string
 INTEGER                         :: iachar_s
 ! returns the position of the character string in the ISO 646
 ! collating sequence.
 ! string must be of length one
 IF (LEN(string) /= 1) THEN
    WRITE(*,*) " ERROR, argument in IACHAR not of length one"
    STOP
 ENDIF
 iachar_s = IACHAR(string%chars(1))
ENDFUNCTION iachar_s

!----- ICHAR procedure ------------------------------------------------------!
FUNCTION ichar_s(string)
 type(VARYING_STRING),INTENT(IN) :: string
 INTEGER                         :: ichar_s
 ! returns the position of character from string in the processor collating
 ! sequence.
 ! string must be of length one
 IF (LEN(string) /= 1) THEN
    WRITE(*,*) " Argument string in ICHAR has to be of length one"
    STOP
 ENDIF
 ichar_s = ICHAR(string%chars(1))
ENDFUNCTION ichar_s

!----- ADJUSTL procedure ----------------------------------------------------!
FUNCTION adjustl_s(string)
 type(VARYING_STRING),INTENT(IN) :: string
 type(VARYING_STRING)            :: adjustl_s
 ! Returns the string adjusted to the left, removing leading blanks and
 ! inserting trailing blanks
 INTEGER                         :: ls,pos
 ls=LEN(string)
 DO pos = 1,ls
    IF(string%chars(pos) /= blank) EXIT
 ENDDO
 ! pos now holds the position of the first non-blank character
 ! or ls+1 if all characters are blank
 ALLOCATE(adjustl_s%chars(1:ls))
 adjustl_s%chars(1:ls-pos+1) = string%chars(pos:ls)
 adjustl_s%chars(ls-pos+2:ls) = blank
ENDFUNCTION adjustl_s

!----- ADJUSTR procedure ----------------------------------------------------!
FUNCTION adjustr_s(string)
 type(VARYING_STRING),INTENT(IN) :: string
 type(VARYING_STRING)            :: adjustr_s
 ! Returns the string adjusted to the right, removing trailing blanks
 ! and inserting leading blanks
 INTEGER                         :: ls,pos
 ls=LEN(string)
 DO pos = ls,1,-1
    IF(string%chars(pos) /= blank) EXIT
 ENDDO
 ! pos now holds the position of the last non-blank character
 ! or zero if all characters are blank
 ALLOCATE(adjustr_s%chars(1:ls))
 adjustr_s%chars(ls-pos+1:ls) = string%chars(1:pos)
 adjustr_s%chars(1:ls-pos) = blank
ENDFUNCTION adjustr_s

ENDMODULE ISO_VARYING_STRING