TimeArraySeriesLink.f90

Go to the documentation of this file.

module timearrayserieslinkmodule
 
  use kindmodule, only: dp, i4b
  use constantsmodule, only: lenpackagename, lentimeseriestext
  use inputoutputmodule, only: upcase
  use listmodule, only: listtype
  use timearrayseriesmodule, only: timearrayseriestype
 
  implicit none
 
  private
  public :: timearrayserieslinktype, constructtimearrayserieslink, &
            addtimearrayserieslinktolist, gettimearrayserieslinkfromlist
  private :: castastimearrayserieslinktype
 
  type :: timearrayserieslinktype
    ! -- Public members
    character(len=LENPACKAGENAME), public :: packagename = ''
    character(len=LENTIMESERIESTEXT), public :: text = ''
    integer(I4B), public :: iprpak = 1
    logical, public :: usedefaultproc = .true.
    logical, public :: convertflux = .false.
    integer(I4B), dimension(:), pointer, contiguous, public :: nodelist => null()
    ! BndArray can point to an array in either the bound or auxval
    ! array of BndType, or any other double precision variable or array
    ! element that contains a value that could be controlled by a time series.
    real(dp), dimension(:), pointer, public :: bndarray => null()
    real(dp), dimension(:), pointer, public :: rmultarray => null()
    type(timearrayseriestype), pointer, public :: timearrayseries => null()
 
  contains
 
    procedure, public :: da => tasl_da
  end type timearrayserieslinktype
 
contains
 
  !> @brief Deallocate
  !<
  subroutine tasl_da(this)
    ! -- dummy
    class(timearrayserieslinktype), intent(inout) :: this
    !
    this%nodelist => null()
    this%bndarray => null()
    this%rmultarray => null()
    this%TimeArraySeries => null()
    !
    ! -- Return
    return
  end subroutine tasl_da
 
  !> @brief Construct a time series of arrays that are linked
  !<
  subroutine constructtimearrayserieslink(newTasLink, timeArraySeries, &
                                          pkgName, bndArray, iprpak, text)
    ! -- dummy
    type(timearrayserieslinktype), pointer, intent(out) :: newtaslink
    type(timearrayseriestype), pointer, intent(in) :: timearrayseries
    character(len=*), intent(in) :: pkgname
    real(dp), dimension(:), pointer, intent(in) :: bndarray
    integer(I4B), intent(in) :: iprpak
    character(len=*), intent(in) :: text
    ! -- local
    character(len=LENPACKAGENAME) :: pkgnametemp
    !
    allocate (newtaslink)
    ! Store package name as all caps
    pkgnametemp = pkgname
    call upcase(pkgnametemp)
    newtaslink%PackageName = pkgnametemp
    newtaslink%timeArraySeries => timearrayseries
    newtaslink%BndArray => bndarray
    newtaslink%Iprpak = iprpak
    newtaslink%Text = text
    !
    ! -- Return
    return
  end subroutine constructtimearrayserieslink
 
  !> @brief Cast an unlimited polymorphic object as TimeArraySeriesLinkType
  !<
  function castastimearrayserieslinktype(obj) result(res)
    ! -- dummy
    class(*), pointer, intent(inout) :: obj
    ! -- return
    type(timearrayserieslinktype), pointer :: res
    !
    res => null()
    if (.not. associated(obj)) return
    !
    select type (obj)
    type is (timearrayserieslinktype)
      res => obj
    end select
    !
    ! -- Return
    return
  end function castastimearrayserieslinktype
 
  !> @brief Add time-array series to list
  !<
  subroutine addtimearrayserieslinktolist(list, tasLink)
    ! -- dummy
    type(listtype), intent(inout) :: list
    ! -- return
    type(timearrayserieslinktype), pointer, intent(inout) :: taslink
    ! -- local
    class(*), pointer :: obj
    !
    obj => taslink
    call list%Add(obj)
    !
    ! -- Return
    return
  end subroutine addtimearrayserieslinktolist
 
  !> @brief Get time-array series from a list and return
  !<
  function gettimearrayserieslinkfromlist(list, idx) result(res)
    ! -- dummy
    type(listtype), intent(inout) :: list
    integer(I4B), intent(in) :: idx
    ! -- return
    type(timearrayserieslinktype), pointer :: res
    ! -- local
    class(*), pointer :: obj
    !
    obj => list%GetItem(idx)
    res => castastimearrayserieslinktype(obj)
    !
    ! -- Return
    return
  end function gettimearrayserieslinkfromlist
 
end module timearrayserieslinkmodule