ecearth3/sources/oasis3-mct/lib/mct/mct/m_Navigator.F90

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!-----------------------------------------------------------------------
! CVS m_Navigator.F90,v 1.9 2004-04-21 22:47:09 jacob Exp
! CVS MCT_2_8_0 
!BOP -------------------------------------------------------------------
!
! !MODULE: m_Navigator - An Object for Indexing Segments of a Vector
!
! !DESCRIPTION:
! A {\em Navigator} is a table used to {\em index} or {\em Navigate} 
!  segments of a vector, or segments of a dimension of a 
! higher-dimensional array.  In MCT, this concept is embodied in 
! the {\tt Navigator} datatype, which contains 
! the following components:
! \begin{itemize}
! \item The {\em number} of segments;
! \item The {\em displacement} of the starting index of each segment 
! from the vector's first element (i.e. the starting index minus 1);
! \item The {\em length} of each segment; and
! \item The {\em total length} of the vector or array dimension for which 
! segments are defined.  This last item is optional, but if defined 
! provides the ability for the {\tt Navigator} to check for erroneous
! segment entries (i.e., segments that are out-of-bounds).
! \end{itemize}
!
! This module defines the {\tt Navigator} datatype, creation and 
! destruction methods, a variety of query methods, and a method for 
! resizing the {\tt Navigator}.
!
! !INTERFACE:

 module m_Navigator

! !USES:
! No external modules are used in the declaration section of this module.

      implicit none

      private	! except

! !PUBLIC TYPES:

      public :: Navigator		! The class data structure

    Type Navigator
      integer :: NumSegments	! Number of defined Segments
      integer :: VectorLength	! Length of the Vector being indexed
      integer,pointer,dimension(:) :: displs ! Segment start displacements
      integer,pointer,dimension(:) :: counts ! Segment lengths
    End Type Navigator

! !PUBLIC MEMBER FUNCTIONS:

      public :: Navigator_init,init ! initialize an object
      public :: clean               ! clean an object
      public :: NumSegments         ! number of vector segments
      public :: VectorLength        ! indexed vector's total length
      public :: msize               ! the maximum size
      public :: resize              ! adjust the true size
      public :: get                 ! get an entry
      public :: ptr_displs          ! referencing %displs(:)
      public :: ptr_counts          ! referencing %counts(:)

    interface Navigator_init; module procedure	&
       init_
    end interface
    interface init  ; module procedure init_  ; end interface
    interface clean ; module procedure clean_ ; end interface
    interface NumSegments ; module procedure  &
       NumSegments_
    end interface
    interface VectorLength ; module procedure  &
       VectorLength_
    end interface
    interface msize ; module procedure msize_ ; end interface
    interface resize; module procedure resize_; end interface
    interface get   ; module procedure get_   ; end interface
    interface ptr_displs; module procedure &
       ptr_displs_
    end interface
    interface ptr_counts; module procedure &
       ptr_counts_
    end interface

! !REVISION HISTORY:
! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> - initial prototype/prolog/code
! 26Aug02 - J. Larson <larson@mcs.anl.gov> - expanded datatype to inlcude
!           VectorLength component.
!EOP ___________________________________________________________________

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

 contains

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: init_ - Create a Navigator
!
! !DESCRIPTION:
! This routine creates a {\tt Navigator} {\tt Nav} capable of storing 
! information about {\tt NumSegments} segments.  The user can supply the 
! length of the vector (or array subspace) being indexed by supplying the 
! optional input {\tt INTEGER} argument {\tt VectorLength} (if it is not 
! supplied, this component of {\tt Nav} will be set to zero, signifying 
! to other {\tt Navigator} routines that vector length information is 
! unavailable).  The success (failure) of this operation is signified by 
! the zero (non-zero) value of the optional output {\tt INTEGER} argument 
! {\tt stat}.
!
! !INTERFACE:

    subroutine init_(Nav, NumSegments, VectorLength, stat)

! !USES:

      use m_mall,only : mall_ison,mall_mci
      use m_die ,only : die,perr
      use m_stdio, only : stderr

      implicit none

! !INPUT PARAMETERS:

      integer,                   intent(in)  :: NumSegments
      integer,         optional, intent(in)  :: VectorLength

! !OUTPUT PARAMETERS:

      type(Navigator),           intent(out) :: Nav
      integer,         optional, intent(out) :: stat

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

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

! If the argument VectorLength is present, use this value to set 
! Nav%VectorLength.  Otherwise, set Nav%VectorLength to zero.

  if(present(VectorLength)) then
     if(VectorLength < 0) then
	write(stderr,'(2a,i8)') myname_, &
	     ':: FATAL -- illegal value of VectorLength=',VectorLength
	call die(myname_)
     endif
     Nav%VectorLength = VectorLength
  else
     Nav%VectorLength = 0
  endif

