From 2a063b9ff01f3d95b905423e1d9f6128ff35552b Mon Sep 17 00:00:00 2001 From: Eric Morway Date: Fri, 3 Jan 2025 06:38:50 -0800 Subject: [PATCH] refactor(tsp-apt): remove gwe-specific code from apt and distribute to advanced gwe packages (#2123) * refactor(tsp-apt): remove gwe-specific code from apt and distribute to advanced gwe packages * found and fixed a couple of typos * Changes in response to https://github.com/MODFLOW-USGS/modflow6/pull/2123#discussion_r1900817099 --- doc/mf6io/mf6ivar/dfn/gwe-lke.dfn | 2 +- doc/mf6io/mf6ivar/dfn/gwe-mwe.dfn | 2 +- doc/mf6io/mf6ivar/dfn/gwe-sfe.dfn | 2 +- src/Model/GroundWaterEnergy/gwe-lke.f90 | 184 +++++++++++++++++++++++- src/Model/GroundWaterEnergy/gwe-mwe.f90 | 184 +++++++++++++++++++++++- src/Model/GroundWaterEnergy/gwe-sfe.f90 | 184 +++++++++++++++++++++++- src/Model/TransportModel/tsp-apt.f90 | 24 ---- 7 files changed, 549 insertions(+), 33 deletions(-) diff --git a/doc/mf6io/mf6ivar/dfn/gwe-lke.dfn b/doc/mf6io/mf6ivar/dfn/gwe-lke.dfn index 6ddb8288739..1463b9e79fa 100644 --- a/doc/mf6io/mf6ivar/dfn/gwe-lke.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwe-lke.dfn @@ -294,7 +294,7 @@ tagged false in_record true reader urword longname boundary thermal conductivity -description is the thermal conductivity of the of the interface between the aquifer cell and the lake. +description is the thermal conductivity of the material between the aquifer cell and the lake. The thickness of the material is defined by the variable RBTHCND. block packagedata name rbthcnd diff --git a/doc/mf6io/mf6ivar/dfn/gwe-mwe.dfn b/doc/mf6io/mf6ivar/dfn/gwe-mwe.dfn index 2aaea0ca537..e08f06ea081 100644 --- a/doc/mf6io/mf6ivar/dfn/gwe-mwe.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwe-mwe.dfn @@ -294,7 +294,7 @@ tagged false in_record true reader urword longname thermal conductivity of the feature -description is the thermal conductivity of the interface between the aquifer cell and the feature. +description is the thermal conductivity of the material between the aquifer cell and the feature. The thickness of the material is defined by the variable FTHK. block packagedata name fthk diff --git a/doc/mf6io/mf6ivar/dfn/gwe-sfe.dfn b/doc/mf6io/mf6ivar/dfn/gwe-sfe.dfn index b356f7f9a3f..a5367c289b1 100644 --- a/doc/mf6io/mf6ivar/dfn/gwe-sfe.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwe-sfe.dfn @@ -294,7 +294,7 @@ tagged false in_record true reader urword longname boundary thermal conductivity -description is the thermal conductivity of the of the interface between the aquifer cell and the stream reach. +description is the thermal conductivity of the material between the aquifer cell and the stream reach. The thickness of the material is defined by the variable RBTHCND. block packagedata name rbthcnd diff --git a/src/Model/GroundWaterEnergy/gwe-lke.f90 b/src/Model/GroundWaterEnergy/gwe-lke.f90 index ce2b3866ac0..b85b9d91ba5 100644 --- a/src/Model/GroundWaterEnergy/gwe-lke.f90 +++ b/src/Model/GroundWaterEnergy/gwe-lke.f90 @@ -34,8 +34,9 @@ module GweLkeModule use KindModule, only: DP, I4B - use ConstantsModule, only: DZERO, DONE, LINELENGTH - use SimModule, only: store_error + use ConstantsModule, only: DZERO, DONE, LINELENGTH, LENBOUNDNAME, DEP20 + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, count_errors use BndModule, only: BndType, GetBndFromList use TspFmiModule, only: TspFmiType use LakModule, only: LakType @@ -69,6 +70,8 @@ module GweLkeModule real(DP), dimension(:), pointer, contiguous :: tempevap => null() ! evaporation temperature real(DP), dimension(:), pointer, contiguous :: temproff => null() ! runoff temperature real(DP), dimension(:), pointer, contiguous :: tempiflw => null() ! inflow temperature + real(DP), dimension(:), pointer, contiguous :: ktf => null() !< thermal conductivity between the lke and groundwater cell + real(DP), dimension(:), pointer, contiguous :: rfeatthk => null() !< thickness of lakebed material through which thermal conduction occurs contains @@ -91,6 +94,7 @@ module GweLkeModule procedure :: pak_rp_obs => lke_rp_obs procedure :: pak_bd_obs => lke_bd_obs procedure :: pak_set_stressperiod => lke_set_stressperiod + procedure :: apt_read_cvs => lke_read_cvs end type GweLkeType @@ -785,6 +789,10 @@ subroutine lke_da(this) call mem_deallocate(this%temproff) call mem_deallocate(this%tempiflw) ! + ! -- Deallocate arrays + call mem_deallocate(this%ktf) + call mem_deallocate(this%rfeatthk) + ! ! -- Deallocate scalars in TspAptType call this%TspAptType%bnd_da() end subroutine lke_da @@ -1178,4 +1186,176 @@ subroutine lke_set_stressperiod(this, itemno, keyword, found) 999 continue end subroutine lke_set_stressperiod + !> @brief Read feature information for this advanced package + !< + subroutine lke_read_cvs(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use TimeSeriesManagerModule, only: read_value_or_time_series_adv + ! -- dummy + class(GweLkeType), intent(inout) :: this + ! -- local + character(len=LINELENGTH) :: text + character(len=LENBOUNDNAME) :: bndName, bndNameTemp + character(len=9) :: cno + character(len=50), dimension(:), allocatable :: caux + integer(I4B) :: ierr + logical :: isfound, endOfBlock + integer(I4B) :: n + integer(I4B) :: ii, jj + integer(I4B) :: iaux + integer(I4B) :: itmp + integer(I4B) :: nlak + integer(I4B) :: nconn + integer(I4B), dimension(:), pointer, contiguous :: nboundchk + real(DP), pointer :: bndElem => null() + ! + ! -- initialize itmp + itmp = 0 + ! + ! -- allocate apt data + call mem_allocate(this%strt, this%ncv, 'STRT', this%memoryPath) + call mem_allocate(this%ktf, this%ncv, 'KTF', this%memoryPath) + call mem_allocate(this%rfeatthk, this%ncv, 'RFEATTHK', this%memoryPath) + call mem_allocate(this%lauxvar, this%naux, this%ncv, 'LAUXVAR', & + this%memoryPath) + ! + ! -- lake boundary and concentrations + if (this%imatrows == 0) then + call mem_allocate(this%iboundpak, this%ncv, 'IBOUND', this%memoryPath) + call mem_allocate(this%xnewpak, this%ncv, 'XNEWPAK', this%memoryPath) + end if + call mem_allocate(this%xoldpak, this%ncv, 'XOLDPAK', this%memoryPath) + ! + ! -- allocate character storage not managed by the memory manager + allocate (this%featname(this%ncv)) ! ditch after boundnames allocated?? + !allocate(this%status(this%ncv)) + ! + do n = 1, this%ncv + this%strt(n) = DEP20 + this%ktf(n) = DZERO + this%rfeatthk(n) = DZERO + this%lauxvar(:, n) = DZERO + this%xoldpak(n) = DEP20 + if (this%imatrows == 0) then + this%iboundpak(n) = 1 + this%xnewpak(n) = DEP20 + end if + end do + ! + ! -- allocate local storage for aux variables + if (this%naux > 0) then + allocate (caux(this%naux)) + end if + ! + ! -- allocate and initialize temporary variables + allocate (nboundchk(this%ncv)) + do n = 1, this%ncv + nboundchk(n) = 0 + end do + ! + ! -- get packagedata block + call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, & + supportOpenClose=.true.) + ! + ! -- parse locations block if detected + if (isfound) then + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// & + ' PACKAGEDATA' + nlak = 0 + nconn = 0 + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + n = this%parser%GetInteger() + + if (n < 1 .or. n > this%ncv) then + write (errmsg, '(a,1x,i6)') & + 'Itemno must be > 0 and <= ', this%ncv + call store_error(errmsg) + cycle + end if + ! + ! -- increment nboundchk + nboundchk(n) = nboundchk(n) + 1 + ! + ! -- strt + this%strt(n) = this%parser%GetDouble() + ! + ! -- read additional thermal conductivity terms + this%ktf(n) = this%parser%GetDouble() + this%rfeatthk(n) = this%parser%GetDouble() + if (this%rfeatthk(n) <= DZERO) then + write (errmsg, '(4x,a)') & + '****ERROR. Specified thickness used for thermal & + &conduction MUST BE > 0 else divide by zero error occurs' + call store_error(errmsg) + cycle + end if + ! + ! -- get aux data + do iaux = 1, this%naux + call this%parser%GetString(caux(iaux)) + end do + + ! -- set default bndName + write (cno, '(i9.9)') n + bndName = 'Feature'//cno + + ! -- featname + if (this%inamedbound /= 0) then + call this%parser%GetStringCaps(bndNameTemp) + if (bndNameTemp /= '') then + bndName = bndNameTemp + end if + end if + this%featname(n) = bndName + + ! -- fill time series aware data + ! -- fill aux data + do jj = 1, this%naux + text = caux(jj) + ii = n + bndElem => this%lauxvar(jj, ii) + call read_value_or_time_series_adv(text, ii, jj, bndElem, & + this%packName, 'AUX', & + this%tsManager, this%iprpak, & + this%auxname(jj)) + end do + ! + nlak = nlak + 1 + end do + ! + ! -- check for duplicate or missing lakes + do n = 1, this%ncv + if (nboundchk(n) == 0) then + write (errmsg, '(a,1x,i0)') 'No data specified for feature', n + call store_error(errmsg) + else if (nboundchk(n) > 1) then + write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') & + 'Data for feature', n, 'specified', nboundchk(n), 'times' + call store_error(errmsg) + end if + end do + ! + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' PACKAGEDATA' + else + call store_error('Required packagedata block not found.') + end if + ! + ! -- terminate if any errors were detected + if (count_errors() > 0) then + call this%parser%StoreErrorUnit() + end if + ! + ! -- deallocate local storage for aux variables + if (this%naux > 0) then + deallocate (caux) + end if + ! + ! -- deallocate local storage for nboundchk + deallocate (nboundchk) + end subroutine lke_read_cvs + end module GweLkeModule diff --git a/src/Model/GroundWaterEnergy/gwe-mwe.f90 b/src/Model/GroundWaterEnergy/gwe-mwe.f90 index 15fbe76a004..a7723fd7ced 100644 --- a/src/Model/GroundWaterEnergy/gwe-mwe.f90 +++ b/src/Model/GroundWaterEnergy/gwe-mwe.f90 @@ -35,8 +35,9 @@ module GweMweModule use KindModule, only: DP, I4B - use ConstantsModule, only: DZERO, LINELENGTH - use SimModule, only: store_error + use ConstantsModule, only: DZERO, LINELENGTH, LENBOUNDNAME, DEP20 + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, count_errors use BndModule, only: BndType, GetBndFromList use TspFmiModule, only: TspFmiType use MawModule, only: MawType @@ -63,6 +64,8 @@ module GweMweModule integer(I4B), pointer :: idxbudrtmv => null() ! index of rate to mover terms in flowbudptr integer(I4B), pointer :: idxbudfrtm => null() ! index of flowing well rate to mover terms in flowbudptr integer(I4B), pointer :: idxbudmwcd => null() ! index of well bore conduction terms in flowbudptr + real(DP), dimension(:), pointer, contiguous :: ktf => null() !< thermal conductivity between the sfe and groundwater cell + real(DP), dimension(:), pointer, contiguous :: rfeatthk => null() !< thickness of streambed material through which thermal conduction occurs real(DP), dimension(:), pointer, contiguous :: temprate => null() ! well rate temperature contains @@ -84,6 +87,7 @@ module GweMweModule procedure :: pak_rp_obs => mwe_rp_obs procedure :: pak_bd_obs => mwe_bd_obs procedure :: pak_set_stressperiod => mwe_set_stressperiod + procedure :: apt_read_cvs => mwe_read_cvs end type GweMweType @@ -682,6 +686,10 @@ subroutine mwe_da(this) ! -- Deallocate time series call mem_deallocate(this%temprate) ! + ! -- Deallocate arrays + call mem_deallocate(this%ktf) + call mem_deallocate(this%rfeatthk) + ! ! -- Deallocate scalars in TspAptType call this%TspAptType%bnd_da() end subroutine mwe_da @@ -961,4 +969,176 @@ subroutine mwe_set_stressperiod(this, itemno, keyword, found) 999 continue end subroutine mwe_set_stressperiod + !> @brief Read feature information for this advanced package + !< + subroutine mwe_read_cvs(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use TimeSeriesManagerModule, only: read_value_or_time_series_adv + ! -- dummy + class(GweMweType), intent(inout) :: this + ! -- local + character(len=LINELENGTH) :: text + character(len=LENBOUNDNAME) :: bndName, bndNameTemp + character(len=9) :: cno + character(len=50), dimension(:), allocatable :: caux + integer(I4B) :: ierr + logical :: isfound, endOfBlock + integer(I4B) :: n + integer(I4B) :: ii, jj + integer(I4B) :: iaux + integer(I4B) :: itmp + integer(I4B) :: nlak + integer(I4B) :: nconn + integer(I4B), dimension(:), pointer, contiguous :: nboundchk + real(DP), pointer :: bndElem => null() + ! + ! -- initialize itmp + itmp = 0 + ! + ! -- allocate apt data + call mem_allocate(this%strt, this%ncv, 'STRT', this%memoryPath) + call mem_allocate(this%ktf, this%ncv, 'KTF', this%memoryPath) + call mem_allocate(this%rfeatthk, this%ncv, 'RFEATTHK', this%memoryPath) + call mem_allocate(this%lauxvar, this%naux, this%ncv, 'LAUXVAR', & + this%memoryPath) + ! + ! -- lake boundary and concentrations + if (this%imatrows == 0) then + call mem_allocate(this%iboundpak, this%ncv, 'IBOUND', this%memoryPath) + call mem_allocate(this%xnewpak, this%ncv, 'XNEWPAK', this%memoryPath) + end if + call mem_allocate(this%xoldpak, this%ncv, 'XOLDPAK', this%memoryPath) + ! + ! -- allocate character storage not managed by the memory manager + allocate (this%featname(this%ncv)) ! ditch after boundnames allocated?? + !allocate(this%status(this%ncv)) + ! + do n = 1, this%ncv + this%strt(n) = DEP20 + this%ktf(n) = DZERO + this%rfeatthk(n) = DZERO + this%lauxvar(:, n) = DZERO + this%xoldpak(n) = DEP20 + if (this%imatrows == 0) then + this%iboundpak(n) = 1 + this%xnewpak(n) = DEP20 + end if + end do + ! + ! -- allocate local storage for aux variables + if (this%naux > 0) then + allocate (caux(this%naux)) + end if + ! + ! -- allocate and initialize temporary variables + allocate (nboundchk(this%ncv)) + do n = 1, this%ncv + nboundchk(n) = 0 + end do + ! + ! -- get packagedata block + call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, & + supportOpenClose=.true.) + ! + ! -- parse locations block if detected + if (isfound) then + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// & + ' PACKAGEDATA' + nlak = 0 + nconn = 0 + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + n = this%parser%GetInteger() + + if (n < 1 .or. n > this%ncv) then + write (errmsg, '(a,1x,i6)') & + 'Itemno must be > 0 and <= ', this%ncv + call store_error(errmsg) + cycle + end if + ! + ! -- increment nboundchk + nboundchk(n) = nboundchk(n) + 1 + ! + ! -- strt + this%strt(n) = this%parser%GetDouble() + ! + ! -- read additional thermal conductivity terms + this%ktf(n) = this%parser%GetDouble() + this%rfeatthk(n) = this%parser%GetDouble() + if (this%rfeatthk(n) <= DZERO) then + write (errmsg, '(4x,a)') & + '****ERROR. Specified thickness used for thermal & + &conduction MUST BE > 0 else divide by zero error occurs' + call store_error(errmsg) + cycle + end if + ! + ! -- get aux data + do iaux = 1, this%naux + call this%parser%GetString(caux(iaux)) + end do + + ! -- set default bndName + write (cno, '(i9.9)') n + bndName = 'Feature'//cno + + ! -- featname + if (this%inamedbound /= 0) then + call this%parser%GetStringCaps(bndNameTemp) + if (bndNameTemp /= '') then + bndName = bndNameTemp + end if + end if + this%featname(n) = bndName + + ! -- fill time series aware data + ! -- fill aux data + do jj = 1, this%naux + text = caux(jj) + ii = n + bndElem => this%lauxvar(jj, ii) + call read_value_or_time_series_adv(text, ii, jj, bndElem, & + this%packName, 'AUX', & + this%tsManager, this%iprpak, & + this%auxname(jj)) + end do + ! + nlak = nlak + 1 + end do + ! + ! -- check for duplicate or missing lakes + do n = 1, this%ncv + if (nboundchk(n) == 0) then + write (errmsg, '(a,1x,i0)') 'No data specified for feature', n + call store_error(errmsg) + else if (nboundchk(n) > 1) then + write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') & + 'Data for feature', n, 'specified', nboundchk(n), 'times' + call store_error(errmsg) + end if + end do + ! + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' PACKAGEDATA' + else + call store_error('Required packagedata block not found.') + end if + ! + ! -- terminate if any errors were detected + if (count_errors() > 0) then + call this%parser%StoreErrorUnit() + end if + ! + ! -- deallocate local storage for aux variables + if (this%naux > 0) then + deallocate (caux) + end if + ! + ! -- deallocate local storage for nboundchk + deallocate (nboundchk) + end subroutine mwe_read_cvs + end module GweMweModule diff --git a/src/Model/GroundWaterEnergy/gwe-sfe.f90 b/src/Model/GroundWaterEnergy/gwe-sfe.f90 index 507737a57d5..839c7ec4f16 100644 --- a/src/Model/GroundWaterEnergy/gwe-sfe.f90 +++ b/src/Model/GroundWaterEnergy/gwe-sfe.f90 @@ -34,8 +34,9 @@ module GweSfeModule use KindModule, only: DP, I4B - use ConstantsModule, only: DZERO, DONE, LINELENGTH - use SimModule, only: store_error + use ConstantsModule, only: DZERO, DONE, LINELENGTH, LENBOUNDNAME, DEP20 + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, count_errors use BndModule, only: BndType, GetBndFromList use TspFmiModule, only: TspFmiType use SfrModule, only: SfrType @@ -69,6 +70,8 @@ module GweSfeModule real(DP), dimension(:), pointer, contiguous :: tempevap => null() !< evaporation temperature real(DP), dimension(:), pointer, contiguous :: temproff => null() !< runoff temperature real(DP), dimension(:), pointer, contiguous :: tempiflw => null() !< inflow temperature + real(DP), dimension(:), pointer, contiguous :: ktf => null() !< thermal conductivity between the sfe and groundwater cell + real(DP), dimension(:), pointer, contiguous :: rfeatthk => null() !< thickness of streambed material through which thermal conduction occurs contains @@ -90,6 +93,7 @@ module GweSfeModule procedure :: pak_rp_obs => sfe_rp_obs procedure :: pak_bd_obs => sfe_bd_obs procedure :: pak_set_stressperiod => sfe_set_stressperiod + procedure :: apt_read_cvs => sfe_read_cvs end type GweSfeType @@ -737,6 +741,10 @@ subroutine sfe_da(this) call mem_deallocate(this%temproff) call mem_deallocate(this%tempiflw) ! + ! -- Deallocate arrays + call mem_deallocate(this%ktf) + call mem_deallocate(this%rfeatthk) + ! ! -- Deallocate scalars in TspAptType call this%TspAptType%bnd_da() end subroutine sfe_da @@ -1089,4 +1097,176 @@ subroutine sfe_set_stressperiod(this, itemno, keyword, found) 999 continue end subroutine sfe_set_stressperiod + !> @brief Read feature information for this advanced package + !< + subroutine sfe_read_cvs(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use TimeSeriesManagerModule, only: read_value_or_time_series_adv + ! -- dummy + class(GweSfeType), intent(inout) :: this + ! -- local + character(len=LINELENGTH) :: text + character(len=LENBOUNDNAME) :: bndName, bndNameTemp + character(len=9) :: cno + character(len=50), dimension(:), allocatable :: caux + integer(I4B) :: ierr + logical :: isfound, endOfBlock + integer(I4B) :: n + integer(I4B) :: ii, jj + integer(I4B) :: iaux + integer(I4B) :: itmp + integer(I4B) :: nlak + integer(I4B) :: nconn + integer(I4B), dimension(:), pointer, contiguous :: nboundchk + real(DP), pointer :: bndElem => null() + ! + ! -- initialize itmp + itmp = 0 + ! + ! -- allocate apt data + call mem_allocate(this%strt, this%ncv, 'STRT', this%memoryPath) + call mem_allocate(this%ktf, this%ncv, 'KTF', this%memoryPath) + call mem_allocate(this%rfeatthk, this%ncv, 'RFEATTHK', this%memoryPath) + call mem_allocate(this%lauxvar, this%naux, this%ncv, 'LAUXVAR', & + this%memoryPath) + ! + ! -- lake boundary and concentrations + if (this%imatrows == 0) then + call mem_allocate(this%iboundpak, this%ncv, 'IBOUND', this%memoryPath) + call mem_allocate(this%xnewpak, this%ncv, 'XNEWPAK', this%memoryPath) + end if + call mem_allocate(this%xoldpak, this%ncv, 'XOLDPAK', this%memoryPath) + ! + ! -- allocate character storage not managed by the memory manager + allocate (this%featname(this%ncv)) ! ditch after boundnames allocated?? + !allocate(this%status(this%ncv)) + ! + do n = 1, this%ncv + this%strt(n) = DEP20 + this%ktf(n) = DZERO + this%rfeatthk(n) = DZERO + this%lauxvar(:, n) = DZERO + this%xoldpak(n) = DEP20 + if (this%imatrows == 0) then + this%iboundpak(n) = 1 + this%xnewpak(n) = DEP20 + end if + end do + ! + ! -- allocate local storage for aux variables + if (this%naux > 0) then + allocate (caux(this%naux)) + end if + ! + ! -- allocate and initialize temporary variables + allocate (nboundchk(this%ncv)) + do n = 1, this%ncv + nboundchk(n) = 0 + end do + ! + ! -- get packagedata block + call this%parser%GetBlock('PACKAGEDATA', isfound, ierr, & + supportOpenClose=.true.) + ! + ! -- parse locations block if detected + if (isfound) then + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text))// & + ' PACKAGEDATA' + nlak = 0 + nconn = 0 + do + call this%parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + n = this%parser%GetInteger() + + if (n < 1 .or. n > this%ncv) then + write (errmsg, '(a,1x,i6)') & + 'Itemno must be > 0 and <= ', this%ncv + call store_error(errmsg) + cycle + end if + ! + ! -- increment nboundchk + nboundchk(n) = nboundchk(n) + 1 + ! + ! -- strt + this%strt(n) = this%parser%GetDouble() + ! + ! -- read additional thermal conductivity terms + this%ktf(n) = this%parser%GetDouble() + this%rfeatthk(n) = this%parser%GetDouble() + if (this%rfeatthk(n) <= DZERO) then + write (errmsg, '(4x,a)') & + '****ERROR. Specified thickness used for thermal & + &conduction MUST BE > 0 else divide by zero error occurs' + call store_error(errmsg) + cycle + end if + ! + ! -- get aux data + do iaux = 1, this%naux + call this%parser%GetString(caux(iaux)) + end do + + ! -- set default bndName + write (cno, '(i9.9)') n + bndName = 'Feature'//cno + + ! -- featname + if (this%inamedbound /= 0) then + call this%parser%GetStringCaps(bndNameTemp) + if (bndNameTemp /= '') then + bndName = bndNameTemp + end if + end if + this%featname(n) = bndName + + ! -- fill time series aware data + ! -- fill aux data + do jj = 1, this%naux + text = caux(jj) + ii = n + bndElem => this%lauxvar(jj, ii) + call read_value_or_time_series_adv(text, ii, jj, bndElem, & + this%packName, 'AUX', & + this%tsManager, this%iprpak, & + this%auxname(jj)) + end do + ! + nlak = nlak + 1 + end do + ! + ! -- check for duplicate or missing lakes + do n = 1, this%ncv + if (nboundchk(n) == 0) then + write (errmsg, '(a,1x,i0)') 'No data specified for feature', n + call store_error(errmsg) + else if (nboundchk(n) > 1) then + write (errmsg, '(a,1x,i0,1x,a,1x,i0,1x,a)') & + 'Data for feature', n, 'specified', nboundchk(n), 'times' + call store_error(errmsg) + end if + end do + ! + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' PACKAGEDATA' + else + call store_error('Required packagedata block not found.') + end if + ! + ! -- terminate if any errors were detected + if (count_errors() > 0) then + call this%parser%StoreErrorUnit() + end if + ! + ! -- deallocate local storage for aux variables + if (this%naux > 0) then + deallocate (caux) + end if + ! + ! -- deallocate local storage for nboundchk + deallocate (nboundchk) + end subroutine sfe_read_cvs + end module GweSfeModule diff --git a/src/Model/TransportModel/tsp-apt.f90 b/src/Model/TransportModel/tsp-apt.f90 index bfaeee35317..a420af703d7 100644 --- a/src/Model/TransportModel/tsp-apt.f90 +++ b/src/Model/TransportModel/tsp-apt.f90 @@ -79,8 +79,6 @@ module TspAptModule integer(I4B), pointer :: idxprepak => null() !< budget-object index that precedes package-specific budget objects integer(I4B), pointer :: idxlastpak => null() !< budget-object index of last package-specific budget object real(DP), dimension(:), pointer, contiguous :: strt => null() !< starting feature concentration (or temperature) - real(DP), dimension(:), pointer, contiguous :: ktf => null() !< thermal conductivity between the apt and groundwater cell - real(DP), dimension(:), pointer, contiguous :: rfeatthk => null() !< thickness of streambed/lakebed/filter-pack material through which thermal conduction occurs integer(I4B), dimension(:), pointer, contiguous :: idxlocnode => null() !< map position in global rhs and x array of pack entry integer(I4B), dimension(:), pointer, contiguous :: idxpakdiag => null() !< map diag position of feature in global amat integer(I4B), dimension(:), pointer, contiguous :: idxdglo => null() !< map position in global array of package diagonal row entries @@ -1236,8 +1234,6 @@ subroutine apt_da(this) call mem_deallocate(this%qsto) call mem_deallocate(this%ccterm) call mem_deallocate(this%strt) - call mem_deallocate(this%ktf) - call mem_deallocate(this%rfeatthk) call mem_deallocate(this%lauxvar) call mem_deallocate(this%xoldpak) if (this%imatrows == 0) then @@ -1498,8 +1494,6 @@ subroutine apt_read_cvs(this) ! ! -- allocate apt data call mem_allocate(this%strt, this%ncv, 'STRT', this%memoryPath) - call mem_allocate(this%ktf, this%ncv, 'KTF', this%memoryPath) - call mem_allocate(this%rfeatthk, this%ncv, 'RFEATTHK', this%memoryPath) call mem_allocate(this%lauxvar, this%naux, this%ncv, 'LAUXVAR', & this%memoryPath) ! @@ -1516,8 +1510,6 @@ subroutine apt_read_cvs(this) ! do n = 1, this%ncv this%strt(n) = DEP20 - this%ktf(n) = DZERO - this%rfeatthk(n) = DZERO this%lauxvar(:, n) = DZERO this%xoldpak(n) = DEP20 if (this%imatrows == 0) then @@ -1565,22 +1557,6 @@ subroutine apt_read_cvs(this) ! -- strt this%strt(n) = this%parser%GetDouble() ! - ! -- If GWE model, read additional thermal conductivity terms - if (this%depvartype == 'TEMPERATURE') then - ! -- Skip for UZE - if (trim(adjustl(this%text)) /= 'UZE') then - this%ktf(n) = this%parser%GetDouble() - this%rfeatthk(n) = this%parser%GetDouble() - if (this%rfeatthk(n) <= DZERO) then - write (errmsg, '(4x,a)') & - '****ERROR. Specified thickness used for thermal & - &conduction MUST BE > 0 else divide by zero error occurs' - call store_error(errmsg) - cycle - end if - end if - end if - ! ! -- get aux data do iaux = 1, this%naux call this%parser%GetString(caux(iaux))