ecearth3/sources/oasis3-mct/lib/mct/mpeu/m_List.F90

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!-----------------------------------------------------------------------
! CVS m_List.F90,v 1.36 2007-11-06 00:03:31 jacob Exp
! CVS MCT_2_8_0  
!BOP -------------------------------------------------------------------
!
! !MODULE: m_List - A List Manager
!
! !DESCRIPTION:  A {\em List} is a character buffer comprising 
! substrings called {\em items} separated by colons, combined with 
! indexing information describing (1) the starting point in the character 
! buffer of each substring, and  (2) the length of each substring.  The 
! only constraints on the valid list items are (1) the value of an 
! item does not contain the ``\verb":"'' delimitter, and (2) leading 
! and trailing blanks are stripped from any character string presented 
! to define a list item (although any imbeded blanks are retained).
!
! {\bf Example:}  Suppose we wish to define a List containing the 
! items {\tt 'latitude'}, {\tt 'longitude'}, and {\tt 'pressure'}.
! The character buffer of the List containing these items will be the 
! 27-character string
! \begin{verbatim}
! 'latitude:longitude:pressure'
! \end{verbatim}
! and the indexing information is summarized in the table below.
!
!\begin{table}[htbp]
!\begin{center}
!\begin{tabular}{|c|c|c|}
!\hline
!{\bf Item} & {\bf Starting Point in Buffer} & {\bf Length} \\
!\hline
!{\tt latitude} & 1 & 8 \\
!\hline
!{\tt longitude} & 9 & 9 \\
!\hline
!{\tt pressure} & 20 & 8\\
!\hline
!\end{tabular}
!\end{center}
!\end{table}
!
! One final note:  All operations for the {\tt List} datatype are 
! {\bf case sensitive}. 
!
! !INTERFACE:

 module m_List

! !USES:
!
! No other Fortran modules are used.

      implicit none

      private	! except

! !PUBLIC TYPES:

      public :: List		! The class data structure

      Type List
#ifdef SEQUENCE
     sequence
#endif
	 character(len=1),dimension(:),pointer :: bf
	 integer,       dimension(:,:),pointer :: lc
      End Type List

! !PUBLIC MEMBER FUNCTIONS:

      public :: init
      public :: clean
      public :: nullify
      public :: index
      public :: get_indices
      public :: test_indices
      public :: nitem
      public :: get
      public :: identical
      public :: assignment(=)
      public :: allocated
      public :: copy
      public :: exportToChar
      public :: exportToString
      public :: CharBufferSize
      public :: append
      public :: concatenate
      public :: bcast
      public :: send
      public :: recv
      public :: GetSharedListIndices

  interface init ; module procedure	&
      init_,		&
      initStr_,	&
      initstr1_
  end interface
  interface clean; module procedure clean_; end interface
  interface nullify; module procedure nullify_; end interface
  interface index; module procedure	&
      index_,     &
      indexStr_
  end interface
  interface get_indices; module procedure get_indices_; end interface
  interface test_indices; module procedure test_indices_; end interface
  interface nitem; module procedure nitem_; end interface
  interface get  ; module procedure	&
      get_,		&
      getall_,	&
      getrange_
  end interface
  interface identical; module procedure identical_; end interface
  interface assignment(=)
    module procedure copy_
  end interface
  interface allocated ; module procedure &
       allocated_
  end interface
  interface copy ; module procedure copy_ ;  end interface
  interface exportToChar ; module procedure &
       exportToChar_
  end interface
  interface exportToString ; module procedure &
       exportToString_
  end interface
  interface CharBufferSize ; module procedure &
      CharBufferSize_
  end interface
  interface append ; module procedure append_ ; end interface
  interface concatenate ; module procedure concatenate_ ; end interface
  interface bcast; module procedure bcast_; end interface
  interface send; module procedure send_; end interface
  interface recv; module procedure recv_; end interface
  interface GetSharedListIndices; module procedure &
      GetSharedListIndices_ 
  end interface

! !REVISION HISTORY:
! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
! 16May01 - J. Larson <larson@mcs.anl.gov> - Several changes / fixes:
!           public interface for copy_(), corrected version of copy_(),
!           corrected version of bcast_().
! 15Oct01 - J. Larson <larson@mcs.anl.gov> - Added the LOGICAL 
!           function identical_().
! 14Dec01 - J. Larson <larson@mcs.anl.gov> - Added the LOGICAL 
!           function allocated_().
! 13Feb02 - J. Larson <larson@mcs.anl.gov> - Added the List query 
!           functions exportToChar() and CharBufferLength().
! 13Jun02-  R.L. Jacob <jacob@mcs.anl.gov> - Move GetSharedListIndices
!           from mct to this module.
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname='MCT(MPEU)::m_List'

 contains

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: init_ - Initialize a List from a CHARACTER String
!
! !DESCRIPTION:
!
! A list is a string in the form of ``\verb"Larry:Moe:Curly"'',
! or ``\verb"lat:lon:lev"'', combined with substring location and 
! length information.  Through the initialization call, the
! items delimited by ``\verb":"'' are stored as an array of sub-
! strings of a long string, accessible through an array of substring
! indices.  The only constraints now on the valid list entries are,
! (1) the value of an entry does not contain ``\verb":"'', and (2)
! The leading and the trailing blanks are insignificant, although
! any imbeded blanks are.  For example,
!
! \begin{verbatim} 
! call init_(aList, 'batman  :SUPERMAN:Green Lantern:  Aquaman')
! \end{verbatim} 
! will result in {\tt aList} having four items:  'batman', 'SUPERMAN', 
! 'Green Lantern', and 'Aquaman'.  That is
! \begin{verbatim} 
! aList%bf =  'batman:SUPERMAN:Green Lantern:Aquaman'
! \end{verbatim} 
!
! !INTERFACE:

 subroutine init_(aList,Values)

! !USES:
!
      use m_die,only : die
      use m_mall,only : mall_mci,mall_ison
 
      implicit none

! !INPUT PARAMETERS: 
!
      character(len=*),intent(in) :: Values ! ":" delimited names

! !OUTPUT PARAMETERS:   
!
      type(List),intent(out)	  :: aList  ! an indexed string values
 

! !REVISION HISTORY:
! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::init_'
  character(len=1) :: c
  integer :: ib,ie,id,lb,le,ni,i,ier

	! Pass 1, getting the sizes
  le=0
  ni=0
  ib=1
  ie=0
  id=0
  do i=1,len(Values)
    c=Values(i:i)
    select case(c)
    case(' ')
      if(ib==i) ib=i+1	! moving ib up, starting from the next
    case(':')
      if(ib<=ie) then
	ni=ni+1
	id=1		! mark a ':'
      endif
      ib=i+1		! moving ib up, starting from the next
    case default
      ie=i
      if(id==1) then	! count an earlier marked ':'
	id=0
	le=le+1
      endif
      le=le+1
    end select
  end do
  if(ib<=ie) ni=ni+1

  ! COMPILER MAY NOT SIGNAL AN ERROR IF 
  ! ALIST HAS ALREADY BEEN INITIALIZED.
  ! PLEASE CHECK FOR PREVIOUS INITIALIZATION
  
  allocate(aList%bf(le),aList%lc(0:1,ni),stat=ier)
  if(ier /= 0) call die(myname_,'allocate()',ier)

	if(mall_ison()) then
	  call mall_mci(aList%bf,myname)
	  call mall_mci(aList%lc,myname)
	endif

	! Pass 2, copy the value and assign the pointers
  lb=1
  le=0
  ni=0
  ib=1
  ie=0
  id=0
  do i=1,len(Values)
    c=Values(i:i)

    select case(c)
    case(' ')
      if(ib==i) ib=i+1	! moving ib up, starting from the next
    case(':')
      if(ib<=ie) then
	ni=ni+1
	aList%lc(0:1,ni)=(/lb,le/)
	id=1		! mark a ':'
      endif

      ib=i+1		! moving ib up, starting from the next
      lb=le+2		! skip to the next non-':' and non-','
    case default
      ie=i
      if(id==1) then	! copy an earlier marked ':'
	id=0
	le=le+1
        aList%bf(le)=':'
      endif

      le=le+1
      aList%bf(le)=c
    end select
  end do
  if(ib<=ie) then
    ni=ni+1
    aList%lc(0:1,ni)=(/lb,le/)
  endif

 end subroutine init_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: initStr_ - Initialize a List Using the String Type