! Allocate segment attribute table arrays:

  allocate(Nav%displs(NumSegments),Nav%counts(NumSegments),stat=ier)
  if(ier/=0) then
     call perr(myname_,'allocate()',ier)
     if(.not.present(stat)) call die(myname_)
     stat=ier
     return
  endif
  if(mall_ison()) then
     call mall_mci(Nav%displs,myname)
     call mall_mci(Nav%counts,myname)
  endif

  Nav%NumSegments=NumSegments

 end subroutine init_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: clean_ - Destroy a Navigator
!
! !DESCRIPTION:
! This routine deallocates allocated memory associated with the 
! input/output {\tt Navigator} argument {\tt Nav}, and clears the 
! vector length and number of segments components  The success (failure) 
! of this operation is signified by the zero (non-zero) value of the 
! optional output {\tt INTEGER} argument {\tt stat}.
!
! !INTERFACE:

 subroutine clean_(Nav, stat)

! !USES:

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

      implicit none

! !INPUT/OUTPUT PARAMETERS:

      type(Navigator),intent(inout) :: Nav

! !OUTPUT PARAMETERS:

      integer,optional,intent(out) :: stat

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

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

  if(mall_ison()) then
     if(associated(Nav%displs)) call mall_mco(Nav%displs,myname_)
     if(associated(Nav%counts)) call mall_mco(Nav%counts,myname_)
  endif

  deallocate(Nav%displs,Nav%counts,stat=ier)

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

  Nav%NumSegments = 0
  Nav%VectorLength = 0

 end subroutine clean_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: NumSegments_ - Return the Number of Segments
!
! !DESCRIPTION:
! This {\tt INTEGER} query function returns the number of segments 
! in the input {\tt Navigator} argument {\tt Nav} for which segment 
! start and length information are defined .
!
! !INTERFACE:

 integer function NumSegments_(Nav)

! !USES:

      implicit none

! !INPUT PARAMETERS:

      type(Navigator), intent(in) :: Nav

! !REVISION HISTORY:
! 22May00 - Jing Guo <guo@dao.gsfc.nasa.gov> initial prototype/prolog/code
!  1Mar02 - E.T. Ong <eong@mcs.anl.gov> - removed die to prevent crashes.
!EOP ___________________________________________________________________

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

  NumSegments_=Nav%NumSegments

 end function NumSegments_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: msize_ - Return the Maximum Capacity for Segment Storage
!
! !DESCRIPTION:
! This {\tt INTEGER} query function returns the maximum number of 
! segments for which start and length information can be stored in the 
! input {\tt Navigator} argument {\tt Nav}.
!
! !INTERFACE:

 integer function msize_(Nav)

! !USES:

      implicit none

! !INPUT PARAMETERS:

      type(Navigator),intent(in) :: Nav

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

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

  msize_=size(Nav%displs)

 end function msize_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: VectorLength_ - Return the Navigated Vector's Length
!
! !DESCRIPTION:
! This {\tt INTEGER} query function returns the total length of the 
! vector navigated by the input {\tt Navigator} argument {\tt Nav}.
! Note that the vector length is a quantity the user must have set 
! when {\tt Nav} was initialized.  If it has not been set, the return 
! value will be zero.
!
! !INTERFACE:

 integer function VectorLength_(Nav)

! !USES:

      implicit none

! !INPUT PARAMETERS:

      type(Navigator), intent(in) :: Nav

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

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

  VectorLength_=Nav%VectorLength

 end function VectorLength_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: resize_ - Reset the Number of Segments
!
! !DESCRIPTION:
! This routine resets the number of segments stored in the input/output 
! {\tt Navigator} argument {\tt Nav}.  It behaves in one of two modes:  
! If the optional {\tt INTEGER} input argument {\tt NumSegments} is 
! provided, then this value is taken to be the new number of segments.
! If this routine is invoked without {\tt NumSegments} provided, then 
! the new number of segments is set as per the result of the Fortran 
! {\tt size()} function applied to the segment table arrays.
!
! !INTERFACE:

 subroutine resize_(Nav, NumSegments)
 
! !USES:
   
      use m_stdio, only : stderr
      use m_die,  only : die

      implicit none

! !INPUT PARAMETERS:

      integer,optional,intent(in) :: NumSegments

! !INPUT/OUTPUT PARAMETERS:

      type(Navigator),intent(inout) :: Nav

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

  character(len=*),parameter :: myname_=myname//'::resize_'
  integer :: m

  m=msize_(Nav)

  if(present(NumSegments)) then
     if(NumSegments > m) then
	write(stderr,'(3a,2(i8,a))') myname_, &
	     ':: FATAL value of argument NumSegments exceeds maximum ', &
	     ' storage for this Navigator.  NumSegments = ',NumSegments, &
	     ' Maximum storage capacity = ',m,' segments.'
	call die(myname_)
     endif
     Nav%NumSegments=NumSegments
  else
     Nav%NumSegments=m
  endif

 end subroutine resize_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: get_ - Retrieve Characteristics of a Segment
