TimeArray.f90

Go to the documentation of this file.

module timearraymodule
 
  use kindmodule, only: dp, i4b
  use listmodule, only: listtype
  use simvariablesmodule, only: errmsg
  use simmodule, only: store_error
 
  implicit none
  private
  public :: timearraytype, constructtimearray, &
            addtimearraytolist, castastimearraytype, &
            gettimearrayfromlist
 
  type :: timearraytype
    ! -- Public members
    real(dp), public :: tatime
    real(dp), dimension(:), pointer, contiguous, public :: taarray => null()
 
  contains
 
    ! -- Public procedures
    ! -- When gfortran adds support for finalization, the
    !    following declaration could be: final :: finalize
    procedure, public :: da => ta_da
  end type timearraytype
 
contains
 
  !> @brief Construct time array
  !!
  !! Allocate and assign members of a new TimeArrayType object. Allocate space
  !! for the array so that this subroutine can be called repeatedly with the
  !! same array (but with different contents).
  !<
  subroutine constructtimearray(newTa, modelname)
    ! -- modules
    use constantsmodule, only: lenmempath
    use memorymanagermodule, only: mem_setptr
    use memoryhelpermodule, only: create_mem_path
    ! -- dummy
    type(timearraytype), pointer, intent(out) :: newta
    character(len=*), intent(in) :: modelname
    ! -- local
    integer(I4B), dimension(:), contiguous, &
      pointer :: mshape
    character(len=LENMEMPATH) :: mempath
    integer(I4B) :: isize
    !
    ! -- initialize
    nullify (mshape)
    !
    ! -- create mempath
    mempath = create_mem_path(component=modelname, subcomponent='DIS')
    !
    ! -- set mshape pointer
    call mem_setptr(mshape, 'MSHAPE', mempath)
    !
    ! Get dimensions for supported discretization type
    if (size(mshape) == 2) then
      isize = mshape(2)
    else if (size(mshape) == 3) then
      isize = mshape(2) * mshape(3)
    else
      errmsg = 'Time array series is not supported for discretization type'
      call store_error(errmsg, terminate=.true.)
    end if
    !
    allocate (newta)
    allocate (newta%taArray(isize))
  end subroutine constructtimearray
 
  !> @brief Cast an unlimited polymorphic object as TimeArrayType
  !<
  function castastimearraytype(obj) result(res)
    ! -- dummy
    class(*), pointer, intent(inout) :: obj
    ! -- return
    type(timearraytype), pointer :: res
    !
    res => null()
    if (.not. associated(obj)) return
    !
    select type (obj)
    type is (timearraytype)
      res => obj
    end select
  end function castastimearraytype
 
  !> @brief Add a time array to a to list
  !<
  subroutine addtimearraytolist(list, timearray)
    ! -- dummy
    type(listtype), intent(inout) :: list
    type(timearraytype), pointer, intent(inout) :: timearray
    ! -- local
    class(*), pointer :: obj
    !
    obj => timearray
    call list%Add(obj)
  end subroutine addtimearraytolist
 
  !> @brief Retrieve a time array from a list
  !<
  function gettimearrayfromlist(list, indx) result(res)
    ! -- dummy
    type(listtype), intent(inout) :: list
    integer(I4B), intent(in) :: indx
    ! -- return
    type(timearraytype), pointer :: res
    ! -- local
    class(*), pointer :: obj
    !
    obj => list%GetItem(indx)
    res => castastimearraytype(obj)
  end function gettimearrayfromlist
 
  !> @brief Deallocate memory
  !<
  subroutine ta_da(this)
    ! -- dummy
    class(timearraytype) :: this
    !
    deallocate (this%taArray)
    this%taArray => null()
  end subroutine ta_da
 
end module timearraymodule