# 1 "GNU-f95-on-LINUX/f95files/vec{str}.F90"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "GNU-f95-on-LINUX/f95files/vec{str}.F90"
!---------------------------------------------------------------------------
!
!  VEC{STR}: String vectors
!
!  Notes
!
!  Normally, a STR variable means a character string of length STR_SIZE.
!  However, in this module we use assumed length character strings.
!  Note also that ELEMENT_TYPE_SIZE is defind as "len(self(1))*CHR_SIZE".
!
! Copyright (C) Dylan Jayatilaka, 1998
!
! This library is free software; you can redistribute it and/or
! modify it under the terms of the GNU Library General Public
! License as published by the Free Software Foundation; either
! version 2 of the License, or (at your option) any later version.
!
! This library is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
! Library General Public License for more details.
!
! You should have received a copy of the GNU Library General Public
! License along with this library; if not, write to the
! Free Software Foundation, Inc., 59 Temple Place - Suite 330,
! Boston, MA  02111-1307, USA.
!
! $Id: vec{str}.foo 2787 2006-04-18 05:35:01Z dylan_ $
!---------------------------------------------------------------------------

module VEC_STR_MODULE

   use TYPES_MODULE

   use SYSTEM_MODULE

   use STR_MODULE, only: remove_blanks_
   use STR_MODULE, only: replace_all_
   use STR_MODULE, only: same_as_
   use STR_MODULE, only: to_lower_case_
   use STR_MODULE, only: to_upper_case_

   use VEC_INT_MODULE, only: create_
   use VEC_INT_MODULE, only: destroy_

   implicit none





   private

   public    append_
   interface append_
      module procedure append_0
      module procedure append_1
   end interface

   public    append_only_if_unique_
   interface append_only_if_unique_
      module procedure append_only_if_unique
   end interface

   public    copy_
   interface copy_
      module procedure copy
   end interface

   public    create_
   interface create_
      module procedure create_0
      module procedure create_1
      module procedure create_2
   end interface

   public    create_copy_
   interface create_copy_
      module procedure create_copy
   end interface

   public    destroy_
   interface destroy_
      module procedure destroy
   end interface

   public    equals_
   interface equals_
      module procedure equals
   end interface

   public    expand_
   interface expand_
      module procedure expand
   end interface

   public    has_any_included_in_
   interface has_any_included_in_
      module procedure has_any_included_in
   end interface

   public    has_any_including_
   interface has_any_including_
      module procedure has_any_including
   end interface

   public    has_repetitions_
   interface has_repetitions_
      module procedure has_repetitions
   end interface

   public    includes_
   interface includes_
      module procedure includes
   end interface

   public    index_of_
   interface index_of_
      module procedure index_of
   end interface

   public    index_of_first_included_in_
   interface index_of_first_included_in_
      module procedure index_of_first_included_in
   end interface

   public    index_of_first_that_includes_
   interface index_of_first_that_includes_
      module procedure index_of_first_that_includes
   end interface

   public    index_of_matching_bracket_
   interface index_of_matching_bracket_
      module procedure index_of_matching_bracket
   end interface

   public    join_
   interface join_
      module procedure join_0
      module procedure join_1
   end interface

   public    no_of_unique_elements_
   interface no_of_unique_elements_
      module procedure no_of_unique_elements
   end interface

   public    prepend_
   interface prepend_
      module procedure prepend_0
      module procedure prepend_1
   end interface

   public    prune_
   interface prune_
      module procedure prune_0
      module procedure prune_1
   end interface

   public    quick_sort_
   interface quick_sort_
      module procedure quick_sort_0
      module procedure quick_sort_1
   end interface

   private    quick_sort_decreasing_
   interface quick_sort_decreasing_
      module procedure quick_sort_decreasing_0
      module procedure quick_sort_decreasing_1
   end interface

   private    quick_sort_increasing_
   interface quick_sort_increasing_
      module procedure quick_sort_increasing_0
      module procedure quick_sort_increasing_1
   end interface

   public    remove_blanks_
   interface remove_blanks_
      module procedure remove_blanks
   end interface

   public    remove_repetitions_
   interface remove_repetitions_
      module procedure remove_repetitions
   end interface

   public    replace_all_
   interface replace_all_
      module procedure replace_all
   end interface

   public    reverse_order_
   interface reverse_order_
      module procedure reverse_order
   end interface

   public    same_as_
   interface same_as_
      module procedure same_as
   end interface

   public    shrink_
   interface shrink_
      module procedure shrink
   end interface

   public    sort_
   interface sort_
      module procedure sort
   end interface

   public    swap_elements_
   interface swap_elements_
      module procedure swap_elements
   end interface

   public    to_lower_case_
   interface to_lower_case_
      module procedure to_lower_case
   end interface

   public    to_upper_case_
   interface to_upper_case_
      module procedure to_upper_case
   end interface