!
! !DESCRIPTION: This routine initializes a {\tt List} datatype given 
! an input {\tt String} datatype (see {\tt m\_String} for more 
! information regarding the {\tt String} type).  The contents of the 
! input {\tt String} argument {\tt pstr} must adhere to the restrictions
! stated for character input stated in the prologue of the routine 
! {\tt init\_()} in this module.
!
! !INTERFACE:

 subroutine initStr_(aList, pstr)

! !USES:
!
      use m_String, only : String,toChar

      implicit none

! !INPUT PARAMETERS: 
!
      type(String),intent(in)	  :: pstr

! !OUTPUT PARAMETERS:   
!
      type(List),intent(out)	  :: aList  ! an indexed string values


! !REVISION HISTORY:
! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::initStr_'

  call init_(aList,toChar(pstr))

 end subroutine initStr_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: initStr1_ - Initialize a List Using an Array of Strings
!
! !DESCRIPTION: This routine initializes a {\tt List} datatype given 
! as input array of {\tt String} datatypes (see {\tt m\_String} for more 
! information regarding the {\tt String} type).  The contents of each 
! {\tt String} element of the input array {\tt strs} must adhere to the 
! restrictions stated for character input stated in the prologue of the 
! routine {\tt init\_()} in this module.  Specifically, no element in 
! {\tt strs} may contain the colon \verb':' delimiter, and any 
! leading or trailing blanks will be stripped (though embedded blank
! spaces will be retained).  For example, consider an invocation of 
! {\tt initStr1\_()} where the array {\tt strs(:)} contains four entries:
! {\tt strs(1)='John'}, {\tt strs(2)=' Paul'}, 
! {\tt strs(3)='George '}, and {\tt strs(4)='  Ringo'}.  The resulting
! {\tt List} output {\tt aList} will have
! \begin{verbatim} 
! aList%bf =  'John:Paul:George:Ringo'
! \end{verbatim} 
! !INTERFACE:

 subroutine initStr1_(aList, strs)

! !USES:
!
      use m_String, only : String,toChar
      use m_String, only : len
      use m_String, only : ptr_chars
      use m_die,only : die

      implicit none

! !INPUT PARAMETERS: 
!
      type(String),dimension(:),intent(in)	  :: strs

! !OUTPUT PARAMETERS:   
!
      type(List),intent(out)	  :: aList  ! an indexed string values


! !REVISION HISTORY:
! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::initStr1_'
  character(len=1),allocatable,dimension(:) :: ch1
  integer :: ier
  integer :: n,i,lc,le

  n=size(strs)
  le=0
  do i=1,n
    le=le+len(strs(i))
  end do
  le=le+n-1	! for n-1 ":"s

	allocate(ch1(le),stat=ier)
		if(ier/=0) call die(myname_,'allocate()',ier)

  le=0
  do i=1,n
    if(i>1) then
      le=le+1
      ch1(le)=':'
    endif

    lc=le+1
    le=le+len(strs(i))
    ch1(lc:le)=ptr_chars(strs(i))
  end do
    
  call init_(aList,toChar(ch1))

	deallocate(ch1,stat=ier)
		if(ier/=0) call die(myname_,'deallocate()',ier)

 end subroutine initStr1_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: clean_ - Deallocate Memory Used by a List
!
! !DESCRIPTION:  This routine deallocates the allocated memory components
! of the input/output {\tt List} argument {\tt aList}.  Specifically, it
! deallocates {\tt aList\%bf} and {\tt aList\%lc}.  If the optional 
! output {\tt INTEGER} arguemnt {\tt stat} is supplied, no warning will
! be printed if the Fortran intrinsic {\tt deallocate()} returns with an
! error condition.
!
! !INTERFACE:

 subroutine clean_(aList, stat)

! !USES:
!
      use m_die,  only : warn
      use m_mall, only : mall_mco,mall_ison

      implicit none

! !INPUT/OUTPUT PARAMETERS: 
!
      type(List),        intent(inout) :: aList

! !OUTPUT PARAMETERS:   
!
      integer, optional, intent(out)   :: stat

! !REVISION HISTORY:
! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
!  1Mar02 - E.T. Ong <eong@mcs.anl.gov> - added stat argument and
!           removed die to prevent crashes.
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::clean_'
  integer :: ier

  if(mall_ison()) then
     if(associated(aList%bf)) call mall_mco(aList%bf,myname_)
     if(associated(aList%lc)) call mall_mco(aList%lc,myname_)
  endif

  if(associated(aList%bf) .and. associated(aList%lc)) then

     deallocate(aList%bf, aList%lc, stat=ier)

     if(present(stat)) then
	stat=ier
     else
	if(ier /= 0) call warn(myname_,'deallocate(aList%...)',ier)
     endif

  endif

 end subroutine clean_

!--- -------------------------------------------------------------------
!     Math + Computer Science Division / Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: nullify_ - Nullify Pointers in a List
!
! !DESCRIPTION:  In Fortran 90, pointers may have three states:  
! (1) {\tt ASSOCIATED}, that is the pointer is pointing at a target, 
! (2) {\tt UNASSOCIATED}, and (3) {\tt UNINITIALIZED}.  On some 
! platforms, the Fortran intrinsic function {\tt associated()} 
! will view uninitialized pointers as {\tt UNASSOCIATED} by default.
! This is not always the case.  It is good programming practice to 
! nullify pointers if they are not to be used.  This routine nullifies
! the pointers present in the {\tt List} datatype.
!
! !INTERFACE:

 subroutine nullify_(aList)

! !USES:
!
      use m_die,only : die

      implicit none

! !INPUT/OUTPUT PARAMETERS: 
!
      type(List),intent(inout) :: aList

! !REVISION HISTORY:
! 18Jun01 - J.W. Larson - <larson@mcs.anl.gov> - initial version
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::nullify_'

  nullify(aList%bf)
  nullify(aList%lc)

 end subroutine nullify_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: nitem_ - Return the Number of Items in a List
!
! !DESCRIPTION:  
! This function enumerates the number of items in the input {\tt List} 
! argument {\tt aList}.  For example, suppose 
! \begin{verbatim}
!  aList%bf = 'John:Paul:George:Ringo'
! \end{verbatim}
!  Then, 
! $${\tt nitem\_(aList)} = 4 .$$
!
! !INTERFACE:

 integer function nitem_(aList)

