diff --git a/src/Model/GroundWaterFlow/gwf3.f90 b/src/Model/GroundWaterFlow/gwf3.f90 index 6835e6c7171..3f17c8bc77c 100644 --- a/src/Model/GroundWaterFlow/gwf3.f90 +++ b/src/Model/GroundWaterFlow/gwf3.f90 @@ -792,7 +792,7 @@ subroutine gwf_cq(this, icnvg, isuppress_output) ! head solution. do ip = 1, this%bndlist%Count() packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_cf(reset_mover=.false.) + call packobj%bnd_cf() if (this%inbuy > 0) call this%buy%buy_cf_bnd(packobj, this%x) call packobj%bnd_cq(this%x, this%flowja) end do diff --git a/src/Model/GroundWaterFlow/gwf3drn8.f90 b/src/Model/GroundWaterFlow/gwf3drn8.f90 index 7b3090a7f26..631cb81fb83 100644 --- a/src/Model/GroundWaterFlow/gwf3drn8.f90 +++ b/src/Model/GroundWaterFlow/gwf3drn8.f90 @@ -382,7 +382,7 @@ subroutine drn_ck(this) return end subroutine drn_ck - subroutine drn_cf(this, reset_mover) + subroutine drn_cf(this) ! ****************************************************************************** ! drn_cf -- Formulate the HCOF and RHS terms ! Subroutine: (1) skip if no drains @@ -393,26 +393,17 @@ subroutine drn_cf(this, reset_mover) ! ------------------------------------------------------------------------------ ! -- dummy class(DrnType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i integer(I4B) :: node real(DP) :: cdrn real(DP) :: drnbot real(DP) :: fact - logical :: lrm ! ------------------------------------------------------------------------------ ! ! -- Return if no drains if (this%nbound == 0) return ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each drn entry do i = 1, this%nbound node = this%nodelist(i) diff --git a/src/Model/GroundWaterFlow/gwf3evt8.f90 b/src/Model/GroundWaterFlow/gwf3evt8.f90 index f3efa402208..ffc03d02eb9 100644 --- a/src/Model/GroundWaterFlow/gwf3evt8.f90 +++ b/src/Model/GroundWaterFlow/gwf3evt8.f90 @@ -568,7 +568,7 @@ subroutine set_nodesontop(this) return end subroutine set_nodesontop - subroutine evt_cf(this, reset_mover) + subroutine evt_cf(this) ! ****************************************************************************** ! evt_cf -- Formulate the HCOF and RHS terms ! ****************************************************************************** @@ -577,7 +577,6 @@ subroutine evt_cf(this, reset_mover) ! ------------------------------------------------------------------------------ ! -- dummy class(EvtType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, iseg, node integer(I4B) :: idxdepth, idxrate diff --git a/src/Model/GroundWaterFlow/gwf3ghb8.f90 b/src/Model/GroundWaterFlow/gwf3ghb8.f90 index a7e3f696455..06a8cce5296 100644 --- a/src/Model/GroundWaterFlow/gwf3ghb8.f90 +++ b/src/Model/GroundWaterFlow/gwf3ghb8.f90 @@ -280,7 +280,7 @@ subroutine ghb_ck(this) return end subroutine ghb_ck - subroutine ghb_cf(this, reset_mover) + subroutine ghb_cf(this) ! ****************************************************************************** ! ghb_cf -- Formulate the HCOF and RHS terms ! Subroutine: (1) skip if no ghbs @@ -291,22 +291,13 @@ subroutine ghb_cf(this, reset_mover) ! ------------------------------------------------------------------------------ ! -- dummy class(GhbType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, node - logical :: lrm ! ------------------------------------------------------------------------------ ! ! -- Return if no ghbs if (this%nbound .eq. 0) return ! - ! -- packmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each ghb entry do i = 1, this%nbound node = this%nodelist(i) diff --git a/src/Model/GroundWaterFlow/gwf3lak8.f90 b/src/Model/GroundWaterFlow/gwf3lak8.f90 index fbaac89658d..aa131fa7ea8 100644 --- a/src/Model/GroundWaterFlow/gwf3lak8.f90 +++ b/src/Model/GroundWaterFlow/gwf3lak8.f90 @@ -3841,7 +3841,7 @@ subroutine lak_ad(this) return end subroutine lak_ad - subroutine lak_cf(this, reset_mover) + subroutine lak_cf(this) ! ****************************************************************************** ! lak_cf -- Formulate the HCOF and RHS terms ! Subroutine: (1) skip if no lakes @@ -3852,12 +3852,10 @@ subroutine lak_cf(this, reset_mover) ! ------------------------------------------------------------------------------ ! -- dummy class(LakType) :: this - logical(LGP), intent(in), optional :: reset_mover ! -- local integer(I4B) :: j, n integer(I4B) :: igwfnode real(DP) :: hlak, blak - logical(LGP) :: lrm ! ------------------------------------------------------------------------------ !! !! -- Calculate lak conductance and update package RHS and HCOF @@ -3874,13 +3872,6 @@ subroutine lak_cf(this, reset_mover) call this%lak_calculate_exchange(n, this%s0(n), this%qgwf0(n)) end do ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- find highest active cell do n = 1, this%nlakes do j = this%idxlakeconn(n), this%idxlakeconn(n + 1) - 1 diff --git a/src/Model/GroundWaterFlow/gwf3maw8.f90 b/src/Model/GroundWaterFlow/gwf3maw8.f90 index 59c79e205c6..63d08913f1d 100644 --- a/src/Model/GroundWaterFlow/gwf3maw8.f90 +++ b/src/Model/GroundWaterFlow/gwf3maw8.f90 @@ -2279,7 +2279,7 @@ subroutine maw_ad(this) return end subroutine maw_ad - subroutine maw_cf(this, reset_mover) + subroutine maw_cf(this) ! ****************************************************************************** ! maw_cf -- Formulate the HCOF and RHS terms ! Subroutine: (1) skip if no multi-aquifer wells @@ -2290,21 +2290,12 @@ subroutine maw_cf(this, reset_mover) ! ------------------------------------------------------------------------------ ! -- dummy class(MawType) :: this - logical, intent(in), optional :: reset_mover ! -- local - logical :: lrm ! ------------------------------------------------------------------------------ ! ! -- Calculate maw conductance and update package RHS and HCOF call this%maw_cfupdate() ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Return return end subroutine maw_cf diff --git a/src/Model/GroundWaterFlow/gwf3rch8.f90 b/src/Model/GroundWaterFlow/gwf3rch8.f90 index 5656350df6d..cc028332757 100644 --- a/src/Model/GroundWaterFlow/gwf3rch8.f90 +++ b/src/Model/GroundWaterFlow/gwf3rch8.f90 @@ -369,7 +369,7 @@ subroutine set_nodesontop(this) return end subroutine set_nodesontop - subroutine rch_cf(this, reset_mover) + subroutine rch_cf(this) ! ****************************************************************************** ! rch_cf -- Formulate the HCOF and RHS terms ! Subroutine: (1) skip if no recharge @@ -380,7 +380,6 @@ subroutine rch_cf(this, reset_mover) ! ------------------------------------------------------------------------------ ! -- dummy class(rchtype) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, node ! ------------------------------------------------------------------------------ diff --git a/src/Model/GroundWaterFlow/gwf3riv8.f90 b/src/Model/GroundWaterFlow/gwf3riv8.f90 index 7033f91c3ac..6e15b73ec15 100644 --- a/src/Model/GroundWaterFlow/gwf3riv8.f90 +++ b/src/Model/GroundWaterFlow/gwf3riv8.f90 @@ -303,7 +303,7 @@ subroutine riv_ck(this) return end subroutine riv_ck - subroutine riv_cf(this, reset_mover) + subroutine riv_cf(this) ! ****************************************************************************** ! riv_cf -- Formulate the HCOF and RHS terms ! Subroutine: (1) skip in no rivs @@ -314,23 +314,14 @@ subroutine riv_cf(this, reset_mover) ! ------------------------------------------------------------------------------ ! -- dummy class(RivType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, node real(DP) :: hriv, criv, rbot - logical :: lrm ! ------------------------------------------------------------------------------ ! ! -- Return if no rivs if (this%nbound .eq. 0) return ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each riv entry do i = 1, this%nbound node = this%nodelist(i) diff --git a/src/Model/GroundWaterFlow/gwf3sfr8.f90 b/src/Model/GroundWaterFlow/gwf3sfr8.f90 index ab21074fbdf..ed0af1010fb 100644 --- a/src/Model/GroundWaterFlow/gwf3sfr8.f90 +++ b/src/Model/GroundWaterFlow/gwf3sfr8.f90 @@ -1955,14 +1955,12 @@ end subroutine sfr_ad !! added to the coefficient matrix and right-hand side vector. !! !< - subroutine sfr_cf(this, reset_mover) + subroutine sfr_cf(this) ! -- dummy variables class(SfrType) :: this !< SfrType object - logical(LGP), intent(in), optional :: reset_mover !< boolean for resetting mover ! -- local variables integer(I4B) :: n integer(I4B) :: igwfnode - logical(LGP) :: lrm ! ! -- return if no sfr reaches if (this%nbound == 0) return @@ -1979,13 +1977,6 @@ subroutine sfr_cf(this, reset_mover) this%nodelist(n) = igwfnode end do ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- return return end subroutine sfr_cf diff --git a/src/Model/GroundWaterFlow/gwf3uzf8.f90 b/src/Model/GroundWaterFlow/gwf3uzf8.f90 index 3c1202787f9..a688c277208 100644 --- a/src/Model/GroundWaterFlow/gwf3uzf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3uzf8.f90 @@ -1069,7 +1069,7 @@ subroutine uzf_ad(this) return end subroutine uzf_ad - subroutine uzf_cf(this, reset_mover) + subroutine uzf_cf(this) ! ****************************************************************************** ! uzf_cf -- Formulate the HCOF and RHS terms ! Subroutine: (1) skip if no UZF cells @@ -1081,10 +1081,8 @@ subroutine uzf_cf(this, reset_mover) ! -- modules ! -- dummy class(UzfType) :: this - logical, intent(in), optional :: reset_mover ! -- locals integer(I4B) :: n - logical :: lrm ! ------------------------------------------------------------------------------ ! ! -- Return if no UZF cells @@ -1098,13 +1096,6 @@ subroutine uzf_cf(this, reset_mover) this%gwd0(n) = this%gwd(n) end do ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- return return end subroutine uzf_cf diff --git a/src/Model/GroundWaterFlow/gwf3wel8.f90 b/src/Model/GroundWaterFlow/gwf3wel8.f90 index 76eb3ccc785..b92c71f447b 100644 --- a/src/Model/GroundWaterFlow/gwf3wel8.f90 +++ b/src/Model/GroundWaterFlow/gwf3wel8.f90 @@ -316,10 +316,9 @@ end subroutine wel_rp !! added to the coefficient matrix and right-hand side vector. !! !< - subroutine wel_cf(this, reset_mover) + subroutine wel_cf(this) ! -- dummy variables class(WelType) :: this !< WelType object - logical, intent(in), optional :: reset_mover !< boolean for resetting mover ! -- local variables integer(I4B) :: i, node, ict real(DP) :: qmult @@ -327,18 +326,10 @@ subroutine wel_cf(this, reset_mover) real(DP) :: tp real(DP) :: bt real(DP) :: thick - logical :: lrm ! ! -- Return if no wells if (this%nbound == 0) return ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each well entry do i = 1, this%nbound node = this%nodelist(i) diff --git a/src/Model/GroundWaterTransport/gwt1.f90 b/src/Model/GroundWaterTransport/gwt1.f90 index fc265aa466f..4850bfaeaeb 100644 --- a/src/Model/GroundWaterTransport/gwt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1.f90 @@ -528,7 +528,7 @@ subroutine gwt_cq(this, icnvg, isuppress_output) ! conc solution. do ip = 1, this%bndlist%Count() packobj => GetBndFromList(this%bndlist, ip) - call packobj%bnd_cf(reset_mover=.false.) + call packobj%bnd_cf() call packobj%bnd_cq(this%x, this%flowja) end do ! diff --git a/src/Model/GroundWaterTransport/gwt1apt1.f90 b/src/Model/GroundWaterTransport/gwt1apt1.f90 index aa4c28778b5..8527604a4d9 100644 --- a/src/Model/GroundWaterTransport/gwt1apt1.f90 +++ b/src/Model/GroundWaterTransport/gwt1apt1.f90 @@ -125,7 +125,7 @@ module GwtAptModule procedure :: bnd_ar => apt_ar procedure :: bnd_rp => apt_rp procedure :: bnd_ad => apt_ad - procedure :: bnd_cf => apt_cf + procedure :: bnd_reset => apt_reset procedure :: bnd_fc => apt_fc procedure, private :: apt_fc_expanded procedure :: pak_fc_expanded @@ -717,32 +717,18 @@ subroutine apt_ad(this) return end subroutine apt_ad - !> @ brief Formulate the package hcof and rhs terms. - !! - !! For the APT Package, the sole purpose here is to - !! reset the qmfrommvr term. - !! - !< - subroutine apt_cf(this, reset_mover) - ! -- modules + !> @brief Override bnd reset for custom mover logic + !< TODO_MJR: check this + subroutine apt_reset(this) class(GwtAptType) :: this !< GwtAptType object - logical(LGP), intent(in), optional :: reset_mover !< boolean for resetting mover - ! -- local + ! local integer(I4B) :: i - logical :: lrm - ! - ! -- reset qmfrommvr - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (lrm) then - do i = 1, size(this%qmfrommvr) - this%qmfrommvr(i) = DZERO - end do - end if - ! - ! -- return - return - end subroutine apt_cf + + do i = 1, size(this%qmfrommvr) + this%qmfrommvr(i) = DZERO + end do + + end subroutine apt_reset subroutine apt_fc(this, rhs, ia, idxglo, matrix_sln) ! ****************************************************************************** diff --git a/src/Model/GroundWaterTransport/gwt1src1.f90 b/src/Model/GroundWaterTransport/gwt1src1.f90 index 1565c40ef09..92d8db04782 100644 --- a/src/Model/GroundWaterTransport/gwt1src1.f90 +++ b/src/Model/GroundWaterTransport/gwt1src1.f90 @@ -124,7 +124,7 @@ subroutine src_allocate_scalars(this) return end subroutine src_allocate_scalars - subroutine src_cf(this, reset_mover) + subroutine src_cf(this) ! ****************************************************************************** ! src_cf -- Formulate the HCOF and RHS terms ! Subroutine: (1) skip if no sources @@ -135,23 +135,14 @@ subroutine src_cf(this, reset_mover) ! ------------------------------------------------------------------------------ ! -- dummy class(GwtSrcType) :: this - logical, intent(in), optional :: reset_mover ! -- local integer(I4B) :: i, node real(DP) :: q - logical :: lrm ! ------------------------------------------------------------------------------ ! ! -- Return if no sources if (this%nbound == 0) return ! - ! -- pakmvrobj cf - lrm = .true. - if (present(reset_mover)) lrm = reset_mover - if (this%imover == 1 .and. lrm) then - call this%pakmvrobj%cf() - end if - ! ! -- Calculate hcof and rhs for each source entry do i = 1, this%nbound node = this%nodelist(i) diff --git a/src/Model/ModelUtilities/BoundaryPackage.f90 b/src/Model/ModelUtilities/BoundaryPackage.f90 index 58895f2554f..9bda0f770f8 100644 --- a/src/Model/ModelUtilities/BoundaryPackage.f90 +++ b/src/Model/ModelUtilities/BoundaryPackage.f90 @@ -120,6 +120,7 @@ module BndModule procedure :: bnd_rp procedure :: bnd_ad procedure :: bnd_ck + procedure :: bnd_reset procedure :: bnd_cf procedure :: bnd_fc procedure :: bnd_fn @@ -445,6 +446,17 @@ subroutine bnd_ck(this) return end subroutine bnd_ck + !> @ brief Reset bnd package before formulating + !< + subroutine bnd_reset(this) + class(BndType) :: this !< BndType object + + if (this%imover == 1) then + call this%pakmvrobj%reset() + end if + + end subroutine bnd_reset + !> @ brief Formulate the package hcof and rhs terms. !! !! Formulate the hcof and rhs terms for the package that will be @@ -453,10 +465,9 @@ end subroutine bnd_ck !! boundary package. !! !< - subroutine bnd_cf(this, reset_mover) + subroutine bnd_cf(this) ! -- modules class(BndType) :: this !< BndType object - logical(LGP), intent(in), optional :: reset_mover !< boolean for resetting mover ! ! -- bnd has no cf routine ! diff --git a/src/Model/ModelUtilities/PackageMover.f90 b/src/Model/ModelUtilities/PackageMover.f90 index 98dc2a9c625..f8304460c1d 100644 --- a/src/Model/ModelUtilities/PackageMover.f90 +++ b/src/Model/ModelUtilities/PackageMover.f90 @@ -26,7 +26,7 @@ module PackageMoverModule contains procedure :: ar procedure :: ad - procedure :: cf + procedure :: reset procedure :: fc procedure :: da procedure :: allocate_scalars @@ -100,7 +100,7 @@ subroutine ad(this) return end subroutine ad - subroutine cf(this) + subroutine reset(this) class(PackageMoverType) :: this integer :: i ! @@ -116,7 +116,7 @@ subroutine cf(this) ! ! -- return return - end subroutine cf + end subroutine reset subroutine fc(this) class(PackageMoverType) :: this diff --git a/src/Model/NumericalModel.f90 b/src/Model/NumericalModel.f90 index 59ccf46ec76..e4d5e0e5add 100644 --- a/src/Model/NumericalModel.f90 +++ b/src/Model/NumericalModel.f90 @@ -48,6 +48,7 @@ module NumericalModelModule procedure :: model_mc procedure :: model_rp procedure :: model_ad + procedure :: model_reset procedure :: model_cf procedure :: model_fc procedure :: model_ptcchk @@ -106,6 +107,20 @@ subroutine model_ad(this) class(NumericalModelType) :: this end subroutine model_ad + subroutine model_reset(this) + use BndModule, only: BndType, GetBndFromList + class(NumericalModelType) :: this + ! local + class(BndType), pointer :: packobj + integer(I4B) :: ip + + do ip = 1, this%bndlist%Count() + packobj => GetBndFromList(this%bndlist, ip) + call packobj%bnd_reset() + end do + + end subroutine model_reset + subroutine model_cf(this, kiter) class(NumericalModelType) :: this integer(I4B), intent(in) :: kiter diff --git a/src/Solution/NumericalSolution.f90 b/src/Solution/NumericalSolution.f90 index 028c4c789c1..66dfc6a28c1 100644 --- a/src/Solution/NumericalSolution.f90 +++ b/src/Solution/NumericalSolution.f90 @@ -1904,7 +1904,6 @@ subroutine sln_buildsystem(this, kiter, inewton) class(NumericalSolutionType) :: this integer(I4B), intent(in) :: kiter integer(I4B), intent(in) :: inewton - ! local integer(I4B) :: im, ic class(NumericalModelType), pointer :: mp @@ -1913,6 +1912,12 @@ subroutine sln_buildsystem(this, kiter, inewton) ! -- Set amat and rhs to zero call this%sln_reset() + ! reset models + do im = 1, this%modellist%Count() + mp => GetNumericalModelFromList(this%modellist, im) + call mp%model_reset() + end do + ! synchronize for CF call this%synchronize(STG_BFR_EXG_CF, this%synchronize_ctx)