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

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !MODULE: m_StringLinkedList - A linked-list of String
!
! !DESCRIPTION:
!
! !INTERFACE:

    module m_StringLinkedList
      use m_String,only : String
      implicit none
      private	! except

      public :: StringLinkedList	! The class data structure

		! o An object of a StringLinkedList should be defined
		!   as a pointer of a StringLinkedList.  It is often
		!   represented by a pointer to the head-node of the
		!   linked-list.
		!
		! o A node in a StringLinkedList is specificed by a
		!   reference pointer.  A reference pointer is a
		!   logical reference of a node in the list.  However,
		!   it does not physically point to that node.  In
		!   fact, a reference pointer normally references to
		!   the node physically pointed by the pointer in the
		!   node physically pointed by the reference pointer,
		!
		!	[this] -> [..|next] -> [..|next]
		!
		!   where the last node is the logically referenced
		!   node.

      public :: StringLinkedList_init	! constructor
      public :: StringLinkedList_clean  ! destructor

		! A _clean() action will reset a StringLinkedList to its
		! pre-_init() status.

      public :: StringLinkedList_insert ! grower, insert a node
      public :: StringLinkedList_delete ! ungrower, delete a node

		! Both procedures processing the node through a given
		! reference pointer.  The reference pointer will not
		! be modified directly through either _insert() or
		! _delete().  It is the pointer in the node physically
		! pointed by a reference pointer got modified.  Also,
		! the node logically referenced by the reference
		! pointer is either the new node for an _insert(), and
		! the removed node for a _delete().

      public :: StringLinkedList_eol	! inquirer, is an end-node?

		! An end-of-list situation occurs when the reference
		! pointer is logically referencing to the end-node or
		! beyond.  Note that an end-node links to itself.

      public :: StringLinkedList_next	! iterator, go to the next node.

      public :: StringLinkedList_count	! counter
      
		! Count the number of nodes from this reference pointer,
		! starting from and including the logical node but
		! excluding the end-node.

      public :: StringLinkedList_get	! fetcher

		! Get the value logically referenced by a reference
		! pointer.  Return EOL if the referenced node is an
		! EOL().  The reference pointer will be iterated to
		! the next node if the referenced node is not an EOL.

    type StringLinkedList
      type(String) :: str
      type(StringLinkedList),pointer :: next
    end type StringLinkedList

    interface StringLinkedList_init  ; module procedure	&
	init_
    end interface

    interface StringLinkedList_clean ; module procedure	&
	clean_
    end interface

    interface StringLinkedList_insert; module procedure	&
	insertc_,	&	! insert a CHARACTER(len=*) argument
	inserts_		! insert a String argument
    end interface

    interface StringLinkedList_delete; module procedure	&
	delete_
    end interface

    interface StringLinkedList_eol   ; module procedure	&
	eol_
    end interface

    interface StringLinkedList_next  ; module procedure	&
	next_
    end interface

    interface StringLinkedList_count ; module procedure	&
	count_
    end interface

    interface StringLinkedList_get   ; module procedure	&
	getc_,		&	! get as a CHARACTER(len=*)
	gets_			! get as a String
    end interface

! !REVISION HISTORY:
! 	16Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

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

!   Examples:
!
!   1) Creating a first-in-first-out linked-list,
!
!	type(StringLinkedList),pointer :: head,this
!	character(len=80) :: aline
!
!	call StringLinkedList_init(head)
!	this => head
!	do
!	  read(*,'(a)',iostat=ier) aline
!	  if(ier/=0) exit
!	  call StringLinkedList_insert(trim(aline),this)
!	  call StringLinkedList_next(this)
!	end do
!
!   2) Creating a last-in-first-out linked-list,  Note that the only
!     difference from Example (1) is without a call to
!     StringLinkedList_next().
!
!	type(StringLinkedList),pointer :: head,this
!	character(len=80) :: aline
!
!	call StringLinkedList_init(head)
!	this => head
!	do
!	  read(*,'(a)',iostat=ier) aline
!	  if(ier/=0) exit
!	  call StringLinkedList_insert(trim(aline),this)
!	end do
!

contains
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: init_ - initialize a StringLinkedList from a pointer
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine init_(head)
      use m_die, only : die
      use m_mall,only : mall_ison,mall_ci
      implicit none
      type(StringLinkedList),pointer :: head	! (out) a list

! !REVISION HISTORY:
! 	22Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::init_'
  type(StringLinkedList),pointer :: tail
  integer :: ier

	! Two special nodes are needed for a linked-list, according to
	! Robert Sedgewick (Algorithms, QA76.6.S435, page 21).
	!
	! It seems only _head_ will be needed for external references.
	! Node _tail_ will be used to denote an end-node.

  allocate(head,tail,stat=ier)
	if(ier/=0) call die(myname_,'allocate()',ier)

	if(mall_ison()) call mall_ci(2,myname)	! for two nodes

  head%next => tail
  tail%next => tail

  nullify(tail)

end subroutine init_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: insertc_ - insert before the logically referenced node
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine insertc_(cstr,this)
      use m_String,only : String_init
      use m_mall,  only : mall_ison,mall_ci
      use m_die,   only : die
      implicit none
      character(len=*),intent(in) :: cstr ! a new entry
      type(StringLinkedList),pointer :: this ! (in) a node

! !REVISION HISTORY:
! 	16Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::insertc_'
  type(StringLinkedList),pointer :: tmpl
  integer :: ier

	! Create a memory cell for the new entry of StringLinkedList

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

	if(mall_ison()) call mall_ci(1,myname)	! for one nodes

	! Store the data

  call String_init(tmpl%str,cstr)

	! Rebuild the links, if the List was not empty

  tmpl%next => this%next
  this%next => tmpl

	! Clean the working pointer

  nullify(tmpl)

