Skip to content

Commit

Permalink
refactor(tsp): Elevate IC to generalized transport class (MODFLOW-USG…
Browse files Browse the repository at this point in the history 
…S#1392)
  • Loading branch information
@emorway-usgs
emorway-usgs authored Oct 12, 2023
1 parent d5c3caf commit d41878c
Show file tree
Hide file tree
Showing 7 changed files with 99 additions and 70 deletions.
4 changes: 2 additions & 2 deletions make/makefile
View file
Original file line number Diff line number Diff line change
Expand Up @@ -206,11 +206,11 @@ $(OBJDIR)/gwf3drn8.o \
$(OBJDIR)/IndexMap.o \
$(OBJDIR)/VirtualModel.o \
$(OBJDIR)/BaseExchange.o \
$(OBJDIR)/gwf3ic8.o \
$(OBJDIR)/tsp1fmi1.o \
$(OBJDIR)/TspAdvOptions.o \
$(OBJDIR)/UzfCellGroup.o \
$(OBJDIR)/OutputControlData.o \
$(OBJDIR)/gwf3ic8.o \
$(OBJDIR)/Xt3dInterface.o \
$(OBJDIR)/gwf3tvk8.o \
$(OBJDIR)/gwf3vsc8.o \
Expand All @@ -221,6 +221,7 @@ $(OBJDIR)/ImsLinearSettings.o \
$(OBJDIR)/ConvergenceSummary.o \
$(OBJDIR)/CellWithNbrs.o \
$(OBJDIR)/NumericalExchange.o \
$(OBJDIR)/tsp1ic1.o \
$(OBJDIR)/tsp1adv1.o \
$(OBJDIR)/gwf3disv8.o \
$(OBJDIR)/gwf3disu8.o \
Expand All @@ -229,7 +230,6 @@ $(OBJDIR)/gwf3uzf8.o \
$(OBJDIR)/gwt1apt1.o \
$(OBJDIR)/GwtSpc.o \
$(OBJDIR)/OutputControl.o \
$(OBJDIR)/gwt1ic1.o \
$(OBJDIR)/gwt1mst1.o \
$(OBJDIR)/GwtDspOptions.o \
$(OBJDIR)/gwf3npf8.o \
Expand Down
4 changes: 2 additions & 2 deletions msvs/mf6core.vfproj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -170,7 +170,6 @@
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1disv1idm.f90"/>
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1dsp1.f90"/>
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1dsp1idm.f90"/>
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1ic1.f90"/>
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1idm.f90"/>
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1ist1.f90"/>
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1lkt1.f90"/>
Expand Down Expand Up @@ -208,7 +207,8 @@
<Filter Name="TransportModel">
<File RelativePath="..\src\Model\TransportModel\tsp1.f90"/>
<File RelativePath="..\src\Model\TransportModel\tsp1adv1.f90"/>
<File RelativePath="..\src\Model\TransportModel\tsp1fmi1.f90"/></Filter>
<File RelativePath="..\src\Model\TransportModel\tsp1fmi1.f90"/>
<File RelativePath="..\src\Model\TransportModel\tsp1ic1.f90"/></Filter>
<File RelativePath="..\src\Model\BaseModel.f90"/>
<File RelativePath="..\src\Model\ExplicitModel.f90"/>
<File RelativePath="..\src\Model\NumericalModel.f90"/>
Expand Down
85 changes: 51 additions & 34 deletions src/Model/GroundWaterTransport/gwt1.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,6 @@ module GwtModule
use TransportModelModule, only: TransportModelType
use BaseModelModule, only: BaseModelType
use BndModule, only: BndType, AddBndToList, GetBndFromList
use GwtIcModule, only: GwtIcType
use TspFmiModule, only: TspFmiType
use GwtDspModule, only: GwtDspType
use GwtSsmModule, only: GwtSsmType
Expand All @@ -38,14 +37,12 @@ module GwtModule

type, extends(TransportModelType) :: GwtModelType

type(GwtIcType), pointer :: ic => null() ! initial conditions package
type(GwtMstType), pointer :: mst => null() ! mass storage and transfer package
type(GwtDspType), pointer :: dsp => null() ! dispersion package
type(GwtSsmType), pointer :: ssm => null() ! source sink mixing package
type(GwtMvtType), pointer :: mvt => null() ! mover transport package
type(GwtOcType), pointer :: oc => null() ! output control package
type(GwtObsType), pointer :: obs => null() ! observation package
integer(I4B), pointer :: inic => null() ! unit number IC
integer(I4B), pointer :: inmvt => null() ! unit number MVT
integer(I4B), pointer :: inmst => null() ! unit number MST
integer(I4B), pointer :: indsp => null() ! DSP enabled flag
Expand Down Expand Up @@ -158,10 +155,11 @@ subroutine gwt_cr(filename, id, modelname)
return
end subroutine gwt_cr

!> @brief Define packages of the model
!
! (1) call df routines for each package
! (2) set variables and pointers
!> @brief Define packages of the GWT model
!!
!! This subroutine defines a gwt model type. Steps include:
!! (1) call df routines for each package
!! (2) set variables and pointers
!<
subroutine gwt_df(this)
! -- modules
Expand Down Expand Up @@ -243,7 +241,8 @@ subroutine gwt_ac(this, sparse)
return
end subroutine gwt_ac

!> @brief Map connection positions in numerical solution coefficient matrix.
!> @brief Map the positions of the GWT model connections in the numerical
!! solution coefficient matrix.
!<
subroutine gwt_mc(this, matrix_sln)
! -- dummy
Expand All @@ -256,6 +255,7 @@ subroutine gwt_mc(this, matrix_sln)
! -- Find the position of each connection in the global ia, ja structure
! and store them in idxglo.
call this%dis%dis_mc(this%moffset, this%idxglo, matrix_sln)
!
if (this%indsp > 0) call this%dsp%dsp_mc(this%moffset, matrix_sln)
!
! -- Map any package connections
Expand All @@ -268,10 +268,11 @@ subroutine gwt_mc(this, matrix_sln)
return
end subroutine gwt_mc

!> @brief Allocate and Read
!
! (1) allocates and reads packages part of this model,
! (2) allocates memory for arrays part of this model object
!> @brief GWT Model Allocate and Read
!!
!! This subroutine:
!! - allocates and reads packages that are part of this model,
!! - allocates memory for arrays used by this model object
!<
subroutine gwt_ar(this)
! -- modules
Expand Down Expand Up @@ -321,7 +322,9 @@ subroutine gwt_ar(this)
return
end subroutine gwt_ar

!> @brief Read and prepare (calls package read and prepare routines)
!> @brief GWT Model Read and Prepare
!!
!! Call the read and prepare routines of the attached packages
!<
subroutine gwt_rp(this)
! -- modules
Expand Down Expand Up @@ -352,7 +355,9 @@ subroutine gwt_rp(this)
return
end subroutine gwt_rp

!> @brief Time step advance (calls package advance subroutines)
!> @brief GWT Model Time Step Advance
!!
!! Call the advance subroutines of the attached packages
!<
subroutine gwt_ad(this)
! -- modules
Expand Down Expand Up @@ -407,9 +412,12 @@ subroutine gwt_ad(this)
return
end subroutine gwt_ad

!> @brief Calculate coefficients
!> @brief GWT Model calculate coefficients
!!
!! Call the calculate coefficients subroutines of the attached packages
!<
subroutine gwt_cf(this, kiter)
! -- modules
! -- dummy
class(GwtModelType) :: this
integer(I4B), intent(in) :: kiter
Expand All @@ -427,9 +435,12 @@ subroutine gwt_cf(this, kiter)
return
end subroutine gwt_cf

!> @brief Fill coefficients
!> @brief GWT Model fill coefficients
!!
!! Call the fill coefficients subroutines attached packages
!<
subroutine gwt_fc(this, kiter, matrix_sln, inwtflag)
! -- modules
! -- dummy
class(GwtModelType) :: this
integer(I4B), intent(in) :: kiter
Expand Down Expand Up @@ -471,7 +482,9 @@ subroutine gwt_fc(this, kiter, matrix_sln, inwtflag)
return
end subroutine gwt_fc

!> @brief Final convergence check (calls package cc routines)
!> @brief GWT Model Final Convergence Check
!!
!! If MVR/MVT is active, call the MVR convergence check subroutines
!<
subroutine gwt_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
! -- dummy
Expand Down Expand Up @@ -501,7 +514,9 @@ subroutine gwt_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
return
end subroutine gwt_cc

!> @brief Calculate intercell flows (flowja)
!> @brief GWT Model calculate flow
!!
!! Call the intercell flows (flow ja) subroutine
!<
subroutine gwt_cq(this, icnvg, isuppress_output)
! -- modules
Expand Down Expand Up @@ -548,10 +563,11 @@ subroutine gwt_cq(this, icnvg, isuppress_output)
return
end subroutine gwt_cq

!> @brief Model budget
!
! (1) Calculate intercell flows (flowja)
! (2) Calculate package contributions to model budget
!> @brief GWT Model Budget
!!
!! This subroutine:
!! (1) calculates intercell flows (flowja)
!! (2) calculates package contributions to the model budget
!<
subroutine gwt_bd(this, icnvg, isuppress_output)
use ConstantsModule, only: DZERO
Expand Down Expand Up @@ -579,13 +595,14 @@ subroutine gwt_bd(this, icnvg, isuppress_output)
packobj => GetBndFromList(this%bndlist, ip)
call packobj%bnd_bd(this%budget)
end do

!
! -- Return
return
end subroutine gwt_bd

!> @brief Print and/or save model output
!!
!! Call the parent class output routine
!<
subroutine gwt_ot(this)
! -- modules
Expand Down Expand Up @@ -813,6 +830,8 @@ subroutine gwt_ot_bdsummary(this, ibudfl, ipflag)
end subroutine gwt_ot_bdsummary

!> @brief Deallocate
!!
!! Deallocate memmory at conclusion of model run
!<
subroutine gwt_da(this)
! -- modules
Expand Down Expand Up @@ -862,7 +881,6 @@ subroutine gwt_da(this)
end do
!
! -- Scalars
call mem_deallocate(this%inic)
call mem_deallocate(this%indsp)
call mem_deallocate(this%inssm)
call mem_deallocate(this%inmst)
Expand All @@ -885,8 +903,6 @@ end subroutine gwt_da
!! This subroutine adds a budget entry to the flow budget. It was added as
!! a method for the gwt model object so that the exchange object could add its
!! contributions.
!!
!! (1) adds the entry to the budget object
!<
subroutine gwt_bdentry(this, budterm, budtxt, rowlabel)
! -- modules
Expand Down Expand Up @@ -937,7 +953,11 @@ function gwt_get_iasym(this) result(iasym)
return
end function gwt_get_iasym

!> @brief Allocate memory for non-allocatable members
!> Allocate memory for non-allocatable members
!!
!! A subroutine for allocating the scalars specific to the GWT model type.
!! Additional scalars used by the parent class are allocated by the parent
!! class.
!<
subroutine allocate_scalars(this, modelname)
! -- modules
Expand All @@ -950,15 +970,13 @@ subroutine allocate_scalars(this, modelname)
call this%allocate_tsp_scalars(modelname)
!
! -- allocate members that are part of model class
call mem_allocate(this%inic, 'INIC', this%memoryPath)
call mem_allocate(this%inmvt, 'INMVT', this%memoryPath)
call mem_allocate(this%inmst, 'INMST', this%memoryPath)
call mem_allocate(this%indsp, 'INDSP', this%memoryPath)
call mem_allocate(this%inssm, 'INSSM', this%memoryPath)
call mem_allocate(this%inoc, 'INOC ', this%memoryPath)
call mem_allocate(this%inobs, 'INOBS', this%memoryPath)
!
this%inic = 0
this%inmvt = 0
this%inmst = 0
this%indsp = 0
Expand All @@ -971,6 +989,8 @@ subroutine allocate_scalars(this, modelname)
end subroutine allocate_scalars

!> @brief Create boundary condition packages for this model
!!
!! Call the package create routines for packages activated by the user.
!<
subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, inunit, &
iout)
Expand Down Expand Up @@ -1056,6 +1076,7 @@ function CastAsGwtModel(model) result(gwtmodel)
type is (GwtModelType)
gwtmodel => model
end select
!
! -- Return
return
end function CastAsGwtModel
Expand Down Expand Up @@ -1127,7 +1148,6 @@ subroutine create_gwt_packages(this, indis)
use MemoryManagerModule, only: mem_setptr
use MemoryHelperModule, only: create_mem_path
use SimVariablesModule, only: idm_context
use GwtIcModule, only: ic_cr
use GwtMstModule, only: mst_cr
use GwtDspModule, only: dsp_cr
use GwtSsmModule, only: ssm_cr
Expand Down Expand Up @@ -1174,8 +1194,6 @@ subroutine create_gwt_packages(this, indis)
!
! -- create dis package first as it is a prerequisite for other packages
select case (pkgtype)
case ('IC6')
this%inic = inunit
case ('MVT6')
this%inmvt = inunit
case ('MST6')
Expand All @@ -1199,7 +1217,6 @@ subroutine create_gwt_packages(this, indis)
end do
!
! -- Create packages that are tied directly to model
call ic_cr(this%ic, this%name, this%inic, this%iout, this%dis)
call mst_cr(this%mst, this%name, this%inmst, this%iout, this%fmi)
call dsp_cr(this%dsp, this%name, mempathdsp, this%indsp, this%iout, &
this%fmi)
Expand All @@ -1209,7 +1226,7 @@ subroutine create_gwt_packages(this, indis)
call gwt_obs_cr(this%obs, this%inobs)
!
! -- Check to make sure that required ftype's have been specified
call this%ftype_check(indis, this%inmst, this%inic)
call this%ftype_check(indis, this%inmst)
!
call this%create_bndpkgs(bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
!
Expand Down
8 changes: 4 additions & 4 deletions src/Model/GroundWaterTransport/gwt1obs1.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ module GwtObsModule
use KindModule, only: DP, I4B
use ConstantsModule, only: LINELENGTH, MAXOBSTYPES
use BaseDisModule, only: DisBaseType
use GwtIcModule, only: GwtIcType
use TspIcModule, only: TspIcType
use ObserveModule, only: ObserveType
use ObsModule, only: ObsType
use SimModule, only: count_errors, store_error, &
Expand All @@ -15,7 +15,7 @@ module GwtObsModule

type, extends(ObsType) :: GwtObsType
! -- Private members
type(GwtIcType), pointer, private :: ic => null() ! initial conditions
type(TspIcType), pointer, private :: ic => null() ! initial conditions
real(DP), dimension(:), pointer, contiguous, private :: x => null() ! concentration
real(DP), dimension(:), pointer, contiguous, private :: flowja => null() ! intercell flows
contains
Expand Down Expand Up @@ -64,7 +64,7 @@ subroutine gwt_obs_ar(this, ic, x, flowja)
! ------------------------------------------------------------------------------
! -- dummy
class(GwtObsType), intent(inout) :: this
type(GwtIcType), pointer, intent(in) :: ic
type(TspIcType), pointer, intent(in) :: ic
real(DP), dimension(:), pointer, contiguous, intent(in) :: x
real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja
! ------------------------------------------------------------------------------
Expand Down Expand Up @@ -193,7 +193,7 @@ subroutine set_pointers(this, ic, x, flowja)
! ------------------------------------------------------------------------------
! -- dummy
class(GwtObsType), intent(inout) :: this
type(GwtIcType), pointer, intent(in) :: ic
type(TspIcType), pointer, intent(in) :: ic
real(DP), dimension(:), pointer, contiguous, intent(in) :: x
real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja
! ------------------------------------------------------------------------------
Expand Down
Loading

0 comments on commit d41878c

Please sign in to comment.