iso_varying_string.f90

!> \file
!> \author Rich Townsend <rhdt@bartol.udel.edu>

! ******************************************************************************
! *                                                                            *
! * iso_varying_string.f90                                                     *
! *                                                                            *
! * Copyright (c) 2003, Rich Townsend <rhdt@bartol.udel.edu>                   *
! * All rights reserved.                                                       *
! *                                                                            *
! * Redistribution and use in source and binary forms, with or without         *
! * modification, are permitted provided that the following conditions are     *
! * met:                                                                       *
! *                                                                            *
! *  * Redistributions of source code must retain the above copyright notice,  *
! *    this list of conditions and the following disclaimer.                   *
! *  * Redistributions in binary form must reproduce the above copyright       *
! *    notice, this list of conditions and the following disclaimer in the     *
! *    documentation and/or other materials provided with the distribution.    *
! *                                                                            *
! * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS    *
! * IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,  *
! * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR     *
! * PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR           *
! * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,      *
! * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,        *
! * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR         *
! * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF     *
! * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING       *
! * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS         *
! * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.               *
! *                                                                            *
! ******************************************************************************
!
! Author    : Rich Townsend <rhdt@bartol.udel.edu>
! Synopsis  : Definition of iso_varying_string module, conformant to the API 
!             specified in ISO/IEC 1539-2:2000 (varying-length strings for 
!             Fortran 95). 
! Version   : 1.3-F
! Thanks    : Lawrie Schonfelder (bugfixes and design pointers), Walt Brainerd
!             (conversion to F).

!JL 20/10/10  seems *very* strange that there is no deallocate statement in this entire file... given that varying string is 
!             an allocatable character array. Adding one to prevent memory leak - has to be called manually like normal 
!             deallocate statement

!CPL 13/09/11
!   It's not accurate to think of allocatables as just a kind of pointer (in particular, allocate should not be thought
!   of as just a Fortran-style malloc). They are more like managed resources, and there is quite a bit of hidden
!   machinery involved when using them.
!
!   Note that the Fortran95 spec states the following:
!   Allocatable arrays (including type components) are automatically deallocated when they leave scope.
!   Assigning to an allocatable array will cause it to be automatically deallocated, then reallocated with the right size.
!
!   In the context of varying_string, this means that all copies are deep copies, and temporaries (such as those generated
!   by compound concatenations and function calls) are cleaned up automatically at runtime.


!>This module provides an iso_varying_string module, conformant to the API specified in
!>ISO/IEC 1539-2:2000 (varying-length strings for Fortran 95). 
MODULE ISO_VARYING_STRING
  USE ISO_C_BINDING

! No implicit typing

  implicit none

! Parameter definitions

  integer, parameter, private :: GET_BUFFER_LEN = 256

! Type definitions

  TYPE, PUBLIC :: VARYING_STRING
     private
     character(LEN=1), dimension(:), allocatable :: chars
  END TYPE VARYING_STRING