end subroutine insertc_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: inserts_ - insert before the logically referenced node
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine inserts_(str,this)
      use m_String,only : String,String_init
      use m_mall,  only : mall_ison,mall_ci
      use m_die,   only : die
      implicit none
      type(String),intent(in)  :: str	! a new entry
      type(StringLinkedList),pointer :: this ! (in) a node

! !REVISION HISTORY:
! 	16Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::inserts_'
  type(StringLinkedList),pointer :: tmpl
  integer :: ier

	! Create a memory cell for the new entry of StringLinkedList

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

	if(mall_ison()) call mall_ci(1,myname)	! for one nodes

	! Store the data

  call String_init(tmpl%str,str)

	! Rebuild the links, if the List was not empty

  tmpl%next => this%next
  this%next => tmpl

	! Clean the working pointer, if it mean anyting

  nullify(tmpl)

end subroutine inserts_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: delete_ - delete the logically referenced node
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine delete_(this)
      use m_String,only : String_clean
      use m_mall,  only : mall_ison,mall_co
      use m_die,   only : die
      implicit none
      type(StringLinkedList),pointer :: this ! (in) a node

! !REVISION HISTORY:
! 	17Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::delete_'
  type(StringLinkedList),pointer :: tmpl
  integer :: ier

  tmpl => this%next%next		! hold the next target
  call String_clean(this%next%str)	! remove the next storage

	if(mall_ison()) call mall_co(1,myname)	! removing one node

  deallocate(this%next,stat=ier)	! Clean memory gabage
	if(ier/=0) call die(myname_,'deallocate()',ier)

	! Skip the current target.  Rebuild the link to the target
	! of the current target.

  this%next => tmpl

	! Clean the working pointer, if it mean anything

  nullify(tmpl)
end subroutine delete_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: eol_ - if the logically referenced node is an end-node
!
! !DESCRIPTION:
!
! !INTERFACE:

    function eol_(this)
      implicit none
      type(StringLinkedList),pointer :: this ! (in) a node
      logical :: eol_		! returned value

! !REVISION HISTORY:
! 	23Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

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

  eol_=associated(this%next,this%next%next)
end function eol_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: next_ - point a reference pointer to the next node
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine next_(this)
      implicit none
      type(StringLinkedList),pointer :: this ! (inout) a node

! !REVISION HISTORY:
! 	23Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

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

  this => this%next

end subroutine next_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: count_ - count the number of nodes
!
! !DESCRIPTION:
!
! !INTERFACE:

    function count_(this)
      implicit none
      type(StringLinkedList),pointer :: this ! (in) a node
      integer :: count_		! returned value

! !REVISION HISTORY:
! 	24Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::count_'
  type(StringLinkedList),pointer :: tmpl

  tmpl => this

  count_=0
  do while(.not.eol_(tmpl))
    count_=count_+1
    call next_(tmpl)
  end do

  nullify(tmpl)
end function count_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: getc_ - get the logically referenced value as CHARACTERs
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine getc_(this,cstr,eol)
      use m_String,only : String
      use m_String,only : String_init
      use m_String,only : String_clean
      use m_String,only : char
      implicit none
      type(StringLinkedList),pointer :: this ! (inout) a node
      character(len=*),intent(out) :: cstr ! the referenced value
      logical         ,intent(out) :: eol  ! if the node is an end-node

! !REVISION HISTORY:
! 	17Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

  character(len=*),parameter :: myname_=myname//'::getc_'
  type(String) :: str

  call gets_(this,str,eol)

  if(.not.eol) then
    cstr=char(str)
    call String_clean(str)
  endif

end subroutine getc_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: gets_ - get the logically referenced value as a String
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine gets_(this,str,eol)
      use m_String,only : String
      use m_String,only : String_init
      implicit none
      type(StringLinkedList),pointer :: this ! (inout) a node
      type(String),intent(out) :: str  ! the referenced value
      logical     ,intent(out) :: eol  ! if the node is an end-node

! !REVISION HISTORY:
! 	17Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

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

  eol=eol_(this)
  if(.not.eol) then
    call String_init(str,this%next%str)
    call next_(this)
  endif

end subroutine gets_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!       NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS      !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: clean_ - clean the whole object from this point
!
! !DESCRIPTION:
!
! !INTERFACE:

    subroutine clean_(head,stat)
      use m_die,only : die,perr
      use m_mall,only : mall_ison,mall_co
      implicit none
      type(StringLinkedList),pointer :: head ! (inout) a head-node
      integer,optional,intent(out) :: stat ! return status

! !REVISION HISTORY:
! 	17Feb00	- Jing Guo <guo@dao.gsfc.nasa.gov>
!		- initial prototype/prolog/code
!EOP ___________________________________________________________________

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

  if(present(stat)) stat=0

	! Verify if the pointer is valid

  err=.not.associated(head)
  if(.not.err) err=.not.associated(head%next)

	if(err) then
	  call perr(myname_,'Attempting to clean an uninitialized list')
	  if(.not.present(stat)) call die(myname_)
	  stat=-1
	  return
	endif

	! Clean the rest before delete the current one.

  do
    if(eol_(head)) exit
    call delete_(head)
  end do

	if(mall_ison()) call mall_co(2,myname)	! remove two nodes

  deallocate(head%next,stat=ier)
  if(ier==0) deallocate(head,stat=ier)
	if(ier/=0) then
	  call perr(myname_,'deallocate()',ier)
	  if(.not.present(stat)) call die(myname_)
	  stat=-1
	  return
	endif

end subroutine clean_

end module m_StringLinkedList