From 41e9c341cdffc0dfd61357e5b76b723065ab9cba Mon Sep 17 00:00:00 2001 From: mjreno Date: Tue, 1 Nov 2022 08:53:15 -0400 Subject: [PATCH] refactor(input-data-model): rework found construct for readability and maintainability (#1072) Co-authored-by: mjreno --- make/makefile | 44 ++-- src/Model/GroundWaterFlow/gwf3dis8.f90 | 82 ++++--- src/Model/GroundWaterFlow/gwf3dis8idm.f90 | 17 ++ src/Model/GroundWaterFlow/gwf3disu8.f90 | 116 ++++----- src/Model/GroundWaterFlow/gwf3disu8idm.f90 | 31 +++ src/Model/GroundWaterFlow/gwf3disv8.f90 | 74 +++--- src/Model/GroundWaterFlow/gwf3disv8idm.f90 | 23 ++ src/Model/GroundWaterFlow/gwf3npf8.f90 | 224 ++++++++++-------- src/Model/GroundWaterFlow/gwf3npf8idm.f90 | 41 ++++ src/Model/GroundWaterTransport/gwt1dsp.f90 | 82 ++++--- src/Model/GroundWaterTransport/gwt1dspidm.f90 | 12 + utils/idmloader/scripts/dfn2f90.py | 11 + utils/mf5to6/make/makefile | 8 +- 13 files changed, 471 insertions(+), 294 deletions(-) diff --git a/make/makefile b/make/makefile index e17d8abd2bd..2f65fc3fc66 100644 --- a/make/makefile +++ b/make/makefile @@ -6,28 +6,28 @@ include ./makedefaults # Define the source file directories SOURCEDIR1=../src SOURCEDIR2=../src/Exchange -SOURCEDIR3=../src/Solution -SOURCEDIR4=../src/Solution/LinearMethods -SOURCEDIR5=../src/Timing -SOURCEDIR6=../src/Utilities -SOURCEDIR7=../src/Utilities/Idm -SOURCEDIR8=../src/Utilities/TimeSeries -SOURCEDIR9=../src/Utilities/Memory -SOURCEDIR10=../src/Utilities/OutputControl -SOURCEDIR11=../src/Utilities/ArrayRead -SOURCEDIR12=../src/Utilities/Libraries -SOURCEDIR13=../src/Utilities/Libraries/rcm -SOURCEDIR14=../src/Utilities/Libraries/blas -SOURCEDIR15=../src/Utilities/Libraries/sparskit2 -SOURCEDIR16=../src/Utilities/Libraries/daglib -SOURCEDIR17=../src/Utilities/Libraries/sparsekit -SOURCEDIR18=../src/Utilities/Observation -SOURCEDIR19=../src/Model -SOURCEDIR20=../src/Model/Connection -SOURCEDIR21=../src/Model/GroundWaterTransport -SOURCEDIR22=../src/Model/ModelUtilities -SOURCEDIR23=../src/Model/GroundWaterFlow -SOURCEDIR24=../src/Model/Geometry +SOURCEDIR3=../src/Model +SOURCEDIR4=../src/Model/Connection +SOURCEDIR5=../src/Model/Geometry +SOURCEDIR6=../src/Model/GroundWaterFlow +SOURCEDIR7=../src/Model/GroundWaterTransport +SOURCEDIR8=../src/Model/ModelUtilities +SOURCEDIR9=../src/Solution +SOURCEDIR10=../src/Solution/LinearMethods +SOURCEDIR11=../src/Timing +SOURCEDIR12=../src/Utilities +SOURCEDIR13=../src/Utilities/ArrayRead +SOURCEDIR14=../src/Utilities/Idm +SOURCEDIR15=../src/Utilities/Libraries +SOURCEDIR16=../src/Utilities/Libraries/blas +SOURCEDIR17=../src/Utilities/Libraries/daglib +SOURCEDIR18=../src/Utilities/Libraries/rcm +SOURCEDIR19=../src/Utilities/Libraries/sparsekit +SOURCEDIR20=../src/Utilities/Libraries/sparskit2 +SOURCEDIR21=../src/Utilities/Memory +SOURCEDIR22=../src/Utilities/Observation +SOURCEDIR23=../src/Utilities/OutputControl +SOURCEDIR24=../src/Utilities/TimeSeries VPATH = \ ${SOURCEDIR1} \ diff --git a/src/Model/GroundWaterFlow/gwf3dis8.f90 b/src/Model/GroundWaterFlow/gwf3dis8.f90 index 54017c42265..e7e954471f5 100644 --- a/src/Model/GroundWaterFlow/gwf3dis8.f90 +++ b/src/Model/GroundWaterFlow/gwf3dis8.f90 @@ -200,28 +200,29 @@ subroutine source_options(this) use MemoryTypeModule, only: MemoryType use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisInputModule, only: GwfDisParamFoundType ! -- dummy class(GwfDisType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath character(len=LENVARNAME), dimension(3) :: lenunits = & &[character(len=LENVARNAME) :: 'FEET', 'METERS', 'CENTIMETERS'] - logical, dimension(5) :: afound + type(GwfDisParamFoundType) :: found ! ! -- set memory path idmMemoryPath = create_mem_path(this%name_model, 'DIS', idm_context) ! ! -- update defaults with idm sourced values call mem_set_value(this%lenuni, 'LENGTH_UNITS', idmMemoryPath, lenunits, & - afound(1)) - call mem_set_value(this%nogrb, 'NOGRB', idmMemoryPath, afound(2)) - call mem_set_value(this%xorigin, 'XORIGIN', idmMemoryPath, afound(3)) - call mem_set_value(this%yorigin, 'YORIGIN', idmMemoryPath, afound(4)) - call mem_set_value(this%angrot, 'ANGROT', idmMemoryPath, afound(5)) + found%length_units) + call mem_set_value(this%nogrb, 'NOGRB', idmMemoryPath, found%nogrb) + call mem_set_value(this%xorigin, 'XORIGIN', idmMemoryPath, found%xorigin) + call mem_set_value(this%yorigin, 'YORIGIN', idmMemoryPath, found%yorigin) + call mem_set_value(this%angrot, 'ANGROT', idmMemoryPath, found%angrot) ! ! -- log values to list file if (this%iout > 0) then - call this%log_options(afound) + call this%log_options(found) end if ! ! -- Return @@ -230,31 +231,32 @@ end subroutine source_options !> @brief Write user options to list file !< - subroutine log_options(this, afound) + subroutine log_options(this, found) + use GwfDisInputModule, only: GwfDisParamFoundType class(GwfDisType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Options' - if (afound(1)) then + if (found%length_units) then write (this%iout, '(4x,a,i0)') 'MODEL LENGTH UNIT [0=UND, 1=FEET, & &2=METERS, 3=CENTIMETERS] SET AS ', this%lenuni end if - if (afound(2)) then + if (found%nogrb) then write (this%iout, '(4x,a,i0)') 'BINARY GRB FILE [0=GRB, 1=NOGRB] & &SET AS ', this%nogrb end if - if (afound(3)) then + if (found%xorigin) then write (this%iout, '(4x,a,G0)') 'XORIGIN = ', this%xorigin end if - if (afound(4)) then + if (found%yorigin) then write (this%iout, '(4x,a,G0)') 'YORIGIN = ', this%yorigin end if - if (afound(5)) then + if (found%angrot) then write (this%iout, '(4x,a,G0)') 'ANGROT = ', this%angrot end if @@ -269,24 +271,25 @@ subroutine source_dimensions(this) use MemoryTypeModule, only: MemoryType use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisInputModule, only: GwfDisParamFoundType ! -- dummy class(GwfDisType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath integer(I4B) :: i, j, k - logical, dimension(3) :: afound + type(GwfDisParamFoundType) :: found ! ! -- set memory path idmMemoryPath = create_mem_path(this%name_model, 'DIS', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%nlay, 'NLAY', idmMemoryPath, afound(1)) - call mem_set_value(this%nrow, 'NROW', idmMemoryPath, afound(2)) - call mem_set_value(this%ncol, 'NCOL', idmMemoryPath, afound(3)) + call mem_set_value(this%nlay, 'NLAY', idmMemoryPath, found%nlay) + call mem_set_value(this%nrow, 'NROW', idmMemoryPath, found%nrow) + call mem_set_value(this%ncol, 'NCOL', idmMemoryPath, found%ncol) ! ! -- log simulation values if (this%iout > 0) then - call this%log_dimensions(afound) + call this%log_dimensions(found) end if ! ! -- verify dimensions were set @@ -335,21 +338,22 @@ end subroutine source_dimensions !> @brief Write dimensions to list file !< - subroutine log_dimensions(this, afound) + subroutine log_dimensions(this, found) + use GwfDisInputModule, only: GwfDisParamFoundType class(GwfDisType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Dimensions' - if (afound(1)) then + if (found%nlay) then write (this%iout, '(4x,a,i0)') 'NLAY = ', this%nlay end if - if (afound(2)) then + if (found%nrow) then write (this%iout, '(4x,a,i0)') 'NROW = ', this%nrow end if - if (afound(3)) then + if (found%ncol) then write (this%iout, '(4x,a,i0)') 'NCOL = ', this%ncol end if @@ -367,11 +371,12 @@ subroutine source_griddata(this) ! -- modules use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisInputModule, only: GwfDisParamFoundType ! -- dummy class(GwfDisType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath - logical, dimension(5) :: afound + type(GwfDisParamFoundType) :: found ! -- formats ! ------------------------------------------------------------------------------ ! @@ -379,15 +384,15 @@ subroutine source_griddata(this) idmMemoryPath = create_mem_path(this%name_model, 'DIS', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%delr, 'DELR', idmMemoryPath, afound(1)) - call mem_set_value(this%delc, 'DELC', idmMemoryPath, afound(2)) - call mem_set_value(this%top2d, 'TOP', idmMemoryPath, afound(3)) - call mem_set_value(this%bot3d, 'BOTM', idmMemoryPath, afound(4)) - call mem_set_value(this%idomain, 'IDOMAIN', idmMemoryPath, afound(5)) + call mem_set_value(this%delr, 'DELR', idmMemoryPath, found%delr) + call mem_set_value(this%delc, 'DELC', idmMemoryPath, found%delc) + call mem_set_value(this%top2d, 'TOP', idmMemoryPath, found%top) + call mem_set_value(this%bot3d, 'BOTM', idmMemoryPath, found%botm) + call mem_set_value(this%idomain, 'IDOMAIN', idmMemoryPath, found%idomain) ! ! -- log simulation values if (this%iout > 0) then - call this%log_griddata(afound) + call this%log_griddata(found) end if ! ! -- Return @@ -396,29 +401,30 @@ end subroutine source_griddata !> @brief Write dimensions to list file !< - subroutine log_griddata(this, afound) + subroutine log_griddata(this, found) + use GwfDisInputModule, only: GwfDisParamFoundType class(GwfDisType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Griddata' - if (afound(1)) then + if (found%delr) then write (this%iout, '(4x,a)') 'DELR set from input file' end if - if (afound(2)) then + if (found%delc) then write (this%iout, '(4x,a)') 'DELC set from input file' end if - if (afound(3)) then + if (found%top) then write (this%iout, '(4x,a)') 'TOP set from input file' end if - if (afound(4)) then + if (found%botm) then write (this%iout, '(4x,a)') 'BOTM set from input file' end if - if (afound(5)) then + if (found%idomain) then write (this%iout, '(4x,a)') 'IDOMAIN set from input file' end if diff --git a/src/Model/GroundWaterFlow/gwf3dis8idm.f90 b/src/Model/GroundWaterFlow/gwf3dis8idm.f90 index fd4bbd51b3a..c75fd75a284 100644 --- a/src/Model/GroundWaterFlow/gwf3dis8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3dis8idm.f90 @@ -5,6 +5,23 @@ module GwfDisInputModule public gwf_dis_param_definitions public gwf_dis_aggregate_definitions public gwf_dis_block_definitions + public GwfDisParamFoundType + + type GwfDisParamFoundType + logical :: length_units = .false. + logical :: nogrb = .false. + logical :: xorigin = .false. + logical :: yorigin = .false. + logical :: angrot = .false. + logical :: nlay = .false. + logical :: nrow = .false. + logical :: ncol = .false. + logical :: delr = .false. + logical :: delc = .false. + logical :: top = .false. + logical :: botm = .false. + logical :: idomain = .false. + end type GwfDisParamFoundType type(InputParamDefinitionType), parameter :: & gwfdis_length_units = InputParamDefinitionType & diff --git a/src/Model/GroundWaterFlow/gwf3disu8.f90 b/src/Model/GroundWaterFlow/gwf3disu8.f90 index 21cd3bebab4..62dc3ecd788 100644 --- a/src/Model/GroundWaterFlow/gwf3disu8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disu8.f90 @@ -553,35 +553,36 @@ end subroutine nodeu_to_array !> @brief Write user options to list file !< - subroutine log_options(this, afound) + subroutine log_options(this, found) + use GwfDisuInputModule, only: GwfDisuParamFoundType class(GwfDisuType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisuParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Options' - if (afound(1)) then + if (found%length_units) then write (this%iout, '(4x,a,i0)') 'MODEL LENGTH UNIT [0=UND, 1=FEET, & &2=METERS, 3=CENTIMETERS] SET AS ', this%lenuni end if - if (afound(2)) then + if (found%nogrb) then write (this%iout, '(4x,a,i0)') 'BINARY GRB FILE [0=GRB, 1=NOGRB] & &SET AS ', this%nogrb end if - if (afound(3)) then + if (found%xorigin) then write (this%iout, '(4x,a,G0)') 'XORIGIN = ', this%xorigin end if - if (afound(4)) then + if (found%yorigin) then write (this%iout, '(4x,a,G0)') 'YORIGIN = ', this%yorigin end if - if (afound(5)) then + if (found%angrot) then write (this%iout, '(4x,a,G0)') 'ANGROT = ', this%angrot end if - if (afound(6)) then + if (found%voffsettol) then write (this%iout, '(4x,a,G0)') 'VERTICAL_OFFSET_TOLERANCE = ', & this%voffsettol end if @@ -604,13 +605,14 @@ subroutine source_options(this) use MemoryHelperModule, only: create_mem_path use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisuInputModule, only: GwfDisuParamFoundType ! -- dummy class(GwfDisuType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath character(len=LENVARNAME), dimension(3) :: lenunits = & &[character(len=LENVARNAME) :: 'FEET', 'METERS', 'CENTIMETERS'] - logical, dimension(6) :: afound + type(GwfDisuParamFoundType) :: found ! ------------------------------------------------------------------------------ ! ! -- set memory path @@ -618,16 +620,17 @@ subroutine source_options(this) ! ! -- update defaults with idm sourced values call mem_set_value(this%lenuni, 'LENGTH_UNITS', idmMemoryPath, lenunits, & - afound(1)) - call mem_set_value(this%nogrb, 'NOGRB', idmMemoryPath, afound(2)) - call mem_set_value(this%xorigin, 'XORIGIN', idmMemoryPath, afound(3)) - call mem_set_value(this%yorigin, 'YORIGIN', idmMemoryPath, afound(4)) - call mem_set_value(this%angrot, 'ANGROT', idmMemoryPath, afound(5)) - call mem_set_value(this%voffsettol, 'VOFFSETTOL', idmMemoryPath, afound(6)) + found%length_units) + call mem_set_value(this%nogrb, 'NOGRB', idmMemoryPath, found%nogrb) + call mem_set_value(this%xorigin, 'XORIGIN', idmMemoryPath, found%xorigin) + call mem_set_value(this%yorigin, 'YORIGIN', idmMemoryPath, found%yorigin) + call mem_set_value(this%angrot, 'ANGROT', idmMemoryPath, found%angrot) + call mem_set_value(this%voffsettol, 'VOFFSETTOL', idmMemoryPath, & + found%voffsettol) ! ! -- log values to list file if (this%iout > 0) then - call this%log_options(afound) + call this%log_options(found) end if ! ! -- Return @@ -636,21 +639,22 @@ end subroutine source_options !> @brief Write dimensions to list file !< - subroutine log_dimensions(this, afound) + subroutine log_dimensions(this, found) + use GwfDisuInputModule, only: GwfDisuParamFoundType class(GwfDisuType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisuParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Dimensions' - if (afound(1)) then + if (found%nodes) then write (this%iout, '(4x,a,i0)') 'NODES = ', this%nodesuser end if - if (afound(2)) then + if (found%nja) then write (this%iout, '(4x,a,i0)') 'NJA = ', this%njausr end if - if (afound(3)) then + if (found%nvert) then write (this%iout, '(4x,a,i0)') 'NVERT = ', this%nvert end if @@ -671,25 +675,26 @@ subroutine source_dimensions(this) use MemoryHelperModule, only: create_mem_path use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisuInputModule, only: GwfDisuParamFoundType ! -- dummy class(GwfDisuType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath integer(I4B) :: n - logical, dimension(3) :: afound + type(GwfDisuParamFoundType) :: found ! ------------------------------------------------------------------------------ ! ! -- set memory path idmMemoryPath = create_mem_path(this%name_model, 'DISU', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%nodesuser, 'NODES', idmMemoryPath, afound(1)) - call mem_set_value(this%njausr, 'NJA', idmMemoryPath, afound(2)) - call mem_set_value(this%nvert, 'NVERT', idmMemoryPath, afound(3)) + call mem_set_value(this%nodesuser, 'NODES', idmMemoryPath, found%nodes) + call mem_set_value(this%njausr, 'NJA', idmMemoryPath, found%nja) + call mem_set_value(this%nvert, 'NVERT', idmMemoryPath, found%nvert) ! ! -- log simulation values if (this%iout > 0) then - call this%log_dimensions(afound) + call this%log_dimensions(found) end if ! ! -- verify dimensions were set @@ -738,25 +743,26 @@ end subroutine source_dimensions !> @brief Write griddata found to list file !< - subroutine log_griddata(this, afound) + subroutine log_griddata(this, found) + use GwfDisuInputModule, only: GwfDisuParamFoundType class(GwfDisuType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisuParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Griddata' - if (afound(1)) then + if (found%top) then write (this%iout, '(4x,a)') 'TOP set from input file' end if - if (afound(2)) then + if (found%bot) then write (this%iout, '(4x,a)') 'BOT set from input file' end if - if (afound(3)) then + if (found%area) then write (this%iout, '(4x,a)') 'AREA set from input file' end if - if (afound(4)) then + if (found%idomain) then write (this%iout, '(4x,a)') 'IDOMAIN set from input file' end if @@ -775,11 +781,12 @@ subroutine source_griddata(this) use MemoryHelperModule, only: create_mem_path use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisuInputModule, only: GwfDisuParamFoundType ! -- dummy class(GwfDisuType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath - logical, dimension(4) :: afound + type(GwfDisuParamFoundType) :: found ! -- formats ! ------------------------------------------------------------------------------ ! @@ -787,14 +794,14 @@ subroutine source_griddata(this) idmMemoryPath = create_mem_path(this%name_model, 'DISU', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%top1d, 'TOP', idmMemoryPath, afound(1)) - call mem_set_value(this%bot1d, 'BOT', idmMemoryPath, afound(2)) - call mem_set_value(this%area1d, 'AREA', idmMemoryPath, afound(3)) - call mem_set_value(this%idomain, 'IDOMAIN', idmMemoryPath, afound(4)) + call mem_set_value(this%top1d, 'TOP', idmMemoryPath, found%top) + call mem_set_value(this%bot1d, 'BOT', idmMemoryPath, found%bot) + call mem_set_value(this%area1d, 'AREA', idmMemoryPath, found%area) + call mem_set_value(this%idomain, 'IDOMAIN', idmMemoryPath, found%idomain) ! ! -- log simulation values if (this%iout > 0) then - call this%log_griddata(afound) + call this%log_griddata(found) end if ! ! -- Return @@ -803,9 +810,10 @@ end subroutine source_griddata !> @brief Write griddata found to list file !< - subroutine log_connectivity(this, afound, iac) + subroutine log_connectivity(this, found, iac) + use GwfDisuInputModule, only: GwfDisuParamFoundType class(GwfDisuType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisuParamFoundType), intent(in) :: found integer(I4B), dimension(:), contiguous, pointer, intent(in) :: iac write (this%iout, '(1x,a)') 'Setting Discretization Connectivity' @@ -814,23 +822,23 @@ subroutine log_connectivity(this, afound, iac) write (this%iout, '(4x,a)') 'IAC set from input file' end if - if (afound(1)) then + if (found%ja) then write (this%iout, '(4x,a)') 'JA set from input file' end if - if (afound(2)) then + if (found%ihc) then write (this%iout, '(4x,a)') 'IHC set from input file' end if - if (afound(3)) then + if (found%cl12) then write (this%iout, '(4x,a)') 'CL12 set from input file' end if - if (afound(4)) then + if (found%hwva) then write (this%iout, '(4x,a)') 'HWVA set from input file' end if - if (afound(5)) then + if (found%angldegx) then write (this%iout, '(4x,a)') 'ANGLDEGX set from input file' end if @@ -850,11 +858,12 @@ subroutine source_connectivity(this) use MemoryManagerModule, only: mem_setptr use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisuInputModule, only: GwfDisuParamFoundType ! -- dummy class(GwfDisuType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath - logical, dimension(5) :: afound + type(GwfDisuParamFoundType) :: found integer(I4B), dimension(:), contiguous, pointer :: iac => null() ! -- formats ! ------------------------------------------------------------------------------ @@ -863,11 +872,12 @@ subroutine source_connectivity(this) idmMemoryPath = create_mem_path(this%name_model, 'DISU', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%jainp, 'JA', idmMemoryPath, afound(1)) - call mem_set_value(this%ihcinp, 'IHC', idmMemoryPath, afound(2)) - call mem_set_value(this%cl12inp, 'CL12', idmMemoryPath, afound(3)) - call mem_set_value(this%hwvainp, 'HWVA', idmMemoryPath, afound(4)) - call mem_set_value(this%angldegxinp, 'ANGLDEGX', idmMemoryPath, afound(5)) + call mem_set_value(this%jainp, 'JA', idmMemoryPath, found%ja) + call mem_set_value(this%ihcinp, 'IHC', idmMemoryPath, found%ihc) + call mem_set_value(this%cl12inp, 'CL12', idmMemoryPath, found%cl12) + call mem_set_value(this%hwvainp, 'HWVA', idmMemoryPath, found%hwva) + call mem_set_value(this%angldegxinp, 'ANGLDEGX', idmMemoryPath, & + found%angldegx) ! ! -- set pointer to iac input array call mem_setptr(iac, 'IAC', idmMemoryPath) @@ -876,11 +886,11 @@ subroutine source_connectivity(this) if (associated(iac)) call iac_to_ia(iac, this%iainp) ! ! -- Set angldegx flag if found - if (afound(5)) this%iangledegx = 1 + if (found%angldegx) this%iangledegx = 1 ! ! -- log simulation values if (this%iout > 0) then - call this%log_connectivity(afound, iac) + call this%log_connectivity(found, iac) end if ! ! -- Return diff --git a/src/Model/GroundWaterFlow/gwf3disu8idm.f90 b/src/Model/GroundWaterFlow/gwf3disu8idm.f90 index f696aa8db6e..42245c2ae42 100644 --- a/src/Model/GroundWaterFlow/gwf3disu8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3disu8idm.f90 @@ -5,6 +5,37 @@ module GwfDisuInputModule public gwf_disu_param_definitions public gwf_disu_aggregate_definitions public gwf_disu_block_definitions + public GwfDisuParamFoundType + + type GwfDisuParamFoundType + logical :: length_units = .false. + logical :: nogrb = .false. + logical :: xorigin = .false. + logical :: yorigin = .false. + logical :: angrot = .false. + logical :: voffsettol = .false. + logical :: nodes = .false. + logical :: nja = .false. + logical :: nvert = .false. + logical :: top = .false. + logical :: bot = .false. + logical :: area = .false. + logical :: idomain = .false. + logical :: iac = .false. + logical :: ja = .false. + logical :: ihc = .false. + logical :: cl12 = .false. + logical :: hwva = .false. + logical :: angldegx = .false. + logical :: iv = .false. + logical :: xv = .false. + logical :: yv = .false. + logical :: icell2d = .false. + logical :: xc = .false. + logical :: yc = .false. + logical :: ncvert = .false. + logical :: icvert = .false. + end type GwfDisuParamFoundType type(InputParamDefinitionType), parameter :: & gwfdisu_length_units = InputParamDefinitionType & diff --git a/src/Model/GroundWaterFlow/gwf3disv8.f90 b/src/Model/GroundWaterFlow/gwf3disv8.f90 index e1581abff11..421904e501b 100644 --- a/src/Model/GroundWaterFlow/gwf3disv8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disv8.f90 @@ -221,13 +221,14 @@ subroutine source_options(this) use KindModule, only: LGP use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisvInputModule, only: GwfDisvParamFoundType ! -- dummy class(GwfDisvType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath character(len=LENVARNAME), dimension(3) :: lenunits = & &[character(len=LENVARNAME) :: 'FEET', 'METERS', 'CENTIMETERS'] - logical, dimension(5) :: afound + type(GwfDisvParamFoundType) :: found ! ------------------------------------------------------------------------------ ! ! -- set memory path @@ -235,15 +236,15 @@ subroutine source_options(this) ! ! -- update defaults with idm sourced values call mem_set_value(this%lenuni, 'LENGTH_UNITS', idmMemoryPath, lenunits, & - afound(1)) - call mem_set_value(this%nogrb, 'NOGRB', idmMemoryPath, afound(2)) - call mem_set_value(this%xorigin, 'XORIGIN', idmMemoryPath, afound(3)) - call mem_set_value(this%yorigin, 'YORIGIN', idmMemoryPath, afound(4)) - call mem_set_value(this%angrot, 'ANGROT', idmMemoryPath, afound(5)) + found%length_units) + call mem_set_value(this%nogrb, 'NOGRB', idmMemoryPath, found%nogrb) + call mem_set_value(this%xorigin, 'XORIGIN', idmMemoryPath, found%xorigin) + call mem_set_value(this%yorigin, 'YORIGIN', idmMemoryPath, found%yorigin) + call mem_set_value(this%angrot, 'ANGROT', idmMemoryPath, found%angrot) ! ! -- log values to list file if (this%iout > 0) then - call this%log_options(afound) + call this%log_options(found) end if ! ! -- Return @@ -252,31 +253,32 @@ end subroutine source_options !> @brief Write user options to list file !< - subroutine log_options(this, afound) + subroutine log_options(this, found) + use GwfDisvInputModule, only: GwfDisvParamFoundType class(GwfDisvType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisvParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Options' - if (afound(1)) then + if (found%length_units) then write (this%iout, '(4x,a,i0)') 'MODEL LENGTH UNIT [0=UND, 1=FEET, & &2=METERS, 3=CENTIMETERS] SET AS ', this%lenuni end if - if (afound(2)) then + if (found%nogrb) then write (this%iout, '(4x,a,i0)') 'BINARY GRB FILE [0=GRB, 1=NOGRB] & &SET AS ', this%nogrb end if - if (afound(3)) then + if (found%xorigin) then write (this%iout, '(4x,a,G0)') 'XORIGIN = ', this%xorigin end if - if (afound(4)) then + if (found%yorigin) then write (this%iout, '(4x,a,G0)') 'YORIGIN = ', this%yorigin end if - if (afound(5)) then + if (found%angrot) then write (this%iout, '(4x,a,G0)') 'ANGROT = ', this%angrot end if @@ -296,25 +298,26 @@ subroutine source_dimensions(this) use KindModule, only: LGP use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisvInputModule, only: GwfDisvParamFoundType ! -- dummy class(GwfDisvType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath integer(I4B) :: j, k - logical, dimension(3) :: afound + type(GwfDisvParamFoundType) :: found ! ------------------------------------------------------------------------------ ! ! -- set memory path idmMemoryPath = create_mem_path(this%name_model, 'DISV', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%nlay, 'NLAY', idmMemoryPath, afound(1)) - call mem_set_value(this%ncpl, 'NCPL', idmMemoryPath, afound(2)) - call mem_set_value(this%nvert, 'NVERT', idmMemoryPath, afound(3)) + call mem_set_value(this%nlay, 'NLAY', idmMemoryPath, found%nlay) + call mem_set_value(this%ncpl, 'NCPL', idmMemoryPath, found%ncpl) + call mem_set_value(this%nvert, 'NVERT', idmMemoryPath, found%nvert) ! ! -- log simulation values if (this%iout > 0) then - call this%log_dimensions(afound) + call this%log_dimensions(found) end if ! ! -- verify dimensions were set @@ -361,21 +364,22 @@ end subroutine source_dimensions !> @brief Write dimensions to list file !< - subroutine log_dimensions(this, afound) + subroutine log_dimensions(this, found) + use GwfDisvInputModule, only: GwfDisvParamFoundType class(GwfDisvType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisvParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Dimensions' - if (afound(1)) then + if (found%nlay) then write (this%iout, '(4x,a,i0)') 'NLAY = ', this%nlay end if - if (afound(2)) then + if (found%ncpl) then write (this%iout, '(4x,a,i0)') 'NCPL = ', this%ncpl end if - if (afound(3)) then + if (found%nvert) then write (this%iout, '(4x,a,i0)') 'NVERT = ', this%nvert end if @@ -393,11 +397,12 @@ subroutine source_griddata(this) ! -- modules use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfDisvInputModule, only: GwfDisvParamFoundType ! -- dummy class(GwfDisvType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath - logical, dimension(3) :: afound + type(GwfDisvParamFoundType) :: found ! -- formats ! ------------------------------------------------------------------------------ ! @@ -405,13 +410,13 @@ subroutine source_griddata(this) idmMemoryPath = create_mem_path(this%name_model, 'DISV', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%top1d, 'TOP', idmMemoryPath, afound(1)) - call mem_set_value(this%bot2d, 'BOTM', idmMemoryPath, afound(2)) - call mem_set_value(this%idomain, 'IDOMAIN', idmMemoryPath, afound(3)) + call mem_set_value(this%top1d, 'TOP', idmMemoryPath, found%top) + call mem_set_value(this%bot2d, 'BOTM', idmMemoryPath, found%botm) + call mem_set_value(this%idomain, 'IDOMAIN', idmMemoryPath, found%idomain) ! ! -- log simulation values if (this%iout > 0) then - call this%log_griddata(afound) + call this%log_griddata(found) end if ! ! -- Return @@ -420,21 +425,22 @@ end subroutine source_griddata !> @brief Write griddata found to list file !< - subroutine log_griddata(this, afound) + subroutine log_griddata(this, found) + use GwfDisvInputModule, only: GwfDisvParamFoundType class(GwfDisvType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfDisvParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting Discretization Griddata' - if (afound(1)) then + if (found%top) then write (this%iout, '(4x,a)') 'TOP set from input file' end if - if (afound(2)) then + if (found%botm) then write (this%iout, '(4x,a)') 'BOTM set from input file' end if - if (afound(3)) then + if (found%idomain) then write (this%iout, '(4x,a)') 'IDOMAIN set from input file' end if diff --git a/src/Model/GroundWaterFlow/gwf3disv8idm.f90 b/src/Model/GroundWaterFlow/gwf3disv8idm.f90 index 81bb4db9635..86e553c1dfc 100644 --- a/src/Model/GroundWaterFlow/gwf3disv8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3disv8idm.f90 @@ -5,6 +5,29 @@ module GwfDisvInputModule public gwf_disv_param_definitions public gwf_disv_aggregate_definitions public gwf_disv_block_definitions + public GwfDisvParamFoundType + + type GwfDisvParamFoundType + logical :: length_units = .false. + logical :: nogrb = .false. + logical :: xorigin = .false. + logical :: yorigin = .false. + logical :: angrot = .false. + logical :: nlay = .false. + logical :: ncpl = .false. + logical :: nvert = .false. + logical :: top = .false. + logical :: botm = .false. + logical :: idomain = .false. + logical :: iv = .false. + logical :: xv = .false. + logical :: yv = .false. + logical :: icell2d = .false. + logical :: xc = .false. + logical :: yc = .false. + logical :: ncvert = .false. + logical :: icvert = .false. + end type GwfDisvParamFoundType type(InputParamDefinitionType), parameter :: & gwfdisv_length_units = InputParamDefinitionType & diff --git a/src/Model/GroundWaterFlow/gwf3npf8.f90 b/src/Model/GroundWaterFlow/gwf3npf8.f90 index dcfdf99bc31..c154d66e751 100644 --- a/src/Model/GroundWaterFlow/gwf3npf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3npf8.f90 @@ -1293,7 +1293,7 @@ subroutine allocate_arrays(this, ncells, njas) return end subroutine allocate_arrays - subroutine log_options(this, afound) + subroutine log_options(this, found) ! ****************************************************************************** ! log_options -- log npf options sourced from the input mempath ! ****************************************************************************** @@ -1302,67 +1302,74 @@ subroutine log_options(this, afound) ! ------------------------------------------------------------------------------ ! -- modules use KindModule, only: LGP + use GwfNpfInputModule, only: GwfNpfParamFoundType ! -- dummy class(GwfNpftype) :: this ! -- locals - logical, dimension(:), intent(in) :: afound + type(GwfNpfParamFoundType), intent(in) :: found ! ------------------------------------------------------------------------------ ! write (this%iout, '(1x,a)') 'Setting NPF Options' - if (afound(1)) & + if (found%iprflow) & write (this%iout, '(4x,a)') 'CELL-BY-CELL FLOW INFORMATION WILL BE PRINTED & &TO LISTING FILE WHENEVER ICBCFL IS NOT ZERO.' - if (afound(2)) & + if (found%ipakcb) & write (this%iout, '(4x,a)') 'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED & &TO BINARY FILE WHENEVER ICBCFL IS NOT ZERO.' - if (afound(3)) & + if (found%cellavg) & write (this%iout, '(4x,a,i0)') 'ALTERNATIVE CELL AVERAGING [1=LOGARITHMIC, & &2=AMT-LMK, 3=AMT-HMK] SET TO: ', & this%icellavg - if (afound(4)) write (this%iout, '(4x,a)') 'THICKSTRT OPTION HAS BEEN & - &ACTIVATED.' - if (afound(5)) write (this%iout, '(4x,a)') 'VERTICAL FLOW WILL BE ADJUSTED & - &FOR PERCHED CONDITIONS.' - if (afound(6)) write (this%iout, '(4x,a)') 'VERTICAL CONDUCTANCE VARIES WITH & - &WATER TABLE.' - if (afound(7)) write (this%iout, '(4x,a)') 'VERTICAL CONDUCTANCE ACCOUNTS & - &FOR DEWATERED PORTION OF AN & - &UNDERLYING CELL.' - if (afound(8)) write (this%iout, '(4x,a)') 'XT3D FORMULATION IS SELECTED.' - if (afound(9)) write (this%iout, '(4x,a)') 'XT3D RHS FORMULATION IS SELECTED.' - if (afound(10)) & + if (found%ithickstrt) & + write (this%iout, '(4x,a)') 'THICKSTRT OPTION HAS BEEN ACTIVATED.' + if (found%iperched) & + write (this%iout, '(4x,a)') 'VERTICAL FLOW WILL BE ADJUSTED FOR PERCHED & + &CONDITIONS.' + if (found%ivarcv) & + write (this%iout, '(4x,a)') 'VERTICAL CONDUCTANCE VARIES WITH WATER TABLE.' + if (found%idewatcv) & + write (this%iout, '(4x,a)') 'VERTICAL CONDUCTANCE ACCOUNTS FOR DEWATERED & + &PORTION OF AN UNDERLYING CELL.' + if (found%ixt3d) write (this%iout, '(4x,a)') 'XT3D FORMULATION IS SELECTED.' + if (found%ixt3drhs) & + write (this%iout, '(4x,a)') 'XT3D RHS FORMULATION IS SELECTED.' + if (found%isavspdis) & write (this%iout, '(4x,a)') 'SPECIFIC DISCHARGE WILL BE CALCULATED AT CELL & &CENTERS AND WRITTEN TO DATA-SPDIS IN BUDGET & &FILE WHEN REQUESTED.' - if (afound(11)) & + if (found%isavsat) & write (this%iout, '(4x,a)') 'SATURATION WILL BE WRITTEN TO DATA-SAT IN & &BUDGET FILE WHEN REQUESTED.' - if (afound(12)) & + if (found%ik22overk) & write (this%iout, '(4x,a)') 'VALUES SPECIFIED FOR K22 ARE ANISOTROPY & &RATIOS AND WILL BE MULTIPLIED BY K BEFORE & &BEING USED IN CALCULATIONS.' - if (afound(13)) & + if (found%ik33overk) & write (this%iout, '(4x,a)') 'VALUES SPECIFIED FOR K33 ARE ANISOTROPY & &RATIOS AND WILL BE MULTIPLIED BY K BEFORE & &BEING USED IN CALCULATIONS.' - if (afound(15)) write (this%iout, '(4x,a)') 'NEWTON-RAPHSON method disabled & - &for unconfined cells' - if (afound(16)) write (this%iout, '(4x,a)') 'MODFLOW-USG saturation & - &calculation method will be used' - if (afound(17)) write (this%iout, '(4x,a)') 'MODFLOW-NWT upstream weighting & - &method will be used ' - if (afound(18)) & + if (found%inewton) & + write (this%iout, '(4x,a)') 'NEWTON-RAPHSON method disabled for unconfined & + &cells' + if (found%iusgnrhc) & + write (this%iout, '(4x,a)') 'MODFLOW-USG saturation calculation method & + &will be used' + if (found%inwtupw) & + write (this%iout, '(4x,a)') 'MODFLOW-NWT upstream weighting method will be & + &used' + if (found%satmin) & write (this%iout, '(4x,a,1pg15.6)') 'MINIMUM SATURATED THICKNESS HAS BEEN & &SET TO: ', this%satmin - if (afound(19)) & + if (found%satomega) & write (this%iout, '(4x,a,1pg15.6)') 'SATURATION OMEGA: ', this%satomega - if (afound(20)) write (this%iout, '(4x,a)') 'REWETTING IS ACTIVE.' - if (afound(21)) write (this%iout, '(4x,a,1pg15.6)') 'WETTING FACTOR HAS BEEN & - &SET TO: ', this%wetfct - if (afound(22)) write (this%iout, '(4x,a,i5)') 'IWETIT HAS BEEN SET TO: ', & - this%iwetit - if (afound(23)) write (this%iout, '(4x,a,i5)') 'IHDWET HAS BEEN SET TO: ', & - this%ihdwet + if (found%irewet) write (this%iout, '(4x,a)') 'REWETTING IS ACTIVE.' + if (found%wetfct) & + write (this%iout, '(4x,a,1pg15.6)') 'WETTING FACTOR HAS BEEN SET TO: ', & + this%wetfct + if (found%iwetit) & + write (this%iout, '(4x,a,i5)') 'IWETIT HAS BEEN SET TO: ', this%iwetit + if (found%ihdwet) & + write (this%iout, '(4x,a,i5)') 'IHDWET HAS BEEN SET TO: ', this%ihdwet write (this%iout, '(1x,a,/)') 'End Setting NPF Options' ! ! -- Write rewet settings @@ -1385,13 +1392,14 @@ subroutine source_options(this) use MemoryHelperModule, only: create_mem_path use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfNpfInputModule, only: GwfNpfParamFoundType ! -- dummy class(GwfNpftype) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath character(len=LENVARNAME), dimension(3) :: cellavg_method = & &[character(len=LENVARNAME) :: 'LOGARITHMIC', 'AMT-LMK', 'AMT-HMK'] - logical, dimension(23) :: afound + type(GwfNpfParamFoundType) :: found character(len=LINELENGTH) :: tvk6_filename ! ------------------------------------------------------------------------------ ! @@ -1399,57 +1407,62 @@ subroutine source_options(this) idmMemoryPath = create_mem_path(this%name_model, 'NPF', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%iprflow, 'IPRFLOW', idmMemoryPath, afound(1)) - call mem_set_value(this%ipakcb, 'IPAKCB', idmMemoryPath, afound(2)) + call mem_set_value(this%iprflow, 'IPRFLOW', idmMemoryPath, found%iprflow) + call mem_set_value(this%ipakcb, 'IPAKCB', idmMemoryPath, found%ipakcb) call mem_set_value(this%icellavg, 'CELLAVG', idmMemoryPath, cellavg_method, & - afound(3)) - call mem_set_value(this%ithickstrt, 'ITHICKSTRT', idmMemoryPath, afound(4)) - call mem_set_value(this%iperched, 'IPERCHED', idmMemoryPath, afound(5)) - call mem_set_value(this%ivarcv, 'IVARCV', idmMemoryPath, afound(6)) - call mem_set_value(this%idewatcv, 'IDEWATCV', idmMemoryPath, afound(7)) - call mem_set_value(this%ixt3d, 'IXT3D', idmMemoryPath, afound(8)) - call mem_set_value(this%ixt3drhs, 'IXT3DRHS', idmMemoryPath, afound(9)) - call mem_set_value(this%isavspdis, 'ISAVSPDIS', idmMemoryPath, afound(10)) - call mem_set_value(this%isavsat, 'ISAVSAT', idmMemoryPath, afound(11)) - call mem_set_value(this%ik22overk, 'IK22OVERK', idmMemoryPath, afound(12)) - call mem_set_value(this%ik33overk, 'IK33OVERK', idmMemoryPath, afound(13)) - call mem_set_value(tvk6_filename, 'TVK6_FILENAME', idmMemoryPath, afound(14)) - call mem_set_value(this%inewton, 'INEWTON', idmMemoryPath, afound(15)) + found%cellavg) + call mem_set_value(this%ithickstrt, 'ITHICKSTRT', idmMemoryPath, & + found%ithickstrt) + call mem_set_value(this%iperched, 'IPERCHED', idmMemoryPath, found%iperched) + call mem_set_value(this%ivarcv, 'IVARCV', idmMemoryPath, found%ivarcv) + call mem_set_value(this%idewatcv, 'IDEWATCV', idmMemoryPath, found%idewatcv) + call mem_set_value(this%ixt3d, 'IXT3D', idmMemoryPath, found%ixt3d) + call mem_set_value(this%ixt3drhs, 'IXT3DRHS', idmMemoryPath, found%ixt3drhs) + call mem_set_value(this%isavspdis, 'ISAVSPDIS', idmMemoryPath, & + found%isavspdis) + call mem_set_value(this%isavsat, 'ISAVSAT', idmMemoryPath, found%isavsat) + call mem_set_value(this%ik22overk, 'IK22OVERK', idmMemoryPath, & + found%ik22overk) + call mem_set_value(this%ik33overk, 'IK33OVERK', idmMemoryPath, & + found%ik33overk) + call mem_set_value(tvk6_filename, 'TVK6_FILENAME', idmMemoryPath, & + found%tvk6_filename) + call mem_set_value(this%inewton, 'INEWTON', idmMemoryPath, found%inewton) call mem_set_value(this%iusgnrhc, 'IUSGNRHC', idmMemoryPath, & - afound(16)) - call mem_set_value(this%inwtupw, 'INWTUPW', idmMemoryPath, afound(17)) - call mem_set_value(this%satmin, 'SATMIN', idmMemoryPath, afound(18)) - call mem_set_value(this%satomega, 'SATOMEGA', idmMemoryPath, afound(19)) - call mem_set_value(this%irewet, 'IREWET', idmMemoryPath, afound(20)) - call mem_set_value(this%wetfct, 'WETFCT', idmMemoryPath, afound(21)) - call mem_set_value(this%iwetit, 'IWETIT', idmMemoryPath, afound(22)) - call mem_set_value(this%ihdwet, 'IHDWET', idmMemoryPath, afound(23)) + found%iusgnrhc) + call mem_set_value(this%inwtupw, 'INWTUPW', idmMemoryPath, found%inwtupw) + call mem_set_value(this%satmin, 'SATMIN', idmMemoryPath, found%satmin) + call mem_set_value(this%satomega, 'SATOMEGA', idmMemoryPath, found%satomega) + call mem_set_value(this%irewet, 'IREWET', idmMemoryPath, found%irewet) + call mem_set_value(this%wetfct, 'WETFCT', idmMemoryPath, found%wetfct) + call mem_set_value(this%iwetit, 'IWETIT', idmMemoryPath, found%iwetit) + call mem_set_value(this%ihdwet, 'IHDWET', idmMemoryPath, found%ihdwet) ! ! -- save flows option active - if (afound(2)) this%ipakcb = -1 + if (found%ipakcb) this%ipakcb = -1 ! ! -- xt3d active with rhs - if (afound(8) .and. afound(9)) this%ixt3d = 2 + if (found%ixt3d .and. found%ixt3drhs) this%ixt3d = 2 ! ! -- save specific discharge active - if (afound(10)) this%icalcspdis = this%isavspdis + if (found%isavspdis) this%icalcspdis = this%isavspdis ! ! -- TVK6 subpackage file spec provided - if (afound(14)) then + if (found%tvk6_filename) then this%intvk = GetUnit() call openfile(this%intvk, this%iout, tvk6_filename, 'TVK') call tvk_cr(this%tvk, this%name_model, this%intvk, this%iout) end if ! ! -- no newton specified - if (afound(15)) then + if (found%inewton) then this%inewton = 0 this%iasym = 0 end if ! ! -- log options if (this%iout > 0) then - call this%log_options(afound) + call this%log_options(found) end if ! ! -- Return @@ -1586,41 +1599,42 @@ end subroutine check_options !> @brief Write dimensions to list file !< - subroutine log_griddata(this, afound) + subroutine log_griddata(this, found) + use GwfNpfInputModule, only: GwfNpfParamFoundType class(GwfNpfType) :: this - logical, dimension(:), intent(in) :: afound + type(GwfNpfParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting NPF Griddata' - if (afound(1)) then + if (found%icelltype) then write (this%iout, '(4x,a)') 'ICELLTYPE set from input file' end if - if (afound(2)) then + if (found%k) then write (this%iout, '(4x,a)') 'K set from input file' end if - if (afound(3)) then + if (found%k33) then write (this%iout, '(4x,a)') 'K33 set from input file' end if - if (afound(4)) then + if (found%k22) then write (this%iout, '(4x,a)') 'K22 set from input file' end if - if (afound(5)) then + if (found%wetdry) then write (this%iout, '(4x,a)') 'WETDRY set from input file' end if - if (afound(6)) then + if (found%angle1) then write (this%iout, '(4x,a)') 'ANGLE1 set from input file' end if - if (afound(7)) then + if (found%angle2) then write (this%iout, '(4x,a)') 'ANGLE2 set from input file' end if - if (afound(8)) then + if (found%angle3) then write (this%iout, '(4x,a)') 'ANGLE3 set from input file' end if @@ -1641,12 +1655,14 @@ subroutine source_griddata(this) use MemoryManagerModule, only: mem_reallocate use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context + use GwfNpfInputModule, only: GwfNpfParamFoundType ! -- dummy class(GwfNpftype) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath character(len=LINELENGTH) :: errmsg - logical, dimension(10) :: afound + type(GwfNpfParamFoundType) :: found + logical, dimension(2) :: afound integer(I4B), dimension(:), pointer, contiguous :: map ! -- formats ! ------------------------------------------------------------------------------ @@ -1660,68 +1676,68 @@ subroutine source_griddata(this) ! ! -- update defaults with idm sourced values call mem_set_value(this%icelltype, 'ICELLTYPE', idmMemoryPath, map, & - afound(1)) - call mem_set_value(this%k11, 'K', idmMemoryPath, map, afound(2)) - call mem_set_value(this%k33, 'K33', idmMemoryPath, map, afound(3)) - call mem_set_value(this%k22, 'K22', idmMemoryPath, map, afound(4)) - call mem_set_value(this%wetdry, 'WETDRY', idmMemoryPath, map, afound(5)) - call mem_set_value(this%angle1, 'ANGLE1', idmMemoryPath, map, afound(6)) - call mem_set_value(this%angle2, 'ANGLE2', idmMemoryPath, map, afound(7)) - call mem_set_value(this%angle3, 'ANGLE3', idmMemoryPath, map, afound(8)) + found%icelltype) + call mem_set_value(this%k11, 'K', idmMemoryPath, map, found%k) + call mem_set_value(this%k33, 'K33', idmMemoryPath, map, found%k33) + call mem_set_value(this%k22, 'K22', idmMemoryPath, map, found%k22) + call mem_set_value(this%wetdry, 'WETDRY', idmMemoryPath, map, found%wetdry) + call mem_set_value(this%angle1, 'ANGLE1', idmMemoryPath, map, found%angle1) + call mem_set_value(this%angle2, 'ANGLE2', idmMemoryPath, map, found%angle2) + call mem_set_value(this%angle3, 'ANGLE3', idmMemoryPath, map, found%angle3) ! ! -- ensure ICELLTYPE was found - if (.not. afound(1)) then + if (.not. found%icelltype) then write (errmsg, '(a)') 'Error in GRIDDATA block: ICELLTYPE not found.' call store_error(errmsg) end if ! ! -- ensure K was found - if (.not. afound(2)) then + if (.not. found%k) then write (errmsg, '(a)') 'Error in GRIDDATA block: K not found.' call store_error(errmsg) end if ! ! -- set error if ik33overk set with no k33 - if (.not. afound(3) .and. this%ik33overk /= 0) then + if (.not. found%k33 .and. this%ik33overk /= 0) then write (errmsg, '(a)') 'K33OVERK option specified but K33 not specified.' call store_error(errmsg) end if ! ! -- set error if ik22overk set with no k22 - if (.not. afound(4) .and. this%ik22overk /= 0) then + if (.not. found%k22 .and. this%ik22overk /= 0) then write (errmsg, '(a)') 'K22OVERK option specified but K22 not specified.' call store_error(errmsg) end if ! ! -- handle found side effects - if (afound(3)) this%ik33 = 1 - if (afound(4)) this%ik22 = 1 - if (afound(5)) this%iwetdry = 1 - if (afound(6)) this%iangle1 = 1 - if (afound(7)) this%iangle2 = 1 - if (afound(8)) this%iangle3 = 1 + if (found%k33) this%ik33 = 1 + if (found%k22) this%ik22 = 1 + if (found%wetdry) this%iwetdry = 1 + if (found%angle1) this%iangle1 = 1 + if (found%angle2) this%iangle2 = 1 + if (found%angle3) this%iangle3 = 1 ! ! -- handle not found side effects - if (.not. afound(3)) then + if (.not. found%k33) then write (this%iout, '(1x, a)') 'K33 not provided. Setting K33 = K.' - call mem_set_value(this%k33, 'K', idmMemoryPath, map, afound(9)) + call mem_set_value(this%k33, 'K', idmMemoryPath, map, afound(1)) end if - if (.not. afound(4)) then + if (.not. found%k22) then write (this%iout, '(1x, a)') 'K22 not provided. Setting K22 = K.' - call mem_set_value(this%k22, 'K', idmMemoryPath, map, afound(10)) + call mem_set_value(this%k22, 'K', idmMemoryPath, map, afound(2)) end if - if (.not. afound(5)) call mem_reallocate(this%wetdry, 1, 'WETDRY', & - trim(this%memoryPath)) - if (.not. afound(6) .and. this%ixt3d == 0) & + if (.not. found%wetdry) call mem_reallocate(this%wetdry, 1, 'WETDRY', & + trim(this%memoryPath)) + if (.not. found%angle1 .and. this%ixt3d == 0) & call mem_reallocate(this%angle1, 1, 'ANGLE1', trim(this%memoryPath)) - if (.not. afound(7) .and. this%ixt3d == 0) & + if (.not. found%angle2 .and. this%ixt3d == 0) & call mem_reallocate(this%angle2, 1, 'ANGLE2', trim(this%memoryPath)) - if (.not. afound(8) .and. this%ixt3d == 0) & + if (.not. found%angle3 .and. this%ixt3d == 0) & call mem_reallocate(this%angle3, 1, 'ANGLE3', trim(this%memoryPath)) ! ! -- log griddata if (this%iout > 0) then - call this%log_griddata(afound) + call this%log_griddata(found) end if ! ! -- Return diff --git a/src/Model/GroundWaterFlow/gwf3npf8idm.f90 b/src/Model/GroundWaterFlow/gwf3npf8idm.f90 index c757278d6b7..9a7d39579d3 100644 --- a/src/Model/GroundWaterFlow/gwf3npf8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3npf8idm.f90 @@ -5,6 +5,47 @@ module GwfNpfInputModule public gwf_npf_param_definitions public gwf_npf_aggregate_definitions public gwf_npf_block_definitions + public GwfNpfParamFoundType + + type GwfNpfParamFoundType + logical :: ipakcb = .false. + logical :: iprflow = .false. + logical :: cellavg = .false. + logical :: ithickstrt = .false. + logical :: cvoptions = .false. + logical :: ivarcv = .false. + logical :: idewatcv = .false. + logical :: iperched = .false. + logical :: rewet_record = .false. + logical :: irewet = .false. + logical :: wetfct = .false. + logical :: iwetit = .false. + logical :: ihdwet = .false. + logical :: xt3doptions = .false. + logical :: ixt3d = .false. + logical :: ixt3drhs = .false. + logical :: isavspdis = .false. + logical :: isavsat = .false. + logical :: ik22overk = .false. + logical :: ik33overk = .false. + logical :: tvk_filerecord = .false. + logical :: tvk6 = .false. + logical :: filein = .false. + logical :: tvk6_filename = .false. + logical :: inewton = .false. + logical :: iusgnrhc = .false. + logical :: inwtupw = .false. + logical :: satmin = .false. + logical :: satomega = .false. + logical :: icelltype = .false. + logical :: k = .false. + logical :: k22 = .false. + logical :: k33 = .false. + logical :: angle1 = .false. + logical :: angle2 = .false. + logical :: angle3 = .false. + logical :: wetdry = .false. + end type GwfNpfParamFoundType type(InputParamDefinitionType), parameter :: & gwfnpf_ipakcb = InputParamDefinitionType & diff --git a/src/Model/GroundWaterTransport/gwt1dsp.f90 b/src/Model/GroundWaterTransport/gwt1dsp.f90 index 3bff76ec9ec..d2a773dd6ea 100644 --- a/src/Model/GroundWaterTransport/gwt1dsp.f90 +++ b/src/Model/GroundWaterTransport/gwt1dsp.f90 @@ -551,9 +551,10 @@ end subroutine dsp_da !> @brief Write user options to list file !< - subroutine log_options(this, afound) + subroutine log_options(this, found) + use GwtDspInputModule, only: GwtDspParamFoundType class(GwTDspType) :: this - logical, dimension(:), intent(in) :: afound + type(GwtDspParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting DSP Options' write (this%iout, '(4x,a,i0)') 'XT3D FORMULATION [0=INACTIVE, 1=ACTIVE, & @@ -575,27 +576,28 @@ subroutine source_options(this) use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context use ConstantsModule, only: LENMEMPATH + use GwtDspInputModule, only: GwtDspParamFoundType ! -- dummy class(GwtDspType) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath - logical, dimension(2) :: afound + type(GwtDspParamFoundType) :: found ! ------------------------------------------------------------------------------ ! ! -- set memory path idmMemoryPath = create_mem_path(this%name_model, 'DSP', idm_context) ! ! -- update defaults with idm sourced values - call mem_set_value(this%ixt3doff, 'XT3D_OFF', idmMemoryPath, afound(1)) - call mem_set_value(this%ixt3drhs, 'XT3D_RHS', idmMemoryPath, afound(2)) + call mem_set_value(this%ixt3doff, 'XT3D_OFF', idmMemoryPath, found%xt3d_off) + call mem_set_value(this%ixt3drhs, 'XT3D_RHS', idmMemoryPath, found%xt3d_rhs) ! ! -- set xt3d state flag - if (afound(1)) this%ixt3d = 0 - if (afound(2)) this%ixt3d = 2 + if (found%xt3d_off) this%ixt3d = 0 + if (found%xt3d_rhs) this%ixt3d = 2 ! ! -- log options if (this%iout > 0) then - call this%log_options(afound) + call this%log_options(found) end if ! ! -- Return @@ -604,33 +606,34 @@ end subroutine source_options !> @brief Write dimensions to list file !< - subroutine log_griddata(this, afound) + subroutine log_griddata(this, found) + use GwtDspInputModule, only: GwtDspParamFoundType class(GwtDspType) :: this - logical, dimension(:), intent(in) :: afound + type(GwtDspParamFoundType), intent(in) :: found write (this%iout, '(1x,a)') 'Setting DSP Griddata' - if (afound(1)) then + if (found%diffc) then write (this%iout, '(4x,a)') 'DIFFC set from input file' end if - if (afound(2)) then + if (found%alh) then write (this%iout, '(4x,a)') 'ALH set from input file' end if - if (afound(3)) then + if (found%alv) then write (this%iout, '(4x,a)') 'ALV set from input file' end if - if (afound(4)) then + if (found%ath1) then write (this%iout, '(4x,a)') 'ATH1 set from input file' end if - if (afound(5)) then + if (found%ath2) then write (this%iout, '(4x,a)') 'ATH2 set from input file' end if - if (afound(6)) then + if (found%atv) then write (this%iout, '(4x,a)') 'ATV set from input file' end if @@ -652,14 +655,14 @@ subroutine source_griddata(this) use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context use ConstantsModule, only: LENMEMPATH, LINELENGTH + use GwtDspInputModule, only: GwtDspParamFoundType ! -- dummy class(GwtDsptype) :: this ! -- locals character(len=LENMEMPATH) :: idmMemoryPath character(len=LINELENGTH) :: errmsg - logical, dimension(6) :: afound + type(GwtDspParamFoundType) :: found integer(I4B), dimension(:), pointer, contiguous :: map - integer(I4B) :: idisp ! -- formats ! ------------------------------------------------------------------------------ ! @@ -671,48 +674,49 @@ subroutine source_griddata(this) if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser ! ! -- update defaults with idm sourced values - call mem_set_value(this%diffc, 'DIFFC', idmMemoryPath, map, afound(1)) - call mem_set_value(this%alh, 'ALH', idmMemoryPath, map, afound(2)) - call mem_set_value(this%alv, 'ALV', idmMemoryPath, map, afound(3)) - call mem_set_value(this%ath1, 'ATH1', idmMemoryPath, map, afound(4)) - call mem_set_value(this%ath2, 'ATH2', idmMemoryPath, map, afound(5)) - call mem_set_value(this%atv, 'ATV', idmMemoryPath, map, afound(6)) + call mem_set_value(this%diffc, 'DIFFC', idmMemoryPath, map, found%diffc) + call mem_set_value(this%alh, 'ALH', idmMemoryPath, map, found%alh) + call mem_set_value(this%alv, 'ALV', idmMemoryPath, map, found%alv) + call mem_set_value(this%ath1, 'ATH1', idmMemoryPath, map, found%ath1) + call mem_set_value(this%ath2, 'ATH2', idmMemoryPath, map, found%ath2) + call mem_set_value(this%atv, 'ATV', idmMemoryPath, map, found%atv) ! ! -- set active flags - if (afound(1)) this%idiffc = 1 - if (afound(2)) this%ialh = 1 - if (afound(3)) this%ialv = 1 - if (afound(4)) this%iath1 = 1 - if (afound(5)) this%iath2 = 1 - if (afound(6)) this%iatv = 1 + if (found%diffc) this%idiffc = 1 + if (found%alh) this%ialh = 1 + if (found%alv) this%ialv = 1 + if (found%ath1) this%iath1 = 1 + if (found%ath2) this%iath2 = 1 + if (found%atv) this%iatv = 1 ! ! -- reallocate diffc if not found - if (.not. afound(1)) then + if (.not. found%diffc) then call mem_reallocate(this%diffc, 0, 'DIFFC', trim(this%memoryPath)) end if ! ! -- set this%idisp flag - do idisp = 2, 5 ! ALH, ALV, ATH1, ATH2 - if (afound(idisp)) this%idisp = this%idisp + 1 - end do + if (found%alh) this%idisp = this%idisp + 1 + if (found%alv) this%idisp = this%idisp + 1 + if (found%ath1) this%idisp = this%idisp + 1 + if (found%ath2) this%idisp = this%idisp + 1 ! ! -- manage dispersion arrays if (this%idisp > 0) then - if (.not. (afound(2) .and. afound(4))) then + if (.not. (found%alh .and. found%ath1)) then write (errmsg, '(1x,a)') & 'IF DISPERSIVITIES ARE SPECIFIED THEN ALH AND ATH1 ARE REQUIRED.' call store_error(errmsg) end if ! -- If alv not specified then point it to alh - if (.not. afound(3)) & + if (.not. found%alv) & call mem_reassignptr(this%alv, 'ALV', trim(this%memoryPath), & 'ALH', trim(this%memoryPath)) ! -- If ath2 not specified then point it to ath1 - if (.not. afound(5)) & + if (.not. found%ath2) & call mem_reassignptr(this%ath2, 'ATH2', trim(this%memoryPath), & 'ATH1', trim(this%memoryPath)) ! -- If atv not specified then point it to ath2 - if (.not. afound(6)) & + if (.not. found%atv) & call mem_reassignptr(this%atv, 'ATV', trim(this%memoryPath), & 'ATH2', trim(this%memoryPath)) else @@ -725,7 +729,7 @@ subroutine source_griddata(this) ! ! -- log griddata if (this%iout > 0) then - call this%log_griddata(afound) + call this%log_griddata(found) end if ! ! -- Return diff --git a/src/Model/GroundWaterTransport/gwt1dspidm.f90 b/src/Model/GroundWaterTransport/gwt1dspidm.f90 index ac857c5dcae..323346d5d56 100644 --- a/src/Model/GroundWaterTransport/gwt1dspidm.f90 +++ b/src/Model/GroundWaterTransport/gwt1dspidm.f90 @@ -5,6 +5,18 @@ module GwtDspInputModule public gwt_dsp_param_definitions public gwt_dsp_aggregate_definitions public gwt_dsp_block_definitions + public GwtDspParamFoundType + + type GwtDspParamFoundType + logical :: xt3d_off = .false. + logical :: xt3d_rhs = .false. + logical :: diffc = .false. + logical :: alh = .false. + logical :: alv = .false. + logical :: ath1 = .false. + logical :: ath2 = .false. + logical :: atv = .false. + end type GwtDspParamFoundType type(InputParamDefinitionType), parameter :: & gwtdsp_xt3d_off = InputParamDefinitionType & diff --git a/utils/idmloader/scripts/dfn2f90.py b/utils/idmloader/scripts/dfn2f90.py index 1863439397b..6bc271c5fc0 100644 --- a/utils/idmloader/scripts/dfn2f90.py +++ b/utils/idmloader/scripts/dfn2f90.py @@ -45,6 +45,13 @@ def write_f90(self, odspec=None, gwt_name=False): # file header f.write(self._source_file_header(self.component, self.subcomponent)) + # found type + f.write(f" type {self.component.capitalize()}{self.subcomponent.capitalize()}ParamFoundType\n") + for var in self._param_varnames: + varname = var.split(f"{self.component.lower()}{self.subcomponent.lower()}_")[1] + f.write(f" logical :: {varname} = .false.\n") + f.write(f" end type {self.component.capitalize()}{self.subcomponent.capitalize()}ParamFoundType\n\n") + # params if len(self._param_varnames): f.write(self._param_str) @@ -343,6 +350,10 @@ def _source_file_header(self, component, subcomponent): ) s += ( f" public {component.lower()}_{subcomponent.lower()}_block_definitions" + + "\n" + ) + s += ( + f" public {component.capitalize()}{subcomponent.capitalize()}ParamFoundType" + "\n\n" ) return s diff --git a/utils/mf5to6/make/makefile b/utils/mf5to6/make/makefile index 161a83f072d..9708dc02d99 100644 --- a/utils/mf5to6/make/makefile +++ b/utils/mf5to6/make/makefile @@ -5,10 +5,10 @@ include ./makedefaults # Define the source file directories SOURCEDIR1=../src -SOURCEDIR2=../src/NWT -SOURCEDIR3=../src/LGR -SOURCEDIR4=../src/Preproc -SOURCEDIR5=../src/MF2005 +SOURCEDIR2=../src/LGR +SOURCEDIR3=../src/MF2005 +SOURCEDIR4=../src/NWT +SOURCEDIR5=../src/Preproc SOURCEDIR6=../../../src/Utilities/Memory SOURCEDIR7=../../../src/Utilities/TimeSeries SOURCEDIR8=../../../src/Utilities