contains

! *****************
! Memory allocation
! *****************

   subroutine create_0(self,dim)
   character(len=*), dimension(:) :: self
   ! Create space for object
      pointer :: self
      integer(4), intent(in) :: dim
   ! Ensure (dim>=0) or die and print: "VEC{STR}:create_0 ... dimension of array not 1 or greater"
   ! The following code is inherited from VEC{INTRINSIC}
      nullify(self)
      allocate(self(dim))
      ! Normally keep track of new memory usage here ...
   end subroutine

   subroutine create_1(self,lb,ub)
   character(len=*), dimension(:) :: self
   ! Create the vector with lower bound "lb", upper bound "ub"
      pointer :: self
      integer(4), intent(in) :: lb,ub
   ! The following code is inherited from VEC{INTRINSIC}
      nullify(self)
      allocate(self(lb:ub))
      ! Normally keep track of new memory usage here ...
   end subroutine

   subroutine create_2(self,bounds)
   character(len=*), dimension(:) :: self
   ! Create the vector with "bounds"
      pointer :: self
      integer(4), dimension(2), intent(in) :: bounds
   ! The following code is inherited from VEC{INTRINSIC}
      call create_(self,bounds(1),bounds(2))
    ! if (bounds.dim==1); .create(bounds(1))
    ! else;               .create(bounds(1),bounds(2))
    ! end
   end subroutine

   subroutine destroy(self)
   character(len=*), dimension(:) :: self
   ! Destroy space for object
      pointer :: self
   ! The following code is inherited from VEC{INTRINSIC}
      if (.not. associated(self)) return
      ! Normally delete old memory usage here ...
      deallocate(self)
   end subroutine

   subroutine create_copy(self,v)
   character(len=*), dimension(:) :: self
   ! Create a copy of vector "v".
      pointer :: self
      character(len=*), dimension(:), intent(in) :: v
   ! The following code is inherited from VEC{INTRINSIC}
      call create_(self,size(v))
      self = v
   end subroutine

   subroutine copy(self,v)
   character(len=*), dimension(:) :: self
   ! Copy vector "v".
      character(len=*), dimension(:), intent(in) :: v
   ! Ensure (size(self)==size(v)) or die and print: "VEC{STR}:copy ... vec size does not match"
   ! The following code is inherited from VEC{INTRINSIC}
      self = v
   end subroutine

! ******************
! Size-of operations
! ******************

