Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

refactor(gwt1src1.f90): minor updates in source loading package #1432

Merged
merged 4 commits into from
Nov 9, 2023
Merged

refactor(gwt1src1.f90): minor updates in source loading package #1432

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
9e56f47
refactor(gwt1src1.f90): minor updates in source loading package
emorway-usgs Nov 7, 2023
d58b038
Update src/Model/GroundWaterTransport/gwt1src1.f90
emorway-usgs Nov 8, 2023
c9307b1
Update src/Model/GroundWaterTransport/gwt1src1.f90
emorway-usgs Nov 8, 2023
8382809
Restore original docstring (not sure where all these GWE related chan…
emorway-usgs Nov 8, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion src/Model/GroundWaterTransport/gwt1.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -790,7 +790,8 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, &
call cnc_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
pakname, dvt, mempath)
case ('SRC6')
call src_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
call src_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
this%depvartype, pakname)
case ('LKT6')
call lkt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
pakname, this%fmi)
Expand Down
147 changes: 69 additions & 78 deletions src/Model/GroundWaterTransport/gwt1src1.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
module GwtSrcModule
!
use KindModule, only: DP, I4B
use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE
use ConstantsModule, only: DZERO, DEM1, DONE, LENFTYPE, LENVARNAME
use BndModule, only: BndType
use ObsModule, only: DefaultObsIdProcessor
use TimeSeriesLinkModule, only: TimeSeriesLinkType, &
Expand All @@ -18,7 +18,11 @@ module GwtSrcModule
character(len=16) :: text = ' SRC'
!
type, extends(BndType) :: GwtSrcType

character(len=LENVARNAME) :: depvartype = '' !< stores string of dependent variable type, depending on model type

contains

procedure :: allocate_scalars => src_allocate_scalars
procedure :: bnd_cf => src_cf
procedure :: bnd_fc => src_fc
Expand All @@ -29,19 +33,17 @@ module GwtSrcModule
procedure, public :: bnd_df_obs => src_df_obs
! -- methods for time series
procedure, public :: bnd_rp_ts => src_rp_ts

end type GwtSrcType

contains

subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
! ******************************************************************************
! src_create -- Create a New Src Package
! Subroutine: (1) create new-style package
! (2) point bndobj to the new package
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
!> @brief Create a source loading package
!!
!! This subroutine points bndobj to the newly created package
!<
subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
depvartype)
! -- dummy
class(BndType), pointer :: packobj
integer(I4B), intent(in) :: id
Expand All @@ -50,9 +52,9 @@ subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
integer(I4B), intent(in) :: iout
character(len=*), intent(in) :: namemodel
character(len=*), intent(in) :: pakname
character(len=LENVARNAME), intent(in) :: depvartype
! -- local
type(GwtSrcType), pointer :: srcobj
! ------------------------------------------------------------------------------
!
! -- allocate the object and assign values to object variables
allocate (srcobj)
Expand All @@ -75,43 +77,38 @@ subroutine src_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
packobj%ncolbnd = 1
packobj%iscloc = 1
!
! -- Store the appropriate label based on the dependent variable
srcobj%depvartype = depvartype
!
! -- return
return
end subroutine src_create

!> @brief Deallocate memory
!<
subroutine src_da(this)
! ******************************************************************************
! src_da -- deallocate
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- modules
use MemoryManagerModule, only: mem_deallocate
! -- dummy
class(GwtSrcType) :: this
! ------------------------------------------------------------------------------
!
! -- Deallocate parent package
call this%BndType%bnd_da()
!
! -- scalars
!
! -- return
! -- Return
return
end subroutine src_da

!> @brief Allocate scalars
!!
!! Allocate scalars specific to this source loading package
!<
subroutine src_allocate_scalars(this)
! ******************************************************************************
! allocate_scalars -- allocate scalar members
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
use MemoryManagerModule, only: mem_allocate
! -- dummy
class(GwtSrcType) :: this
! ------------------------------------------------------------------------------
!
! -- call standard BndType allocate scalars
call this%BndType%allocate_scalars()
Expand All @@ -120,25 +117,22 @@ subroutine src_allocate_scalars(this)
!
! -- Set values
!
! -- return
! -- Return
return
end subroutine src_allocate_scalars

