TimeArraySeriesManager.f90

Go to the documentation of this file.

module timearrayseriesmanagermodule
 
  use kindmodule, only: dp, i4b
  use simvariablesmodule, only: errmsg
  use constantsmodule, only: dzero, lentimeseriesname, linelength, &
                             lenhugeline, lenmodelname
  use listmodule, only: listtype
  use simmodule, only: store_error, store_error_unit
  use tdismodule, only: delt, totimc, kper, kstp
  use timearrayserieslinkmodule, only: timearrayserieslinktype, &
                                       constructtimearrayserieslink, &
                                       gettimearrayserieslinkfromlist, &
                                       addtimearrayserieslinktolist
  use timearrayseriesmodule, only: timearrayseriestype
  use basedismodule, only: disbasetype
 
  implicit none
 
  private
  public :: timearrayseriesmanagertype, tasmanager_cr
 
  type timearrayseriesmanagertype
    ! -- Public members
    integer(I4B), public :: iout = 0 ! output unit num
    class(disbasetype), pointer :: dis => null() ! pointer to dis
    character(len=LENMODELNAME) :: modelname
    ! -- Private members
    type(listtype), pointer, private :: boundtaslinks => null() ! list of TAS links
    character(len=LINELENGTH), allocatable, dimension(:) :: tasfiles ! list of TA file names
    type(timearrayseriestype), dimension(:), pointer, contiguous :: taslist ! array of TA pointers
    character(len=LENTIMESERIESNAME), allocatable, dimension(:) :: tasnames ! array of TA names
 
  contains
 
    ! -- Public procedures
    procedure, public :: tasmanager_df
    procedure, public :: ad => tasmgr_ad
    procedure, public :: da => tasmgr_da
    procedure, public :: add_tasfile
    procedure, public :: countlinks
    procedure, public :: getlink
    procedure, public :: maketaslink
    procedure, public :: reset
    ! -- Private procedures
    procedure, private :: tasmgr_add_link
    procedure, private :: tasmgr_convert_flux
  end type timearrayseriesmanagertype
 
contains
 
! -- Type-bound procedures of TimeArraySeriesManagerType
 
  ! -- Public procedures
 
  !> @brief Create the time-array series manager
  !<
  subroutine tasmanager_cr(this, dis, modelname, iout)
    ! -- dummy
    type(timearrayseriesmanagertype) :: this
    class(disbasetype), pointer, optional :: dis
    character(len=*), intent(in) :: modelname
    integer(I4B), intent(in) :: iout
    !
    if (present(dis)) then
      this%dis => dis
    end if
    !
    this%modelname = modelname
    this%iout = iout
    allocate (this%boundTasLinks)
    allocate (this%tasfiles(0))
  end subroutine tasmanager_cr
 
  !> @brief Define the time-array series manager
  !<
  subroutine tasmanager_df(this)
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    ! -- local
    type(timearrayseriestype), pointer :: tasptr => null()
    integer(I4B) :: nfiles
    integer(I4B) :: i
    !
    ! -- determine how many tasfiles.  This is the number of time array series
    !    so allocate arrays to store them
    nfiles = size(this%tasfiles)
    allocate (this%taslist(nfiles))
    allocate (this%tasnames(nfiles))
    !
    ! -- Setup a time array series for each file specified
    do i = 1, nfiles
      tasptr => this%taslist(i)
      call tasptr%tas_init(this%tasfiles(i), this%modelname, &
                           this%iout, this%tasnames(i))
    end do
  end subroutine tasmanager_df
 
  !> @brief Time step (or subtime step) advance.
  !!
  !! Call this each time step or subtime step.
  !<
  subroutine tasmgr_ad(this)
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    ! -- local
    type(timearrayserieslinktype), pointer :: tasLink => null()
    type(timearrayseriestype), pointer :: timearrayseries => null()
    integer(I4B) :: i, j, nlinks, nvals, isize1, isize2, inunit
    real(DP) :: begintime, endtime
    ! -- formats
    character(len=*), parameter :: fmt5 = &
      "(/,'Time-array-series controlled arrays in stress period ', &
      &i0, ', time step ', i0, ':')"