! !USES:
!
      implicit none

! !INPUT PARAMETERS: 
!
      type(List),intent(in) :: aList

! !REVISION HISTORY:
! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
! 10Oct01 - J.W. Larson <larson@mcs.anl.gov> - modified routine to
!           check pointers aList%bf and aList%lc using  the f90 
!           intrinsic ASSOCIATED before proceeding with the item
!           count.  If these pointers are UNASSOCIATED, an item
!           count of zero is returned.
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::nitem_'
  integer :: NumItems

       ! Initialize item count to zero

  NumItems = 0

       ! If the List pointers are ASSOCIATED, perform item count:

  if(ASSOCIATED(aList%bf) .and. ASSOCIATED(aList%lc)) then
     NumItems = size(aList%lc,2)
  endif

  nitem_ = NumItems

 end function nitem_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: index_ - Return Rank in a List of a Given Item (CHARACTER)
!
! !DESCRIPTION:
! This function returns the rank of an item (defined by the 
! {\tt CHARACTER} argument {\tt item}) in the input {\tt List} argument
! {\tt aList}.  If {\tt item} is not present in {\tt aList}, then zero 
! is returned.  For example, suppose 
! \begin{verbatim}
!  aList%bf = 'Bob:Carol:Ted:Alice'
! \end{verbatim}
!  Then, ${\tt index\_(aList, 'Ted')}=3$, ${\tt index\_(aList, 'Carol')}=2$,
! and ${\tt index\_(aList, 'The Dude')}=0.$
!
! !INTERFACE:

 integer function index_(aList, item)

! !USES:
!
      use m_String, only : toChar

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),      intent(in) :: aList	! a List of names
      character(len=*),intent(in) :: item	! a given item name

! !REVISION HISTORY:
! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::index_'
  integer :: i,lb,le
  integer :: itemLength, length, nMatch, j

       ! How long is the input item name?

  itemLength = len(item)

       ! Set output to zero (no item match) value:

  index_=0

       ! Now, go through the aList one item at a time

  ITEM_COMPARE: do i=1,size(aList%lc,2)		! == nitem_(aList)

       ! Compute some stats for the current item in aList:

    lb=aList%lc(0,i) ! starting index of item in aList%bf
    le=aList%lc(1,i) ! ending index item in aList%bf

    length = le -lb + 1 ! length of the current item
    if(length /= itemLength) then ! this list item can't match input item

       CYCLE ! that is, jump to the next item in aList...

    else ! compare one character at a time...

       ! Initialize number of matching characters in the two strings

       nMatch = 0 

       ! Now, compare item to the current item in aList one character 
       ! at a time:

       CHAR_COMPARE: do j=1,length
	  if(aList%bf(lb+j-1) == item(j:j)) then ! a match for this character
	     nMatch = nMatch + 1
	  else
	     EXIT
	  endif
       end do CHAR_COMPARE

       ! Check the number of leading characters in the current item in aList
       ! that match the input item.  If it is equal to the item length, then
       ! we have found a match and are finished.  Otherwise, we cycle on to
       ! the next item in aList.

       if(nMatch == itemLength) then 
	  index_ = i
	  EXIT
       endif

! Old code that does not work with V. of the IBM 
!    if(item==toChar(aList%bf(lb:le))) then
!      index_=i
!      exit
    endif
  end do ITEM_COMPARE

 end function index_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: indexStr_ - Return Rank in a List of a Given Item (String)
!
! !DESCRIPTION:
! This function performs the same operation as the function 
! {\tt index\_()}, but the item to be indexed is instead presented in 
! the form of a {\tt String} datatype (see the module {\tt m\_String} 
! for more information about the {\tt String} type).  This routine 
! searches through the input {\tt List} argument {\tt aList} for an 
! item that matches the item defined by {\tt itemStr}, and if a match 
! is found, the rank of the item in the list is returned (see also the 
! prologue for the routine {\tt index\_()} in this module).  If no match 
! is found, a value of zero is returned.
!
! !INTERFACE:

 integer function indexStr_(aList, itemStr)

! !USES:
!
      use m_String,only : String,toChar

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),      intent(in) :: aList	! a List of names
      type(String),    intent(in) :: itemStr

! !REVISION HISTORY:
! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
! 25Oct02 - R. Jacob <jacob@mcs.anl.gov> - just call index_ above
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::indexStr_'

  indexStr_=0
  indexStr_=index_(aList,toChar(itemStr))

 end function indexStr_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: allocated_ - Check Pointers in a List for Association Status
!
! !DESCRIPTION:
! This function checks the input {\tt List} argument {\tt inList} to 
! determine whether or not it has been allocated.  It does this by 
! invoking the Fortran90 intrinsic function {\tt associated()} on the 
! pointers {\tt inList\%bf} and {\tt inList\%lc}.  If both of these 
! pointers are associated, the return value is {\tt .TRUE.}.
!
! {\bf N.B.:}  In Fortran90, pointers have three different states:   
! {\tt ASSOCIATED}, {\tt UNASSOCIATED}, and {\tt UNDEFINED}.
!  If a pointer is {\tt UNDEFINED}, this function may return either 
! {\tt .TRUE.} or {\tt .FALSE.} values, depending on the Fortran90 
! compiler.  To avoid such problems, we advise that users invoke the 
! {\tt List} method {\tt nullify()} to nullify any {\tt List} pointers
! for {\tt List} variables that are not initialized.
!
! !INTERFACE:

 logical function allocated_(inList)

! !USES:

      use m_die,only : die

      implicit none

! !INPUT PARAMETERS:

      type(List), intent(in) :: inList

! !REVISION HISTORY:
! 14Dec01 - J. Larson <larson@mcs.anl.gov> - inital version
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::allocated_'

  allocated_ = associated(inList%bf) .and. associated(inList%lc)

 end function allocated_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: copy_ - Copy a List
!
! !DESCRIPTION:
! This routine copies the contents of the input {\tt List} argument 
! {\tt xL} into the output {\tt List} argument {\tt yL}.
!
! !INTERFACE:

 subroutine copy_(yL,xL)	! yL=xL

! !USES:
!
      use m_die,only : die
      use m_stdio
      use m_String ,only : String
      use m_String ,only : String_clean
      use m_mall,only : mall_mci,mall_ison

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),intent(in)  :: xL

! !OUTPUT PARAMETERS:   
!
      type(List),intent(out) :: yL


! !REVISION HISTORY:
! 22Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
! 16May01 - J. Larson <larson@mcs.anl.gov> - simpler, working 
!           version that exploits the String datatype (see m_String)
!  1Aug02 - Larson/Ong - Added logic for correct copying of blank 
!           Lists.
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::copy_'
  type(String) DummStr

  if(size(xL%lc,2) > 0) then

       ! Download input List info from xL to String DummStr

     call getall_(DummStr,xL)

       ! Initialize yL from DummStr

     call initStr_(yL,DummStr)

     call String_clean(DummStr)

  else
     if(size(xL%lc,2) < 0) then ! serious error...
	write(stderr,'(2a,i8)') myname_, &
	     ':: FATAL size(xL%lc,2) = ',size(xL%lc,2)
     endif
       ! Initialize yL as a blank list
     call init_(yL, ' ')
  endif

 end subroutine copy_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: exportToChar_ - Export List to a CHARACTER
