refactor: add model_reset for package movers (MODFLOW-USGS#1419)

emorway-usgs · Nov 2, 2023 · dea7cf7 · dea7cf7
1 parent 9705a30
commit dea7cf7
Show file tree

Hide file tree

Showing 18 changed files with 61 additions and 127 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -316,29 +316,20 @@ 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
     real(DP) :: q
     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
@@ -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
@@ -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
@@ -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)