! ***********************
! Shrinking and expansion
! ***********************

   subroutine shrink(self,dim)
   character(len=*), dimension(:) :: self
   ! Shrink self to dimension dim.  Contents are retained.
     pointer :: self
     integer(4), intent(in) :: dim
     character(len=len(self(1))), dimension(:), pointer :: old
     integer(4) :: n
   ! Ensure (associated(self)) or die and print: "VEC{STR}:shrink ... no self array"
   ! Ensure (dim<=size(self)) or die and print: "VEC{STR}:shrink ... dim too large"
   ! The following code is inherited from VEC{INTRINSIC}
     if (dim==size(self)) return
     old => self
     nullify(self)
     call create_(self,dim)
     do n=1,dim
       self(n) = old(n)
     end do
     call destroy_(old)
   end subroutine

   subroutine expand(self,dim)
   character(len=*), dimension(:) :: self
   ! Expand self to dimension dim. New slots are left undefined.
     pointer :: self
     integer(4), intent(in) :: dim
     character(len=len(self(1))), dimension(:), pointer :: old
     integer(4) :: old_dim
   ! The following code is inherited from VEC{INTRINSIC}
     if (.not. associated(self)) then
        call create_(self,dim)
     else
        ! Ensure (dim>=size(self)) or die and print: "VEC{STR}:expand ... dim not large enough"
        old => self
        old_dim = size(old)
        nullify(self)
        call create_(self,dim)
        self(1:old_dim) = old
        call destroy_(old)
     end if
   end subroutine

   subroutine append_0(self,v)
   character(len=*), dimension(:) :: self
   ! Expands self and appends the contents of vector "v".
     pointer :: self
     character(len=*), dimension(:), intent(in) :: v
     integer(4) :: dim
   ! The following code is inherited from VEC{INTRINSIC}
     if (.not. associated(self)) then; dim = 0
     else;                 dim = size(self)
     end if
     call expand_(self,dim+size(v))
     self(dim+1:) = v
   end subroutine

   subroutine append_1(self,value)
   character(len=*), dimension(:) :: self
   ! Expands self by 1, and appends the single scalar "value" onto the end.
     pointer :: self
     character(len=*), intent(in) :: value
     integer(4) :: dim
   ! The following code is inherited from VEC{INTRINSIC}
     if (.not. associated(self)) then; dim = 0
     else;                 dim = size(self)
     end if
     call expand_(self,dim+1)
     self(dim+1) = value
   end subroutine

   subroutine append_only_if_unique(self,value)
   character(len=*), dimension(:) :: self
   ! Expands self by 1, and appends the single scalar "value" onto the end, but
   ! only if the "value" is unique
     pointer :: self
     character(len=*), intent(in) :: value
   ! The following code is inherited from VEC{INTRINSIC}
     if (any(self==value)) return
     call append_(self,value)
   end subroutine

   subroutine prepend_0(self,v)
   character(len=*), dimension(:) :: self
   ! Prepend the vector "v" to "self". "self" is expanded.
     pointer :: self
     character(len=*), dimension(:), intent(in) :: v
     integer(4) :: dim,dimv
   ! The following code is inherited from VEC{INTRINSIC}
     dim  = size(self)
     dimv = size(v)
     call expand_(self,dim+dimv)
     self(dimv+1:    ) = self(1:dim)
     self(     1:dimv) = v
   end subroutine

   subroutine prepend_1(self,value)
   character(len=*), dimension(:) :: self
   ! Prepend an single "value" to "self". "self" is expanded.
     pointer :: self
     character(len=*), intent(in) :: value
     integer(4) :: dim
   ! The following code is inherited from VEC{INTRINSIC}
     dim = size(self)
     call expand_(self,dim+1)
     self(2:) = self(1:dim)
     self(1 ) = value
   end subroutine

   function join_0(self,v) result(res)
   character(len=*), dimension(:) :: self
   ! Yield a vector which is the concatenation of "self" and "v"
     character(len=*), dimension(:), intent(in) :: v
     character(len=len(self(1))), dimension(:), pointer :: res
     integer(4) :: dim, dim_v
   ! The following code is inherited from VEC{INTRINSIC}
     dim   = size(self)
     dim_v = size(v)
     call create_(res,dim+dim_v)
     res(    1:dim      ) = self
     res(dim+1:dim+dim_v) = v
   end function

   function join_1(self,v1,v2) result(res)
   character(len=*), dimension(:) :: self
   ! Yield a vector which is the concatenation of "self" and "v1" and "v2"
     character(len=*), dimension(:), intent(in) :: v1,v2
     character(len=len(self(1))), dimension(:), pointer :: res
     integer(4) :: dim, dim_v1, dim_v2
   ! The following code is inherited from VEC{INTRINSIC}
     dim    = size(self)
     dim_v1 = size(v1)
     dim_v2 = size(v2)
     call create_(res,dim+dim_v1+dim_v2)
     res(           1:dim              ) = self
     res(dim+       1:dim+dim_v1       ) = v1
     res(dim+dim_v1+1:dim+dim_v1+dim_v2) = v2
   end function

   subroutine prune_0(self,values)
   character(len=*), dimension(:) :: self
   ! Removes the scalar "values" from the vector, if they are there.
   ! The order of the elementsis otherwise unchanged.
     pointer :: self
     character(len=*), dimension(:), intent(in) :: values
     character(len=512), dimension(:), pointer :: copy
     integer(4) :: i,n
   ! The following code is inherited from VEC{INTRINSIC}
     call create_(copy,size(self))
     n = 0
     do i = 1,size(self)
        if (any(values==self(i))) cycle
        n = n + 1
        copy(n) = self(i)
     end do
     call shrink_(copy,n)
     call destroy_(self)
     self => copy
   end subroutine

   subroutine prune_1(self,value)
   character(len=*), dimension(:) :: self
   ! Removes the single scalar "value" from the vector, if it is there.
   ! The order of the elementsis otherwise unchanged.
     pointer :: self
     character(len=*), intent(in) :: value
     character(len=512), dimension(:), pointer :: copy
     integer(4) :: i,n
   ! The following code is inherited from VEC{INTRINSIC}
     call create_(copy,size(self))
     n = 0
     do i = 1,size(self)
        if (self(i)==value) cycle
        n = n + 1
        copy(n) = self(i)
     end do
     call shrink_(copy,n)
     call destroy_(self)
     self => copy
   end subroutine