!
! !DESCRIPTION:  This function returns the character buffer portion of
! the input {\tt List} argument {\tt inList}---that is, the contents of
! {\tt inList\%bf}---as a {\tt CHARACTER} (suitable for printing).  An
! example of the use of this function is:
! \begin{verbatim}
!           write(stdout,'(1a)') exportToChar(inList) 
! \end{verbatim}
! which writes the contents of {\tt inList\%bf} to the Fortran device 
! {\tt stdout}.
!
! !INTERFACE:

 function exportToChar_(inList)

! !USES:
!
      use m_die,    only : die
      use m_stdio,  only : stderr
      use m_String, only : String
      use m_String, only : String_ToChar => toChar
      use m_String, only : String_clean

      implicit none

! ! INPUT PARAMETERS:

      type(List),        intent(in)  :: inList

! ! OUTPUT PARAMETERS:

      character(len=size(inList%bf,1)) :: exportToChar_

! !REVISION HISTORY:
! 13Feb02 - J. Larson <larson@mcs.anl.gov> - initial version.
! 06Jun03 - R. Jacob <jacob@mcs.anl.gov> - return blank if List is not allocated
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::exportToChar_'
  type(String) DummStr

       ! Download input List info from inList to String DummStr
  if(allocated_(inList)) then
     call getall_(DummStr,inList)
     exportToChar_ = String_ToChar(DummStr)
     call String_clean(DummStr)
  else
     exportToChar_ = ''
  endif

 end function exportToChar_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: exportToString_ - Export List to a String
!
! !DESCRIPTION:  This function returns the character buffer portion of
! the input {\tt List} argument {\tt inList}---that is, the contents of
! {\tt inList\%bf}---as a {\tt String} (see the mpeu module m\_String 
! for more information regarding the {\tt String} type).  This function
! was created to circumvent problems with implementing inheritance of 
! the function {\tt exportToChar\_()} to other datatypes build on top
! of the {\tt List} type.
!
! !INTERFACE:

 function exportToString_(inList)

! !USES:
!
      use m_die,    only : die
      use m_stdio,  only : stderr

      use m_String, only : String
      use m_String, only : String_init => init

      implicit none

! ! INPUT PARAMETERS:

      type(List),       intent(in) :: inList

! ! OUTPUT PARAMETERS:

      type(String)                 :: exportToString_

! !REVISION HISTORY:
! 14Aug02 - J. Larson <larson@mcs.anl.gov> - initial version.
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::exportToString_'

  if(allocated_(inList)) then
     call getall_(exportToString_, inList)
  else
     call String_init(exportToString_, 'NOTHING')
  endif

 end function exportToString_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: CharBufferSize_ - Return size of a List's Character Buffer
!
! !DESCRIPTION:  This function returns the length of the character 
! buffer portion of the input {\tt List} argument {\tt inList} (that 
! is, the number of characters stored in {\tt inList\%bf}) as an
! {\tt INTEGER}.  Suppose for the sake of argument that {\tt inList} 
! was created using the following call to {\tt init\_()}:
! \begin{verbatim}
!  call init_(inList, 'Groucho:Harpo:Chico:Zeppo')
! \end{verbatim}
! Then, using the above example value of {\tt inList}, we can use 
! {\tt CharBufferSize\_()} as follows:
! \begin{verbatim}
! integer :: BufferLength
! BufferLength = CharBufferSize(inList) 
! \end{verbatim}
! and the resulting value of {\tt BufferLength} will be 25.
!
! !INTERFACE:

 integer function CharBufferSize_(inList)

! !USES:
!
      use m_die,    only : die
      use m_stdio,  only : stderr

      implicit none

! ! INPUT PARAMETERS:

      type(List),         intent(in) :: inList

! !REVISION HISTORY:
! 13Feb02 - J. Larson <larson@mcs.anl.gov> - initial version.
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::CharBufferSize_'

  if(allocated_(inList)) then
     CharBufferSize_ = size(inList%bf)
  else
     write(stderr,'(2a)') myname_,":: Argument inList not allocated."
     call die(myname_)
  endif

 end function CharBufferSize_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: get_ - Retrieve a Numbered Item from a List as a String
!
! !DESCRIPTION:
! This routine retrieves a numbered item (defined by the input 
! {\tt INTEGER} argument {\tt ith}) from the input {\tt List} argument 
! {\tt aList}, and returns it in the output {\tt String} argument 
! {\tt itemStr} (see the module {\tt m\_String} for more information 
! about the {\tt String} type).  If the argument {\tt ith} is nonpositive, 
! or greater than the number of items in {\tt aList}, a String containing
! one blank space is returned.
!
! !INTERFACE:

 subroutine get_(itemStr, ith, aList)

! !USES:
!
      use m_String, only : String, init, toChar

      implicit none

! !INPUT PARAMETERS: 
!
      integer,     intent(in)  :: ith
      type(List),  intent(in)  :: aList

! !OUTPUT PARAMETERS:   
!
      type(String),intent(out) :: itemStr


! !REVISION HISTORY:
! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
! 14May07 - Larson, Jacob - add space to else case string so function
!                           matches documentation.
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::get_'
  integer :: lb,le

  if(ith>0 .and. ith <= size(aList%lc,2)) then
    lb=aList%lc(0,ith)
    le=aList%lc(1,ith)
    call init(itemStr,toChar(aList%bf(lb:le)))
  else
    call init(itemStr,' ')
  endif

 end subroutine get_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: getall_ - Return all Items from a List as one String
!
! !DESCRIPTION:
! This routine returns all the items from the input {\tt List} argument
! {\tt aList} in the output {\tt String} argument {\tt itemStr} (see 
! the module {\tt m\_String} for more information about the {\tt String} 
! type).  The contents of the character buffer in {\tt itemStr} will 
! be the all of the items in {\tt aList}, separated by the colon delimiter.
!
! !INTERFACE:

 subroutine getall_(itemStr, aList)

! !USES:
!
      use m_String, only : String, init, toChar

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),   intent(in)  :: aList

! !OUTPUT PARAMETERS:   
!
      type(String), intent(out) :: itemStr


! !REVISION HISTORY:
! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::getall_'
  integer :: lb,le,ni

  ni=size(aList%lc,2)
  lb=aList%lc(0,1)
  le=aList%lc(1,ni)
  call init(itemStr,toChar(aList%bf(lb:le)))

 end subroutine getall_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: getrange_ - Return a Range of Items from a List as one String
!
! !DESCRIPTION:
! This routine returns all the items ranked {\tt i1} through {\tt i2} 
! from the input {\tt List} argument {\tt aList} in the output 
! {\tt String} argument {\tt itemStr} (see the module {\tt m\_String} 
! for more information about the {\tt String} type).  The contents of 
! the character buffer in {\tt itemStr} will be items in {\tt i1} through 
! {\tt i2} {\tt aList}, separated by the colon delimiter.
!
! !INTERFACE:

 subroutine getrange_(itemStr, i1, i2, aList)

! !USES:
!
      use m_die,    only : die
      use m_stdio,  only : stderr
      use m_String, only : String,init,toChar

      implicit none

! !INPUT PARAMETERS: 
!
      integer,     intent(in)  :: i1
      integer,     intent(in)  :: i2
      type(List),  intent(in)  :: aList

! !OUTPUT PARAMETERS:   
!
      type(String),intent(out) :: itemStr

