Skip to content

Commit

Permalink
refactor(fmi): reduce unneeded duplication
Browse files Browse the repository at this point in the history
  • Loading branch information
@wpbonelli
wpbonelli committed Sep 14, 2023
1 parent df1e180 commit 6813950
Show file tree
Hide file tree
Showing 2 changed files with 42 additions and 142 deletions.
150 changes: 25 additions & 125 deletions src/Model/GroundWaterTransport/gwt1fmi1.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,8 +59,8 @@ module GwtFmiModule
procedure :: initialize_gwfterms_from_bfr
procedure :: initialize_gwfterms_from_gwfbndlist
procedure :: read_options => gwtfmi_read_options
procedure :: read_packagedata => gwtfmi_read_packagedata
procedure :: set_aptbudobj_pointer
procedure :: read_packagedata => gwtfmi_read_packagedata

end type GwtFmiType

Expand Down Expand Up @@ -231,15 +231,8 @@ subroutine fmi_ad(this, cnew)
return
end subroutine fmi_ad

!> @brief Calculate coefficients and fill matrix and rhs
subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
! ******************************************************************************
! fmi_fc -- Calculate coefficients and fill matrix and rhs
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
!use BndModule, only: BndType, GetBndFromList
! -- dummy
class(GwtFmiType) :: this
integer, intent(in) :: nodes
Expand All @@ -250,7 +243,6 @@ subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
real(DP), intent(inout), dimension(nodes) :: rhs
! -- local
integer(I4B) :: n, idiag, idiag_sln
! ------------------------------------------------------------------------------
!
! -- Calculate the flow imbalance error and make a correction for it
if (this%iflowerr /= 0) then
Expand All @@ -268,14 +260,8 @@ subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
return
end subroutine fmi_fc

!> @brief Calculate flow correction
subroutine fmi_cq(this, cnew, flowja)
! ******************************************************************************
! fmi_cq -- Calculate flow correction
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtFmiType) :: this
real(DP), intent(in), dimension(:) :: cnew
Expand All @@ -284,7 +270,6 @@ subroutine fmi_cq(this, cnew, flowja)
integer(I4B) :: n
integer(I4B) :: idiag
real(DP) :: rate
! ------------------------------------------------------------------------------
!
! -- If not adding flow error correction, return
if (this%iflowerr /= 0) then
Expand All @@ -305,13 +290,8 @@ subroutine fmi_cq(this, cnew, flowja)
return
end subroutine fmi_cq

!> @brief Calculate budget terms
subroutine fmi_bd(this, isuppress_output, model_budget)
! ******************************************************************************
! mst_bd -- Calculate budget terms
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
use TdisModule, only: delt
use BudgetModule, only: BudgetType, rate_accumulator
Expand All @@ -322,7 +302,6 @@ subroutine fmi_bd(this, isuppress_output, model_budget)
! -- local
real(DP) :: rin
real(DP) :: rout
! ------------------------------------------------------------------------------
!
! -- flow correction
if (this%iflowerr /= 0) then
Expand All @@ -334,13 +313,8 @@ subroutine fmi_bd(this, isuppress_output, model_budget)
return
end subroutine fmi_bd

!> @brief Save budget terms
subroutine fmi_ot_flow(this, icbcfl, icbcun)
! ******************************************************************************
! fmi_ot_flow -- Save budget terms
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwtFmiType) :: this
integer(I4B), intent(in) :: icbcfl
Expand All @@ -350,7 +324,6 @@ subroutine fmi_ot_flow(this, icbcfl, icbcun)
integer(I4B) :: iprint, nvaluesp, nwidthp
character(len=1) :: cdatafmp = ' ', editdesc = ' '
real(DP) :: dinact
! ------------------------------------------------------------------------------
!
! -- Set unit number for binary output
if (this%ipakcb < 0) then
Expand Down Expand Up @@ -380,18 +353,12 @@ subroutine fmi_ot_flow(this, icbcfl, icbcun)
return
end subroutine fmi_ot_flow