! ********************
! Comparison functions
! ********************

   function equals(self,v) result(res)
   character(len=*), dimension(:) :: self
   ! Return true if "self" is the same as "v".
      intent(in) :: self
      character(len=*), dimension(:), intent(in) :: v
      logical(4) :: res
   ! The following code is inherited from VEC{INTRINSIC}
      res = same_as_(self,v)
   end function

   function same_as(self,v) result(res)
   character(len=*), dimension(:) :: self
   ! Return true if "self" is the same as "v".
      intent(in) :: self
      character(len=*), dimension(:), intent(in) :: v
      logical(4) :: res
   ! The following code is inherited from VEC{INTRINSIC}
      if (size(self)/=size(v)) then; res = .false.
      else;                  res = all(self==v)
      end if
   end function

! *****************************
! Repetition related operations
! *****************************

   subroutine remove_repetitions(self)
   character(len=*), dimension(:) :: self
   ! Sort through the vector and remove repeated elements which come later in
   ! the list.  NOTE: the vector may shrink
      pointer :: self
      character(len=len(self(1))), dimension(:), pointer :: unique
      integer(4) :: i,j,n
      logical(4) :: found
   ! Ensure (associated(self)) or die and print: "VEC{STR}:remove_repetitions ... no vector"
   ! The following code is inherited from VEC{OBJECT}
      if (size(self)==1) return
      call create_(unique,size(self))
      n = 1
      unique(1) = self(1)
      do i = 2,size(self)
         found = .false.
         do j = 1,n
            if (.not. same_as_(self(i),unique(j))) cycle
            found = .true.
         end do
         if (found) cycle
         n = n + 1
         unique(n) = self(i)
      end do
      call destroy_(self)
      call create_(self,n)
      self = unique(1:n)
      call destroy_(unique)
   end subroutine

   function has_repetitions(self) result(res)
   character(len=*), dimension(:) :: self
   ! Return .true. if self has at least one repeated element.
      logical(4) :: res
      character(len=len(self(1))), dimension(:), pointer :: unique
      integer(4) :: i,j,n
   ! The following code is inherited from VEC{OBJECT}
      res = .false.
      if (size(self)==1) return
      call create_(unique,size(self))
      n = 1
      unique(1) = self(1)
      do i = 2,size(self)
         do j = 1,n
            if (.not. same_as_(self(i),unique(j))) cycle
            res = .true.
            return
         end do
         n = n + 1
         unique(n) = self(i)
      end do
      call destroy_(unique)
   end function

   pure function no_of_unique_elements(self) result(res)
   character(len=*), dimension(:) :: self
   ! Return the number of unique elements in the vector.
      intent(in) :: self
      integer(4) :: res
      integer(4) :: n,i
      logical(4) :: same
   ! The following code is inherited from VEC{OBJECT}
      res = 1
      do n = 2,size(self)
         same = .false.
         do i = 1,n-1
            if (.not. same_as_(self(n),self(i))) cycle
            same = .true.
            exit
         end do
         if (.not. same) res = res + 1
      end do
   end function