! !REVISION HISTORY:
! 23Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
! 26Jul02 - J. Larson - Added argument checks.
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::getrange_'
  integer :: lb,le,ni

       ! Argument Sanity Checks:

  if(.not. allocated_(aList)) then
     write(stderr,'(2a)') myname_, &
	  ':: FATAL--List argument aList is not initialized.'
     call die(myname_)
  endif

       ! is i2 >= i1 as we assume?

  if(i1 > i2) then
     write(stderr,'(2a,2(a,i8))') myname_, &
	  ':: FATAL.  Starting/Ending item ranks are out of order; ', &
	  'i2 must be greater or equal to i1.  i1 =',i1,' i2 = ',i2
     call die(myname_)
  endif

  ni=size(aList%lc,2) ! the number of items in aList...

       ! is i1 or i2 too big?

  if(i1 > ni) then
     write(stderr,'(2a,2(a,i8))') myname_, &
	  ':: FATAL--i1 is greater than the number of items in ', &
	  'The List argument aList: i1 =',i1,' ni = ',ni
     call die(myname_)
  endif

  if(i2 > ni) then
     write(stderr,'(2a,2(a,i8))') myname_, &
	  ':: FATAL--i2 is greater than the number of items in ', &
	  'The List argument aList: i2 =',i2,' ni = ',ni
     call die(myname_)
  endif

       ! End of Argument Sanity Checks.

  lb=aList%lc(0,max(1,i1))
  le=aList%lc(1,min(ni,i2))
  call init(itemStr,toChar(aList%bf(lb:le)))

 end subroutine getrange_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: identical_ - Compare Two Lists for Equality
!
! !DESCRIPTION:
! This function compares the string buffer and indexing information in
! the two input {\tt List} arguments {\tt yL} and {\tt xL}.  If the 
! string buffers and index buffers of {\tt yL} and {\tt xL} match, this
! function returns a value of {\tt .TRUE.}  Otherwise, it returns a 
! value of {\tt .FALSE.}
!
! !INTERFACE:

 logical function identical_(yL, xL)

! !USES:
!
      use m_die,only : die
      use m_String ,only : String
      use m_String ,only : String_clean

      implicit none

! !INPUT PARAMETERS: 
!
      type(List), intent(in) :: yL
      type(List), intent(in) :: xL

! !REVISION HISTORY:
! 14Oct01 - J. Larson <larson@mcs.anl.gov> - original version
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::identical_'

  logical :: myIdentical
  type(String) :: DummStr
  integer :: n, NumItems

       ! Compare the number of the items in the Lists xL and yL.
       ! If they differ, myIdentical is set to .FALSE. and we are
       ! finished.  If both Lists sport the same number of items,
       ! we must compare them one-by-one...

  myIdentical = .FALSE.

  if(nitem_(yL) == nitem_(xL)) then

     NumItems = nitem_(yL)

     COMPARE_LOOP:  do n=1,NumItems

	call get_(DummStr, n, yL)  ! retrieve nth tag as a String

	if( indexStr_(xL, Dummstr) /= n ) then ! a discrepency spotted.
	   call String_clean(Dummstr)
	   myIdentical = .FALSE.    
	   EXIT
	else
	   call String_clean(Dummstr)
	endif

	   myIdentical = .TRUE.   ! we survived the whole test process.

     end do COMPARE_LOOP

  endif

  identical_ = myIdentical

 end function identical_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: get_indices_ - Index Multiple Items in a List
!
! !DESCRIPTION:  This routine takes as input a {\tt List} argument 
! {\tt aList}, and a {\tt CHARACTER} string {Values}, which is a colon-
! delimited string of items, and returns an {\tt INTEGER} array 
! {\tt indices(:)}, which contain the rank of each item in {\tt aList}.
! For example, suppose {\tt aList} was created from the character string
! \begin{verbatim}
! 'happy:sleepy:sneezey:grumpy:dopey::bashful:doc'
! \end{verbatim}
! and get\_indices\_() is invoked as follows:
! \begin{verbatim}
! call get_indices_(indices, aList, 'sleepy:grumpy:bashful:doc')
! \end{verbatim}
! The array {\tt indices(:)} will be returned with 4 entries:  
! ${\tt indices(1)}=2$, ${\tt indices(2)}=4$, ${\tt indices(3)}=6$, and
! ${\tt indices(4)}=7$.
!
! {\bf N.B.}:  This routine operates on the assumption that each of the 
! substrings in the colon-delimited string {\tt Values} is an item in 
! {\tt aList}.  If this assumption is invalid, this routine terminates 
! execution with an error message.
!
! {\bf N.B.}:  The pointer {\tt indices} must be {\tt UNASSOCIATED} on entry 
! to this routine, and will be {\tt ASSOCIATED} upon return.  After this pointer
! is no longer needed, it should be deallocated.  Failure to do so will result 
! in a memory leak.
!
! !INTERFACE:

 subroutine get_indices_(indices, aList, Values)

! !USES:
!
      use m_stdio
      use m_die
      use m_String, only : String
      use m_String, only : String_clean => clean
      use m_String, only : String_toChar => toChar

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),            intent(in)	:: aList  ! an indexed string values
      character(len=*),      intent(in) :: Values ! ":" delimited names

! !OUTPUT PARAMETERS:   
!
      integer, dimension(:), pointer    :: indices

! !REVISION HISTORY:
! 31May98 - Jing Guo <guo@thunder> - initial prototype/prolog/code
! 12Feb03 - J. Larson <larson@mcs.anl.gov> Working refactored version  
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::get_indices_'
  type(List)   :: tList
  type(String) :: tStr
  integer :: i, ierr, n

       ! Create working list based on input colon-delimited string

  call init_(tList, values)


       ! Count items in tList and allocate indices(:) accordingly

  n = nitem_(tList)

  if(n > nitem_(aList)) then
     write(stderr,'(5a,2(i8,a))') myname_, &
	  ':: FATAL--more items in argument Values than aList!  Input string', &
	  'Values = "',Values,'" has ',n,' items.  aList has ',nitem_(aList),  &
	  ' items.'
     call die(myname_)
  endif
  allocate(indices(n), stat=ierr)
  if(ierr /= 0) then
     write(stderr,'(2a,i8,a)') myname_, &
	  ':: FATAL--allocate(indices(...) failed with stat=',ierr,&
	  '.  On entry to this routine, this pointer must be NULL.'
     call die(myname_)
  endif

       ! Retrieve each item from tList as a String and index it

  do i=1,n
    call get_(tStr,i,tList)
    indices(i) = indexStr_(aList,tStr)
    if(indices(i) == 0) then ! ith item not present in aList!
       write(stderr,'(4a)') myname_, &
	    ':: FATAL--item "',String_toChar(tStr),'" not found.'
       call die(myname_)
    endif
    call String_clean(tStr)
  end do

       ! Clean up temporary List tList

  call clean_(tList)

 end subroutine get_indices_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: test_indices_ - Test/Index Multiple Items in a List