!> @brief Deallocate variables
subroutine gwtfmi_da(this)
! ******************************************************************************
! fmi_da -- Deallocate variables
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
class(GwtFmiType) :: this
! ------------------------------------------------------------------------------
! -- todo: finalize hfr and bfr either here or in a finalize routine
!
! -- deallocate any memory stored with gwfpackages
Expand Down Expand Up @@ -446,34 +413,18 @@ subroutine gwtfmi_allocate_scalars(this)
class(GwtFmiType) :: this
! -- local
!
! -- allocate scalars in NumericalPackageType
call this%NumericalPackageType%allocate_scalars()
! -- allocate scalars in parent
call this%FlowModelInterfaceType%allocate_scalars()
!
! -- Allocate
call mem_allocate(this%flows_from_file, 'FLOWS_FROM_FILE', this%memoryPath)
call mem_allocate(this%iflowsupdated, 'IFLOWSUPDATED', this%memoryPath)
call mem_allocate(this%iflowerr, 'IFLOWERR', this%memoryPath)
call mem_allocate(this%igwfstrgss, 'IGWFSTRGSS', this%memoryPath)
call mem_allocate(this%igwfstrgsy, 'IGWFSTRGSY', this%memoryPath)
call mem_allocate(this%iubud, 'IUBUD', this%memoryPath)
call mem_allocate(this%iuhds, 'IUHDS', this%memoryPath)
call mem_allocate(this%iumvr, 'IUMVR', this%memoryPath)
call mem_allocate(this%nflowpack, 'NFLOWPACK', this%memoryPath)
!
! -- Although not a scalar, allocate the advanced package transport
! budget object to zero so that it can be dynamically resized later
allocate (this%aptbudobj(0))
!
! -- Initialize
this%flows_from_file = .true.
this%iflowsupdated = 1
this%iflowerr = 0
this%igwfstrgss = 0
this%igwfstrgsy = 0
this%iubud = 0
this%iuhds = 0
this%iumvr = 0
this%nflowpack = 0
!
! -- Return
return
Expand All @@ -490,6 +441,9 @@ subroutine gwtfmi_allocate_arrays(this, nodes)
! -- local
integer(I4B) :: n
!
! -- allocate parent arrays
call this%FlowModelInterfaceType%allocate_arrays(nodes)
!
! -- Allocate variables needed for all cases
if (this%iflowerr == 0) then
call mem_allocate(this%flowcorrect, 1, 'FLOWCORRECT', this%memoryPath)
Expand All @@ -500,66 +454,12 @@ subroutine gwtfmi_allocate_arrays(this, nodes)
this%flowcorrect(n) = DZERO
end do
!
! -- Allocate ibdgwfsat0, which is an indicator array marking cells with
! saturation greater than 0.0 with a value of 1
call mem_allocate(this%ibdgwfsat0, nodes, 'IBDGWFSAT0', this%memoryPath)
do n = 1, nodes
this%ibdgwfsat0(n) = 1
end do
!
! -- Allocate differently depending on whether or not flows are
! being read from a file.
if (this%flows_from_file) then
call mem_allocate(this%gwfflowja, this%dis%con%nja, 'GWFFLOWJA', &
this%memoryPath)
call mem_allocate(this%gwfsat, nodes, 'GWFSAT', this%memoryPath)
call mem_allocate(this%gwfhead, nodes, 'GWFHEAD', this%memoryPath)
call mem_allocate(this%gwfspdis, 3, nodes, 'GWFSPDIS', this%memoryPath)
do n = 1, nodes
this%gwfsat(n) = DONE
this%gwfhead(n) = DZERO
this%gwfspdis(:, n) = DZERO
end do
do n = 1, size(this%gwfflowja)
this%gwfflowja(n) = DZERO
end do
!
! -- allocate and initialize storage arrays
if (this%igwfstrgss == 0) then
call mem_allocate(this%gwfstrgss, 1, 'GWFSTRGSS', this%memoryPath)
else
call mem_allocate(this%gwfstrgss, nodes, 'GWFSTRGSS', this%memoryPath)
end if
if (this%igwfstrgsy == 0) then
call mem_allocate(this%gwfstrgsy, 1, 'GWFSTRGSY', this%memoryPath)
else
call mem_allocate(this%gwfstrgsy, nodes, 'GWFSTRGSY', this%memoryPath)
end if
do n = 1, size(this%gwfstrgss)
this%gwfstrgss(n) = DZERO
end do
do n = 1, size(this%gwfstrgsy)
this%gwfstrgsy(n) = DZERO
end do
!
! -- If there is no fmi package, then there are no flows at all or a
! connected GWF model, so allocate gwfpackages to zero
if (this%inunit == 0) call this%allocate_gwfpackages(this%nflowpack)
end if
!
! -- Return
! -- return
return
end subroutine gwtfmi_allocate_arrays

!> @brief Calculate groundwater cell head saturation for end of last time step
function gwfsatold(this, n, delt) result(satold)
! ******************************************************************************
! gwfsatold -- calculate the groundwater cell head saturation for the end of
! the last time step
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
! -- dummy
class(GwtFmiType) :: this
integer(I4B), intent(in) :: n
Expand All @@ -570,7 +470,6 @@ function gwfsatold(this, n, delt) result(satold)
real(DP) :: vcell
real(DP) :: vnew
real(DP) :: vold
! ------------------------------------------------------------------------------
!
! -- calculate the value
vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
Expand Down Expand Up @@ -765,12 +664,12 @@ subroutine gwtfmi_read_packagedata(this)
end subroutine gwtfmi_read_packagedata