10  format('"', a, '" package: ', a, ' array obtained from time-array series "', &
           a, '"')
    !
    ! -- Initialize time variables
    begintime = totimc
    endtime = begintime + delt
    !
    ! -- Iterate through boundtaslinks and update specified
    !    array with array of average values obtained from
    !    appropriate time series.
    if (associated(this%boundTasLinks)) then
      nlinks = this%boundTasLinks%Count()
      do i = 1, nlinks
        taslink => gettimearrayserieslinkfromlist(this%boundTasLinks, i)
        if (taslink%Iprpak == 1 .and. i == 1) then
          write (this%iout, fmt5) kper, kstp
        end if
        if (taslink%UseDefaultProc) then
          timearrayseries => taslink%timeArraySeries
          nvals = size(taslink%BndArray)
          !
          ! -- Fill the package array with integrated values
          call timearrayseries%GetAverageValues(nvals, taslink%BndArray, &
                                                begintime, endtime)
          !
          ! -- If conversion from flux to flow is required, multiply by cell area
          if (taslink%ConvertFlux) then
            call this%tasmgr_convert_flux(taslink)
          end if
          !
          ! -- If PRINT_INPUT is specified, write information
          !    regarding source of time-array series data
          if (taslink%Iprpak == 1) then
            write (this%iout, 10) trim(taslink%PackageName), &
              trim(taslink%Text), &
              trim(taslink%timeArraySeries%Name)
          end if
        end if
        if (i == nlinks) then
          write (this%iout, '()')
        end if
      end do
      !
      ! -- Now that all array values have been substituted, can now multiply
      !    an array by a multiplier array
      do i = 1, nlinks
        taslink => gettimearrayserieslinkfromlist(this%boundTasLinks, i)
        if (taslink%UseDefaultProc) then
          if (associated(taslink%RMultArray)) then
            isize1 = size(taslink%BndArray)
            isize2 = size(taslink%RMultArray)
            if (isize1 == isize2 .and. isize1 == nvals) then
              do j = 1, nvals
                taslink%BndArray(j) = taslink%BndArray(j) * taslink%RMultArray(j)
              end do
            else
              errmsg = 'Size mismatch between boundary and multiplier arrays'// &
                       ' using time-array series: '// &
                       trim(taslink%TimeArraySeries%Name)
              call store_error(errmsg)
              inunit = taslink%TimeArraySeries%GetInunit()
              call store_error_unit(inunit)
            end if
          end if
        end if
      end do
    end if
  end subroutine tasmgr_ad
 
  !> @brief Deallocate
  !<
  subroutine tasmgr_da(this)
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    ! -- local
    integer :: i, n
    type(timearrayserieslinktype), pointer :: tasLink => null()
    !
    ! -- Deallocate contents of each TimeArraySeriesType object in list
    !    of time-array series links.
    n = this%boundTasLinks%Count()
    do i = 1, n
      taslink => gettimearrayserieslinkfromlist(this%boundTasLinks, i)
      call taslink%da()
    end do
    !
    ! -- Go through and deallocate individual time array series
    do i = 1, size(this%taslist)
      call this%taslist(i)%da()
    end do
    !
    ! -- Deallocate the list of time-array series links.
    call this%boundTasLinks%Clear(.true.)
    deallocate (this%boundTasLinks)
    deallocate (this%tasfiles)
    !
    ! -- Deallocate the time array series
    deallocate (this%taslist)
    deallocate (this%tasnames)
    !
    ! -- nullify pointers
    this%dis => null()
    this%boundTasLinks => null()
  end subroutine tasmgr_da
 
  !> @brief Add a time-array series file
  !<
  subroutine add_tasfile(this, fname)
    ! -- modules
    use arrayhandlersmodule, only: expandarray
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    character(len=*), intent(in) :: fname
    ! -- local
    integer(I4B) :: indx
    !
    call expandarray(this%tasfiles, 1)
    indx = size(this%tasfiles)
    this%tasfiles(indx) = fname
  end subroutine add_tasfile
 
  !> @brief Zero out arrays that are represented with time series
  !!
  !! Delete all existing links from time array series to package arrays as they
  !! will need to be created with a new BEGIN PERIOD block
  !<
  subroutine reset(this, pkgName)
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    character(len=*), intent(in) :: pkgName
    ! -- local
    integer(I4B) :: i, j, nlinks
    type(timearrayserieslinktype), pointer :: taslink
    !
    ! -- Reassign all linked elements to zero
    nlinks = this%boundTasLinks%Count()
    do i = 1, nlinks
      taslink => gettimearrayserieslinkfromlist(this%boundTasLinks, i)
      if (associated(taslink)) then
        do j = 1, size(taslink%BndArray)
          taslink%BndArray(j) = dzero
        end do
      end if
    end do
    !
    ! -- Delete all existing time array links
    if (associated(this%boundTasLinks)) then
      ! Deallocate and remove all links belonging to package
      nlinks = this%boundTasLinks%Count()
      do i = nlinks, 1, -1
        taslink => gettimearrayserieslinkfromlist(this%boundTasLinks, i)
        if (associated(taslink)) then
          call taslink%da()
          call this%boundTasLinks%RemoveNode(i, .true.)
        end if
      end do
    end if
  end subroutine reset
 
  !> @brief Make link from time-array series to package array
  !<
  subroutine maketaslink(this, pkgName, bndArray, iprpak, &
                         tasName, text, convertFlux, nodelist, inunit)
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    character(len=*), intent(in) :: pkgName
    real(DP), dimension(:), pointer :: bndArray
    integer(I4B), intent(in) :: iprpak
    character(len=*), intent(in) :: tasName
    character(len=*), intent(in) :: text
    logical, intent(in) :: convertFlux
    integer(I4B), dimension(:), pointer, contiguous, intent(in) :: nodelist
    integer(I4B), intent(in) :: inunit
    ! -- local
    integer(I4B) :: i, nfiles, iloc
    character(LINELENGTH) :: ermsg
    type(timearrayserieslinktype), pointer :: newTasLink
    type(timearrayseriestype), pointer :: tasptr => null()
    !
    ! -- Find the time array series
    nfiles = size(this%tasnames)
    iloc = 0
    do i = 1, nfiles
      if (this%tasnames(i) == tasname) then
        iloc = i
        exit
      end if
    end do
    if (iloc == 0) then
      ermsg = 'Error: Time-array series "'//trim(tasname)//'" not found.'
      call store_error(ermsg)
      call store_error_unit(inunit)
    end if
    tasptr => this%taslist(iloc)
    !
    ! -- Construct a time-array series link
    newtaslink => null()
    call constructtimearrayserieslink(newtaslink, tasptr, &
                                      pkgname, bndarray, iprpak, &
                                      text)
    newtaslink%ConvertFlux = convertflux
    newtaslink%nodelist => nodelist
    !
    ! -- Add link to list of links
    call this%tasmgr_add_link(newtaslink)
  end subroutine maketaslink
 
  !> @brief Get link from the boundtaslinks list
  !<
  function getlink(this, indx) result(tasLink)
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    integer(I4B), intent(in) :: indx
    ! -- return
    type(timearrayserieslinktype), pointer :: taslink
    !
    taslink => null()
    !
    if (associated(this%boundTasLinks)) then
      taslink => gettimearrayserieslinkfromlist(this%boundTasLinks, indx)
    end if
  end function getlink
 
  !> @brief Count number of links in the boundtaslinks list
  !<
  function countlinks(this)
    ! -- return
    integer(I4B) :: countlinks
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    !
    if (associated(this%boundtaslinks)) then
      countlinks = this%boundTasLinks%Count()
    else
      countlinks = 0
    end if
  end function countlinks
 
  ! -- Private procedures
 
  !> @brief Convert the array from a flux to a flow rate by multiplying by the
  !! cell area
  !<
  subroutine tasmgr_convert_flux(this, tasLink)
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    type(timearrayserieslinktype), pointer, intent(inout) :: tasLink
    ! -- local
    integer(I4B) :: i, n, noder
    real(DP) :: area
    !
    if (.not. (associated(this%dis) .and. &
               associated(taslink%nodelist))) then
      errmsg = 'Programming error. Cannot convert flux. Verify that '&
               &'a valid DIS instance and nodelist were provided.'
      call store_error(errmsg)
      call store_error_unit(taslink%TimeArraySeries%GetInunit())
    end if
    !
    n = size(taslink%BndArray)
    do i = 1, n
      noder = taslink%nodelist(i)
      if (noder > 0) then
        area = this%dis%get_area(noder)
        taslink%BndArray(i) = taslink%BndArray(i) * area
      end if
    end do
  end subroutine tasmgr_convert_flux
 
  !> @brief Add a time arrays series link
  !<
  subroutine tasmgr_add_link(this, tasLink)
    ! -- dummy
    class(timearrayseriesmanagertype) :: this
    type(timearrayserieslinktype), pointer :: tasLink
    ! -- local
    !
    call addtimearrayserieslinktolist(this%boundTasLinks, taslink)
  end subroutine tasmgr_add_link
 
end module timearrayseriesmanagermodule