! ****************
! Sorting routines
! ****************

   pure subroutine sort(self,decreasing_order)
   character(len=*), dimension(:) :: self
   ! Sort array "self" from lowest to highest, using simple insertion sort.  If
   ! "decreasing_order" is present and .true. sort from highest to lowest instead.
     intent(inout) :: self
     logical(4), intent(in), optional :: decreasing_order
     integer(4) :: i,j,n
     logical(4) :: lowest_first
   ! The following code is inherited from VEC{OBJECT}
     lowest_first = .true.
     if (present(decreasing_order)) lowest_first = .not. decreasing_order
     n = size(self)
     if (lowest_first) then
       do i=1,n-1
       do j=i+1,n
          if (self(j) < self(i)) call swap_elements_(self,i,j)
       end do
       end do
     else
       do i=1,n-1
       do j=i+1,n
          if (self(j) > self(i)) call swap_elements_(self,i,j)
       end do
       end do
     end if
   end subroutine

   subroutine quick_sort_0(self,decreasing_order)
   character(len=*), dimension(:) :: self
   ! Sort the vector into increasing order.If "decreasing_order" is present and
   ! .true., the vector is sorted from largest to smallest
      intent(in) :: self
      logical(4), optional, intent(in) :: decreasing_order
      logical(4) :: decreasing
   ! The following code is inherited from VEC{OBJECT}
      decreasing = .false.
      if (present(decreasing_order)) decreasing = decreasing_order
      if (.not. decreasing) then; call quick_sort_increasing_(self)
      else;                     call quick_sort_decreasing_(self)
      end if
   end subroutine

   recursive subroutine quick_sort_increasing_0(self)
   character(len=*), dimension(:) :: self
   ! Sort the vector into order, smallest to largest
      character(len=len(self(1))), dimension(:), pointer :: smaller,larger
      integer(4) :: n, ns, ne, nl
      character(len=len(self(1))) :: chosen
   ! The following code is inherited from VEC{OBJECT}
      if (size(self)<=1) return
      n = size(self)
      chosen = self(1)
      ns = count(self<chosen)
      nl = count(self>chosen)
      ne = n - ns - nl
      call create_(smaller,ns)
      call create_(larger,nl)
      smaller = pack(self,self<chosen)
      larger  = pack(self,self>chosen)
      call quick_sort_(smaller)
      call quick_sort_(larger)
      self(1:ns)       = smaller
      self(ns+1:ns+ne) = chosen
      self(ns+ne+1:)   = larger
      call destroy_(larger)
      call destroy_(smaller)
   end subroutine

   recursive subroutine quick_sort_decreasing_0(self)
   character(len=*), dimension(:) :: self
   ! Sort the vector into order, largest to smallest
      character(len=len(self(1))), dimension(:), pointer :: smaller,larger
      integer(4) :: n, ns, ne, nl
      character(len=len(self(1))) :: chosen
   ! The following code is inherited from VEC{OBJECT}
      if (size(self)<=1) return
      n = size(self)
      chosen = self(1)
      ns = count(self<chosen)
      nl = count(self>chosen)
      ne = n - ns - nl
      call create_(smaller,ns)
      call create_(larger,nl)
      smaller = pack(self,self<chosen)
      larger  = pack(self,self>chosen)
      call quick_sort_(smaller)
      call quick_sort_(larger)
      self(1:nl)       = larger
      self(nl+1:nl+ne) = chosen
      self(nl+ne+1:)   = smaller
      call destroy_(larger)
      call destroy_(smaller)
   end subroutine

   subroutine quick_sort_1(self,indices,decreasing_order)
   character(len=*), dimension(:) :: self
   ! Return the "indices" which sort self from smallest to largest, i.e. on
   ! return "self(indices)" is sorted. NOTE: self is *not* sorted.
   ! If "decreasing_order" is present and .true., the indices are sorted from
   ! largest to smallest
      intent(in) :: self
      integer(4), dimension(:), intent(inout) :: indices
      logical(4), optional, intent(in) :: decreasing_order
      logical(4) :: decreasing
      integer(4) :: i
   ! Ensure (size(indices)==size(self)) or die and print: "VEC{STR}:quick_sort_1 ... wrong size, indices"
   ! The following code is inherited from VEC{OBJECT}
      decreasing = .false.
      if (present(decreasing_order)) decreasing = decreasing_order
      indices = (/(i,i=1,size(self))/) ! initialise indices
      if (.not. decreasing) then; call quick_sort_increasing_(self,indices)
      else;                     call quick_sort_decreasing_(self,indices)
      end if
   end subroutine

   recursive subroutine quick_sort_increasing_1(self,indices)
   character(len=*), dimension(:) :: self
   ! Return the indices which sort vector from smallest to largest, i.e. on
   ! return "self(indices)" is sorted. NOTE: self is *not* sorted.
      intent(in) :: self
      integer(4), dimension(:), intent(inout) :: indices
      integer(4), dimension(:), pointer :: list,small,equal,large,small_indices,equal_indices,large_indices
      integer(4) :: n, i, ns, ne, nl
      character(len=len(self(1))) :: chosen
   ! The following code is inherited from VEC{OBJECT}
      if (size(indices)<=1) return
      n = size(indices)
      call create_(list,n); list = (/(i,i=1,n)/)
      chosen = self(1)
      ns = count(self<chosen)
      nl = count(self>chosen)
      ne = n - ns - nl
      call create_(small,ns); call create_(small_indices,ns)
      call create_(equal,ne); call create_(equal_indices,ne)
      call create_(large,nl); call create_(large_indices,nl)
      small = pack(list,self <chosen) ! indices of small self elements
      equal = pack(list,self==chosen) ! indices of equal self elements
      large = pack(list,self >chosen) ! indices of large self elements
      small_indices = indices(small)
      equal_indices = indices(equal)
      large_indices = indices(large)
      if (ns>1) call quick_sort_increasing_(self(small),small_indices)
      if (nl>1) call quick_sort_increasing_(self(large),large_indices)
      indices(1:ns)       = small_indices
      indices(ns+1:ns+ne) = equal_indices
      indices(ns+ne+1:)   = large_indices
      call destroy_(large_indices); call destroy_(large)
      call destroy_(equal_indices); call destroy_(equal)
      call destroy_(small_indices); call destroy_(small)
      call destroy_(list)
   end subroutine

   recursive subroutine quick_sort_decreasing_1(self,indices)
   character(len=*), dimension(:) :: self
   ! Return the indices which sort vector from largest to smallest, i.e. on
   ! return "self(indices)" is sorted. NOTE: self is *not* sorted.
      intent(in) :: self
      integer(4), dimension(:), intent(inout) :: indices
      integer(4), dimension(:), pointer :: list,small,equal,large,small_indices,equal_indices,large_indices
      integer(4) :: n, i, ns, ne, nl
      character(len=len(self(1))) :: chosen
   ! The following code is inherited from VEC{OBJECT}
      if (size(indices)<=1) return
      n = size(indices)
      call create_(list,n); list = (/(i,i=1,n)/)
      chosen = self(1)
      ns = count(self>chosen)
      nl = count(self<chosen)
      ne = n - ns - nl
      call create_(small,ns); call create_(small_indices,ns)
      call create_(equal,ne); call create_(equal_indices,ne)
      call create_(large,nl); call create_(large_indices,nl)
      small = pack(list,self >chosen) ! indices of large self elements
      equal = pack(list,self==chosen) ! indices of equal self elements
      large = pack(list,self <chosen) ! indices of small self elements
      small_indices = indices(small)
      equal_indices = indices(equal)
      large_indices = indices(large)
      if (ns>1) call quick_sort_decreasing_(self(small),small_indices)
      if (nl>1) call quick_sort_decreasing_(self(large),large_indices)
      indices(1:ns)       = small_indices
      indices(ns+1:ns+ne) = equal_indices
      indices(ns+ne+1:)   = large_indices
      call destroy_(large_indices); call destroy_(large)
      call destroy_(equal_indices); call destroy_(equal)
      call destroy_(small_indices); call destroy_(small)
      call destroy_(list)
   end subroutine

   pure subroutine reverse_order(self)
   character(len=*), dimension(:) :: self
   ! Reverse the order of the elements of self
     intent(inout) :: self
     integer(4) :: n,dim
   ! The following code is inherited from VEC{INTRINSIC}
     dim = size(self)
     do n = 1,dim/2
       call swap_elements_(self,n,dim-n+1)
     end do
   end subroutine

   pure subroutine swap_elements(self,e1,e2)
   character(len=*), dimension(:) :: self
   ! Swap elements "e1" and "e2" in "self".
      intent(inout) :: self
      integer(4), intent(in) :: e1,e2

      character(len=512) :: val
   ! The following code is inherited from VEC{INTRINSIC}
      val = self(e1)
      self(e1) = self(e2)
      self(e2) = val
   end subroutine