!
! !DESCRIPTION:  This routine takes as input a {\tt List} argument 
! {\tt aList}, and a {\tt CHARACTER} string {Values}, which is a colon-
! delimited string of items, and returns an {\tt INTEGER} array 
! {\tt indices(:)}, which contain the rank of each item in {\tt aList}.
! For example, suppose {\tt aList} was created from the character string
! \begin{verbatim}
! 'happy:sleepy:sneezey:grumpy:dopey::bashful:doc'
! \end{verbatim}
! and {\tt test\_indices\_()} is invoked as follows:
! \begin{verbatim}
! call test_indices_(indices, aList, 'sleepy:grumpy:bashful:doc')
! \end{verbatim}
! The array {\tt indices(:)} will be returned with 4 entries:  
! ${\tt indices(1)}=2$, ${\tt indices(2)}=4$, ${\tt indices(3)}=6$, and
! ${\tt indices(4)}=7$.
!
! Now suppose {\tt test\_indices\_()} is invoked as follows:
! \begin{verbatim}
! call test_indices_(indices, aList, 'sleepy:grumpy:bashful:Snow White')
! \end{verbatim}
! The array {\tt indices(:)} will be returned with 4 entries:  
! ${\tt indices(1)}=2$, ${\tt indices(2)}=4$, ${\tt indices(3)}=6$, and
! ${\tt indices(4)}=0$.
!
! {\bf N.B.}:  This routine operates on the assumption that one or more 
! of the substrings in the colon-delimited string {\tt Values} is may not 
! be an item in {\tt aList}.  If an item in {\tt Values} is {\em not} in 
! {\tt aList}, its corresponding entry in {\tt indices(:)} is set to zero.
!
! {\bf N.B.}:  The pointer {\tt indices} must be {\tt UNASSOCIATED} on entry 
! to this routine, and will be {\tt ASSOCIATED} upon return.  After this pointer
! is no longer needed, it should be deallocated.  Failure to do so will result 
! in a memory leak.
!
! !INTERFACE:

 subroutine test_indices_(indices, aList, Values)

! !USES:
!
      use m_stdio
      use m_die
      use m_String, only : String
      use m_String, only : String_clean => clean
      use m_String, only : String_toChar => toChar

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),            intent(in)	:: aList  ! an indexed string values
      character(len=*),      intent(in) :: Values ! ":" delimited names

! !OUTPUT PARAMETERS:   
!
      integer, dimension(:), pointer    :: indices

! !REVISION HISTORY:
! 12Feb03 - J. Larson <larson@mcs.anl.gov> Working refactored version  
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::test_indices_'
  type(List)   :: tList
  type(String) :: tStr
  integer :: i, ierr, n

       ! Create working list based on input colon-delimited string

  call init_(tList, values)


       ! Count items in tList and allocate indices(:) accordingly

  n = nitem_(tList)
  allocate(indices(n), stat=ierr)
  if(ierr /= 0) then
     write(stderr,'(2a,i8,a)') myname_, &
	  ':: FATAL--allocate(indices(...) failed with stat=',ierr,&
	  '.  On entry to this routine, this pointer must be NULL.'
     call die(myname_)
  endif

       ! Retrieve each item from tList as a String and index it

  do i=1,n
    call get_(tStr,i,tList)
    indices(i) = indexStr_(aList,tStr)
    call String_clean(tStr)
  end do

       ! Clean up temporary List tList

  call clean_(tList)

 end subroutine test_indices_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: append_ - Append One List Onto the End of Another
!
! !DESCRIPTION:  This routine takes two {\tt List} arguments
! {\tt iList1} and {\tt iList2}, and appends {\tt List2} onto 
! the end of {\tt List1}.
!
! {\bf N.B.}:  There is no check for shared items in the arguments 
! {\tt List1} and {\tt List2}.  It is the user's responsibility to 
! ensure {\tt List1} and {\tt List2} share no items.  If this routine
! is invoked in such a manner that {\tt List1} and {\tt List2} share
! common items, the resultant value of {\tt List1} will produce 
! ambiguous results for some of the {\tt List} query functions.
!
! {\bf N.B.}:  The outcome of this routine is order dependent.  That is,
! the entries of {\tt iList2} will follow the {\em input} entries in 
! {\tt iList1}.
!
! !INTERFACE:

    subroutine append_(iList1, iList2)
!
! !USES:
!
      use m_stdio
      use m_die, only : die

      use m_mpif90

      use m_String, only:  String
      use m_String, only:  String_toChar => toChar
      use m_String, only:  String_len
      use m_String, only:  String_clean => clean

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),         intent(in)    :: iList2 

! !INPUT/OUTPUT PARAMETERS: 
!
      type(List),         intent(inout) :: iList1

! !REVISION HISTORY:
!  6Aug02 - J. Larson - Initial version
!EOP ___________________________________________________________________

 character(len=*),parameter :: myname_=myname//'::append_'

  type(List) :: DummyList

  call copy_(DummyList, iList1)
  call clean_(iList1)
  call concatenate(DummyList, iList2, iList1)
  call clean_(DummyList)

 end subroutine append_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: concatenate_ - Concatenates two Lists to form a Third List.
!
! !DESCRIPTION:  This routine takes two input {\tt List} arguments
! {\tt iList1} and {\tt iList2}, and concatenates them, producing an 
! output {\tt List} argument {\tt oList}.
!
! {\bf N.B.}:  The nature of this routine is such that one must 
! {\bf never} supply as the actual value of {\tt oList} the same 
! value supplied for either {\tt iList1} or {\tt iList2}.
!
! {\bf N.B.}:  The outcome of this routine is order dependent.  That is,
! the entries of {\tt iList2} will follow {\tt iList1}.
!
! !INTERFACE:

    subroutine concatenate_(iList1, iList2, oList)
!
! !USES:
!
      use m_stdio
      use m_die, only : die

      use m_mpif90

      use m_String, only:  String
      use m_String, only:  String_init => init
      use m_String, only:  String_clean => clean

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),         intent(in)  :: iList1
      type(List),         intent(in)  :: iList2 

! !OUTPUT PARAMETERS: 
!
      type(List),         intent(out) :: oList

! !BUGS:  For now, the List concatenate algorithm relies on fixed-length
! CHARACTER variables as intermediate storage.  The lengths of these
! scratch variables is hard-wired to 10000, which should be large enough
! for most applications.  This undesirable feature should be corrected 
! ASAP.
!
! !REVISION HISTORY:
!  8May01 - J.W. Larson - initial version.
! 17May01 - J.W. Larson - Re-worked and tested successfully.
! 17Jul02 - E. Ong - fixed the bug mentioned above
!EOP ___________________________________________________________________

 character(len=*),parameter :: myname_=myname//'::concatenate_'

 character, dimension(:), allocatable :: CatBuff
 integer :: CatBuffLength, i, ierr, Length1, Length2
 type(String) :: CatString

       ! First, handle the case of either iList1 and/or iList2 being
       ! null

  if((nitem_(iList1) == 0) .or. (nitem_(iList2) == 0)) then

     if((nitem_(iList1) == 0) .and. (nitem_(iList2) == 0)) then
	call init_(oList,'')
     else
	if((nitem_(iList1) == 0) .and. (nitem_(iList2) > 0)) then
	   call copy_(oList, iList2)
	endif
	if((nitem_(iList1) > 0) .and. (nitem_(iList2) == 0)) then
	   call copy_(oList,iList1)
	endif
     endif

  else ! both lists are non-null

       ! Step one:  Get lengths of character buffers of iList1 and iList2:

     Length1 = CharBufferSize_(iList1)
     Length2 = CharBufferSize_(iList2)

       ! Step two:  create CatBuff(:) as workspace

     CatBuffLength =  Length1 + Length2 + 1
     allocate(CatBuff(CatBuffLength), stat=ierr)
     if(ierr /= 0) then
	write(stderr,'(2a,i8)') myname_, &
	     ':: FATAL--allocate(CatBuff(...) failed.  ierr=',ierr
	call die(myname_)
     endif

       ! Step three:  concatenate CHARACTERs with the colon separator
       ! into CatBuff(:)

     do i=1,Length1
	CatBuff(i) = iList1%bf(i)
     end do

     CatBuff(Length1 + 1) = ':'

     do i=1,Length2
	CatBuff(Length1 + 1 + i) = iList2%bf(i)
     end do

       ! Step four:  initialize a String CatString:

     call String_init(CatString, CatBuff)

       ! Step five:  initialize oList:

     call  initStr_(oList, CatString)

       ! The concatenation is complete.  Now, clean up

     call String_clean(CatString)

     deallocate(CatBuff,stat=ierr)
     if(ierr /= 0) then
	write(stderr,'(2a,i8)') myname_, &
	     ':: FATAL--deallocate(CatBuff) failed.  ierr=',ierr
	call die(myname_)
     endif

  endif

 end subroutine concatenate_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: bcast_ - MPI Broadcast for the List Type