!> @brief Set the pointer to a budget object
!!
!! An advanced transport can pass in a name and a
!! pointer budget object, and this routine will look through the budget
!! objects managed by FMI and point to the one with the same name, such as
!! LAK-1, SFR-1, etc.
!!
!
! An advanced transport can pass in a name and a
! pointer budget object, and this routine will look through the budget
! objects managed by FMI and point to the one with the same name, such as
! LAK-1, SFR-1, etc.
!
!<
subroutine set_aptbudobj_pointer(this, name, budobjptr)
! -- modules
Expand Down Expand Up @@ -851,7 +750,8 @@ subroutine initialize_gwfterms_from_bfr(this)
call this%gwfpackages(ip)%set_name(this%bfr%dstpackagenamearray(i), &
this%bfr%budtxtarray(i))
naux = this%bfr%nauxarray(i)
call this%gwfpackages(ip)%set_auxname(naux, this%bfr%auxtxtarray(1:naux, i))
call this%gwfpackages(ip)%set_auxname(naux, &
this%bfr%auxtxtarray(1:naux, i))
ip = ip + 1
end do
!
Expand Down Expand Up @@ -960,10 +860,10 @@ subroutine initialize_gwfterms_from_gwfbndlist(this)
end subroutine initialize_gwfterms_from_gwfbndlist

!> @brief Allocate GWF packages
!!
!! This routine allocates gwfpackages (an array of PackageBudget
!! objects) to the proper size and initializes member variables.
!!
!
! This routine allocates gwfpackages (an array of PackageBudget
! objects) to the proper size and initializes member variables.
!
!<
subroutine gwtfmi_allocate_gwfpackages(this, ngwfterms)
! -- modules
Expand Down
34 changes: 17 additions & 17 deletions src/Model/ModelUtilities/FlowModelInterface.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -435,10 +435,10 @@ subroutine initialize_bfr(this)
end subroutine initialize_bfr

!> @brief Advance the budget file reader
!!
!! Advance the budget file reader by reading the next chunk
!! of information for the current time step and stress period.
!!
!
! Advance the budget file reader by reading the next chunk
! of information for the current time step and stress period.
!
!<
subroutine advance_bfr(this)
! -- modules
Expand Down Expand Up @@ -504,9 +504,9 @@ subroutine advance_bfr(this)
if (kper /= this%bfr%kper) then
write (errmsg, '(4x,a)') 'PERIOD NUMBER IN BUDGET FILE &
&DOES NOT MATCH PERIOD NUMBER IN TRANSPORT MODEL. IF THERE &
&IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN STRESS &
&PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS &
&ONE-FOR-ONE IN THAT STRESS PERIOD.'
&IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN &
&STRESS PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL &
&TIME STEPS ONE-FOR-ONE IN THAT STRESS PERIOD.'
call store_error(errmsg)
call store_error_unit(this%iubud)
end if
Expand All @@ -515,7 +515,7 @@ subroutine advance_bfr(this)
if (this%bfr%kstp > 1 .and. (kstp /= this%bfr%kstp)) then
write (errmsg, '(4x,a)') 'TIME STEP NUMBER IN BUDGET FILE &
&DOES NOT MATCH TIME STEP NUMBER IN TRANSPORT MODEL. IF THERE &
&IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN STRESS &
&IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN STRESS &
&PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS &
&ONE-FOR-ONE IN THAT STRESS PERIOD.'
call store_error(errmsg)
Expand Down Expand Up @@ -712,10 +712,10 @@ subroutine finalize_hfr(this)
end subroutine finalize_hfr

!> @brief Initialize gwf terms from budget file
!!
!! initalize terms and figure out how many
!! different terms and packages are contained within the file
!!
!
! initalize terms and figure out how many
! different terms and packages are contained within the file
!
!<
subroutine initialize_gwfterms_from_bfr(this)
! -- modules
Expand Down Expand Up @@ -879,11 +879,11 @@ subroutine initialize_gwfterms_from_gwfbndlist(this)
end subroutine initialize_gwfterms_from_gwfbndlist

!> @brief Allocate budget packages
!!
!! gwfpackages is an array of PackageBudget objects.
!! This routine allocates gwfpackages to the proper size and initializes some
!! member variables.
!!
!
! gwfpackages is an array of PackageBudget objects.
! This routine allocates gwfpackages to the proper size and initializes some
! member variables.
!
!<
subroutine allocate_gwfpackages(this, ngwfterms)
! -- modules
Expand Down

0 comments on commit 6813950

Please sign in to comment.