! *****************************************
! Inclusion and matching related operations
! *****************************************

   function has_any_included_in(self,string,at_start) result(res)
   character(len=*), dimension(:) :: self
   ! Return .true. if self has any element included in "string" which starts at
   ! the start of the "string", provided "at_start" is .true.; otherwise
   ! returns .true. even if the match was not at the start.
      character(len=*), intent(in) :: string
      logical(4), optional :: at_start
      logical(4) :: res
      logical(4) :: first
      first = .false.
      if (present(at_start)) first = at_start
      if (first) then
         res = any(index(spread(string,1,size(self)),self) == 1)
      else
         res = any(index(spread(string,1,size(self)),self) /= 0)
      end if
   end function

   function index_of_first_included_in(self,string) result(res)
   character(len=*), dimension(:) :: self
   ! Return the index of the first element in self which is included in
   ! "string", or zero otherwise.
      character(len=*), intent(in) :: string
      integer(4) :: res
      integer(4) :: i
      res = 0
      do i = 1,size(self)
         res = index(string,self(i))
         if (res>0) exit
      end do
   end function

   function has_any_including(self,string) result(res)
   character(len=*), dimension(:) :: self
   ! Return .true. if self has any element which includes "string".
      character(len=*), intent(in) :: string
      logical(4) :: res
      res = any(index(self,spread(string,1,size(self))) /= 0)
   end function

   function includes(self,string,at_start) result(res)
   character(len=*), dimension(:) :: self
   ! Return .true. for a particular element, if that element of self includes "string".
   ! Returns .false. if no element matches. If "at_start" is present and .true., then the
   ! result is .true. only if the item matches at the start of the string.
      character(len=*), intent(in) :: string
      logical(4), optional :: at_start
      logical(4), dimension(size(self)) :: res
      logical(4) :: first
      first = .false.
      if (present(at_start)) first = at_start
      if (first) then
         res = index(self,spread(string,1,size(self))) == 1
      else
         res = index(self,spread(string,1,size(self))) /= 0
      end if
   end function

   function index_of_first_that_includes(self,string) result(res)
   character(len=*), dimension(:) :: self
   ! Return the index of the first element of self that includes "string".
   ! Returns 0 if no element matches.
      character(len=*), intent(in) :: string
      integer(4) :: res
      integer(4) :: i
      do i = 1,size(self)
         res = index(self(i),string)
         if (res==0) cycle
         res = i
         exit
      end do
   end function

   function index_of(self,string) result(res)
   character(len=*), dimension(:) :: self
   ! Return the first index of the "string" in self.
   ! Returns 0 if no element matches.
      character(len=*), intent(in) :: string
      integer(4) :: res
      integer(4) :: i
      res = 0
      do i = 1,size(self)
         if (self(i)/=string) cycle
         res = i
         exit
      end do
   end function

   function index_of_matching_bracket(self,symbol) result(res)
   character(len=*), dimension(:) :: self
   ! Return the first index of the matching bracket "symbol" in self.
   ! The first element of self need not be an opening bracket symbol.
      character(len=*), intent(in) :: symbol
      integer(4) :: res
      character(len=1), dimension(4) :: opening = (/"{","(","[","<"/)
      character(len=1), dimension(4) :: closing = (/"}",")","]",">"/)
      character(len=1) :: op,cl
      integer(4) :: i,s,n
   ! Ensure (any(symbol==opening)) or die and print: "VEC{STR}:index_of_matching_bracket ... unrecognised open bracket symbol"
   ! Ensure (index_of_(self,symbol)>0) or die and print: "VEC{STR}:index_of_matching_bracket ... no open bracket symbol in self"
   ! Ensure (index_of_(self,symbol)<size(self)) or die and print: "VEC{STR}:index_of_matching_bracket ... open bracket is at end of self"
      op = symbol
      cl = closing(index_of_(opening,symbol))
      s = index_of_(self,op)
      n = 0
      do i = s+1,size(self)
         if (self(i)==op) n = n + 1
         if (self(i)==cl .and. n==0) exit
         if (self(i)==cl .and. n>0) n = n - 1
      end do
      ! Ensure (n==0) or die and print: "VEC{STR}:index_of_matching_bracket ... unmatching number of closing bracket symbols"
      res = i
   end function

! **********
! Misc stuff
! **********

   subroutine to_lower_case(self)
   character(len=*), dimension(:) :: self
   ! Change upper case charaters to lower case in all elements
       integer(4) :: i
      do i = 1,size(self)
         call to_lower_case_(self(i))
      end do
   end subroutine

   subroutine to_upper_case(self)
   character(len=*), dimension(:) :: self
   ! Change lower case charaters to upper case in all elements
       integer(4) :: i
      do i = 1,size(self)
         call to_upper_case_(self(i))
      end do
   end subroutine

   subroutine replace_all(self,a,b)
   character(len=*), dimension(:) :: self
   ! Replace all occurences of string "a" by "b". String "b" can be zero
   ! length, however, replacements only occur up to the last nonblank
   ! character in "self" i.e. up to len_trim(self).
      character(len=*) :: a,b
      integer(4) :: i
      do i = 1,size(self)
         call replace_all_(self(i),a,b)
      end do
   end subroutine

   subroutine remove_blanks(self)
   character(len=*), dimension(:) :: self
   ! Replace all blanks by moving all non-blank characters leftwards
      integer(4) :: i
      do i = 1,size(self)
         call remove_blanks_(self(i))
      end do
   end subroutine

end module