!
! !DESCRIPTION:  This routine takes an input {\tt List} argument 
! {\tt iList} (on input, valid on the root only), and broadcasts it.
!
! {\bf N.B.}:  The outcome of this routine, {\tt ioList} on non-root
! processes, represents allocated memory.  When this {\tt List} is
! no longer needed, it must be deallocated by invoking the routine 
! {\tt List\_clean()}.  Failure to do so will cause a memory leak.
!
! !INTERFACE:

    subroutine bcast_(ioList, root, comm, status)
!
! !USES:
!
      use m_stdio,  only : stderr
      use m_die, only : MP_perr_die, die

      use m_String, only:  String
      use m_String, only:  String_bcast => bcast
      use m_String, only:  String_clean => clean

      use m_mpif90

      implicit none

! !INPUT PARAMETERS: 
!
      integer,            intent(in)     :: root
      integer,            intent(in)     :: comm

! !INPUT/OUTPUT PARAMETERS: 
!
      type(List),         intent(inout)  :: ioList  


! !OUTPUT PARAMETERS: 
!
      integer, optional,  intent(out)    :: status

! !REVISION HISTORY:
!  7May01 - J.W. Larson - initial version.
! 14May01 - R.L. Jacob - fix error checking
! 16May01 - J.W. Larson - new, simpler String-based algorigthm
!           (see m_String for details), which works properly on
!           the SGI platform.
! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
!           (if present).
!EOP ___________________________________________________________________

 character(len=*),parameter :: myname_=myname//'::bcast_'
 integer :: myID, ierr
 type(String) :: DummStr

      ! Initialize status (if present)

  if(present(status)) status = 0

       ! Which process am I?

  call MPI_COMM_RANK(comm, myID, ierr)
  if(ierr /= 0) then
   if(present(status)) then
     status = ierr
     write(stderr,'(2a,i4)') myname_,":: MPI_COMM_RANK(), ierr=",ierr
     return
   else
     call MP_perr_die(myname_,"MPI_COMM_RANK()",ierr)
   endif
  endif

       ! on the root, convert ioList into the String variable DummStr

  if(myID == root) then
     if(CharBufferSize_(ioList) <= 0) then
	call die(myname_, 'Attempting to broadcast an empty list!',&
	     CharBufferSize_(ioList))
     endif
     call getall_(DummStr, ioList)
  endif

       ! Broadcast DummStr

  call String_bcast(DummStr, root, comm, ierr)
  if(ierr /= 0) then
   if(present(status)) then
     status = ierr
     write(stderr,'(2a,i4)') myname_,":: call String_bcast(), ierr=",ierr
     return
   else
     call MP_perr_die(myname_,"String_bcast() failed, stat=",ierr)
   endif
  endif

       ! Initialize ioList off the root using DummStr

  if(myID /= root) then
     call initStr_(ioList, DummStr)
  endif

       ! And now, the List broadcast is complete.

  call String_clean(DummStr)

 end subroutine bcast_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: send_ - MPI Point-to-Point Send for the List Type
!
! !DESCRIPTION:  This routine takes an input {\tt List} argument 
! {\tt inList} and sends it to processor {\tt dest} on the communicator 
! associated with the fortran 90 {\tt INTEGER} handle {\tt comm}.  The 
! message is tagged by the input {\tt INTEGER} argument {\tt TagBase}.  
! The success (failure) of this operation is reported in the zero 
! (nonzero) optional output argument {\tt status}.
!
! {\bf N.B.}:  One must avoid assigning elsewhere the MPI tag values 
! {\tt TagBase} and {\tt TagBase+1}.  This is because {\tt send\_()} 
! performs the send of the {\tt List} as a pair of operations.  The 
! first send is the number of characters in {\tt inList\%bf}, and is 
! given MPI tag value {\tt TagBase}.  The second send is the 
! {\tt CHARACTER} data present in {\tt inList\%bf}, and is given MPI 
! tag value {\tt TagBase+1}.
!
! !INTERFACE:

    subroutine send_(inList, dest, TagBase, comm, status)
!
! !USES:
!
      use m_stdio
      use m_die, only : MP_perr_die

      use m_mpif90

      use m_String, only:  String
      use m_String, only:  String_toChar => toChar
      use m_String, only:  String_len
      use m_String, only:  String_clean => clean

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),         intent(in)  :: inList  
      integer,            intent(in)  :: dest
      integer,            intent(in)  :: TagBase
      integer,            intent(in)  :: comm

! !OUTPUT PARAMETERS: 
!
      integer, optional,  intent(out) :: status

! !REVISION HISTORY:
!  6Jun01 - J.W. Larson - initial version.
! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
!           (if present).
!EOP ___________________________________________________________________

 character(len=*),parameter :: myname_=myname//'::send_'

 type(String) :: DummStr
 integer :: ierr, length

       ! Set status flag to zero (success) if present:

 if(present(status)) status = 0

       ! Step 1.  Extract CHARACTER buffer from inList and store it
       ! in String variable DummStr, determine its length.

 call getall_(DummStr, inList)
 length = String_len(DummStr)

       ! Step 2.  Send Length of String DummStr to process dest.

 call MPI_SEND(length, 1, MP_type(length), dest, TagBase, comm, ierr)
  if(ierr /= 0) then
     if(present(status)) then
        write(stderr,'(2a,i8)') myname_, &
	     ':: MPI_SEND(length...) failed.  ierror=', ierr
        status = ierr
        return
     else
        call MP_perr_die(myname_,':: MPI_SEND(length...) failed',ierr)
     endif
  endif

       ! Step 3.  Send CHARACTER portion of String DummStr 
       ! to process dest.

 call MPI_SEND(DummStr%c(1), length, MP_CHARACTER, dest, TagBase+1, &
               comm, ierr)
  if(ierr /= 0) then
     if(present(status)) then
        write(stderr,'(2a,i8)') myname_, &
	     ':: MPI_SEND(DummStr%c...) failed.  ierror=', ierr
        status = ierr
        return
     else
        call MP_perr_die(myname_,':: MPI_SEND(DummStr%c...) failed',ierr)
     endif
  endif

 end subroutine send_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: recv_ - MPI Point-to-Point Receive for the List Type