!> @brief Formulate the HCOF and RHS terms
!!
!! This subroutine:
!! - calculates hcof and rhs terms
!! - skip if no sources
!<
subroutine src_cf(this)
! ******************************************************************************
! src_cf -- Formulate the HCOF and RHS terms
! Subroutine: (1) skip if no sources
! (2) calculate hcof and rhs
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwtSrcType) :: this
! -- local
integer(I4B) :: i, node
real(DP) :: q
! ------------------------------------------------------------------------------
!
! -- Return if no sources
if (this%nbound == 0) return
Expand All @@ -155,16 +149,15 @@ subroutine src_cf(this)
this%rhs(i) = -q
end do
!
! -- Return
return
end subroutine src_cf

!> @brief Add matrix terms related to specified mass source loading
!!
!! Copy rhs and hcof into solution rhs and amat
!<
subroutine src_fc(this, rhs, ia, idxglo, matrix_sln)
! **************************************************************************
! src_fc -- Copy rhs and hcof into solution rhs and amat
! **************************************************************************
!
! SPECIFICATIONS:
! --------------------------------------------------------------------------
! -- dummy
class(GwtSrcType) :: this
real(DP), dimension(:), intent(inout) :: rhs
Expand All @@ -173,7 +166,6 @@ subroutine src_fc(this, rhs, ia, idxglo, matrix_sln)
class(MatrixBaseType), pointer :: matrix_sln
! -- local
integer(I4B) :: i, n, ipos
! --------------------------------------------------------------------------
!
! -- pakmvrobj fc
if (this%imover == 1) then
Expand All @@ -194,20 +186,19 @@ subroutine src_fc(this, rhs, ia, idxglo, matrix_sln)
end if
end do
!
! -- return
! -- Return
return
end subroutine src_fc

!> @brief Define list labels
!!
!! Define the list heading that is written to iout when PRINT_INPUT
!! option is used.
!<
subroutine define_listlabel(this)
! ******************************************************************************
! define_listlabel -- Define the list heading that is written to iout when
! PRINT_INPUT option is used.
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwtSrcType), intent(inout) :: this
! ------------------------------------------------------------------------------
! -- local
!
! -- create the header list label
this%listlabel = trim(this%filtyp)//' NO.'
Expand All @@ -226,42 +217,41 @@ subroutine define_listlabel(this)
write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME'
end if
!
! -- return
! -- Return
return
end subroutine define_listlabel

! -- Procedures related to observations
!> @brief Support function for specified mass source loading observations
!!
!! This function:
!! - returns true because SRC package supports observations.
!! - overrides BndType%bnd_obs_supported()
!<
logical function src_obs_supported(this)
! ******************************************************************************
! src_obs_supported
! -- Return true because SRC package supports observations.
! -- Overrides BndType%bnd_obs_supported()
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
implicit none
! -- dummy
class(GwtSrcType) :: this
! ------------------------------------------------------------------------------
!
src_obs_supported = .true.
!
! -- Return
return
end function src_obs_supported

!> @brief Define observations
!!
!! This subroutine:
!! - stores observation types supported by SRC package.
!! - overrides BndType%bnd_df_obs
!<
subroutine src_df_obs(this)
! ******************************************************************************
! src_df_obs (implements bnd_df_obs)
! -- Store observation type supported by SRC package.
! -- Overrides BndType%bnd_df_obs
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
implicit none
! -- dummy
class(GwtSrcType) :: this
! -- local
integer(I4B) :: indx
! ------------------------------------------------------------------------------
!
call this%obs%StoreObsType('src', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor
!
Expand All @@ -270,17 +260,17 @@ subroutine src_df_obs(this)
call this%obs%StoreObsType('to-mvr', .true., indx)
this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor
!
! -- return
! -- Return
return
end subroutine src_df_obs

! -- Procedure related to time series

!> @brief Procedure related to time series
!!
!! Assign tsLink%Text appropriately for all time series in use by package.
!! In the SRC package only the SMASSRATE variable can be controlled by time
!! series.
!<
subroutine src_rp_ts(this)
! -- Assign tsLink%Text appropriately for
! all time series in use by package.
! In the SRC package only the SMASSRATE variable
! can be controlled by time series.
! -- dummy
class(GwtSrcType), intent(inout) :: this
! -- local
Expand All @@ -297,6 +287,7 @@ subroutine src_rp_ts(this)
end if
end do
!
! -- Return
return
end subroutine src_rp_ts

Expand Down
Loading