diff --git a/src/Model/ModelUtilities/BoundaryPackage.f90 b/src/Model/ModelUtilities/BoundaryPackage.f90 index 8fd71401f45..58895f2554f 100644 --- a/src/Model/ModelUtilities/BoundaryPackage.f90 +++ b/src/Model/ModelUtilities/BoundaryPackage.f90 @@ -187,7 +187,7 @@ subroutine bnd_df(this, neq, dis) ! ! -- Create time series managers call tsmanager_cr(this%TsManager, this%iout) - call tasmanager_cr(this%TasManager, dis, this%iout) + call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout) ! ! -- create obs package call obs_cr(this%obs, this%inobspkg) diff --git a/src/Model/ModelUtilities/GwtSpc.f90 b/src/Model/ModelUtilities/GwtSpc.f90 index 9b33f196e2d..0b0677afc91 100644 --- a/src/Model/ModelUtilities/GwtSpc.f90 +++ b/src/Model/ModelUtilities/GwtSpc.f90 @@ -117,7 +117,7 @@ subroutine initialize(this, dis, id, inunit, iout, name_model, packNameFlow) ! ! -- Setup the time series manager call tsmanager_cr(this%TsManager, this%iout) - call tasmanager_cr(this%TasManager, dis, this%iout) + call tasmanager_cr(this%TasManager, dis, name_model, this%iout) ! ! -- read options call this%read_options() diff --git a/src/Utilities/TimeSeries/TimeArray.f90 b/src/Utilities/TimeSeries/TimeArray.f90 index 49b7ee99e4c..5a54aa17c4f 100644 --- a/src/Utilities/TimeSeries/TimeArray.f90 +++ b/src/Utilities/TimeSeries/TimeArray.f90 @@ -1,6 +1,5 @@ module TimeArrayModule - use BaseDisModule, only: DisBaseType use KindModule, only: DP, I4B use ListModule, only: ListType use SimVariablesModule, only: errmsg @@ -25,7 +24,7 @@ module TimeArrayModule contains - subroutine ConstructTimeArray(newTa, dis) + subroutine ConstructTimeArray(newTa, modelname) ! ****************************************************************************** ! ConstructTimeArray -- construct time array ! Allocate and assign members of a new TimeArrayType object. @@ -35,20 +34,39 @@ subroutine ConstructTimeArray(newTa, dis) ! ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ + ! -- modules + use ConstantsModule, only: LENMEMPATH + use MemoryManagerModule, only: mem_setptr + use MemoryHelperModule, only: create_mem_path ! -- dummy type(TimeArrayType), pointer, intent(out) :: newTa - class(DisBaseType), pointer, intent(in) :: dis + 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 (dis%supports_layers()) then - isize = dis%get_ncpl() + 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)) return diff --git a/src/Utilities/TimeSeries/TimeArraySeries.f90 b/src/Utilities/TimeSeries/TimeArraySeries.f90 index 34119ffa65a..9bbf23ddd9e 100644 --- a/src/Utilities/TimeSeries/TimeArraySeries.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeries.f90 @@ -3,7 +3,7 @@ module TimeArraySeriesModule use ArrayReadersModule, only: ReadArray use BlockParserModule, only: BlockParserType use ConstantsModule, only: LINELENGTH, UNDEFINED, STEPWISE, LINEAR, & - LENTIMESERIESNAME, DZERO, DONE + LENTIMESERIESNAME, LENMODELNAME, DZERO, DONE use GenericUtilitiesModule, only: is_same use InputOutputModule, only: GetUnit, openfile use KindModule, only: DP, I4B @@ -13,7 +13,6 @@ module TimeArraySeriesModule use TimeArrayModule, only: TimeArrayType, ConstructTimeArray, & AddTimeArrayToList, CastAsTimeArrayType, & GetTimeArrayFromList - use BaseDisModule, only: DisBaseType use, intrinsic :: iso_fortran_env, only: IOSTAT_END implicit none @@ -32,7 +31,7 @@ module TimeArraySeriesModule character(len=LINELENGTH), private :: dataFile = '' logical, private :: autoDeallocate = .true. type(ListType), pointer, private :: list => null() - class(DisBaseType), pointer, private :: dis => null() + character(len=LENMODELNAME) :: modelname type(BlockParserType), private :: parser contains ! -- Public procedures @@ -86,7 +85,7 @@ end subroutine ConstructTimeArraySeries ! -- Public procedures - subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) + subroutine tas_init(this, fname, modelname, iout, tasname, autoDeallocate) ! ****************************************************************************** ! tas_init -- initialize the time array series ! ****************************************************************************** @@ -96,7 +95,7 @@ subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) ! -- dummy class(TimeArraySeriesType), intent(inout) :: this character(len=*), intent(in) :: fname - class(DisBaseType), pointer, intent(inout) :: dis + character(len=*), intent(in) :: modelname integer(I4B), intent(in) :: iout character(len=*), intent(inout) :: tasname logical, optional, intent(in) :: autoDeallocate @@ -114,7 +113,7 @@ subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) allocate (this%list) ! ! -- assign members - this%dis => dis + this%modelname = modelname this%iout = iout ! ! -- open time-array series input file @@ -371,28 +370,43 @@ logical function read_next_array(this) ! ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ + ! -- modules + use ConstantsModule, only: LENMEMPATH + use MemoryManagerModule, only: mem_setptr + use MemoryHelperModule, only: create_mem_path ! -- dummy class(TimeArraySeriesType), intent(inout) :: this ! -- local integer(I4B) :: i, ierr, istart, istat, istop, lloc, nrow, ncol, nodesperlayer logical :: lopen, isFound type(TimeArrayType), pointer :: ta => null() + character(len=LENMEMPATH) :: mempath + integer(I4B), dimension(:), contiguous, & + pointer :: mshape ! ------------------------------------------------------------------------------ ! + ! -- initialize istart = 1 istat = 0 istop = 1 lloc = 1 + nullify (mshape) + ! + ! -- create mempath + mempath = create_mem_path(component=this%modelname, subcomponent='DIS') + ! + ! -- set mshape pointer + call mem_setptr(mshape, 'MSHAPE', mempath) + ! ! Get dimensions for supported discretization type - if (this%dis%supports_layers()) then - nodesperlayer = this%dis%get_ncpl() - if (size(this%dis%mshape) == 3) then - nrow = this%dis%mshape(2) - ncol = this%dis%mshape(3) - else - nrow = 1 - ncol = this%dis%mshape(2) - end if + if (size(mshape) == 2) then + nodesperlayer = mshape(2) + nrow = 1 + ncol = mshape(2) + else if (size(mshape) == 3) then + nodesperlayer = mshape(2) * mshape(3) + nrow = mshape(2) + ncol = mshape(3) else errmsg = 'Time array series is not supported for selected & &discretization type.' @@ -403,7 +417,7 @@ logical function read_next_array(this) read_next_array = .false. inquire (unit=this%inunit, opened=lopen) if (lopen) then - call ConstructTimeArray(ta, this%dis) + call ConstructTimeArray(ta, this%modelname) ! -- read a time and an array from the input file ! -- Get a TIME block and read the time call this%parser%GetBlock('TIME', isFound, ierr, & @@ -412,7 +426,7 @@ logical function read_next_array(this) ta%taTime = this%parser%GetDouble() ! -- Read the array call ReadArray(this%parser%iuactive, ta%taArray, this%Name, & - this%dis%ndim, ncol, nrow, 1, nodesperlayer, & + size(mshape), ncol, nrow, 1, nodesperlayer, & this%iout, 0, 0) ! ! -- multiply values by sfac diff --git a/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 b/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 index 46040ca4cde..562aa9d8542 100644 --- a/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 @@ -3,7 +3,7 @@ module TimeArraySeriesManagerModule use KindModule, only: DP, I4B use SimVariablesModule, only: errmsg use ConstantsModule, only: DZERO, LENTIMESERIESNAME, LINELENGTH, & - LENHUGELINE + LENHUGELINE, LENMODELNAME use ListModule, only: ListType use SimModule, only: store_error, store_error_unit use TdisModule, only: delt, totimc, kper, kstp @@ -22,7 +22,8 @@ module TimeArraySeriesManagerModule type TimeArraySeriesManagerType ! -- Public members integer(I4B), public :: iout = 0 ! output unit num - class(DisBaseType), pointer, public :: dis => null() ! pointer to dis + 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 @@ -49,7 +50,7 @@ module TimeArraySeriesManagerModule ! -- Public procedures - subroutine tasmanager_cr(this, dis, iout) + subroutine tasmanager_cr(this, dis, modelname, iout) ! ****************************************************************************** ! tasmanager_cr -- create the tasmanager ! ****************************************************************************** @@ -58,12 +59,17 @@ subroutine tasmanager_cr(this, dis, iout) ! ------------------------------------------------------------------------------ ! -- dummy type(TimeArraySeriesManagerType) :: this - class(DisBaseType), pointer :: dis + 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 - this%dis => dis allocate (this%boundTasLinks) allocate (this%tasfiles(0)) ! @@ -94,7 +100,7 @@ subroutine tasmanager_df(this) ! -- 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%dis, & + call tasptr%tas_init(this%tasfiles(i), this%modelname, & this%iout, this%tasnames(i)) end do ! @@ -413,6 +419,7 @@ subroutine tasmgr_convert_flux(this, tasLink) ! ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ + ! -- modules ! -- dummy class(TimeArraySeriesManagerType) :: this type(TimeArraySeriesLinkType), pointer, intent(inout) :: tasLink @@ -420,6 +427,13 @@ subroutine tasmgr_convert_flux(this, tasLink) 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