!
! !DESCRIPTION:  This routine receives the output {\tt List} argument 
! {\tt outList} from processor {\tt source} on the communicator associated
! with the fortran 90 {\tt INTEGER} handle {\tt comm}.  The message is
! tagged by the input {\tt INTEGER} argument {\tt TagBase}.  The success
! (failure) of this operation is reported in the zero (nonzero) optional
! output argument {\tt status}.
!
! {\bf N.B.}:  One must avoid assigning elsewhere the MPI tag values 
! {\tt TagBase} and {\tt TagBase+1}.  This is because {\tt recv\_()} 
! performs the receive of the {\tt List} as a pair of operations.  The 
! first receive is the number of characters in {\tt outList\%bf}, and 
! is given MPI tag value {\tt TagBase}.  The second receive is the 
! {\tt CHARACTER} data present in {\tt outList\%bf}, and is given MPI 
! tag value {\tt TagBase+1}.
!
! !INTERFACE:

    subroutine recv_(outList, source, TagBase, comm, status)
!
! !USES:
!
      use m_stdio, only : stderr
      use m_die,   only : MP_perr_die

      use m_mpif90

      use m_String, only : String

      implicit none

! !INPUT PARAMETERS: 
!
      integer,            intent(in)  :: source
      integer,            intent(in)  :: TagBase
      integer,            intent(in)  :: comm

! !OUTPUT PARAMETERS: 
!
      type(List),         intent(out) :: outList  
      integer, optional,  intent(out) :: status

! !REVISION HISTORY:
!  6Jun01 - J.W. Larson - initial version.
! 11Jun01 - R. Jacob - small bug fix; status in MPI_RECV
! 13Jun01 - J.W. Larson <larson@mcs.anl.gov> - Initialize status
!           (if present).
!EOP ___________________________________________________________________

 character(len=*),parameter :: myname_=myname//'::recv_'

 integer :: ierr, length
 integer :: MPstatus(MP_STATUS_SIZE)
 type(String) :: DummStr

       ! Initialize status to zero (success), if present.

  if(present(status)) status = 0

       ! Step 1.  Receive Length of String DummStr from process source.

 call MPI_RECV(length, 1, MP_type(length), source, TagBase, comm, &
               MPstatus, ierr)
  if(ierr /= 0) then
     if(present(status)) then
        write(stderr,'(2a,i8)') myname_, &
	     ':: MPI_RECV(length...) failed.  ierror=', ierr
        status = ierr
        return
     else
        call MP_perr_die(myname_,':: MPI_RECV(length...) failed',ierr)
     endif
  endif

 allocate(DummStr%c(length), stat=ierr)

       ! Step 2.  Send CHARACTER portion of String DummStr 
       ! to process dest.

 call MPI_RECV(DummStr%c(1), length, MP_CHARACTER, source, TagBase+1, &
               comm, MPstatus, ierr)
  if(ierr /= 0) then
     if(present(status)) then
        write(stderr,'(2a,i8)') myname_, &
	     ':: MPI_RECV(DummStr%c...) failed.  ierror=', ierr
        status = ierr
        return
     else
        call MP_perr_die(myname_,':: MPI_RECV(DummStr%c...) failed',ierr)
     endif
  endif

       ! Step 3.  Initialize outList.

 call initStr_(outList, DummStr)

 end subroutine recv_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: GetSharedListIndices_ - Index Shared Items for Two Lists
!
! !DESCRIPTION:  {\tt GetSharedListIndices\_()} compares two user-
! supplied {\tt List} arguments {\tt List1} and {\tt Lis2} to determine:  
! the number of shared items {\tt NumShared}, and arrays of the locations 
! {\tt Indices1} and {\tt Indices2} in {\tt List1} and {\tt List2}, 
! respectively.
!
! {\bf N.B.:}  This routine returns two allocated arrays:  {\tt Indices1(:)} 
! and {\tt Indices2(:)}.  Both of these arrays must be deallocated once they 
! are no longer needed.  Failure to do this will create a memory leak.
!
! !INTERFACE:

 subroutine GetSharedListIndices_(List1, List2, NumShared, Indices1, &
                                   Indices2)

!
! !USES:
!
      use m_die,  only : MP_perr_die, die, warn

      use m_String, only : String
      use m_String, only : String_clean => clean

      implicit none

! !INPUT PARAMETERS: 
!
      type(List),    intent(in)  :: List1
      type(List),    intent(in)  :: List2

! !OUTPUT PARAMETERS:   
!
      integer,           intent(out) :: NumShared

      integer,dimension(:), pointer  :: Indices1
      integer,dimension(:), pointer  :: Indices2

! !REVISION HISTORY:
!  7Feb01 - J.W. Larson <larson@mcs.anl.gov> - initial version
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::GetSharedListIndices_'

! Error flag
  integer :: ierr

! number of items in List1 and List2, respectively:
  integer :: nitem1, nitem2

! MAXIMUM number of matches possible:
  integer :: NumSharedMax

! Temporary storage for a string tag retrieved from a list:
  type(String) :: tag

! Loop counters / temporary indices:
  integer :: n1, n2

       ! Determine the number of items in each list:

  nitem1 = nitem_(List1)
  nitem2 = nitem_(List2)

       ! The maximum number of list item matches possible
       ! is the minimum(nitem1,nitem2):

  NumSharedMax = min(nitem1,nitem2)

       ! Allocate sufficient space for the matches we may find:

  allocate(Indices1(NumSharedMax), Indices2(NumSharedMax), stat=ierr)
  if(ierr /= 0) call die(myname_,'allocate() Indices1 and 2',ierr)

       ! Initialize the counter for the number of matches found:

  NumShared = 0

       ! Scan through the two lists.  For the sake of speed, loop 
       ! over the shorter of the two lists...

  if(nitem1 <= nitem2) then ! List1 is shorter--scan it...

     do n1=1,NumSharedMax

       ! Retrieve string tag n1 from List1:
        call get_(tag, n1, List1)

       ! Index this tag WRT List2--a nonzero value signifies a match
        n2 = indexStr_(List2, tag)

       ! Clear out tag for the next iteration...
        call String_clean(tag)

       ! If we have a hit, update NumShared, and load the indices
       ! n1 and n2 in Indices1 and Indices2, respectively...

        if((0 < n2) .and. (n2 <= nitem2)) then
           NumShared = NumShared + 1
           Indices1(NumShared) = n1
           Indices2(NumShared) = n2
        endif

     end do ! do n1=1,NumSharedMax

  else ! List1 is shorter--scan it...

     do n2=1,NumSharedMax

       ! Retrieve string tag n2 from List2:
        call get_(tag, n2, List2)

       ! Index this tag WRT List1--a nonzero value signifies a match
        n1 = indexStr_(List1, tag)

       ! Clear out tag for the next iteration...
        call String_clean(tag)

       ! If we have a hit, update NumShared, and load the indices
       ! n1 and n2 in Indices1 and Indices2, respectively...

        if((0 < n1) .and. (n1 <= nitem1)) then
           NumShared = NumShared + 1
           Indices1(NumShared) = n1
           Indices2(NumShared) = n2
        endif

     end do ! do n2=1,NumSharedMax

  endif ! if(nitem1 <= nitem2)...

 end subroutine GetSharedListIndices_

 end module m_List
!.