!
! !DESCRIPTION:
! This multi-purpose query routine can be used to retrieve various 
! characteristics of a given segment (identified by the input 
! {\tt INTEGER} argument {\tt iSeg}) stored in the input {\tt Navigator}
! argument {\tt Nav}:
! \begin{enumerate}
! \item The {\em displacement} of the first element in this segment from 
! the first element of the vector.  This quantity is returned in the 
! optional output {\tt INTEGER} argument {\tt displ}
! \item The {\em number of elements} in this segment.  This quantity 
! is returned in the optional output {\tt INTEGER} argument {\tt displ}
! \item The {\em index} of the first element in this segment  This 
! quantity is returned in the optional output {\tt INTEGER} argument 
! {\tt lc}.
! \item The {\em index} of the final element in this segment  This 
! quantity is returned in the optional output {\tt INTEGER} argument 
! {\tt le}.
! \end{enumerate}
! Any combination of the above characteristics may be obtained by 
! invoking this routine with the corresponding optional arguments.
!
! !INTERFACE:

 subroutine get_(Nav, iSeg, displ, count, lc, le)

! !USES:

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

      implicit none

! !INPUT PARAMETERS:

      type(Navigator),           intent(in)  :: Nav
      integer,                   intent(in)  :: iSeg

! !OUTPUT PARAMETERS:

      integer,         optional, intent(out) :: displ
      integer,         optional, intent(out) :: count
      integer,         optional, intent(out) :: lc
      integer,         optional, intent(out) :: le

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

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


       ! Argument sanity check:

  if(iSeg > msize_(Nav)) then
     write(stderr,'(2a,2(a,i8))') myname_, &
	  ':: FATAL -- Segment index out of Navigator table bounds, ', &
	  'Size of Navigator table = ',msize_(Nav),' iSeg = ',iSeg
     call die(myname_)
  endif

  if(present(displ)) displ=Nav%displs(iSeg)
  if(present(count)) count=Nav%counts(iSeg)
  if(present(lc)) lc=Nav%displs(iSeg)+1
  if(present(le)) le=Nav%displs(iSeg)+Nav%counts(iSeg)

 end subroutine get_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: ptr_displs_ - Returns Pointer to the displs(:) Component
!
! !DESCRIPTION:
! This pointer-valued query function returns a pointer to the 
! {\em displacements} information (the displacement of the first element 
! of each segment from the beginning of the vector) contained in the 
! input {\tt Navigator} argument {\tt Nav}.  It has four basic modes 
! of behavior, depending on which (if any) of the optional input 
! {\tt INTEGER} arguments {\tt lbnd} and {\tt ubnd} are supplied.
! \begin{enumerate}
! \item  If neither {\tt lbnd} nor {\tt ubnd} is supplied, then 
! {\tt ptr\_displs\_} returns a pointer to {\em all} the elements in 
! the array {\tt Nav\%displs(:)}.
! \item  If both {\tt lbnd} and {\tt ubnd} are supplied, then 
! {\tt ptr\_displs\_} returns a pointer to the segment of the
! array {\tt Nav\%displs(lbnd:ubnd)}.
! \item  If {\tt lbnd} is supplied but {\tt ubnd} is not, then 
! {\tt ptr\_displs\_} returns a pointer to the segment of the
! array {\tt Nav\%displs(lbnd:msize)}, where {\tt msize} is the 
! length of the array {\tt Nav\%displs(:)}.
! \item  If {\tt lbnd} is not supplied but {\tt ubnd} is, then 
! {\tt ptr\_displs\_} returns a pointer to the segment of the
! array {\tt Nav\%displs(1:ubnd)}.
! \end{enumerate}
!
! !INTERFACE:

 function ptr_displs_(Nav, lbnd, ubnd)

! !USES:

      use m_stdio, only : stderr
      use m_die,  only : die
 
      implicit none

! !INPUT PARAMETERS:

      type(Navigator),           intent(in) :: Nav
      integer,         optional, intent(in) :: lbnd
      integer,         optional, intent(in) :: ubnd