! Interface blocks

  interface assignment(=)
     module procedure op_assign_CH_VS
     module procedure op_assign_VS_CH
  end interface !assignment(=)

  interface operator(//)
     module procedure op_concat_VS_VS
     module procedure op_concat_CH_VS
     module procedure op_concat_VS_CH
     module procedure op_concat_VS_INT
  end interface !operator(//)

  interface operator(==)
     module procedure op_eq_VS_VS
     module procedure op_eq_CH_VS
     module procedure op_eq_VS_CH
  end interface !operator(==)

  interface operator(/=)
     module procedure op_ne_VS_VS
     module procedure op_ne_CH_VS
     module procedure op_ne_VS_CH
  end interface !operator (/=)
  
  interface operator(<)
     module procedure op_lt_VS_VS
     module procedure op_lt_CH_VS
     module procedure op_lt_VS_CH
  end interface !operator (<)
  
  interface operator(<=)
     module procedure op_le_VS_VS
     module procedure op_le_CH_VS
     module procedure op_le_VS_CH
  end interface !operator (<=)
  
  interface operator(>=)
     module procedure op_ge_VS_VS
     module procedure op_ge_CH_VS
     module procedure op_ge_VS_CH
  end interface !operator (>=)

  interface operator(>)
     module procedure op_gt_VS_VS
     module procedure op_gt_CH_VS
     module procedure op_gt_VS_CH
  end interface !operator (>)
  
  interface adjustl
     module procedure adjustl_
  end interface !adjustl

  interface adjustr
     module procedure adjustr_
  end interface !adjustr

  interface char
     module procedure char_auto
     module procedure char_fixed
  end interface !char

  interface cchar
     module procedure c_char_auto
     module procedure c_char_fixed
  end interface !cchar

  interface iachar
     module procedure iachar_
  end interface !iachar

  interface ichar
     module procedure ichar_
  end interface !ichar

  interface index
     module procedure index_VS_VS
     module procedure index_CH_VS
     module procedure index_VS_CH
  end interface !index

  interface len
     module procedure len_
  end interface !len

  interface len_trim
     module procedure len_trim_
  end interface !len_trim

  interface lge
     module procedure lge_VS_VS
     module procedure lge_CH_VS
     module procedure lge_VS_CH
  end interface !lge
  
  interface lgt
     module procedure lgt_VS_VS
     module procedure lgt_CH_VS
     module procedure lgt_VS_CH
  end interface !lgt

  interface lle
     module procedure lle_VS_VS
     module procedure lle_CH_VS
     module procedure lle_VS_CH
  end interface !lle

  interface llt
     module procedure llt_VS_VS
     module procedure llt_CH_VS
     module procedure llt_VS_CH
  end interface !llt

  interface repeat
     module procedure repeat_
  end interface !repeat

  interface scan
     module procedure scan_VS_VS
     module procedure scan_CH_VS
     module procedure scan_VS_CH
  end interface !scan

  interface trim
     module procedure trim_
  end interface !trim

  interface verify
     module procedure verify_VS_VS
     module procedure verify_CH_VS
     module procedure verify_VS_CH
  end interface !verify

  interface var_str
     module procedure var_str_
  end interface !var_str
  
  interface get
     module procedure get_
     module procedure get_unit
     module procedure get_set_VS
     module procedure get_set_CH
     module procedure get_unit_set_VS
     module procedure get_unit_set_CH
  end interface !get

  interface put
     module procedure put_VS
     module procedure put_CH
     module procedure put_unit_VS
     module procedure put_unit_CH
  end interface !put

  interface put_line
     module procedure put_line_VS
     module procedure put_line_CH
     module procedure put_line_unit_VS
     module procedure put_line_unit_CH
  end interface !put_line

  interface extract
     module procedure extract_VS
     module procedure extract_CH
  end interface !extract

  interface insert
     module procedure insert_VS_VS
     module procedure insert_CH_VS
     module procedure insert_VS_CH
     module procedure insert_CH_CH
  end interface !insert

  interface remove
     module procedure remove_VS
     module procedure remove_CH
  end interface !remove

  interface replace
     module procedure replace_VS_VS_auto
     module procedure replace_CH_VS_auto
     module procedure replace_VS_CH_auto
     module procedure replace_CH_CH_auto
     module procedure replace_VS_VS_fixed
     module procedure replace_CH_VS_fixed
     module procedure replace_VS_CH_fixed
     module procedure replace_CH_CH_fixed
     module procedure replace_VS_VS_VS_target
     module procedure replace_CH_VS_VS_target
     module procedure replace_VS_CH_VS_target
     module procedure replace_CH_CH_VS_target
     module procedure replace_VS_VS_CH_target
     module procedure replace_CH_VS_CH_target
     module procedure replace_VS_CH_CH_target
     module procedure replace_CH_CH_CH_target
  end interface

  interface split
     module procedure split_VS
     module procedure split_CH
  end interface !split

  interface erase
    module procedure erase_
  end interface !erase

  ! Access specifiers

  public :: assignment(=)
  public :: operator(//)
  public :: operator(==)
  public :: operator(/=)
  public :: operator(<)
  public :: operator(<=)
  public :: operator(>=)
  public :: operator(>)
  public :: adjustl
  public :: adjustr
  public :: char
  public :: cchar
  public :: iachar
  public :: ichar
  public :: index
  public :: len
  public :: len_trim
  public :: lge
  public :: lgt
  public :: lle
  public :: llt
  public :: repeat
  public :: scan
  public :: trim
  public :: verify
  public :: var_str
  public :: get
  public :: put
  public :: put_line
  public :: extract
  public :: insert
  public :: remove
  public :: replace
  public :: split
  public :: erase

  private :: op_assign_CH_VS
  private :: op_assign_VS_CH
  private :: op_concat_VS_VS
  private :: op_concat_CH_VS
  private :: op_concat_VS_CH
  private :: op_concat_VS_INT
  private :: op_eq_VS_VS
  private :: op_eq_CH_VS
  private :: op_eq_VS_CH
  private :: op_ne_VS_VS
  private :: op_ne_CH_VS
  private :: op_ne_VS_CH
  private :: op_lt_VS_VS
  private :: op_lt_CH_VS
  private :: op_lt_VS_CH
  private :: op_le_VS_VS
  private :: op_le_CH_VS
  private :: op_le_VS_CH
  private :: op_ge_VS_VS
  private :: op_ge_CH_VS
  private :: op_ge_VS_CH
  private :: op_gt_VS_VS
  private :: op_gt_CH_VS
  private :: op_gt_VS_CH
  private :: adjustl_
  private :: adjustr_
  private :: char_auto
  private :: char_fixed
  private :: c_char_auto
  private :: c_char_fixed
  private :: iachar_
  private :: ichar_
  private :: index_VS_VS
  private :: index_CH_VS
  private :: index_VS_CH
  private :: len_
  private :: len_trim_
  private :: lge_VS_VS
  private :: lge_CH_VS
  private :: lge_VS_CH
  private :: lgt_VS_VS
  private :: lgt_CH_VS
  private :: lgt_VS_CH
  private :: lle_VS_VS
  private :: lle_CH_VS
  private :: lle_VS_CH
  private :: llt_VS_VS
  private :: llt_CH_VS
  private :: llt_VS_CH
  private :: repeat_
  private :: scan_VS_VS
  private :: scan_CH_VS
  private :: scan_VS_CH
  private :: trim_
  private :: verify_VS_VS
  private :: verify_CH_VS
  private :: verify_VS_CH
  private :: var_str_
  private :: get_
  private :: get_unit
  private :: get_set_VS
  private :: get_set_CH
  private :: get_unit_set_VS
  private :: get_unit_set_CH
  private :: put_VS
  private :: put_CH
  private :: put_unit_VS
  private :: put_unit_CH
  private :: put_line_VS
  private :: put_line_CH
  private :: put_line_unit_VS
  private :: put_line_unit_CH
  private :: extract_VS
  private :: extract_CH
  private :: insert_VS_VS
  private :: insert_CH_VS
  private :: insert_VS_CH
  private :: insert_CH_CH
  private :: remove_VS
  private :: remove_CH
  private :: replace_VS_VS_auto
  private :: replace_CH_VS_auto
  private :: replace_VS_CH_auto
  private :: replace_CH_CH_auto
  private :: replace_VS_VS_fixed
  private :: replace_CH_VS_fixed
  private :: replace_VS_CH_fixed
  private :: replace_CH_CH_fixed
  private :: replace_VS_VS_VS_target
  private :: replace_CH_VS_VS_target
  private :: replace_VS_CH_VS_target
  private :: replace_CH_CH_VS_target
  private :: replace_VS_VS_CH_target
  private :: replace_CH_VS_CH_target
  private :: replace_VS_CH_CH_target
  private :: replace_CH_CH_CH_target
  private :: split_VS
  private :: split_CH
  private :: erase_

! Procedures

contains

!CPB 26/9/05 Move len here as the IBM compilers require it defined before it is used.
  !****

  elemental function len_ (string) result (length)

    type(varying_string), intent(in) :: string
    integer                          :: length

! Get the length of a varying string

    if(ALLOCATED(string%chars)) then
       length = SIZE(string%chars)
    else
       length = 0
    endif

! Finish

    return

  end function len_

!****

  elemental subroutine op_assign_CH_VS (var, exp)

    character(LEN=*), intent(out)    :: var
    type(varying_string), intent(in) :: exp

! Assign a varying string to a character string

    var = char(exp)

! Finish

    return

  end subroutine op_assign_CH_VS

!****

  elemental subroutine op_assign_VS_CH (var, exp)

    type(varying_string), intent(out) :: var
    character(LEN=*), intent(in)      :: exp

! Assign a character string to a varying string

    var = var_str(exp)

! Finish

    return

  end subroutine op_assign_VS_CH

!****

  elemental function op_concat_VS_VS (string_a, string_b) result (concat_string)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    type(varying_string)             :: concat_string

    integer                          :: len_string_a

! Concatenate two varying strings

    len_string_a = len(string_a)

    ALLOCATE(concat_string%chars(len_string_a+len(string_b)))

    !CPB 20/02/07 aix compiler seems to have problems with this routine if string_a is not allocated and so the the
    !length is zero. Check not zero then execute command.
    if(len_string_a > 0) then

      concat_string%chars(:len_string_a) = string_a%chars

    endif
    concat_string%chars(len_string_a+1:) = string_b%chars

! Finish

    return

  end function op_concat_VS_VS

!****

  elemental function op_concat_CH_VS (string_a, string_b) result (concat_string)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    type(varying_string)             :: concat_string

! Concatenate a character string and a varying 
! string

    concat_string = op_concat_VS_VS(var_str(string_a), string_b)

! Finish

    return

  end function op_concat_CH_VS

!****

  elemental function op_concat_VS_CH (string_a, string_b) result (concat_string)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    type(varying_string)             :: concat_string

! Concatenate a varying string and a character
! string

    concat_string = op_concat_VS_VS(string_a, var_str(string_b))

! Finish

    return

  end function op_concat_VS_CH

!****

  elemental function op_concat_VS_INT (string, value) result (concat_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: value
    type(varying_string)             :: concat_string

! Concatenate a varying string and an integer
    character(LEN=20) :: local_string
    
    WRITE(local_string,"(I12)") value

    concat_string=string//TRIM(ADJUSTL(local_string))

! Finish

    return

  end function op_concat_VS_INT

!****

  elemental function op_eq_VS_VS (string_a, string_b) result (op_eq)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_eq
    integer                          :: len_a, len_b, min_len

! Compare (==) two varying strings

    op_eq = .TRUE.
    len_a = len(string_a)
    len_b = len(string_b)
    min_len = min(len_a, len_b)

    if(any(string_a%chars(1:min_len)/=string_b%chars(1:min_len))) then
      op_eq = .FALSE.
      return
    end if
    !Strings might have different length but be padded with space
    if(any(string_a%chars(len_b+1:len_a)/=" ")) then
      op_eq = .FALSE.
      return
    end if
    if(any(string_b%chars(len_a+1:len_b)/=" ")) then
      op_eq = .FALSE.
      return
    end if

! Finish

    return

  end function op_eq_VS_VS

!****

  elemental function op_eq_CH_VS (string_a, string_b) result (op_eq)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_eq

! Compare (==) a character string and a varying 
! string

    op_eq = string_a == char(string_b)

! Finish

    return

  end function op_eq_CH_VS

!****

  elemental function op_eq_VS_CH (string_a, string_b) result (op_eq)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_eq

! Compare (==) a varying string and a character
! string

    op_eq = char(string_a) == string_b

! Finish

    return

  end function op_eq_VS_CH

!****

  elemental function op_ne_VS_VS (string_a, string_b) result (op_ne)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_ne

! Compare (/=) two varying strings

    op_ne = char(string_a) /= char(string_b)

! Finish

    return

  end function op_ne_VS_VS

!****

  elemental function op_ne_CH_VS (string_a, string_b) result (op_ne)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_ne

! Compare (/=) a character string and a varying
! string

    op_ne = string_a /= char(string_b)

! Finish

    return

  end function op_ne_CH_VS

!****

  elemental function op_ne_VS_CH (string_a, string_b) result (op_ne)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_ne

! Compare (/=) a varying string and a character
! string

    op_ne = char(string_a) /= string_b

! Finish

    return

  end function op_ne_VS_CH

!****

  elemental function op_lt_VS_VS (string_a, string_b) result (op_lt)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_lt

! Compare (<) two varying strings

    op_lt = char(string_a) < char(string_b)

! Finish

    return

  end function op_lt_VS_VS

!****

  elemental function op_lt_CH_VS (string_a, string_b) result (op_lt)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_lt

! Compare (<) a character string and a varying
! string

    op_lt = string_a < char(string_b)

! Finish

    return

  end function op_lt_CH_VS

!****

  elemental function op_lt_VS_CH (string_a, string_b) result (op_lt)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_lt

! Compare (<) a varying string and a character 
! string

    op_lt = char(string_a) < string_b

! Finish

    return

  end function op_lt_VS_CH

!****

  elemental function op_le_VS_VS (string_a, string_b) result (op_le)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_le

! Compare (<=) two varying strings

    op_le = char(string_a) <= char(string_b)

! Finish

    return

  end function op_le_VS_VS

!****

  elemental function op_le_CH_VS (string_a, string_b) result (op_le)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_le

! Compare (<=) a character string and a varying 
! string

    op_le = string_a <= char(string_b)

! Finish

    return

  end function op_le_CH_VS

!****

  elemental function op_le_VS_CH (string_a, string_b) result (op_le)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_le

! Compare (<=) a varying string and a character 
! string

    op_le = char(string_a) <= string_b

! Finish

    return

  end function op_le_VS_CH

!****

  elemental function op_ge_VS_VS (string_a, string_b) result (op_ge)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_ge

! Compare (>=) two varying strings

    op_ge = char(string_a) >= char(string_b)

! Finish

    return

  end function op_ge_VS_VS

!****

  elemental function op_ge_CH_VS (string_a, string_b) result (op_ge)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_ge

! Compare (>=) a character string and a varying
! string

    op_ge = string_a >= char(string_b)

! Finish

    return

  end function op_ge_CH_VS

!****

  elemental function op_ge_VS_CH (string_a, string_b) result (op_ge)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_ge

! Compare (>=) a varying string and a character
! string

    op_ge = char(string_a) >= string_b

! Finish

    return

  end function op_ge_VS_CH

!****

  elemental function op_gt_VS_VS (string_a, string_b) result (op_gt)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_gt

! Compare (>) two varying strings

    op_gt = char(string_a) > char(string_b)

! Finish

    return

  end function op_gt_VS_VS

!****

  elemental function op_gt_CH_VS (string_a, string_b) result (op_gt)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: op_gt

! Compare (>) a character string and a varying
! string

    op_gt = string_a > char(string_b)

! Finish

    return

  end function op_gt_CH_VS

!****

  elemental function op_gt_VS_CH (string_a, string_b) result (op_gt)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: op_gt

! Compare (>) a varying string and a character
! string

    op_gt = char(string_a) > string_b

! Finish

    return

  end function op_gt_VS_CH

!****

  elemental function adjustl_ (string) result (adjustl_string)

    type(varying_string), intent(in) :: string
    type(varying_string)             :: adjustl_string

! Adjust the varying string to the left

    adjustl_string = ADJUSTL(CHAR(string))

! Finish

    return

  end function adjustl_

!****

  elemental function adjustr_ (string) result (adjustr_string)

    type(varying_string), intent(in) :: string
    type(varying_string)             :: adjustr_string

! Adjust the varying string to the right

    adjustr_string = ADJUSTR(CHAR(string))

! Finish

    return

  end function adjustr_

!****

  pure function char_auto (string) result (char_string)

    type(varying_string), intent(in) :: string
    character(LEN=len(string))       :: char_string

    integer                          :: i_char

! Convert a varying string into a character string
! (automatic length)
    
    forall(i_char = 1:len(string))
       char_string(i_char:i_char) = string%chars(i_char)
    end forall

! Finish

    return

  end function char_auto

!****

  pure function char_fixed (string, length) result (char_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: length
    character(LEN=length)            :: char_string

! Convert a varying string into a character string
! (fixed length)

    char_string = char(string)

! Finish

    return

  end function char_fixed

!****

  pure function c_char_auto (string) result (c_char_string)

    type(varying_string), intent(in) :: string
    character(LEN=1,KIND=C_CHAR)     :: c_char_string(len(string)+1)

    integer                          :: i_char
    
! Convert a varying string into a character string
! (automatic length)
    
    forall(i_char = 1:len(string))
       c_char_string(i_char) = string%chars(i_char)
    end forall
    c_char_string(len(string)+1) = C_NULL_CHAR

! Finish

    return

  end function c_char_auto

!****

  pure function c_char_fixed (string, length) result (c_char_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: length
    character(LEN=1,KIND=C_CHAR)     :: c_char_string(length+1)

    integer                          :: i_char

! Convert a varying string into a character string
! (fixed length)

    forall(i_char = 1:length)
       c_char_string(i_char) = string%chars(i_char)
    end forall
    c_char_string(length+1) = C_NULL_CHAR

! Finish

    return

  end function c_char_fixed

!****

  elemental function iachar_ (c) result (i)

    type(varying_string), intent(in) :: c
    integer                          :: i

! Get the position in the ISO 646 collating sequence
! of a varying string character

    i = ICHAR(char(c))

! Finish

    return

  end function iachar_

!****

  elemental function ichar_ (c) result (i)

    type(varying_string), intent(in) :: c
    integer                          :: i

! Get the position in the processor collating 
! sequence of a varying string character

    i = ICHAR(char(c))

! Finish

    return

  end function ichar_

!****

  elemental function index_VS_VS (string, substring, back) result (i_substring)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: back
    integer                          :: i_substring

! Get the index of a varying substring within a
! varying string

    i_substring = INDEX(char(string), char(substring), back)

! Finish

    return

  end function index_VS_VS

!****

  elemental function index_CH_VS (string, substring, back) result (i_substring)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: back
    integer                          :: i_substring

! Get the index of a varying substring within a
! character string

    i_substring = INDEX(string, char(substring), back)

! Finish

    return

  end function index_CH_VS

!****

  elemental function index_VS_CH (string, substring, back) result (i_substring)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: substring
    logical, intent(in), optional    :: back
    integer                          :: i_substring

! Get the index of a character substring within a
! varying string

    i_substring = INDEX(char(string), substring, back)

! Finish

    return

  end function index_VS_CH

!****

  elemental function len_trim_ (string) result (length)

    type(varying_string), intent(in) :: string
    integer                          :: length

! Get the trimmed length of a varying string

    if(ALLOCATED(string%chars)) then
       length = LEN_TRIM(char(string))
    else
       length = 0
    endif

! Finish

    return

  end function len_trim_

!****

  elemental function lge_VS_VS (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LGE) two varying strings

    comp = (char(string_a) >= char(string_b))

! Finish

    return

  end function lge_VS_VS

!****

  elemental function lge_CH_VS (string_a, string_b) result (comp)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LGE) a character string and a varying
! string

    comp = (string_a >= char(string_b))

! Finish

    return

  end function lge_CH_VS

!****

  elemental function lge_VS_CH (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: comp

! Compare (LGE) a varying string and a character
! string

    comp = (char(string_a) >= string_b)

! Finish

    return

  end function lge_VS_CH

!****

  elemental function lgt_VS_VS (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LGT) two varying strings

    comp = (char(string_a) > char(string_b))

! Finish

    return

  end function lgt_VS_VS

!****

  elemental function lgt_CH_VS (string_a, string_b) result (comp)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LGT) a character string and a varying
! string

    comp = (string_a > char(string_b))

! Finish

    return

  end function lgt_CH_VS

!****

  elemental function lgt_VS_CH (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: comp

! Compare (LGT) a varying string and a character
! string

    comp = (char(string_a) > string_b)

! Finish

    return

  end function lgt_VS_CH

!****

  elemental function lle_VS_VS (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LLE) two varying strings

    comp = (char(string_a) <= char(string_b))

! Finish

    return

  end function lle_VS_VS

!****

  elemental function lle_CH_VS (string_a, string_b) result (comp)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LLE) a character string and a varying
! string

    comp = (string_a <= char(string_b))

! Finish

    return

  end function lle_CH_VS

!****

  elemental function lle_VS_CH (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: comp

! Compare (LLE) a varying string and a character
! string

    comp = (char(string_a) <= string_b)

! Finish

    return

  end function lle_VS_CH

!****

  elemental function llt_VS_VS (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LLT) two varying strings

    comp = (char(string_a) < char(string_b))

! Finish

    return

  end function llt_VS_VS

!****

  elemental function llt_CH_VS (string_a, string_b) result (comp)

    character(LEN=*), intent(in)     :: string_a
    type(varying_string), intent(in) :: string_b
    logical                          :: comp

! Compare (LLT) a character string and a varying
! string

    comp = (string_a < char(string_b))

! Finish

    return

  end function llt_CH_VS

!****

  elemental function llt_VS_CH (string_a, string_b) result (comp)

    type(varying_string), intent(in) :: string_a
    character(LEN=*), intent(in)     :: string_b
    logical                          :: comp

! Compare (LLT) a varying string and a character
! string

    comp = (char(string_a) < string_b)

! Finish

    return

  end function llt_VS_CH

!****

  elemental function repeat_ (string, ncopies) result (repeat_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: ncopies
    type(varying_string)             :: repeat_string

! Concatenate several copies of a varying string

    repeat_string = var_str(REPEAT(char(string), ncopies))

! Finish

    return

  end function repeat_

!****

  elemental function scan_VS_VS (string, set, back) result (i)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Scan a varying string for occurrences of 
! characters in a varying-string set

    i = SCAN(char(string), char(set), back)

! Finish

    return

  end function scan_VS_VS
    
!****

  elemental function scan_CH_VS (string, set, back) result (i)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Scan a character string for occurrences of 
! characters in a varying-string set

    i = SCAN(string, char(set), back)

! Finish

    return

  end function scan_CH_VS
    
!****

  elemental function scan_VS_CH (string, set, back) result (i)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Scan a varying string for occurrences of 
! characters in a character-string set

    i = SCAN(char(string), set, back)

! Finish

    return

  end function scan_VS_CH
    
!****

  elemental function trim_ (string) result (trim_string)

    type(varying_string), intent(in) :: string
    type(varying_string)             :: trim_string

! Remove trailing blanks from a varying string

    trim_string = TRIM(char(string))

! Finish

    return

  end function trim_

!****

  elemental function verify_VS_VS (string, set, back) result (i)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Verify a varying string for occurrences of
! characters in a varying-string set

    i = VERIFY(char(string), char(set), back)

! Finish

    return

  end function verify_VS_VS

!****

  elemental function verify_CH_VS (string, set, back) result (i)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Verify a character string for occurrences of 
! characters in a varying-string set

    i = VERIFY(string, char(set), back)

! Finish

    return

  end function verify_CH_VS

!****

  elemental function verify_VS_CH (string, set, back) result (i)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: set
    logical, intent(in), optional    :: back
    integer                          :: i

! Verify a varying string for occurrences of 
! characters in a character-string set

    i = VERIFY(char(string), set, back)

! Finish

    return

  end function verify_VS_CH

!****

  elemental function var_str_ (char) result (string)

    character(LEN=*), intent(in) :: char
    type(varying_string)         :: string

    integer                      :: length
    integer                      :: i

! Convert a character string to a varying string

    length = LEN(char)

    ALLOCATE(string%chars(length))

    forall(i = 1:length)
       string%chars(i) = char(i:i)
    end forall

! Finish

    return

  end function var_str_

!****

  subroutine get_ (string, maxlen, iostat)

    type(varying_string), intent(out) :: string
    integer, intent(in), optional     :: maxlen
    integer, intent(out), optional    :: iostat

    integer                           :: n_chars_remain
    integer                           :: n_chars_read
    character(LEN=GET_BUFFER_LEN)     :: buffer
    integer                           :: local_iostat

! Read from the default unit into a varying string

    string = ""

    if(PRESENT(maxlen)) then
       n_chars_remain = maxlen
    else
       n_chars_remain = HUGE(1)
    endif

    read_loop : do

       if(n_chars_remain <= 0) return

       n_chars_read = MIN(n_chars_remain, GET_BUFFER_LEN)

       if(PRESENT(iostat)) then
          read(unit=*, FMT="(A)", ADVANCE="NO", &
               IOSTAT=iostat, SIZE=n_chars_read) buffer(:n_chars_read)
          if(iostat < 0) exit read_loop
          if(iostat > 0) return
       else
          read(unit=*, FMT="(A)", ADVANCE="NO", &
               IOSTAT=local_iostat, SIZE=n_chars_read) buffer(:n_chars_read)
          if(local_iostat < 0) exit read_loop
       endif

       string = string//buffer(:n_chars_read)
       n_chars_remain = n_chars_remain - n_chars_read

    end do read_loop

    string = string//buffer(:n_chars_read)

! Finish (end-of-record)

    return

  end subroutine get_

!****

  subroutine get_unit (unit, string, maxlen, iostat)

    integer, intent(in)               :: unit
    type(varying_string), intent(out) :: string
    integer, intent(in), optional     :: maxlen
    integer, intent(out), optional    :: iostat

    integer                           :: n_chars_remain
    integer                           :: n_chars_read
    character(LEN=GET_BUFFER_LEN)     :: buffer
    integer                           :: local_iostat

! Read from the specified unit into a varying string

    string = ""

    if(PRESENT(maxlen)) then
       n_chars_remain = maxlen
    else
       n_chars_remain = HUGE(1)
    endif

    read_loop : do

       if(n_chars_remain <= 0) return

       n_chars_read = MIN(n_chars_remain, GET_BUFFER_LEN)

       if(PRESENT(iostat)) then
          read(unit=unit, FMT="(A)", ADVANCE="NO", &
               IOSTAT=iostat, SIZE=n_chars_read) buffer(:n_chars_read)
          if(iostat < 0) exit read_loop
          if(iostat > 0) return
       else
          read(unit=unit, FMT="(A)", ADVANCE="NO", &
               IOSTAT=local_iostat, SIZE=n_chars_read) buffer(:n_chars_read)
          if(local_iostat < 0) exit read_loop
       endif

       string = string//buffer(:n_chars_read)
       n_chars_remain = n_chars_remain - n_chars_read

    end do read_loop

    string = string//buffer(:n_chars_read)

! Finish (end-of-record)

    return

  end subroutine get_unit

!****

  subroutine get_set_VS (string, set, separator, maxlen, iostat)

    type(varying_string), intent(out)           :: string
    type(varying_string), intent(in)            :: set
    type(varying_string), intent(out), optional :: separator
    integer, intent(in), optional               :: maxlen
    integer, intent(out), optional              :: iostat

! Read from the default unit into a varying string,
! with a custom varying-string separator

    call get(string, char(set), separator, maxlen, iostat)

! Finish

    return

  end subroutine get_set_VS

!****

  subroutine get_set_CH (string, set, separator, maxlen, iostat)

    type(varying_string), intent(out)           :: string
    character(LEN=*), intent(in)                :: set
    type(varying_string), intent(out), optional :: separator
    integer, intent(in), optional               :: maxlen
    integer, intent(out), optional              :: iostat

    integer                                     :: n_chars_remain
    character(LEN=1)                            :: buffer
    integer                                     :: i_set
    integer                                     :: local_iostat

! Read from the default unit into a varying string,
! with a custom character-string separator

    string = ""

    if(PRESENT(maxlen)) then
       n_chars_remain = maxlen
    else
       n_chars_remain = HUGE(1)
    endif

    if(PRESENT(separator)) separator = ""

    read_loop : do

       if(n_chars_remain <= 0) return

       if(PRESENT(iostat)) then
          read(unit=*, FMT="(A1)", ADVANCE="NO", IOSTAT=iostat) buffer
          if(iostat /= 0) exit read_loop
       else
          read(unit=*, FMT="(A1)", ADVANCE="NO", IOSTAT=local_iostat) buffer
          if(local_iostat /= 0) exit read_loop
       endif

       i_set = SCAN(buffer, set)

       if(i_set == 1) then
          if(PRESENT(separator)) separator = buffer
          exit read_loop
       endif

       string = string//buffer
       n_chars_remain = n_chars_remain - 1

    end do read_loop

! Finish

    return

  end subroutine get_set_CH

!****

  subroutine get_unit_set_VS (unit, string, set, separator, maxlen, iostat)

    integer, intent(in)                         :: unit
    type(varying_string), intent(out)           :: string
    type(varying_string), intent(in)            :: set
    type(varying_string), intent(out), optional :: separator
    integer, intent(in), optional               :: maxlen
    integer, intent(out), optional              :: iostat

! Read from the specified unit into a varying string,
! with a custom varying-string separator

    call get(unit, string, char(set), separator, maxlen, iostat)

! Finish

    return

  end subroutine get_unit_set_VS

!****

  subroutine get_unit_set_CH (unit, string, set, separator, maxlen, iostat)

    integer, intent(in)                         :: unit
    type(varying_string), intent(out)           :: string
    character(LEN=*), intent(in)                :: set
    type(varying_string), intent(out), optional :: separator
    integer, intent(in), optional               :: maxlen
    integer, intent(out), optional              :: iostat

    integer                                     :: n_chars_remain
    character(LEN=1)                            :: buffer
    integer                                     :: i_set
    integer                                     :: local_iostat

! Read from the default unit into a varying string,
! with a custom character-string separator

    string = ""

    if(PRESENT(maxlen)) then
       n_chars_remain = maxlen
    else
       n_chars_remain = HUGE(1)
    endif

    if(PRESENT(separator)) separator = ""

    read_loop : do

       if(n_chars_remain <= 0) return

       if(PRESENT(iostat)) then
          read(unit=unit, FMT="(A1)", ADVANCE="NO", IOSTAT=iostat) buffer
          if(iostat /= 0) exit read_loop
       else
          read(unit=unit, FMT="(A1)", ADVANCE="NO", IOSTAT=local_iostat) buffer
          if(local_iostat /= 0) exit read_loop
       endif

       i_set = SCAN(buffer, set)

       if(i_set == 1) then
          if(PRESENT(separator)) separator = buffer
          exit read_loop
       endif

       string = string//buffer
       n_chars_remain = n_chars_remain - 1

    end do read_loop

! Finish

    return

  end subroutine get_unit_set_CH

!****

  subroutine put_VS (string, iostat)

    type(varying_string), intent(in) :: string
    integer, intent(out), optional   :: iostat

! Append a varying string to the current record of 
! the default unit

    call put(char(string), iostat)

! Finish

  end subroutine put_VS
    
!****

  subroutine put_CH (string, iostat)

    character(LEN=*), intent(in)   :: string
    integer, intent(out), optional :: iostat

! Append a character string to the current record of 
! the default unit

    if(PRESENT(iostat)) then
       write(unit=*, FMT="(A)", ADVANCE="NO", IOSTAT=iostat) string
    else
       write(unit=*, FMT="(A)", ADVANCE="NO") string
    endif

! Finish

  end subroutine put_CH

!****

  subroutine put_unit_VS (unit, string, iostat)

    integer, intent(in)              :: unit
    type(varying_string), intent(in) :: string
    integer, intent(out), optional   :: iostat

! Append a varying string to the current record of 
! the specified unit

    call put(unit, char(string), iostat)

! Finish

    return

  end subroutine put_unit_VS

!****

  subroutine put_unit_CH (unit, string, iostat)

    integer, intent(in)            :: unit
    character(LEN=*), intent(in)   :: string
    integer, intent(out), optional :: iostat

! Append a character string to the current record of 
! the specified unit

    if(PRESENT(iostat)) then
       write(unit=unit, FMT="(A)", ADVANCE="NO", IOSTAT=iostat) string
    else
       write(unit=unit, FMT="(A)", ADVANCE="NO") string
    endif

! Finish

    return

  end subroutine put_unit_CH

!****

  subroutine put_line_VS (string, iostat)

    type(varying_string), intent(in) :: string
    integer, intent(out), optional   :: iostat

! Append a varying string to the current record of 
! the default unit, terminating the record

    call put_line(char(string), iostat)

! Finish

    return

  end subroutine put_line_VS

!****

  subroutine put_line_CH (string, iostat)

    character(LEN=*), intent(in)   :: string
    integer, intent(out), optional :: iostat

! Append a varying string to the current record of 
! the default unit, terminating the record

    if(PRESENT(iostat)) then
       write(unit=*, FMT="(A,/)", ADVANCE="NO", IOSTAT=iostat) string
    else
       write(unit=*, FMT="(A,/)", ADVANCE="NO") string
    endif

! Finish

    return

  end subroutine put_line_CH

!****

  subroutine put_line_unit_VS (unit, string, iostat)

    integer, intent(in)              :: unit
    type(varying_string), intent(in) :: string
    integer, intent(out), optional   :: iostat

! Append a varying string to the current record of 
! the specified unit, terminating the record

    call put_line(unit, char(string), iostat)

! Finish

    return

  end subroutine put_line_unit_VS

!****

  subroutine put_line_unit_CH (unit, string, iostat)

    integer, intent(in)            :: unit
    character(LEN=*), intent(in)   :: string
    integer, intent(out), optional :: iostat

! Append a varying string to the current record of 
! the specified unit, terminating the record

    if(PRESENT(iostat)) then
       write(unit=unit, FMT="(A,/)", ADVANCE="NO", IOSTAT=iostat) string
    else
       write(unit=unit, FMT="(A,/)", ADVANCE="NO") string
    endif

! Finish

    return

  end subroutine put_line_unit_CH

!****

  elemental function extract_VS (string, start, finish) result (ext_string)

    type(varying_string), intent(in) :: string
    integer, intent(in), optional    :: start
    integer, intent(in), optional    :: finish
    type(varying_string)             :: ext_string

! Extract a varying substring from a varying string

    ext_string = extract(char(string), start, finish)

! Finish

    return

  end function extract_VS

!****

  elemental function extract_CH (string, start, finish) result (ext_string)

    character(LEN=*), intent(in)  :: string
    integer, intent(in), optional :: start
    integer, intent(in), optional :: finish
    type(varying_string)          :: ext_string

    integer                       :: start_
    integer                       :: finish_

! Extract a varying substring from a character string

    if(PRESENT(start)) then
       start_ = MAX(1, start)
    else
       start_ = 1
    endif

    if(PRESENT(finish)) then
       finish_ = MIN(LEN(string), finish)
    else
       finish_ = LEN(string)
    endif

    ext_string = var_str(string(start_:finish_))

! Finish

    return

  end function extract_CH

!****

  elemental function insert_VS_VS (string, start, substring) result (ins_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: ins_string

! Insert a varying substring into a varying string

    ins_string = insert(char(string), start, char(substring))

! Finish

    return

  end function insert_VS_VS

!****

  elemental function insert_CH_VS (string, start, substring) result (ins_string)

    character(LEN=*), intent(in)     :: string
    integer, intent(in)              :: start
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: ins_string

! Insert a varying substring into a character string

    ins_string = insert(string, start, char(substring))

! Finish

    return

  end function insert_CH_VS

!****

  elemental function insert_VS_CH (string, start, substring) result (ins_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    character(LEN=*), intent(in)     :: substring
    type(varying_string)             :: ins_string

! Insert a character substring into a varying string

    ins_string = insert(char(string), start, substring)

! Finish

    return

  end function insert_VS_CH

!****

  elemental function insert_CH_CH (string, start, substring) result (ins_string)

    character(LEN=*), intent(in) :: string
    integer, intent(in)          :: start
    character(LEN=*), intent(in) :: substring
    type(varying_string)         :: ins_string

    integer                      :: start_

! Insert a character substring into a character
! string

    start_ = MAX(1, MIN(start, LEN(string)+1))

    ins_string = var_str(string(:start_-1)//substring//string(start_:))

! Finish

    return

  end function insert_CH_CH

!****

  elemental function remove_VS (string, start, finish) result (rem_string)

    type(varying_string), intent(in) :: string
    integer, intent(in), optional    :: start
    integer, intent(in), optional    :: finish
    TYPE(varying_string)             :: rem_string

! Remove a substring from a varying string

    rem_string = remove(char(string), start, finish)

! Finish

    return

  end function remove_VS

!****

  elemental function remove_CH (string, start, finish) result (rem_string)

    character(LEN=*), intent(in)  :: string
    integer, intent(in), optional :: start
    integer, intent(in), optional :: finish
    type(varying_string)          :: rem_string

    integer                       :: start_
    integer                       :: finish_

! Remove a substring from a character string

    if(PRESENT(start)) then
       start_ = MAX(1, start)
    else
       start_ = 1
    endif

    if(PRESENT(finish)) then
       finish_ = MIN(LEN(string), finish)
    else
       finish_ = LEN(string)
    endif

    if(finish_ >= start_) then
       rem_string = var_str(string(:start_-1)//string(finish_+1:))
    else
       rem_string = string
    endif

! Finish

    return

  end function remove_CH

!****

  elemental function replace_VS_VS_auto (string, start, substring) result (rep_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: rep_string

! Replace part of a varying string with a varying
! substring

    rep_string = replace(char(string), start, MAX(start, 1)+len(substring)-1, char(substring))

! Finish

    return

  end function replace_VS_VS_auto

!****

  elemental function replace_CH_VS_auto (string, start, substring) result (rep_string)

    character(LEN=*), intent(in)     :: string
    integer, intent(in)              :: start
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring

    rep_string = replace(string, start, MAX(start, 1)+len(substring)-1, char(substring))

! Finish

    return

  end function replace_CH_VS_auto

!****

  elemental function replace_VS_CH_auto (string, start, substring) result (rep_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    character(LEN=*), intent(in)     :: substring
    type(varying_string)             :: rep_string

! Replace part of a varying string with a character
! substring

    rep_string = replace(char(string), start, MAX(start, 1)+LEN(substring)-1, substring)

! Finish

    return

  end function replace_VS_CH_auto

!****

  elemental function replace_CH_CH_auto (string, start, substring) result (rep_string)

    character(LEN=*), intent(in) :: string
    integer, intent(in)          :: start
    character(LEN=*), intent(in) :: substring
    type(varying_string)         :: rep_string

! Replace part of a character string with a character
! substring

    rep_string = replace(string, start, MAX(start, 1)+LEN(substring)-1, substring)

! Finish

    return

  end function replace_CH_CH_auto

!****

  elemental function replace_VS_VS_fixed (string, start, finish, substring) result (rep_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    integer, intent(in)              :: finish
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: rep_string

! Replace part of a varying string with a varying
! substring

    rep_string = replace(char(string), start, finish, char(substring))

! Finish

    return

  end function replace_VS_VS_fixed

!****

!****

  elemental function replace_CH_VS_fixed (string, start, finish, substring) result (rep_string)

    character(LEN=*), intent(in)     :: string
    integer, intent(in)              :: start
    integer, intent(in)              :: finish
    type(varying_string), intent(in) :: substring
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring

    rep_string = replace(string, start, finish, char(substring))

! Finish

    return

  end function replace_CH_VS_fixed

!****

  elemental function replace_VS_CH_fixed (string, start, finish, substring) result (rep_string)

    type(varying_string), intent(in) :: string
    integer, intent(in)              :: start
    integer, intent(in)              :: finish
    character(LEN=*), intent(in)     :: substring
    type(varying_string)             :: rep_string

! Replace part of a varying string with a character
! substring

    rep_string = replace(char(string), start, finish, substring)

! Finish

    return

  end function replace_VS_CH_fixed

!****

  elemental function replace_CH_CH_fixed (string, start, finish, substring) result (rep_string)

    character(LEN=*), intent(in) :: string
    integer, intent(in)          :: start
    integer, intent(in)          :: finish
    character(LEN=*), intent(in) :: substring
    type(varying_string)         :: rep_string

    integer                      :: start_
    integer                      :: finish_

! Replace part of a character string with a character
! substring

    start_ = MAX(1, start)
    finish_ = MIN(LEN(string), finish)

    if(finish_ < start_) then
       rep_string = insert(string, start_, substring)
    else
       rep_string = var_str(string(:start_-1)//substring//string(finish_+1:))
    endif

! Finish

    return

  end function replace_CH_CH_fixed

!****

  elemental function replace_VS_VS_VS_target (string, target, substring, every, back) result (rep_string)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: target
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a varying string with a varying
! substring, at a location matching a varying-
! string target

    rep_string = replace(char(string), char(target), char(substring), every, back)

! Finish

    return

  end function replace_VS_VS_VS_target

!****

  elemental function replace_CH_VS_VS_target (string, target, substring, every, back) result (rep_string)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: target
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring, at a location matching a varying-
! string target

    rep_string = replace(string, char(target), char(substring), every, back)

! Finish

    return

  end function replace_CH_VS_VS_target

!****

  elemental function replace_VS_CH_VS_target (string, target, substring, every, back) result (rep_string)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: target
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring, at a location matching a character-
! string target

    rep_string = replace(char(string), target, char(substring), every, back)

! Finish

    return

  end function replace_VS_CH_VS_target

!****

  elemental function replace_CH_CH_VS_target (string, target, substring, every, back) result (rep_string)

    character(LEN=*), intent(in)     :: string
    character(LEN=*), intent(in)     :: target
    type(varying_string), intent(in) :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a character string with a varying
! substring, at a location matching a character-
! string target

    rep_string = replace(string, target, char(substring), every, back)

! Finish

    return

  end function replace_CH_CH_VS_target

!****

  elemental function replace_VS_VS_CH_target (string, target, substring, every, back) result (rep_string)

    type(varying_string), intent(in) :: string
    type(varying_string), intent(in) :: target
    character(LEN=*), intent(in)     :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a varying string with a character
! substring, at a location matching a varying-
! string target

    rep_string = replace(char(string), char(target), substring, every, back)

! Finish

    return

  end function replace_VS_VS_CH_target

!****

  elemental function replace_CH_VS_CH_target (string, target, substring, every, back) result (rep_string)

    character(LEN=*), intent(in)     :: string
    type(varying_string), intent(in) :: target
    character(LEN=*), intent(in)     :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a character string with a character
! substring, at a location matching a varying-
! string target

    rep_string = replace(string, char(target), substring, every, back)

! Finish

    return

  end function replace_CH_VS_CH_target

!****

  elemental function replace_VS_CH_CH_target (string, target, substring, every, back) result (rep_string)

    type(varying_string), intent(in) :: string
    character(LEN=*), intent(in)     :: target
    character(LEN=*), intent(in)     :: substring
    logical, intent(in), optional    :: every
    logical, intent(in), optional    :: back
    type(varying_string)             :: rep_string

! Replace part of a varying string with a character
! substring, at a location matching a character-
! string target

    rep_string = replace(char(string), target, substring, every, back)

! Finish

    return

  end function replace_VS_CH_CH_target

!****

  elemental function replace_CH_CH_CH_target (string, target, substring, every, back) result (rep_string)

    character(LEN=*), intent(in)  :: string
    character(LEN=*), intent(in)  :: target
    character(LEN=*), intent(in)  :: substring
    logical, intent(in), optional :: every
    logical, intent(in), optional :: back
    type(varying_string)          :: rep_string

    logical                       :: every_
    logical                       :: back_
    type(varying_string)          :: work_string
    integer                       :: length_target
    integer                       :: i_target

! Handle special cases when LEN(target) == 0. Such
! instances are prohibited by the standard, but
! since this function is elemental, no error can be
! thrown. Therefore, it makes sense to handle them 
! in a sensible manner

    if(LEN(target) == 0) then
       if(LEN(string) /= 0) then
          rep_string = string
       else
          rep_string = substring
       endif
       return
    end if

! Replace part of a character string with a character
! substring, at a location matching a character-
! string target

    if(PRESENT(every)) then
       every_ = every
    else
       every_ = .false.
    endif

    if(PRESENT(back)) then
       back_ = back
    else
       back_ = .false.
    endif

    rep_string = ""

    work_string = string

    length_target = LEN(target)

    replace_loop : do

       i_target = index(work_string, target, back_)

       if(i_target == 0) exit replace_loop

       if(back_) then
          rep_string = substring//extract(work_string, start=i_target+length_target)//rep_string
          work_string = extract(work_string, finish=i_target-1)
       else
          rep_string = rep_string//extract(work_string, finish=i_target-1)//substring
          work_string = extract(work_string, start=i_target+length_target)
       endif

       if(.NOT. every_) exit replace_loop

    end do replace_loop

    if(back_) then
       rep_string = work_string//rep_string
    else
       rep_string = rep_string//work_string
    endif

! Finish

    return

  end function replace_CH_CH_CH_target

!****

  elemental subroutine split_VS (string, word, set, separator, back)

    type(varying_string), intent(inout)         :: string
    type(varying_string), intent(out)           :: word
    type(varying_string), intent(in)            :: set
    type(varying_string), intent(out), optional :: separator
    logical, intent(in), optional               :: back

! Split a varying string into two verying strings

    call split_CH(string, word, char(set), separator, back)

! Finish

    return

  end subroutine split_VS

!****

  elemental subroutine split_CH (string, word, set, separator, back)

    type(varying_string), intent(inout)         :: string
    type(varying_string), intent(out)           :: word
    character(LEN=*), intent(in)                :: set
    type(varying_string), intent(out), optional :: separator
    logical, intent(in), optional               :: back

    logical                                     :: back_
    integer                                     :: i_separator

! Split a varying string into two verying strings

    if(PRESENT(back)) then
       back_ = back
    else
       back_ = .false.
    endif

    i_separator = scan(string, set, back_)

    if(i_separator /= 0) then

       if(back_) then
          word = extract(string, start=i_separator+1)
          if(PRESENT(separator)) separator = extract(string, start=i_separator, finish=i_separator)
          string = extract(string, finish=i_separator-1)
       else
          word = extract(string, finish=i_separator-1)
          if(PRESENT(separator)) separator = extract(string, start=i_separator, finish=i_separator)
          string = extract(string, start=i_separator+1)
       endif

    else

       word = string
       if(PRESENT(separator)) separator = ""
       string = ""

    endif

! Finish

    return

  end subroutine split_CH

!****

  elemental subroutine erase_ (string)

    type(varying_string), intent(inout) :: string

! Get the length of a varying string

    if(ALLOCATED(string%chars)) then
       deallocate(string%chars)
    endif

! Finish

    return

  end subroutine erase_

END MODULE ISO_VARYING_STRING