! !OUTPUT PARAMETERS:

      integer,     dimension(:), pointer    :: ptr_displs_

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

  character(len=*),parameter :: myname_=myname//'::ptr_displs_'
  integer :: lc,le

       ! Argument sanity checks

  if(present(lbnd)) then
     if(lbnd <= 0) then
	write(stderr,'(3a,i8)') myname_, &
	     ':: FATAL -- illegal lower bound, which must be >= 1.', &
	     'lbnd = ',lbnd
	call die(myname_)
     endif
  endif

  if(present(ubnd)) then
     if(ubnd > msize_(Nav)) then
	write(stderr,'(2a,2(a,i8))') myname_, &
	     ':: FATAL -- illegal upper bound, which must be <= msize(Nav).', &
	     'msize(Nav) = ',msize_(Nav),' ubnd = ',ubnd
	call die(myname_)
     endif
  endif

  if(present(lbnd) .and. present(ubnd)) then
     if(lbnd > ubnd) then
	write(stderr,'(2a,2(a,i8))') myname_, &
	     ':: FATAL --  upper bound, must be >= lower bound.', &
	     'Lower bound lbnd = ',lbnd,' Upper bound ubnd = ',ubnd
	call die(myname_)
     endif
  endif

       ! End argument sanity checks

  if(present(lbnd).or.present(ubnd)) then
    lc=lbound(Nav%displs,1)
    if(present(lbnd)) lc=lbnd
    le=ubound(Nav%displs,1)
    if(present(ubnd)) le=ubnd
    ptr_displs_ => Nav%displs(lc:le)
  else
    le=Nav%NumSegments
    ptr_displs_ => Nav%displs(1:le)
  endif

 end function ptr_displs_

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!    Math and Computer Science Division, Argonne National Laboratory   !
!BOP -------------------------------------------------------------------
!
! !IROUTINE: ptr_counts_ - Returns Pointer to counts(:) Component
!
! !DESCRIPTION:
! This pointer-valued query function returns a pointer to the 
! {\em counts} information (that is, the number of elements in each 
! of each segment the vector being navigated) contained in the 
! input {\tt Navigator} argument {\tt Nav}.  It has four basic modes 
! of behavior, depending on which (if any) of the optional input 
! {\tt INTEGER} arguments {\tt lbnd} and {\tt ubnd} are supplied.
! \begin{enumerate}
! \item  If neither {\tt lbnd} nor {\tt ubnd} is supplied, then 
! {\tt ptr\_counts\_} returns a pointer to {\em all} the elements in 
! the array {\tt Nav\%counts(:)}.
! \item  If both {\tt lbnd} and {\tt ubnd} are supplied, then 
! {\tt ptr\_counts\_} returns a pointer to the segment of the
! array {\tt Nav\%counts(lbnd:ubnd)}.
! \item  If {\tt lbnd} is supplied but {\tt ubnd} is not, then 
! {\tt ptr\_counts\_} returns a pointer to the segment of the
! array {\tt Nav\%counts(lbnd:msize)}, where {\tt msize} is the 
! length of the array {\tt Nav\%counts(:)}.
! \item  If {\tt lbnd} is not supplied but {\tt ubnd} is, then 
! {\tt ptr\_counts\_} returns a pointer to the segment of the
! array {\tt Nav\%counts(1:ubnd)}.
! \end{enumerate}
!
! !INTERFACE:

 function ptr_counts_(Nav, lbnd, ubnd)

! !USES:

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

      implicit none

! !INPUT PARAMETERS:

      type(Navigator),           intent(in) :: Nav
      integer,         optional, intent(in) :: lbnd
      integer,         optional, intent(in) :: ubnd

! !OUTPUT PARAMETERS:

      integer, dimension(:),     pointer    :: ptr_counts_

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

  character(len=*),parameter :: myname_=myname//'::ptr_counts_'
  integer :: lc,le

       ! Argument sanity checks

  if(present(lbnd)) then
     if(lbnd <= 0) then
	write(stderr,'(3a,i8)') myname_, &
	     ':: FATAL -- illegal lower bound, which must be >= 1.', &
	     'lbnd = ',lbnd
	call die(myname_)
     endif
  endif

  if(present(ubnd)) then
     if(ubnd > msize_(Nav)) then
	write(stderr,'(2a,2(a,i8))') myname_, &
	     ':: FATAL -- illegal upper bound, which must be <= msize(Nav).', &
	     'msize(Nav) = ',msize_(Nav),' ubnd = ',ubnd
	call die(myname_)
     endif
  endif

  if(present(lbnd) .and. present(ubnd)) then
     if(lbnd > ubnd) then
	write(stderr,'(2a,2(a,i8))') myname_, &
	     ':: FATAL --  upper bound, must be >= lower bound.', &
	     'Lower bound lbnd = ',lbnd,' Upper bound ubnd = ',ubnd
	call die(myname_)
     endif
  endif

       ! End argument sanity checks

  if(present(lbnd).or.present(ubnd)) then
    lc=lbound(Nav%counts,1)
    if(present(lbnd)) lc=lbnd
    le=ubound(Nav%counts,1)
    if(present(ubnd)) le=ubnd
    ptr_counts_ => Nav%counts(lc:le)
  else
    le=Nav%NumSegments
    ptr_counts_ => Nav%counts(1:le)
  endif

 end function ptr_counts_

 end module m_Navigator