From 9987e5ed6d332bee4e85485b9c94c2675720b993 Mon Sep 17 00:00:00 2001 From: mjreno Date: Fri, 22 Sep 2023 09:23:17 -0400 Subject: [PATCH] feat(idm): support list and grid based input for base stress packages (#1337) * update input definition for timeseries, definition files for sfac param * modflow input type can select array based input definition set * generic list parser updates for reading binary inputs and timeseries strings * memory manager updates including checkin int2d and mem_set_value charstr1d * make dis instance optional in timearrayseries * add load framework and ascii grid and list based dynamic loader modules * use the input stress package load framework * cleanup 1 * move dfn based param allocation to bound context object * cleanup 2 * rebuild makefiles * remove uninteded makefile files * Check dis input dimensions before assigning model shapes * move idm advance call to mf6core --------- Co-authored-by: mjreno --- make/makedefaults | 12 +- make/makefile | 115 +-- msvs/mf6core.vfproj | 11 +- src/Model/GroundWaterFlow/gwf3dis8idm.f90 | 46 +- src/Model/GroundWaterFlow/gwf3disu8idm.f90 | 91 +- src/Model/GroundWaterFlow/gwf3disv8idm.f90 | 67 +- src/Model/GroundWaterFlow/gwf3idm.f90 | 37 +- src/Model/GroundWaterFlow/gwf3npf8.f90 | 37 +- src/Model/GroundWaterFlow/gwf3npf8idm.f90 | 118 ++- .../GroundWaterTransport/gwt1dis1idm.f90 | 46 +- .../GroundWaterTransport/gwt1disu1idm.f90 | 91 +- .../GroundWaterTransport/gwt1disv1idm.f90 | 67 +- .../GroundWaterTransport/gwt1dsp1idm.f90 | 31 +- src/Model/GroundWaterTransport/gwt1idm.f90 | 28 +- src/Model/ModelUtilities/BoundaryPackage.f90 | 2 +- src/Model/ModelUtilities/GwtSpc.f90 | 2 +- src/SimulationCreate.f90 | 2 +- src/Utilities/Idm/BoundInputContext.f90 | 561 +++++++++++++ src/Utilities/Idm/IdmLoad.f90 | 493 +++++++++++ src/Utilities/Idm/IdmSimulation.f90 | 246 ------ src/Utilities/Idm/InputDefinition.f90 | 6 +- src/Utilities/Idm/InputLoadType.f90 | 408 +++++++++ src/Utilities/Idm/ModelPackageInputs.f90 | 88 +- src/Utilities/Idm/ModflowInput.f90 | 106 ++- src/Utilities/Idm/SourceCommon.f90 | 380 +++++++++ src/Utilities/Idm/SourceLoad.F90 | 175 ++++ .../Idm/mf6blockfile/AsciiInputLoadType.f90 | 34 + src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 | 540 +++++++----- .../Idm/mf6blockfile/LoadMf6File.f90 | 287 ++++--- .../Idm/mf6blockfile/StressGridInput.f90 | 513 ++++++++++++ .../Idm/mf6blockfile/StressListInput.f90 | 430 ++++++++++ .../Idm/mf6blockfile/StructArray.f90 | 792 ++++++++++++------ .../Idm/mf6blockfile/StructVector.f90 | 141 +++- src/Utilities/Idm/selector/IdmDfnSelector.f90 | 56 +- .../Idm/selector/IdmGwfDfnSelector.f90 | 134 ++- .../Idm/selector/IdmGwtDfnSelector.f90 | 102 ++- .../Idm/selector/IdmSimDfnSelector.f90 | 42 +- src/Utilities/Memory/MemoryManager.f90 | 44 + src/Utilities/Memory/MemoryManagerExt.f90 | 32 +- src/Utilities/TimeSeries/TimeArray.f90 | 28 +- src/Utilities/TimeSeries/TimeArraySeries.f90 | 48 +- .../TimeSeries/TimeArraySeriesManager.f90 | 26 +- src/meson.build | 9 +- src/mf6core.f90 | 20 +- src/simnamidm.f90 | 64 +- utils/idmloader/scripts/dfn2f90.py | 192 ++++- utils/mf5to6/make/makedefaults | 8 +- utils/mf5to6/make/makefile | 8 +- utils/zonebudget/make/makedefaults | 12 +- 49 files changed, 5493 insertions(+), 1335 deletions(-) create mode 100644 src/Utilities/Idm/BoundInputContext.f90 create mode 100644 src/Utilities/Idm/IdmLoad.f90 delete mode 100644 src/Utilities/Idm/IdmSimulation.f90 create mode 100644 src/Utilities/Idm/InputLoadType.f90 create mode 100644 src/Utilities/Idm/SourceCommon.f90 create mode 100644 src/Utilities/Idm/SourceLoad.F90 create mode 100644 src/Utilities/Idm/mf6blockfile/AsciiInputLoadType.f90 create mode 100644 src/Utilities/Idm/mf6blockfile/StressGridInput.f90 create mode 100644 src/Utilities/Idm/mf6blockfile/StressListInput.f90 diff --git a/make/makedefaults b/make/makedefaults index a9174e9746d..88e1790887a 100644 --- a/make/makedefaults +++ b/make/makedefaults @@ -57,19 +57,16 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp + FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp endif else ifeq ($(FC), gfortran) - FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp + FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp MODSWITCH = -module $(MODDIR) endif - ifeq ($(FC), $(filter $(FC), ftn)) - FFLAGS ?= -h noheap_allocate - endif endif # set the ldflgs @@ -84,9 +81,6 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif - ifeq ($(FC), $(filter $(FC), ftn)) - LDFLAGS ?= -lc - endif endif # check for Windows error condition diff --git a/make/makefile b/make/makefile index f2e1a58dd0b..f82c2725180 100644 --- a/make/makefile +++ b/make/makefile @@ -5,36 +5,36 @@ include ./makedefaults # Define the source file directories SOURCEDIR1=../src -SOURCEDIR2=../src/Distributed -SOURCEDIR3=../src/Exchange -SOURCEDIR4=../src/Model -SOURCEDIR5=../src/Model/Connection -SOURCEDIR6=../src/Model/Geometry -SOURCEDIR7=../src/Model/GroundWaterFlow +SOURCEDIR2=../src/Exchange +SOURCEDIR3=../src/Model +SOURCEDIR4=../src/Model/Geometry +SOURCEDIR5=../src/Model/TransportModel +SOURCEDIR6=../src/Model/ModelUtilities +SOURCEDIR7=../src/Model/Connection SOURCEDIR8=../src/Model/GroundWaterTransport -SOURCEDIR9=../src/Model/ModelUtilities -SOURCEDIR10=../src/Model/TransportModel +SOURCEDIR9=../src/Model/GroundWaterFlow +SOURCEDIR10=../src/Distributed SOURCEDIR11=../src/Solution -SOURCEDIR12=../src/Solution/LinearMethods -SOURCEDIR13=../src/Solution/PETSc +SOURCEDIR12=../src/Solution/PETSc +SOURCEDIR13=../src/Solution/LinearMethods SOURCEDIR14=../src/Timing SOURCEDIR15=../src/Utilities -SOURCEDIR16=../src/Utilities/ArrayRead -SOURCEDIR17=../src/Utilities/Idm -SOURCEDIR18=../src/Utilities/Idm/mf6blockfile -SOURCEDIR19=../src/Utilities/Idm/selector -SOURCEDIR20=../src/Utilities/Libraries +SOURCEDIR16=../src/Utilities/TimeSeries +SOURCEDIR17=../src/Utilities/Libraries +SOURCEDIR18=../src/Utilities/Libraries/rcm +SOURCEDIR19=../src/Utilities/Libraries/sparsekit +SOURCEDIR20=../src/Utilities/Libraries/sparskit2 SOURCEDIR21=../src/Utilities/Libraries/blas SOURCEDIR22=../src/Utilities/Libraries/daglib -SOURCEDIR23=../src/Utilities/Libraries/rcm -SOURCEDIR24=../src/Utilities/Libraries/sparsekit -SOURCEDIR25=../src/Utilities/Libraries/sparskit2 +SOURCEDIR23=../src/Utilities/Idm +SOURCEDIR24=../src/Utilities/Idm/selector +SOURCEDIR25=../src/Utilities/Idm/mf6blockfile SOURCEDIR26=../src/Utilities/Matrix -SOURCEDIR27=../src/Utilities/Memory +SOURCEDIR27=../src/Utilities/Vector SOURCEDIR28=../src/Utilities/Observation SOURCEDIR29=../src/Utilities/OutputControl -SOURCEDIR30=../src/Utilities/TimeSeries -SOURCEDIR31=../src/Utilities/Vector +SOURCEDIR30=../src/Utilities/Memory +SOURCEDIR31=../src/Utilities/ArrayRead VPATH = \ ${SOURCEDIR1} \ @@ -110,16 +110,33 @@ $(OBJDIR)/SmoothingFunctions.o \ $(OBJDIR)/MatrixBase.o \ $(OBJDIR)/ListReader.o \ $(OBJDIR)/Connections.o \ -$(OBJDIR)/DiscretizationBase.o \ +$(OBJDIR)/InputDefinition.o \ $(OBJDIR)/TimeArray.o \ $(OBJDIR)/ObsOutput.o \ +$(OBJDIR)/DiscretizationBase.o \ +$(OBJDIR)/simnamidm.o \ +$(OBJDIR)/gwt1idm.o \ +$(OBJDIR)/gwt1dsp1idm.o \ +$(OBJDIR)/gwt1disv1idm.o \ +$(OBJDIR)/gwt1disu1idm.o \ +$(OBJDIR)/gwt1dis1idm.o \ +$(OBJDIR)/gwf3npf8idm.o \ +$(OBJDIR)/gwf3idm.o \ +$(OBJDIR)/gwf3disv8idm.o \ +$(OBJDIR)/gwf3disu8idm.o \ +$(OBJDIR)/gwf3dis8idm.o \ $(OBJDIR)/TimeArraySeries.o \ $(OBJDIR)/ObsOutputList.o \ $(OBJDIR)/Observe.o \ +$(OBJDIR)/IdmSimDfnSelector.o \ +$(OBJDIR)/IdmGwtDfnSelector.o \ +$(OBJDIR)/IdmGwfDfnSelector.o \ $(OBJDIR)/TimeArraySeriesLink.o \ $(OBJDIR)/ObsUtility.o \ $(OBJDIR)/ObsContainer.o \ $(OBJDIR)/BudgetFileReader.o \ +$(OBJDIR)/IdmDfnSelector.o \ +$(OBJDIR)/ArrayReaderBase.o \ $(OBJDIR)/TimeArraySeriesManager.o \ $(OBJDIR)/PackageMover.o \ $(OBJDIR)/Obs3.o \ @@ -128,31 +145,29 @@ $(OBJDIR)/Budget.o \ $(OBJDIR)/BudgetTerm.o \ $(OBJDIR)/sort.o \ $(OBJDIR)/SfrCrossSectionUtils.o \ -$(OBJDIR)/VirtualBase.o \ $(OBJDIR)/STLVecInt.o \ +$(OBJDIR)/ModflowInput.o \ +$(OBJDIR)/MemoryManagerExt.o \ +$(OBJDIR)/Integer2dReader.o \ +$(OBJDIR)/VirtualBase.o \ $(OBJDIR)/BoundaryPackage.o \ $(OBJDIR)/BaseModel.o \ -$(OBJDIR)/InputDefinition.o \ $(OBJDIR)/PackageBudget.o \ $(OBJDIR)/HeadFileReader.o \ $(OBJDIR)/BudgetObject.o \ $(OBJDIR)/SfrCrossSectionManager.o \ $(OBJDIR)/dag_module.o \ +$(OBJDIR)/StructVector.o \ +$(OBJDIR)/IdmLogger.o \ +$(OBJDIR)/DefinitionSelect.o \ +$(OBJDIR)/InputLoadType.o \ +$(OBJDIR)/Integer1dReader.o \ +$(OBJDIR)/Double2dReader.o \ +$(OBJDIR)/Double1dReader.o \ $(OBJDIR)/VirtualDataLists.o \ $(OBJDIR)/VirtualDataContainer.o \ $(OBJDIR)/SimStages.o \ $(OBJDIR)/NumericalModel.o \ -$(OBJDIR)/simnamidm.o \ -$(OBJDIR)/gwt1idm.o \ -$(OBJDIR)/gwt1dsp1idm.o \ -$(OBJDIR)/gwt1disv1idm.o \ -$(OBJDIR)/gwt1disu1idm.o \ -$(OBJDIR)/gwt1dis1idm.o \ -$(OBJDIR)/gwf3npf8idm.o \ -$(OBJDIR)/gwf3idm.o \ -$(OBJDIR)/gwf3disv8idm.o \ -$(OBJDIR)/gwf3disu8idm.o \ -$(OBJDIR)/gwf3dis8idm.o \ $(OBJDIR)/FlowModelInterface.o \ $(OBJDIR)/PrintSaveManager.o \ $(OBJDIR)/Xt3dAlgorithm.o \ @@ -166,25 +181,28 @@ $(OBJDIR)/GwfVscInputData.o \ $(OBJDIR)/gwf3ghb8.o \ $(OBJDIR)/gwf3drn8.o \ $(OBJDIR)/IndexMap.o \ +$(OBJDIR)/StructArray.o \ +$(OBJDIR)/BoundInputContext.o \ +$(OBJDIR)/AsciiInputLoadType.o \ +$(OBJDIR)/SourceCommon.o \ +$(OBJDIR)/LayeredArrayReader.o \ $(OBJDIR)/VirtualModel.o \ $(OBJDIR)/BaseExchange.o \ -$(OBJDIR)/IdmSimDfnSelector.o \ -$(OBJDIR)/IdmGwtDfnSelector.o \ -$(OBJDIR)/IdmGwfDfnSelector.o \ $(OBJDIR)/UzfCellGroup.o \ $(OBJDIR)/gwt1fmi1.o \ $(OBJDIR)/OutputControlData.o \ $(OBJDIR)/gwf3ic8.o \ $(OBJDIR)/Xt3dInterface.o \ $(OBJDIR)/gwf3tvk8.o \ -$(OBJDIR)/MemoryManagerExt.o \ $(OBJDIR)/gwf3vsc8.o \ $(OBJDIR)/GwfNpfOptions.o \ $(OBJDIR)/InterfaceMap.o \ $(OBJDIR)/SeqVector.o \ +$(OBJDIR)/StressListInput.o \ +$(OBJDIR)/StressGridInput.o \ +$(OBJDIR)/LoadMf6File.o \ $(OBJDIR)/CellWithNbrs.o \ $(OBJDIR)/NumericalExchange.o \ -$(OBJDIR)/IdmDfnSelector.o \ $(OBJDIR)/gwf3uzf8.o \ $(OBJDIR)/gwt1apt1.o \ $(OBJDIR)/GwtSpc.o \ @@ -204,7 +222,7 @@ $(OBJDIR)/VirtualSolution.o \ $(OBJDIR)/SparseMatrix.o \ $(OBJDIR)/LinearSolverBase.o \ $(OBJDIR)/ims8reordering.o \ -$(OBJDIR)/ArrayReaderBase.o \ +$(OBJDIR)/IdmMf6File.o \ $(OBJDIR)/VirtualExchange.o \ $(OBJDIR)/gwf3disu8.o \ $(OBJDIR)/GridSorting.o \ @@ -243,7 +261,7 @@ $(OBJDIR)/gwf3chd8.o \ $(OBJDIR)/RouterBase.o \ $(OBJDIR)/ImsLinearSolver.o \ $(OBJDIR)/ims8base.o \ -$(OBJDIR)/Integer2dReader.o \ +$(OBJDIR)/SourceLoad.o \ $(OBJDIR)/GridConnection.o \ $(OBJDIR)/DistributedVariable.o \ $(OBJDIR)/gwt1.o \ @@ -252,12 +270,8 @@ $(OBJDIR)/SerialRouter.o \ $(OBJDIR)/Timer.o \ $(OBJDIR)/LinearSolverFactory.o \ $(OBJDIR)/ims8linear.o \ +$(OBJDIR)/IdmLoad.o \ $(OBJDIR)/BaseSolution.o \ -$(OBJDIR)/StructVector.o \ -$(OBJDIR)/IdmLogger.o \ -$(OBJDIR)/Integer1dReader.o \ -$(OBJDIR)/Double2dReader.o \ -$(OBJDIR)/Double1dReader.o \ $(OBJDIR)/ExplicitModel.o \ $(OBJDIR)/SpatialModelConnection.o \ $(OBJDIR)/GwtInterfaceModel.o \ @@ -267,16 +281,11 @@ $(OBJDIR)/GwfGwfExchange.o \ $(OBJDIR)/RouterFactory.o \ $(OBJDIR)/NumericalSolution.o \ $(OBJDIR)/MappedMemory.o \ -$(OBJDIR)/StructArray.o \ -$(OBJDIR)/ModflowInput.o \ -$(OBJDIR)/LayeredArrayReader.o \ -$(OBJDIR)/DefinitionSelect.o \ $(OBJDIR)/ExplicitSolution.o \ $(OBJDIR)/GwtGwtConnection.o \ $(OBJDIR)/GwfGwfConnection.o \ $(OBJDIR)/VirtualDataManager.o \ $(OBJDIR)/Mapper.o \ -$(OBJDIR)/LoadMf6File.o \ $(OBJDIR)/VirtualGwtModel.o \ $(OBJDIR)/VirtualGwtExchange.o \ $(OBJDIR)/VirtualGwfModel.o \ @@ -285,10 +294,8 @@ $(OBJDIR)/SolutionGroup.o \ $(OBJDIR)/SolutionFactory.o \ $(OBJDIR)/GwfGwtExchange.o \ $(OBJDIR)/RunControl.o \ -$(OBJDIR)/IdmMf6File.o \ $(OBJDIR)/SimulationCreate.o \ $(OBJDIR)/RunControlFactory.o \ -$(OBJDIR)/IdmSimulation.o \ $(OBJDIR)/ConnectionBuilder.o \ $(OBJDIR)/comarg.o \ $(OBJDIR)/mf6core.o \ diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index ebde0a6be87..81b2dccb5fc 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -268,8 +268,11 @@ + + + @@ -277,12 +280,16 @@ + + - + - + + + diff --git a/src/Model/GroundWaterFlow/gwf3dis8idm.f90 b/src/Model/GroundWaterFlow/gwf3dis8idm.f90 index 0c8d8cd90b1..2df7e2258ac 100644 --- a/src/Model/GroundWaterFlow/gwf3dis8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3dis8idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfDisInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwfDisInputModule public gwf_dis_block_definitions public GwfDisParamFoundType public gwf_dis_multi_package + public gwf_dis_aux_sfac_param type GwfDisParamFoundType logical :: length_units = .false. @@ -27,6 +29,8 @@ module GwfDisInputModule logical :: gwf_dis_multi_package = .false. + character(len=LENVARNAME) :: gwf_dis_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwfdis_length_units = InputParamDefinitionType & ( & @@ -40,7 +44,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -56,7 +61,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -72,7 +78,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -88,7 +95,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -104,7 +112,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -120,7 +129,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -136,7 +146,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -152,7 +163,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -168,7 +180,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -184,7 +197,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -200,7 +214,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -216,7 +231,8 @@ module GwfDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -232,7 +248,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -268,7 +285,8 @@ module GwfDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) & ] diff --git a/src/Model/GroundWaterFlow/gwf3disu8idm.f90 b/src/Model/GroundWaterFlow/gwf3disu8idm.f90 index 10a61f84702..c41538095c8 100644 --- a/src/Model/GroundWaterFlow/gwf3disu8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3disu8idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfDisuInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwfDisuInputModule public gwf_disu_block_definitions public GwfDisuParamFoundType public gwf_disu_multi_package + public gwf_disu_aux_sfac_param type GwfDisuParamFoundType logical :: length_units = .false. @@ -41,6 +43,8 @@ module GwfDisuInputModule logical :: gwf_disu_multi_package = .false. + character(len=LENVARNAME) :: gwf_disu_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwfdisu_length_units = InputParamDefinitionType & ( & @@ -54,7 +58,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -70,7 +75,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -86,7 +92,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -102,7 +109,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -118,7 +126,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -134,7 +143,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -150,7 +160,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -166,7 +177,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -182,7 +194,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -198,7 +211,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -214,7 +228,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -230,7 +245,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -246,7 +262,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -262,7 +279,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -278,7 +296,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -294,7 +313,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -310,7 +330,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -326,7 +347,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -342,7 +364,8 @@ module GwfDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -358,7 +381,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -374,7 +398,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -390,7 +415,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -406,7 +432,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -422,7 +449,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -438,7 +466,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -454,7 +483,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -470,7 +500,8 @@ module GwfDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -518,7 +549,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -534,7 +566,8 @@ module GwfDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterFlow/gwf3disv8idm.f90 b/src/Model/GroundWaterFlow/gwf3disv8idm.f90 index 142d32945d7..42de109815c 100644 --- a/src/Model/GroundWaterFlow/gwf3disv8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3disv8idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfDisvInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwfDisvInputModule public gwf_disv_block_definitions public GwfDisvParamFoundType public gwf_disv_multi_package + public gwf_disv_aux_sfac_param type GwfDisvParamFoundType logical :: length_units = .false. @@ -33,6 +35,8 @@ module GwfDisvInputModule logical :: gwf_disv_multi_package = .false. + character(len=LENVARNAME) :: gwf_disv_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwfdisv_length_units = InputParamDefinitionType & ( & @@ -46,7 +50,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -62,7 +67,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -78,7 +84,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -94,7 +101,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -110,7 +118,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -126,7 +135,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -142,7 +152,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -158,7 +169,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -174,7 +186,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -190,7 +203,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -206,7 +220,8 @@ module GwfDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -222,7 +237,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -238,7 +254,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -254,7 +271,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -270,7 +288,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -286,7 +305,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -302,7 +322,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -318,7 +339,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -334,7 +356,8 @@ module GwfDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -374,7 +397,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -390,7 +414,8 @@ module GwfDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterFlow/gwf3idm.f90 b/src/Model/GroundWaterFlow/gwf3idm.f90 index 0aaf3b5ac74..a4896b01229 100644 --- a/src/Model/GroundWaterFlow/gwf3idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfNamInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwfNamInputModule public gwf_nam_block_definitions public GwfNamParamFoundType public gwf_nam_multi_package + public gwf_nam_aux_sfac_param type GwfNamParamFoundType logical :: list = .false. @@ -24,6 +26,8 @@ module GwfNamInputModule logical :: gwf_nam_multi_package = .false. + character(len=LENVARNAME) :: gwf_nam_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwfnam_list = InputParamDefinitionType & ( & @@ -37,7 +41,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -53,7 +58,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -69,7 +75,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -85,7 +92,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -101,7 +109,8 @@ module GwfNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -117,7 +126,8 @@ module GwfNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -133,7 +143,8 @@ module GwfNamInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -149,7 +160,8 @@ module GwfNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -165,7 +177,8 @@ module GwfNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -181,7 +194,8 @@ module GwfNamInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -212,7 +226,8 @@ module GwfNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterFlow/gwf3npf8.f90 b/src/Model/GroundWaterFlow/gwf3npf8.f90 index fd60dd91cc2..56358e2e9b2 100644 --- a/src/Model/GroundWaterFlow/gwf3npf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3npf8.f90 @@ -1,5 +1,6 @@ module GwfNpfModule use KindModule, only: DP, I4B + use SimVariablesModule, only: errmsg use ConstantsModule, only: DZERO, DEM9, DEM8, DEM7, DEM6, DEM2, & DHALF, DP9, DONE, DTWO, & DLNLOW, DLNHIGH, & @@ -1475,7 +1476,10 @@ subroutine source_options(this) ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ ! -- modules + use SimModule, only: store_error, store_error_filename + use MemoryManagerModule, only: mem_setptr, get_isize use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType use GwfNpfInputModule, only: GwfNpfParamFoundType ! -- dummy class(GwfNpftype) :: this @@ -1483,7 +1487,10 @@ subroutine source_options(this) character(len=LENVARNAME), dimension(3) :: cellavg_method = & &[character(len=LENVARNAME) :: 'LOGARITHMIC', 'AMT-LMK', 'AMT-HMK'] type(GwfNpfParamFoundType) :: found + type(CharacterStringType), dimension(:), pointer, & + contiguous :: tvk6_fnames character(len=LINELENGTH) :: tvk6_filename + integer(I4B) :: tvk6_isize, n ! ------------------------------------------------------------------------------ ! ! -- update defaults with idm sourced values @@ -1508,8 +1515,6 @@ subroutine source_options(this) found%ik22overk) call mem_set_value(this%ik33overk, 'IK33OVERK', this%input_mempath, & found%ik33overk) - call mem_set_value(tvk6_filename, 'TVK6_FILENAME', this%input_mempath, & - found%tvk6_filename) call mem_set_value(this%inewton, 'INEWTON', this%input_mempath, found%inewton) call mem_set_value(this%iusgnrhc, 'IUSGNRHC', this%input_mempath, & found%iusgnrhc) @@ -1531,19 +1536,32 @@ subroutine source_options(this) ! -- save specific discharge active if (found%isavspdis) this%icalcspdis = this%isavspdis ! - ! -- TVK6 subpackage file spec provided - 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 (found%inewton) then this%inewton = 0 this%iasym = 0 end if ! + call get_isize('TVK6_FILENAME', this%input_mempath, tvk6_isize) + ! + if (tvk6_isize > 0) then + ! + if (tvk6_isize /= 1) then + errmsg = 'Multiple TVK6 keywords detected in OPTIONS block.'// & + ' Only one TVK6 entry allowed.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + ! + call mem_setptr(tvk6_fnames, 'TVK6_FILENAME', this%input_mempath) + ! + do n = 1, tvk6_isize + tvk6_filename = tvk6_fnames(n) + call openfile(this%intvk, this%iout, tvk6_filename, 'TVK') + call tvk_cr(this%tvk, this%name_model, this%intvk, this%iout) + end do + end if + ! ! -- log options if (this%iout > 0) then call this%log_options(found) @@ -1582,7 +1600,6 @@ subroutine check_options(this) ! -- dummy class(GwfNpftype) :: this ! -- local - character(len=LINELENGTH) :: errmsg ! ------------------------------------------------------------------------------ ! -- check if this%iusgnrhc has been enabled for a model that is not using ! the Newton-Raphson formulation diff --git a/src/Model/GroundWaterFlow/gwf3npf8idm.f90 b/src/Model/GroundWaterFlow/gwf3npf8idm.f90 index 79fe5bee186..68c1a610a1c 100644 --- a/src/Model/GroundWaterFlow/gwf3npf8idm.f90 +++ b/src/Model/GroundWaterFlow/gwf3npf8idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwfNpfInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwfNpfInputModule public gwf_npf_block_definitions public GwfNpfParamFoundType public gwf_npf_multi_package + public gwf_npf_aux_sfac_param type GwfNpfParamFoundType logical :: ipakcb = .false. @@ -51,6 +53,8 @@ module GwfNpfInputModule logical :: gwf_npf_multi_package = .false. + character(len=LENVARNAME) :: gwf_npf_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwfnpf_ipakcb = InputParamDefinitionType & ( & @@ -64,7 +68,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -80,7 +85,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -96,7 +102,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -112,7 +119,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -128,7 +136,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -144,7 +153,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -160,7 +170,8 @@ module GwfNpfInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -176,7 +187,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -192,7 +204,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -208,7 +221,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -224,7 +238,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -240,7 +255,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -256,7 +272,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -272,7 +289,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -288,7 +306,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -304,7 +323,8 @@ module GwfNpfInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -320,7 +340,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -336,7 +357,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -352,7 +374,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -368,7 +391,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -384,7 +408,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -400,7 +425,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -416,7 +442,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -432,7 +459,8 @@ module GwfNpfInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -448,7 +476,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -464,7 +493,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -480,7 +510,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -496,7 +527,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -512,7 +544,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -528,7 +561,8 @@ module GwfNpfInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -544,7 +578,8 @@ module GwfNpfInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -560,7 +595,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -576,7 +612,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -592,7 +629,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -608,7 +646,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -624,7 +663,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -640,7 +680,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -700,7 +741,8 @@ module GwfNpfInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) & ] diff --git a/src/Model/GroundWaterTransport/gwt1dis1idm.f90 b/src/Model/GroundWaterTransport/gwt1dis1idm.f90 index dda32a6b3a1..fe2f22614c1 100644 --- a/src/Model/GroundWaterTransport/gwt1dis1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1dis1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtDisInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwtDisInputModule public gwt_dis_block_definitions public GwtDisParamFoundType public gwt_dis_multi_package + public gwt_dis_aux_sfac_param type GwtDisParamFoundType logical :: length_units = .false. @@ -27,6 +29,8 @@ module GwtDisInputModule logical :: gwt_dis_multi_package = .false. + character(len=LENVARNAME) :: gwt_dis_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwtdis_length_units = InputParamDefinitionType & ( & @@ -40,7 +44,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -56,7 +61,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -72,7 +78,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -88,7 +95,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -104,7 +112,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -120,7 +129,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -136,7 +146,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -152,7 +163,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -168,7 +180,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -184,7 +197,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -200,7 +214,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -216,7 +231,8 @@ module GwtDisInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -232,7 +248,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -268,7 +285,8 @@ module GwtDisInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) & ] diff --git a/src/Model/GroundWaterTransport/gwt1disu1idm.f90 b/src/Model/GroundWaterTransport/gwt1disu1idm.f90 index 1a194976e94..758e756997e 100644 --- a/src/Model/GroundWaterTransport/gwt1disu1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1disu1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtDisuInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwtDisuInputModule public gwt_disu_block_definitions public GwtDisuParamFoundType public gwt_disu_multi_package + public gwt_disu_aux_sfac_param type GwtDisuParamFoundType logical :: length_units = .false. @@ -41,6 +43,8 @@ module GwtDisuInputModule logical :: gwt_disu_multi_package = .false. + character(len=LENVARNAME) :: gwt_disu_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwtdisu_length_units = InputParamDefinitionType & ( & @@ -54,7 +58,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -70,7 +75,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -86,7 +92,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -102,7 +109,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -118,7 +126,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -134,7 +143,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -150,7 +160,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -166,7 +177,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -182,7 +194,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -198,7 +211,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -214,7 +228,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -230,7 +245,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -246,7 +262,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -262,7 +279,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -278,7 +296,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -294,7 +313,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -310,7 +330,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -326,7 +347,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -342,7 +364,8 @@ module GwtDisuInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -358,7 +381,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -374,7 +398,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -390,7 +415,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -406,7 +432,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -422,7 +449,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -438,7 +466,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -454,7 +483,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -470,7 +500,8 @@ module GwtDisuInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -518,7 +549,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -534,7 +566,8 @@ module GwtDisuInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterTransport/gwt1disv1idm.f90 b/src/Model/GroundWaterTransport/gwt1disv1idm.f90 index 4ed35aca51a..4b888a8329e 100644 --- a/src/Model/GroundWaterTransport/gwt1disv1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1disv1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtDisvInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwtDisvInputModule public gwt_disv_block_definitions public GwtDisvParamFoundType public gwt_disv_multi_package + public gwt_disv_aux_sfac_param type GwtDisvParamFoundType logical :: length_units = .false. @@ -33,6 +35,8 @@ module GwtDisvInputModule logical :: gwt_disv_multi_package = .false. + character(len=LENVARNAME) :: gwt_disv_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwtdisv_length_units = InputParamDefinitionType & ( & @@ -46,7 +50,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -62,7 +67,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -78,7 +84,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -94,7 +101,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -110,7 +118,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -126,7 +135,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -142,7 +152,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -158,7 +169,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -174,7 +186,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -190,7 +203,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -206,7 +220,8 @@ module GwtDisvInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -222,7 +237,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -238,7 +254,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -254,7 +271,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -270,7 +288,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -286,7 +305,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -302,7 +322,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -318,7 +339,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -334,7 +356,8 @@ module GwtDisvInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -374,7 +397,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -390,7 +414,8 @@ module GwtDisvInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/GroundWaterTransport/gwt1dsp1idm.f90 b/src/Model/GroundWaterTransport/gwt1dsp1idm.f90 index 0f9e3c29e1d..9c1ca7fbfe1 100644 --- a/src/Model/GroundWaterTransport/gwt1dsp1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1dsp1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtDspInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwtDspInputModule public gwt_dsp_block_definitions public GwtDspParamFoundType public gwt_dsp_multi_package + public gwt_dsp_aux_sfac_param type GwtDspParamFoundType logical :: xt3d_off = .false. @@ -22,6 +24,8 @@ module GwtDspInputModule logical :: gwt_dsp_multi_package = .false. + character(len=LENVARNAME) :: gwt_dsp_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwtdsp_xt3d_off = InputParamDefinitionType & ( & @@ -35,7 +39,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -51,7 +56,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -67,7 +73,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -83,7 +90,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -99,7 +107,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -115,7 +124,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -131,7 +141,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -147,7 +158,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .true. & ! layered + .true., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -178,7 +190,8 @@ module GwtDspInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) & ] diff --git a/src/Model/GroundWaterTransport/gwt1idm.f90 b/src/Model/GroundWaterTransport/gwt1idm.f90 index e63fd582106..21fe34b8ba7 100644 --- a/src/Model/GroundWaterTransport/gwt1idm.f90 +++ b/src/Model/GroundWaterTransport/gwt1idm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module GwtNamInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module GwtNamInputModule public gwt_nam_block_definitions public GwtNamParamFoundType public gwt_nam_multi_package + public gwt_nam_aux_sfac_param type GwtNamParamFoundType logical :: list = .false. @@ -21,6 +23,8 @@ module GwtNamInputModule logical :: gwt_nam_multi_package = .false. + character(len=LENVARNAME) :: gwt_nam_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & gwtnam_list = InputParamDefinitionType & ( & @@ -34,7 +38,8 @@ module GwtNamInputModule .false., & ! required .false., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -50,7 +55,8 @@ module GwtNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -66,7 +72,8 @@ module GwtNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -82,7 +89,8 @@ module GwtNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -98,7 +106,8 @@ module GwtNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -114,7 +123,8 @@ module GwtNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -130,7 +140,8 @@ module GwtNamInputModule .false., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -158,7 +169,8 @@ module GwtNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/src/Model/ModelUtilities/BoundaryPackage.f90 b/src/Model/ModelUtilities/BoundaryPackage.f90 index 8fd71401f45..58895f2554f 100644 --- a/src/Model/ModelUtilities/BoundaryPackage.f90 +++ b/src/Model/ModelUtilities/BoundaryPackage.f90 @@ -187,7 +187,7 @@ subroutine bnd_df(this, neq, dis) ! ! -- Create time series managers call tsmanager_cr(this%TsManager, this%iout) - call tasmanager_cr(this%TasManager, dis, this%iout) + call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout) ! ! -- create obs package call obs_cr(this%obs, this%inobspkg) diff --git a/src/Model/ModelUtilities/GwtSpc.f90 b/src/Model/ModelUtilities/GwtSpc.f90 index 9b33f196e2d..0b0677afc91 100644 --- a/src/Model/ModelUtilities/GwtSpc.f90 +++ b/src/Model/ModelUtilities/GwtSpc.f90 @@ -117,7 +117,7 @@ subroutine initialize(this, dis, id, inunit, iout, name_model, packNameFlow) ! ! -- Setup the time series manager call tsmanager_cr(this%TsManager, this%iout) - call tasmanager_cr(this%TasManager, dis, this%iout) + call tasmanager_cr(this%TasManager, dis, name_model, this%iout) ! ! -- read options call this%read_options() diff --git a/src/SimulationCreate.f90 b/src/SimulationCreate.f90 index 6407097b7b2..0c0b22e78e2 100644 --- a/src/SimulationCreate.f90 +++ b/src/SimulationCreate.f90 @@ -521,7 +521,7 @@ subroutine solution_groups_create() call mem_setptr(slntype, 'SLNTYPE', input_mempath) call mem_setptr(slnfname, 'SLNFNAME', input_mempath) call mem_setptr(slnmnames, 'SLNMNAMES', input_mempath) - call mem_setptr(blocknum, 'SOLUTIONGROUPnum', input_mempath) + call mem_setptr(blocknum, 'SOLUTIONGROUPNUM', input_mempath) ! ! -- open solution group logging block write (iout, '(/1x,a)') 'READING SOLUTIONGROUP' diff --git a/src/Utilities/Idm/BoundInputContext.f90 b/src/Utilities/Idm/BoundInputContext.f90 new file mode 100644 index 00000000000..2afa3bdf041 --- /dev/null +++ b/src/Utilities/Idm/BoundInputContext.f90 @@ -0,0 +1,561 @@ +!> @brief This module contains the BoundInputContextModule +!! +!! This module contains a type that stores and creates context +!! relevant to stress package inputs. +!! +!< +module BoundInputContextModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, IZERO, LENAUXNAME, LENVARNAME, LENBOUNDNAME + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, store_error_filename + use ModflowInputModule, only: ModflowInputType + use CharacterStringModule, only: CharacterStringType + + implicit none + private + public :: BoundInputContextType + + !> @brief derived type for boundary package input context + !! + !! This derived type defines input context used by dynamic package loaders. + !! Some variables (e.g. iprpak) in the type may have already been created + !! by a static loader whereas others (e.g. nboound) are created by this + !! type, updated by to dynamic loader, and accessed from the model package. + !! + !< + type :: BoundInputContextType + integer(I4B), pointer :: naux => null() !< number of auxiliary variables + integer(I4B), pointer :: maxbound => null() !< max list input records per period + integer(I4B), pointer :: inamedbound => null() !< are bound names optioned + integer(I4B), pointer :: iprpak => null() ! print input option + integer(I4B), pointer :: nbound => null() !< number of bounds in period + integer(I4B), pointer :: ncpl => null() !< number of cells per layer + type(CharacterStringType), dimension(:), pointer, & + contiguous :: auxname_cst => null() !< array of auxiliary names + type(CharacterStringType), dimension(:), pointer, & + contiguous :: boundname_cst => null() !< array of bound names + real(DP), dimension(:, :), pointer, & + contiguous :: auxvar => null() !< auxiliary variable array + integer(I4B), dimension(:), pointer, contiguous :: mshape => null() !< model shape + character(len=LENVARNAME), dimension(:), allocatable :: filtcols !< list input in scope columns + integer(I4B) :: nfiltcol !< list input number of in scope columns + logical(LGP) :: readasarrays !< grid or list based input + type(ModflowInputType) :: mf6_input !< description of input + contains + procedure :: init => bndctx_init + procedure :: create_context + procedure :: enable + procedure :: bound_params_allocate + procedure :: param_init + procedure :: allocate_read_state_var + procedure :: destroy => bndctx_destroy + procedure :: set_filtered_cols + procedure :: filtered_cols + end type BoundInputContextType + +contains + + !> @brief initialize boundary input context + !! + !< + subroutine bndctx_init(this, mf6_input, readasarrays) + ! -- modules + ! -- dummy + class(BoundInputContextType) :: this + type(ModflowInputType), intent(in) :: mf6_input + logical(LGP), intent(in) :: readasarrays + ! + this%mf6_input = mf6_input + this%readasarrays = readasarrays + ! + ! -- create the dynamic package input context + call this%create_context() + ! + ! -- determine in scope list input columns + if (.not. readasarrays) then + call this%set_filtered_cols() + end if + ! + ! --return + return + end subroutine bndctx_init + + !> @brief create boundary input context + !! + !< + subroutine create_context(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize + use MemoryManagerExtModule, only: mem_set_value + ! -- dummy + class(BoundInputContextType) :: this + integer(I4B), dimension(:, :), pointer, contiguous :: cellid => null() + logical(LGP) :: found + ! + ! -- set pointers to defined scalars + call mem_setptr(this%naux, 'NAUX', this%mf6_input%mempath) + ! + ! -- allocate memory managed scalars + call mem_allocate(this%nbound, 'NBOUND', this%mf6_input%mempath) + call mem_allocate(this%ncpl, 'NCPL', this%mf6_input%mempath) + ! + ! -- internally allocate package optional scalars + allocate (this%maxbound) + allocate (this%inamedbound) + allocate (this%iprpak) + ! + ! -- initialize allocated and internal scalars + this%nbound = 0 + this%ncpl = 0 + this%maxbound = 0 + this%inamedbound = 0 + this%iprpak = 0 + this%nfiltcol = 0 + ! + ! -- update optional scalars + call mem_set_value(this%inamedbound, 'BOUNDNAMES', this%mf6_input%mempath, & + found) + call mem_set_value(this%maxbound, 'MAXBOUND', this%mf6_input%mempath, found) + call mem_set_value(this%iprpak, 'IPRPAK', this%mf6_input%mempath, found) + ! + ! -- set pointers to defined arrays + call mem_setptr(this%mshape, 'MODEL_SHAPE', & + this%mf6_input%component_mempath) + ! + ! -- update ncpl as shape is known + if (size(this%mshape) == 2) then + this%ncpl = this%mshape(2) + else if (size(this%mshape) == 3) then + this%ncpl = this%mshape(2) * this%mshape(3) + end if + ! + ! -- set auxname_cst and iauxmultcol + if (this%naux > 0) then + call mem_setptr(this%auxname_cst, 'AUXILIARY', this%mf6_input%mempath) + else + call mem_allocate(this%auxname_cst, LENAUXNAME, 0, & + 'AUXILIARY', this%mf6_input%mempath) + end if + ! + ! -- allocate cellid if this is not list input + if (this%readasarrays) then + call mem_allocate(cellid, 0, 0, 'CELLID', this%mf6_input%mempath) + end if + ! + ! -- return + return + end subroutine create_context + + !> @brief enable bound input context + !! + !! This routine should be invoked after the loader allocates dynamic + !! input params. This routine will assign pointers to arrays if they + !! have been allocated and allocate the arrays if not. + !! + !< + subroutine enable(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize + use MemoryManagerExtModule, only: mem_set_value + ! -- dummy + class(BoundInputContextType) :: this + ! -- local + ! + ! -- allocate or set pointer to BOUNDNAME + if (this%inamedbound == 0) then + call mem_allocate(this%boundname_cst, LENBOUNDNAME, 0, & + 'BOUNDNAME', this%mf6_input%mempath) + ! + else + call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%mf6_input%mempath) + end if + ! + ! -- allocate or set pointer to AUXVAR + if (this%naux == 0) then + call mem_allocate(this%auxvar, 0, 0, 'AUXVAR', this%mf6_input%mempath) + ! + else + call mem_setptr(this%auxvar, 'AUXVAR', this%mf6_input%mempath) + end if + ! + ! -- return + return + end subroutine enable + + !> @brief allocate a read state variable + !! + !! Create and set a read state variable, e.g. 'INRECHARGE', + !! which are updated per iper load as follows: + !! -1: unset, not in use + !! 0: not read in most recent period block + !! 1: numeric input read in most recent period block + !! 2: time series input read in most recent period block + !! + !< + function allocate_read_state_var(this, mf6varname) result(varname) + ! -- modules + use MemoryManagerModule, only: mem_setptr, mem_allocate + ! -- dummy + class(BoundInputContextType) :: this + character(len=*), intent(in) :: mf6varname + ! -- locals + character(len=LENVARNAME) :: varname + integer(I4B) :: ilen + integer(I4B), pointer :: intvar + character(len=2) :: prefix = 'IN' + ! + ! -- assign first column as the block number + ilen = len_trim(mf6varname) + ! + if (ilen > (LENVARNAME - len(prefix))) then + varname = prefix//mf6varname(1:(LENVARNAME - len(prefix))) + else + varname = prefix//trim(mf6varname) + end if + ! + call mem_allocate(intvar, varname, this%mf6_input%mempath) + intvar = -1 + ! + ! -- return + return + end function allocate_read_state_var + + !> @brief allocate dfn period block parameters + !! + !! Currently supports numeric (i.e. array based) params + !! + !< + subroutine bound_params_allocate(this, sourcename) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use InputDefinitionModule, only: InputParamDefinitionType + ! -- dummy + class(BoundInputContextType) :: this + character(len=*) :: sourcename + type(InputParamDefinitionType), pointer :: idt + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + integer(I4B) :: iparam, n, m + ! + ! -- list input allocates via structarray + if (.not. this%readasarrays) then + call store_error('Programming error. (IDM) Bound context unsupported & + &list based param allocation.') + call store_error_filename(sourcename) + end if + ! + ! -- allocate dfn input params + do iparam = 1, size(this%mf6_input%param_dfns) + ! + ! -- assign param definition pointer + idt => this%mf6_input%param_dfns(iparam) + ! + if (idt%blockname == 'PERIOD') then + ! + ! allocate based on dfn datatype + select case (idt%datatype) + case ('INTEGER1D') + ! + call mem_allocate(int1d, this%ncpl, idt%mf6varname, & + this%mf6_input%mempath) + ! + do n = 1, this%ncpl + int1d(n) = IZERO + end do + ! + case ('DOUBLE1D') + ! + call mem_allocate(dbl1d, this%ncpl, idt%mf6varname, & + this%mf6_input%mempath) + ! + do n = 1, this%ncpl + dbl1d(n) = DZERO + end do + ! + case ('DOUBLE2D') + ! + call mem_allocate(dbl2d, this%naux, this%ncpl, & + idt%mf6varname, this%mf6_input%mempath) + ! + do m = 1, this%ncpl + do n = 1, this%naux + dbl2d(n, m) = DZERO + end do + end do + ! + case default + call store_error('Programming error. (IDM) Bound context unsupported & + &data type allocation for param='//trim(idt%tagname)) + call store_error_filename(sourcename) + end select + ! + end if + end do + ! + ! -- enable + call this%enable() + ! + ! -- return + return + end subroutine bound_params_allocate + + subroutine param_init(this, datatype, varname, mempath, sourcename) + ! -- modules + use MemoryManagerModule, only: mem_setptr + ! -- dummy + class(BoundInputContextType) :: this + character(len=*), intent(in) :: datatype + character(len=*), intent(in) :: varname + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: sourcename + ! -- locals + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + type(CharacterStringType), dimension(:), pointer, & + contiguous :: charstr1d => null() + integer(I4B) :: n, m + ! + select case (datatype) + case ('INTEGER1D') + ! + call mem_setptr(int1d, varname, mempath) + do n = 1, this%ncpl + int1d(n) = IZERO + end do + ! + case ('DOUBLE1D') + ! + call mem_setptr(dbl1d, varname, mempath) + do n = 1, this%ncpl + dbl1d(n) = DZERO + end do + ! + case ('DOUBLE2D') + ! + call mem_setptr(dbl2d, varname, mempath) + do m = 1, this%ncpl + do n = 1, this%naux + dbl2d(n, m) = DZERO + end do + end do + ! + case ('CHARSTR1D') + ! + call mem_setptr(charstr1d, varname, mempath) + do n = 1, size(charstr1d) + charstr1d(n) = '' + end do + ! + case default + ! + call store_error('Programming error. (IDM) Bound context unsupported & + &data type initialization for param='//trim(varname)) + call store_error_filename(sourcename) + ! + end select + ! + ! -- return + return + end subroutine param_init + + !> @brief destroy boundary input context + !! + !< + subroutine bndctx_destroy(this) + ! -- modules + ! -- dummy + class(BoundInputContextType) :: this + ! + ! -- deallocate + deallocate (this%maxbound) + deallocate (this%inamedbound) + deallocate (this%iprpak) + ! + ! -- nullify + nullify (this%naux) + nullify (this%nbound) + nullify (this%ncpl) + nullify (this%maxbound) + nullify (this%inamedbound) + nullify (this%iprpak) + nullify (this%auxname_cst) + nullify (this%boundname_cst) + nullify (this%auxvar) + nullify (this%mshape) + ! + deallocate (this%filtcols) + ! + ! --return + return + end subroutine bndctx_destroy + + !> @brief create array of in scope list input columns + !! + !! Filter the recarray description of list input parameters + !! to determine which columns are to be read in this run. + !< + subroutine set_filtered_cols(this) + ! -- modules + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_aggregate_definition_type + use ArrayHandlersModule, only: expandarray + use InputOutputModule, only: parseline + ! -- dummy + class(BoundInputContextType) :: this + ! -- local + type(InputParamDefinitionType), pointer :: ra_idt + character(len=:), allocatable :: parse_str + character(len=LENVARNAME), dimension(:), allocatable :: dfncols + integer(I4B), dimension(:), allocatable :: idxs + integer(I4B) :: dfnncol, icol, keepcnt + logical(LGP) :: keep + ! + ! -- initialize + keepcnt = 0 + ! + ! -- get aggregate param definition for period block + ra_idt => & + get_aggregate_definition_type(this%mf6_input%aggregate_dfns, & + this%mf6_input%component_type, & + this%mf6_input%subcomponent_type, & + 'PERIOD') + ! + ! -- split recarray definition + parse_str = trim(ra_idt%datatype)//' ' + call parseline(parse_str, dfnncol, dfncols) + ! + ! -- determine which columns are in scope + do icol = 1, dfnncol + ! + keep = .false. + ! + if (dfncols(icol) == 'RECARRAY') then + ! no-op + else if (dfncols(icol) == 'AUX') then + if (this%naux > 0) then + keep = .true. + end if + else if (dfncols(icol) == 'BOUNDNAME') then + if (this%inamedbound /= 0) then + keep = .true. + end if + else + keep = pkg_param_in_scope(this%mf6_input, dfncols(icol)) + end if + ! + if (keep) then + keepcnt = keepcnt + 1 + call expandarray(idxs) + idxs(keepcnt) = icol + end if + end do + ! + ! -- update nfiltcol + this%nfiltcol = keepcnt + ! + ! -- allocate filtcols + allocate (this%filtcols(this%nfiltcol)) + ! + ! -- set filtcols + do icol = 1, this%nfiltcol + this%filtcols(icol) = dfncols(idxs(icol)) + end do + ! + ! -- cleanup + deallocate (dfncols) + deallocate (idxs) + deallocate (parse_str) + ! + ! -- return + return + end subroutine set_filtered_cols + + !> @brief allocate and set input array to filtered param set + !! + !< + subroutine filtered_cols(this, cols, ncol) + ! -- modules + ! -- dummy + class(BoundInputContextType) :: this + character(len=LENVARNAME), dimension(:), allocatable, & + intent(inout) :: cols + integer(I4B), intent(inout) :: ncol + integer(I4B) :: n + ! + if (allocated(cols)) deallocate (cols) + ! + ncol = this%nfiltcol + ! + allocate (cols(ncol)) + ! + do n = 1, ncol + cols(n) = this%filtcols(n) + end do + ! + ! -- return + return + end subroutine filtered_cols + + !> @brief determine if input param is in scope for a package + !! + !< + function pkg_param_in_scope(mf6_input, tagname) result(in_scope) + ! -- modules + use MemoryManagerModule, only: get_isize, mem_setptr + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + ! -- dummy + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: tagname + ! -- return + logical(LGP) :: in_scope + ! -- locals + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: pdim_isize, popt_isize + integer(I4B), pointer :: pdim + ! + ! -- initialize + in_scope = .false. + ! + idt => get_param_definition_type(mf6_input%param_dfns, & + mf6_input%component_type, & + mf6_input%subcomponent_type, & + 'PERIOD', tagname, '') + ! + if (idt%required) then + ! -- required params always included + in_scope = .true. + else + ! + ! -- package specific logic to determine if input params to be read + select case (mf6_input%subcomponent_type) + case ('EVT') + ! + if (tagname == 'PXDP' .or. tagname == 'PETM') then + call get_isize('NSEG', mf6_input%mempath, pdim_isize) + if (pdim_isize > 0) then + call mem_setptr(pdim, 'NSEG', mf6_input%mempath) + if (pdim > 1) then + in_scope = .true. + end if + end if + else if (tagname == 'PETM0') then + call get_isize('SURFRATESPEC', mf6_input%mempath, popt_isize) + if (popt_isize > 0) then + in_scope = .true. + end if + end if + ! + case default + end select + end if + ! + ! -- return + return + end function pkg_param_in_scope + +end module BoundInputContextModule diff --git a/src/Utilities/Idm/IdmLoad.f90 b/src/Utilities/Idm/IdmLoad.f90 new file mode 100644 index 00000000000..63690c9863b --- /dev/null +++ b/src/Utilities/Idm/IdmLoad.f90 @@ -0,0 +1,493 @@ +!> @brief This module contains the IdmLoadModule +!! +!! This module contains routines for managing static +!! and dynamic input loading for supported sources. +!! +!< +module IdmLoadModule + + use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME + use SimModule, only: store_error, store_error_filename + use ListModule, only: ListType + use InputLoadTypeModule, only: StaticPkgLoadBaseType, & + DynamicPkgLoadBaseType, & + ModelDynamicPkgsType + use InputDefinitionModule, only: InputParamDefinitionType + use ModflowInputModule, only: ModflowInputType, getModflowInput + + implicit none + private + public :: simnam_load + public :: load_models + public :: idm_df + public :: idm_rp + public :: idm_ad + public :: idm_da + + type(ListType) :: model_dynamic_pkgs + +contains + + !> @brief advance package dynamic data for period steps + !< + subroutine idm_df() + use InputLoadTypeModule, only: GetDynamicModelFromList + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + integer(I4B) :: n + ! + do n = 1, model_dynamic_pkgs%Count() + model_dynamic_input => GetDynamicModelFromList(model_dynamic_pkgs, n) + call model_dynamic_input%df() + end do + ! + ! -- return + return + end subroutine idm_df + + !> @brief load package dynamic data for period + !< + subroutine idm_rp() + use InputLoadTypeModule, only: GetDynamicModelFromList + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + integer(I4B) :: n + ! + do n = 1, model_dynamic_pkgs%Count() + model_dynamic_input => GetDynamicModelFromList(model_dynamic_pkgs, n) + call model_dynamic_input%rp() + end do + ! + ! -- return + return + end subroutine idm_rp + + !> @brief advance package dynamic data for period steps + !< + subroutine idm_ad() + use InputLoadTypeModule, only: GetDynamicModelFromList + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + integer(I4B) :: n + ! + do n = 1, model_dynamic_pkgs%Count() + model_dynamic_input => GetDynamicModelFromList(model_dynamic_pkgs, n) + call model_dynamic_input%ad() + end do + ! + ! -- return + return + end subroutine idm_ad + + !> @brief idm deallocate routine + !< + subroutine idm_da(iout) + integer(I4B), intent(in) :: iout + ! + call dynamic_da(iout) + ! + ! -- return + return + end subroutine idm_da + + !> @brief load an integrated model package from supported source + !< + subroutine model_pkg_load(model_pkg_inputs, itype, ipkg, iout) + use ModelPackageInputsModule, only: ModelPackageInputsType + use SourceLoadModule, only: create_pkg_loader + type(ModelPackageInputsType), intent(in) :: model_pkg_inputs + integer(I4B), intent(in) :: itype + integer(I4B), intent(in) :: ipkg + integer(I4B), intent(in) :: iout + class(StaticPkgLoadBaseType), pointer :: static_loader + class(DynamicPkgLoadBaseType), pointer :: dynamic_loader + class(ModelDynamicPkgsType), pointer :: dynamic_pkgs => null() + ! + ! -- create model package loader + static_loader => & + create_pkg_loader(model_pkg_inputs%component_type, & + model_pkg_inputs%pkglist(itype)%subcomponent_type, & + model_pkg_inputs%pkglist(itype)%pkgnames(ipkg), & + model_pkg_inputs%pkglist(itype)%pkgtype, & + model_pkg_inputs%pkglist(itype)%filenames(ipkg), & + model_pkg_inputs%modelname, & + model_pkg_inputs%modelfname) + ! + ! -- load static input and set dynamic loader + dynamic_loader => static_loader%load(iout) + ! + if (associated(dynamic_loader)) then + ! + ! -- set pointer to model dynamic packages list + dynamic_pkgs => dynamic_model_pkgs(model_pkg_inputs%modelname, & + static_loader%modelfname) + ! + ! -- add dynamic pkg loader to list + call dynamic_pkgs%add(dynamic_loader) + ! + end if + ! + ! -- cleanup + call static_loader%destroy() + deallocate (static_loader) + ! + ! -- return + return + end subroutine model_pkg_load + + !> @brief load integrated model package files + !< + subroutine load_model_pkgs(model_pkg_inputs, iout) + use ModelPackageInputsModule, only: ModelPackageInputsType + use SourceLoadModule, only: open_source_file + use IdmDfnSelectorModule, only: idm_integrated + type(ModelPackageInputsType), intent(inout) :: model_pkg_inputs + integer(i4B), intent(in) :: iout + integer(I4B) :: itype, ipkg + ! + ! -- load package instances by type + do itype = 1, size(model_pkg_inputs%pkglist) + ! + ! -- load package instances + do ipkg = 1, model_pkg_inputs%pkglist(itype)%pnum + + if (idm_integrated(model_pkg_inputs%component_type, & + model_pkg_inputs%pkglist(itype)%subcomponent_type)) & + then + ! + ! -- only load if model pkg can read from input context + call model_pkg_load(model_pkg_inputs, itype, ipkg, iout) + else + ! + ! -- open input file for package parser + model_pkg_inputs%pkglist(itype)%inunits(ipkg) = & + open_source_file(model_pkg_inputs%pkglist(itype)%pkgtype, & + model_pkg_inputs%pkglist(itype)%filenames(ipkg), & + model_pkg_inputs%modelfname, iout) + end if + end do + end do + ! + ! -- return + return + end subroutine load_model_pkgs + + !> @brief load model namfiles and model package files + !< + subroutine load_models(model_loadmask, iout) + ! -- modules + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: mem_setptr + use CharacterStringModule, only: CharacterStringType + use SimVariablesModule, only: idm_context + use ModelPackageInputsModule, only: ModelPackageInputsType + use SourceCommonModule, only: idm_component_type + use SourceLoadModule, only: load_modelnam + ! -- dummy + integer(I4B), dimension(:), intent(in) :: model_loadmask + integer(I4B), intent(in) :: iout + ! -- locals + character(len=LENMEMPATH) :: input_mempath + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mtypes !< model types + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mfnames !< model file names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mnames !< model names + character(len=LINELENGTH) :: mtype, mfname + character(len=LENMODELNAME) :: mname + type(ModelPackageInputsType), allocatable :: model_pkg_inputs + integer(I4B) :: n + ! + ! -- set input memory path + input_mempath = create_mem_path('SIM', 'NAM', idm_context) + ! + ! -- set pointers to input context model attribute arrays + call mem_setptr(mtypes, 'MTYPE', input_mempath) + call mem_setptr(mfnames, 'MFNAME', input_mempath) + call mem_setptr(mnames, 'MNAME', input_mempath) + ! + do n = 1, size(mtypes) + ! + ! -- attributes for this model + mtype = mtypes(n) + mfname = mfnames(n) + mname = mnames(n) + ! + ! -- load specified model inputs + if (model_loadmask(n) > 0) then + ! + ! -- load model nam file + call load_modelnam(mtype, mfname, mname, iout) + ! + ! -- create description of model packages + allocate (model_pkg_inputs) + call model_pkg_inputs%init(mtype, mfname, mname, iout) + ! + ! -- load packages + call load_model_pkgs(model_pkg_inputs, iout) + ! + ! -- publish pkg info to input context + call model_pkg_inputs%memload() + ! + ! -- cleanup + call model_pkg_inputs%destroy() + deallocate (model_pkg_inputs) + end if + end do + ! + ! -- return + return + end subroutine load_models + + !> @brief MODFLOW 6 mfsim.nam input load routine + !< + subroutine simnam_load(paramlog) + use SourceLoadModule, only: load_simnam + integer(I4B), intent(inout) :: paramlog + ! + ! -- load sim nam file + call load_simnam() + ! + ! -- allocate any unallocated simnam params + call simnam_allocate() + ! + ! -- read and set input parameter logging keyword + paramlog = input_param_log() + ! + ! -- memload summary info + call simnam_load_dim() + ! + ! --return + return + end subroutine simnam_load + + !> @brief retrieve list of model dynamic loaders + !< + function dynamic_model_pkgs(modelname, modelfname) result(model_dynamic_input) + use InputLoadTypeModule, only: AddDynamicModelToList, GetDynamicModelFromList + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + class(ModelDynamicPkgsType), pointer :: temp + integer(I4B) :: id + ! + ! -- initialize + nullify (model_dynamic_input) + ! + ! -- assign model loader object if found + do id = 1, model_dynamic_pkgs%Count() + temp => GetDynamicModelFromList(model_dynamic_pkgs, id) + if (temp%modelname == modelname) then + model_dynamic_input => temp + exit + end if + end do + ! + ! -- create if not found + if (.not. associated(model_dynamic_input)) then + allocate (model_dynamic_input) + call model_dynamic_input%init(modelname, modelfname) + call AddDynamicModelToList(model_dynamic_pkgs, model_dynamic_input) + end if + ! + ! -- return + return + end function dynamic_model_pkgs + + !> @brief deallocate all model dynamic loader collections + !< + subroutine dynamic_da(iout) + use InputLoadTypeModule, only: GetDynamicModelFromList + integer(I4B), intent(in) :: iout + class(ModelDynamicPkgsType), pointer :: model_dynamic_input + integer(I4B) :: n + ! + do n = 1, model_dynamic_pkgs%Count() + model_dynamic_input => GetDynamicModelFromList(model_dynamic_pkgs, n) + call model_dynamic_input%destroy() + deallocate (model_dynamic_input) + nullify (model_dynamic_input) + end do + ! + call model_dynamic_pkgs%Clear() + ! + ! -- return + return + end subroutine dynamic_da + + !> @brief return sim input context PRINT_INTPUT value + !< + function input_param_log() result(paramlog) + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: mem_setptr + use SimVariablesModule, only: idm_context + character(len=LENMEMPATH) :: simnam_mempath + integer(I4B) :: paramlog + integer(I4B), pointer :: p + ! + ! -- read and set input value of PRINT_INPUT + simnam_mempath = create_mem_path('SIM', 'NAM', idm_context) + call mem_setptr(p, 'PRINT_INPUT', simnam_mempath) + paramlog = p + ! + ! -- return + return + end function input_param_log + + !> @brief load simulation summary info to input context + !< + subroutine simnam_load_dim() + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: mem_allocate, mem_setptr + use SimVariablesModule, only: idm_context + use CharacterStringModule, only: CharacterStringType + character(len=LENMEMPATH) :: sim_mempath, simnam_mempath + type(CharacterStringType), dimension(:), contiguous, & + pointer :: mtypes !< model types + type(CharacterStringType), dimension(:), contiguous, & + pointer :: etypes !< model types + integer(I4B), pointer :: nummodels => null() + integer(I4B), pointer :: numexchanges => null() + ! + ! -- set memory paths + sim_mempath = create_mem_path(component='SIM', context=idm_context) + simnam_mempath = create_mem_path('SIM', 'NAM', idm_context) + ! + ! -- set pointers to loaded simnam arrays + call mem_setptr(mtypes, 'MTYPE', simnam_mempath) + call mem_setptr(etypes, 'EXGTYPE', simnam_mempath) + ! + ! -- allocate variables + call mem_allocate(nummodels, 'NUMMODELS', sim_mempath) + call mem_allocate(numexchanges, 'NUMEXCHANGES', sim_mempath) + ! + ! -- set values + nummodels = size(mtypes) + numexchanges = size(etypes) + ! + ! -- return + return + end subroutine simnam_load_dim + + !> @brief set sim nam input context default integer value + !< + subroutine allocate_simnam_int(input_mempath, idt) + use MemoryManagerModule, only: mem_allocate + use SimVariablesModule, only: isimcontinue, isimcheck, simfile + character(len=LENMEMPATH), intent(in) :: input_mempath + type(InputParamDefinitionType), pointer, intent(in) :: idt + integer(I4B), pointer :: intvar => null() + ! + ! -- allocate and set default + call mem_allocate(intvar, idt%mf6varname, input_mempath) + ! + select case (idt%mf6varname) + case ('CONTINUE') + intvar = isimcontinue + case ('NOCHECK') + intvar = isimcheck + case ('MAXERRORS') + intvar = 1000 !< MessageType max_message + case ('MXITER') + intvar = 1 + case ('PRINT_INPUT') + intvar = 0 + case default + write (errmsg, '(a,a)') & + 'Programming error. Idm SIMNAM Load default value setting '& + &'is unhandled for this variable: ', & + trim(idt%mf6varname) + call store_error(errmsg) + call store_error_filename(simfile) + end select + ! + ! -- return + return + end subroutine allocate_simnam_int + + !> @brief MODFLOW 6 mfsim.nam parameter allocate and set + !< + subroutine allocate_simnam_param(input_mempath, idt) + use SimVariablesModule, only: simfile + use MemoryManagerModule, only: mem_allocate + use CharacterStringModule, only: CharacterStringType + character(len=LENMEMPATH), intent(in) :: input_mempath + type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=LINELENGTH), pointer :: cstr => null() + type(CharacterStringType), dimension(:), & + pointer, contiguous :: acharstr1d => null() + ! + ! -- initialize + ! + select case (idt%datatype) + case ('KEYWORD', 'INTEGER') + ! + ! -- allocate and set default + call allocate_simnam_int(input_mempath, idt) + ! + case ('STRING') + ! + ! -- did this param originate from sim namfile RECARRAY type + if (idt%in_record) then + ! + ! -- allocate 0 size CharacterStringType array + call mem_allocate(acharstr1d, LINELENGTH, 0, idt%mf6varname, & + input_mempath) + else + ! + ! -- allocate empty string + call mem_allocate(cstr, LINELENGTH, idt%mf6varname, input_mempath) + cstr = '' + end if + case default + write (errmsg, '(a,a)') & + 'Programming error. IdmLoad unhandled datatype: ', & + trim(idt%datatype) + call store_error(errmsg) + call store_error_filename(simfile) + end select + ! + ! -- return + return + end subroutine allocate_simnam_param + + !> @brief MODFLOW 6 mfsim.nam input context parameter allocation + !< + subroutine simnam_allocate() + use MemoryHelperModule, only: create_mem_path + use MemoryManagerModule, only: get_isize, mem_allocate + use SimVariablesModule, only: idm_context + use CharacterStringModule, only: CharacterStringType + character(len=LENMEMPATH) :: input_mempath + type(ModflowInputType) :: mf6_input + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iparam, isize + ! + ! -- set memory path + input_mempath = create_mem_path('SIM', 'NAM', idm_context) + ! + ! -- create description of input + mf6_input = getModflowInput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM') + ! + ! -- allocate sim namfile parameters if not in input context + do iparam = 1, size(mf6_input%param_dfns) + ! + ! -- assign param definition pointer + idt => mf6_input%param_dfns(iparam) + ! + ! -- check if variable is already allocated + call get_isize(idt%mf6varname, input_mempath, isize) + ! + if (isize < 0) then + ! + ! -- allocate and set parameter + call allocate_simnam_param(input_mempath, idt) + ! + end if + end do + ! + ! -- return + return + end subroutine simnam_allocate + +end module IdmLoadModule diff --git a/src/Utilities/Idm/IdmSimulation.f90 b/src/Utilities/Idm/IdmSimulation.f90 deleted file mode 100644 index ecb8da877a7..00000000000 --- a/src/Utilities/Idm/IdmSimulation.f90 +++ /dev/null @@ -1,246 +0,0 @@ -!> @brief This module contains the IdmSimulationModule -!! -!! This module contains the high-level routines for loading -!! sim namefile parameters into the input context -!! -!< -module IdmSimulationModule - - use KindModule, only: DP, I4B, LGP - use ConstantsModule, only: LINELENGTH, LENMEMPATH - use SimModule, only: store_error - use SimVariablesModule, only: iout - use InputOutputModule, only: openfile, getunit - use InputDefinitionModule, only: InputParamDefinitionType - use ModflowInputModule, only: ModflowInputType, getModflowInput - use IdmMf6FileModule, only: input_load - - implicit none - private - public :: simnam_load - public :: load_models - -contains - - !> @brief load simulation summary info to input context - !< - subroutine simnam_load_dim() - use MemoryHelperModule, only: create_mem_path - use MemoryManagerModule, only: mem_allocate, mem_setptr - use SimVariablesModule, only: idm_context - use CharacterStringModule, only: CharacterStringType - character(len=LENMEMPATH) :: sim_mempath, simnam_mempath - type(CharacterStringType), dimension(:), contiguous, & - pointer :: mtypes !< model types - type(CharacterStringType), dimension(:), contiguous, & - pointer :: etypes !< model types - integer(I4B), pointer :: nummodels => null() - integer(I4B), pointer :: numexchanges => null() - ! - ! -- set memory paths - sim_mempath = create_mem_path(component='SIM', context=idm_context) - simnam_mempath = create_mem_path('SIM', 'NAM', idm_context) - ! - ! -- set pointers to loaded simnam arrays - call mem_setptr(mtypes, 'MTYPE', simnam_mempath) - call mem_setptr(etypes, 'EXGTYPE', simnam_mempath) - ! - ! -- allocate variables - call mem_allocate(nummodels, 'NUMMODELS', sim_mempath) - call mem_allocate(numexchanges, 'NUMEXCHANGES', sim_mempath) - ! - ! -- set values - nummodels = size(mtypes) - numexchanges = size(etypes) - ! - ! -- return - return - end subroutine simnam_load_dim - - !> @brief MODFLOW 6 mfsim.nam parameter set default value - !< - subroutine set_default_value(intvar, mf6varname) - use SimVariablesModule, only: isimcontinue, isimcheck - integer(I4B), pointer, intent(in) :: intvar - character(len=*), intent(in) :: mf6varname - character(len=LINELENGTH) :: errmsg - logical(LGP) :: terminate = .true. - ! - ! -- load defaults for keyword/integer types - select case (mf6varname) - ! - case ('CONTINUE') - intvar = isimcontinue - ! - case ('NOCHECK') - intvar = isimcheck - ! - case ('MAXERRORS') - intvar = 1000 !< MessageType max_message - ! - case ('MXITER') - intvar = 1 - ! - case ('PRINT_INPUT') - intvar = 0 - ! - case default - write (errmsg, '(a,a)') & - 'IdmSimulation set_default_value unhandled variable: ', & - trim(mf6varname) - call store_error(errmsg, terminate) - end select - ! - ! -- return - return - end subroutine set_default_value - - !> @brief MODFLOW 6 mfsim.nam input context parameter allocation - !< - subroutine simnam_allocate() - use MemoryHelperModule, only: create_mem_path - use MemoryManagerModule, only: get_isize, mem_allocate - use SimVariablesModule, only: idm_context - use CharacterStringModule, only: CharacterStringType - character(len=LENMEMPATH) :: input_mempath - type(ModflowInputType) :: mf6_input - type(InputParamDefinitionType), pointer :: idt - integer(I4B) :: iparam, isize - logical(LGP) :: terminate = .true. - integer(I4B), pointer :: intvar - character(len=LINELENGTH), pointer :: cstr - type(CharacterStringType), dimension(:), & - pointer, contiguous :: acharstr1d - character(len=LINELENGTH) :: errmsg - ! - ! -- set memory path - input_mempath = create_mem_path('SIM', 'NAM', idm_context) - ! - ! -- create description of input - mf6_input = getModflowInput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM') - ! - ! -- allocate sim namfile parameters if not in input context - do iparam = 1, size(mf6_input%param_dfns) - ! - ! -- assign param definition pointer - idt => mf6_input%param_dfns(iparam) - ! - ! -- check if variable is already allocated - call get_isize(idt%mf6varname, input_mempath, isize) - ! - if (isize < 0) then - ! - ! -- reset pointers - nullify (intvar) - nullify (acharstr1d) - nullify (cstr) - ! - select case (idt%datatype) - case ('KEYWORD', 'INTEGER') - ! - ! -- allocate and set default - call mem_allocate(intvar, idt%mf6varname, input_mempath) - call set_default_value(intvar, idt%mf6varname) - case ('STRING') - ! - ! -- did this param originate from sim namfile RECARRAY type - if (idt%in_record) then - ! - ! -- allocate 0 size CharacterStringType array - call mem_allocate(acharstr1d, LINELENGTH, 0, idt%mf6varname, & - input_mempath) - else - ! - ! -- allocate empty string - call mem_allocate(cstr, LINELENGTH, idt%mf6varname, input_mempath) - cstr = '' - end if - case default - write (errmsg, '(a,a)') & - 'IdmSimulation unhandled datatype: ', & - trim(idt%datatype) - call store_error(errmsg, terminate) - end select - end if - end do - ! - ! -- return - return - end subroutine simnam_allocate - - !> @brief source indenpendent model load entry point - !< - subroutine load_models(model_loadmask, iout) - ! -- modules - use IdmMf6FileModule, only: load_models_mf6 - ! -- dummy - integer(I4B), dimension(:), intent(in) :: model_loadmask - integer(I4B), intent(in) :: iout - ! -- locals - ! - ! -- mf6 blockfile model load - call load_models_mf6(model_loadmask, iout) - ! - ! -- return - return - end subroutine load_models - - function input_param_log() result(paramlog) - use MemoryHelperModule, only: create_mem_path - use MemoryManagerModule, only: mem_setptr - use SimVariablesModule, only: idm_context - character(len=LENMEMPATH) :: simnam_mempath - integer(I4B) :: paramlog - integer(I4B), pointer :: p - ! - ! -- read and set input value of PRINT_INPUT - simnam_mempath = create_mem_path('SIM', 'NAM', idm_context) - call mem_setptr(p, 'PRINT_INPUT', simnam_mempath) - ! - paramlog = p - ! - ! -- return - return - end function input_param_log - - !> @brief MODFLOW 6 mfsim.nam input load routine - !< - subroutine simnam_load(paramlog) - use SimVariablesModule, only: simfile - use GenericUtilitiesModule, only: sim_message - integer(I4B), intent(inout) :: paramlog - integer(I4B) :: inunit - logical :: lexist - character(len=LINELENGTH) :: line - ! - ! -- load mfsim.nam if it exists - inquire (file=trim(adjustl(simfile)), exist=lexist) - ! - if (lexist) then - ! - ! -- write name of namfile to stdout - write (line, '(2(1x,a))') 'Using Simulation name file:', & - trim(adjustl(simfile)) - call sim_message(line, skipafter=1) - ! - ! -- open namfile and load to input context - inunit = getunit() - call openfile(inunit, iout, trim(adjustl(simfile)), 'NAM') - call input_load('NAM6', 'SIM', 'NAM', 'SIM', 'NAM', inunit, iout) - close (inunit) - end if - ! - ! -- allocate any unallocated simnam params - call simnam_allocate() - ! - ! -- read and set input parameter logging keyword - paramlog = input_param_log() - ! - ! -- memload summary info - call simnam_load_dim() - ! - ! --return - return - end subroutine simnam_load - -end module IdmSimulationModule diff --git a/src/Utilities/Idm/InputDefinition.f90 b/src/Utilities/Idm/InputDefinition.f90 index c4dfa5f09bf..0d488e50d90 100644 --- a/src/Utilities/Idm/InputDefinition.f90 +++ b/src/Utilities/Idm/InputDefinition.f90 @@ -7,6 +7,7 @@ module InputDefinitionModule use KindModule, only: LGP + use ConstantsModule, only: LENVARNAME implicit none private @@ -24,13 +25,14 @@ module InputDefinitionModule character(len=100) :: subcomponent_type = '' character(len=100) :: blockname = '' character(len=100) :: tagname = '' - character(len=100) :: mf6varname = '' - character(len=100) :: datatype = '' + character(len=LENVARNAME) :: mf6varname = '' + character(len=120) :: datatype = '' character(len=100) :: shape = '' logical(LGP) :: required = .false. logical(LGP) :: in_record = .false. logical(LGP) :: preserve_case = .false. logical(LGP) :: layered = .false. + logical(LGP) :: timeseries = .false. end type InputParamDefinitionType !> @brief derived type for storing block information diff --git a/src/Utilities/Idm/InputLoadType.f90 b/src/Utilities/Idm/InputLoadType.f90 new file mode 100644 index 00000000000..556e492ccb3 --- /dev/null +++ b/src/Utilities/Idm/InputLoadType.f90 @@ -0,0 +1,408 @@ +!> @brief This module contains the InputLoadTypeModule +!! +!! This module defines types that support generic IDP +!! static and dynamic input loading. +!! +!< +module InputLoadTypeModule + + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: LINELENGTH, LENMODELNAME, LENTIMESERIESNAME + use ModflowInputModule, only: ModflowInputType + use ListModule, only: ListType + use InputDefinitionModule, only: InputParamDefinitionType + + implicit none + private + public :: StaticPkgLoadBaseType + public :: DynamicPkgLoadBaseType + public :: ModelDynamicPkgsType + public :: AddDynamicModelToList, GetDynamicModelFromList + public :: StaticPkgLoadType, DynamicPkgLoadType + + !> @brief derived type for source static load + !! + !! This derived type is a base concrete type for a model + !! package static load + !! + !< + type StaticPkgLoadType + type(ModflowInputType) :: mf6_input !< description of modflow6 input + character(len=LENMODELNAME) :: modelname !< name of model + character(len=LINELENGTH) :: modelfname !< name of model input file + character(len=LINELENGTH) :: sourcename !< source name, e.g. name of file + integer(I4B) :: iperblock + contains + procedure :: init => static_init + procedure :: destroy => static_destroy + end type StaticPkgLoadType + + !> @brief base abstract type for source static load + !! + !! IDM sources should extend and implement this type + !! + !< + type, abstract, extends(StaticPkgLoadType) :: StaticPkgLoadBaseType + contains + procedure(load_if), deferred :: load + end type StaticPkgLoadBaseType + + !> @brief derived type for source dynamic load + !! + !! This derived type is a base concrete type for a model + !! package dynamic (period) load + !! + !< + type :: DynamicPkgLoadType + type(ModflowInputType) :: mf6_input !< description of modflow6 input + character(len=LENMODELNAME) :: modelname !< name of model + character(len=LINELENGTH) :: modelfname !< name of model input file + character(len=LINELENGTH) :: sourcename !< source name, e.g. name of file + logical(LGP) :: readasarrays + integer(I4B) :: iperblock + integer(I4B) :: iout + contains + procedure :: init => dynamic_init + procedure :: df => dynamic_df + procedure :: ad => dynamic_ad + procedure :: destroy => dynamic_destroy + end type DynamicPkgLoadType + + !> @brief base abstract type for source dynamic load + !! + !! IDM sources should extend and implement this type + !! + !< + type, abstract, extends(DynamicPkgLoadType) :: DynamicPkgLoadBaseType + contains + procedure(period_load_if), deferred :: rp + end type DynamicPkgLoadBaseType + + !> @brief load interfaces for source static and dynamic types + !< + abstract interface + function load_if(this, iout) result(dynamic_loader) + import StaticPkgLoadBaseType, DynamicPkgLoadBaseType, I4B + class(StaticPkgLoadBaseType), intent(inout) :: this + integer(I4B), intent(in) :: iout + class(DynamicPkgLoadBaseType), pointer :: dynamic_loader + end function load_if + subroutine period_load_if(this) + import DynamicPkgLoadBaseType, I4B + class(DynamicPkgLoadBaseType), intent(inout) :: this + end subroutine + end interface + + !> @brief derived type for storing a dynamic package load list + !! + !! This derived type is used to store a list of package + !! dynamic load types for a model + !! + !< + type :: ModelDynamicPkgsType + character(len=LENMODELNAME) :: modelname !< name of model + character(len=LINELENGTH) :: modelfname !< name of model input file + type(ListType) :: pkglist !< list of pointers to model dynamic package loaders + contains + procedure :: init => dynamicpkgs_init + procedure :: add => dynamicpkgs_add + procedure :: get => dynamicpkgs_get + procedure :: rp => dynamicpkgs_rp + procedure :: df => dynamicpkgs_df + procedure :: ad => dynamicpkgs_ad + procedure :: size => dynamicpkgs_size + procedure :: destroy => dynamicpkgs_destroy + end type ModelDynamicPkgsType + +contains + + !> @brief initialize static package loader + !! + !< + subroutine static_init(this, mf6_input, modelname, modelfname, source) + class(StaticPkgLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B) :: iblock + ! + this%mf6_input = mf6_input + this%modelname = modelname + this%modelfname = modelfname + this%sourcename = source + this%iperblock = 0 + ! + ! -- identify period block definition + do iblock = 1, size(mf6_input%block_dfns) + ! + if (mf6_input%block_dfns(iblock)%blockname == 'PERIOD') then + this%iperblock = iblock + exit + end if + end do + ! + return + end subroutine static_init + + subroutine static_destroy(this) + class(StaticPkgLoadType), intent(inout) :: this + ! + return + end subroutine static_destroy + + !> @brief initialize dynamic package loader + !! + !! Any managed memory pointed to from model/package context + !! must be allocated when derived dynamic loader is initialized. + !! + !< + subroutine dynamic_init(this, mf6_input, modelname, modelfname, source, & + iperblock, iout) + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, store_error_filename + class(DynamicPkgLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B), intent(in) :: iperblock + integer(I4B), intent(in) :: iout + ! + this%mf6_input = mf6_input + this%modelname = modelname + this%modelfname = modelfname + this%sourcename = source + this%iperblock = iperblock + this%iout = iout + ! + ! -- throw error and exit if not found + if (this%iperblock == 0) then + write (errmsg, '(a,a)') & + 'Programming error. (IDM) PERIOD block not found in '& + &'dynamic package input block dfns: ', & + trim(mf6_input%subcomponent_name) + call store_error(errmsg) + call store_error_filename(this%sourcename) + else + ! + this%readasarrays = (.not. mf6_input%block_dfns(iperblock)%aggregate) + end if + ! + ! -- return + return + end subroutine dynamic_init + + !> @brief dynamic package loader define + !! + !< + subroutine dynamic_df(this) + class(DynamicPkgLoadType), intent(inout) :: this + ! + ! override in derived type + ! + return + end subroutine dynamic_df + + !> @brief dynamic package loader advance + !! + !< + subroutine dynamic_ad(this) + class(DynamicPkgLoadType), intent(inout) :: this + ! + ! override in derived type + ! + return + end subroutine dynamic_ad + + !> @brief dynamic package loader destroy + !! + !< + subroutine dynamic_destroy(this) + use MemoryManagerExtModule, only: memorylist_remove + use SimVariablesModule, only: idm_context + class(DynamicPkgLoadType), intent(inout) :: this + ! + ! -- deallocate package static and dynamic input context + call memorylist_remove(this%mf6_input%component_name, & + this%mf6_input%subcomponent_name, & + idm_context) + ! + return + end subroutine dynamic_destroy + + !> @brief model dynamic packages init + !! + !< + subroutine dynamicpkgs_init(this, modelname, modelfname) + class(ModelDynamicPkgsType), intent(inout) :: this + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + ! + this%modelname = modelname + this%modelfname = modelfname + ! + return + end subroutine dynamicpkgs_init + + !> @brief add package to model dynamic packages list + !! + !< + subroutine dynamicpkgs_add(this, dynamic_pkg) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer, intent(inout) :: dynamic_pkg + class(*), pointer :: obj + ! + obj => dynamic_pkg + call this%pkglist%add(obj) + ! + return + end subroutine dynamicpkgs_add + + !> @brief retrieve package from model dynamic packages list + !! + !< + function dynamicpkgs_get(this, idx) result(res) + class(ModelDynamicPkgsType), intent(inout) :: this + integer(I4B), intent(in) :: idx + class(DynamicPkgLoadBaseType), pointer :: res + class(*), pointer :: obj + ! + nullify (res) + obj => this%pkglist%GetItem(idx) + ! + if (associated(obj)) then + select type (obj) + class is (DynamicPkgLoadBaseType) + res => obj + end select + end if + ! + return + end function dynamicpkgs_get + + !> @brief read and prepare model dynamic packages + !! + !< + subroutine dynamicpkgs_rp(this) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer :: dynamic_pkg + integer(I4B) :: n + ! + do n = 1, this%pkglist%Count() + dynamic_pkg => this%get(n) + call dynamic_pkg%rp() + end do + ! + return + end subroutine dynamicpkgs_rp + + !> @brief define model dynamic packages + !! + !< + subroutine dynamicpkgs_df(this) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer :: dynamic_pkg + integer(I4B) :: n + ! + do n = 1, this%pkglist%Count() + dynamic_pkg => this%get(n) + call dynamic_pkg%df() + end do + ! + return + end subroutine dynamicpkgs_df + + !> @brief advance model dynamic packages + !! + !< + subroutine dynamicpkgs_ad(this) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer :: dynamic_pkg + integer(I4B) :: n + ! + do n = 1, this%pkglist%Count() + dynamic_pkg => this%get(n) + call dynamic_pkg%ad() + end do + ! + return + end subroutine dynamicpkgs_ad + + !> @brief get size of model dynamic packages list + !! + !< + function dynamicpkgs_size(this) result(size) + class(ModelDynamicPkgsType), intent(inout) :: this + integer(I4B) :: size + ! + size = this%pkglist%Count() + ! + return + end function dynamicpkgs_size + + !> @brief destroy model dynamic packages object + !! + !< + subroutine dynamicpkgs_destroy(this) + class(ModelDynamicPkgsType), intent(inout) :: this + class(DynamicPkgLoadBaseType), pointer :: dynamic_pkg + integer(I4B) :: n + ! + do n = 1, this%pkglist%Count() + dynamic_pkg => this%get(n) + call dynamic_pkg%destroy() + deallocate (dynamic_pkg) + nullify (dynamic_pkg) + end do + ! + call this%pkglist%Clear() + ! + return + end subroutine dynamicpkgs_destroy + + !> @brief add model dynamic packages object to list + !! + !< + subroutine AddDynamicModelToList(list, model_dynamic) + ! -- dummy variables + type(ListType), intent(inout) :: list !< package list + class(ModelDynamicPkgsType), pointer, intent(inout) :: model_dynamic + ! -- local variables + class(*), pointer :: obj + ! + obj => model_dynamic + call list%Add(obj) + ! + ! -- return + return + end subroutine AddDynamicModelToList + + !> @brief get model dynamic packages object from list + !! + !< + function GetDynamicModelFromList(list, idx) result(res) + ! -- dummy variables + type(ListType), intent(inout) :: list !< spd list + integer(I4B), intent(in) :: idx !< package number + class(ModelDynamicPkgsType), pointer :: res + ! -- local variables + class(*), pointer :: obj + ! + ! -- initialize res + res => null() + ! + ! -- get the object from the list + obj => list%GetItem(idx) + if (associated(obj)) then + select type (obj) + class is (ModelDynamicPkgsType) + res => obj + end select + end if + ! + ! -- return + return + end function GetDynamicModelFromList + +end module InputLoadTypeModule diff --git a/src/Utilities/Idm/ModelPackageInputs.f90 b/src/Utilities/Idm/ModelPackageInputs.f90 index 25ea01001a6..07ab590fe05 100644 --- a/src/Utilities/Idm/ModelPackageInputs.f90 +++ b/src/Utilities/Idm/ModelPackageInputs.f90 @@ -7,6 +7,7 @@ module ModelPackageInputsModule use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, LENFTYPE, & LENPACKAGETYPE, LENPACKAGENAME use SimModule, only: store_error, store_error_filename @@ -66,7 +67,7 @@ module ModelPackageInputsModule ! -- package type, e.g. 'DIS6 or CHD6' character(len=LENPACKAGETYPE) :: pkgtype ! -- component type, e.g. 'DIS or CHD' - character(len=LENFTYPE) :: component_type + character(len=LENFTYPE) :: subcomponent_type ! -- package instance attribute arrays character(len=LINELENGTH), dimension(:), allocatable :: filenames character(len=LENPACKAGENAME), dimension(:), allocatable :: pkgnames @@ -93,7 +94,8 @@ module ModelPackageInputsModule character(len=LENMODELNAME) :: modelname ! -- component type character(len=LENFTYPE) :: component_type ! -- e.g. 'GWF' - ! -- model mempath + ! -- mempaths + character(len=LENMEMPATH) :: input_mempath character(len=LENMEMPATH) :: model_mempath ! -- pointers to created managed memory type(CharacterStringType), dimension(:), contiguous, & @@ -152,30 +154,6 @@ subroutine supported_model_packages(mtype, pkgtypes, numpkgs) return end subroutine supported_model_packages - !> @brief component from package or model type - !< - function component_type(pkgtype) !result(componenttype) - ! -- modules - ! -- dummy - character(len=LENPACKAGETYPE), intent(in) :: pkgtype - ! -- return - character(len=LENFTYPE) :: component_type - ! -- local - integer(I4B) :: i, ilen - ! - component_type = '' - ! - ilen = len_trim(pkgtype) - do i = 1, ilen - if (pkgtype(i:i) == '6') then - write (component_type, '(a)') trim(pkgtype(1:i - 1)) - end if - end do - ! - ! -- return - return - end function component_type - !> @brief does model support multiple instances of this package type !< function multi_pkg_type(mtype_component, ptype_component, pkgtype) & @@ -226,17 +204,19 @@ end function multi_pkg_type !> @brief create a new package type !< - subroutine pkgtype_create(this, modelname, pkgtype) + subroutine pkgtype_create(this, modeltype, modelname, pkgtype) ! -- modules + use SourceCommonModule, only: idm_subcomponent_type ! -- dummy class(LoadablePackageType) :: this + character(len=*), intent(in) :: modeltype character(len=*), intent(in) :: modelname character(len=*), intent(in) :: pkgtype ! -- local ! ! -- initialize this%pkgtype = pkgtype - this%component_type = component_type(pkgtype) + this%subcomponent_type = idm_subcomponent_type(modeltype, pkgtype) this%pnum = 0 ! ! -- allocate arrays @@ -256,8 +236,10 @@ subroutine pkgtype_add(this, modelname, mtype_component, filetype, & ! -- modules use MemoryManagerModule, only: mem_allocate use MemoryHelperModule, only: create_mem_path + use MemoryManagerExtModule, only: mem_set_value use SimVariablesModule, only: idm_context use IdmDfnSelectorModule, only: idm_integrated, idm_multi_package + use SourceCommonModule, only: subcomponent_name ! -- dummy class(LoadablePackageType) :: this character(len=*), intent(in) :: modelname @@ -267,7 +249,7 @@ subroutine pkgtype_add(this, modelname, mtype_component, filetype, & character(len=*), intent(in) :: pkgname integer(I4B), intent(in) :: iout ! -- local - character(len=LENPACKAGENAME) :: sc_name + character(len=LENPACKAGENAME) :: sc_name, pname character(len=LENMEMPATH) :: mempath character(len=LINELENGTH), pointer :: cstr ! @@ -283,17 +265,18 @@ subroutine pkgtype_add(this, modelname, mtype_component, filetype, & this%pkgnames(this%pnum) = pkgname this%inunits(this%pnum) = 0 ! + ! -- set pkgname if empty + if (this%pkgnames(this%pnum) == '') then + write (pname, '(a,i0)') trim(this%subcomponent_type)//'-', this%pnum + this%pkgnames(this%pnum) = pname + end if + ! ! -- set up input context for model - if (idm_integrated(mtype_component, this%component_type)) then + if (idm_integrated(mtype_component, this%subcomponent_type)) then ! ! -- set subcomponent name - if (idm_multi_package(mtype_component, this%component_type)) then - ! - sc_name = pkgname - else - ! - sc_name = this%component_type - end if + sc_name = subcomponent_name(mtype_component, this%subcomponent_type, & + this%pkgnames(this%pnum)) ! ! -- create and store the mempath this%mempaths(this%pnum) = & @@ -303,6 +286,7 @@ subroutine pkgtype_add(this, modelname, mtype_component, filetype, & mempath = create_mem_path(modelname, sc_name, idm_context) call mem_allocate(cstr, LINELENGTH, 'INPUT_FNAME', mempath) cstr = filename + ! else ! ! -- set mempath empty @@ -338,6 +322,7 @@ subroutine modelpkgs_init(this, modeltype, modelfname, modelname, iout) use MemoryHelperModule, only: create_mem_path use MemoryManagerModule, only: mem_allocate use SimVariablesModule, only: idm_context + use SourceCommonModule, only: idm_component_type ! -- dummy class(ModelPackageInputsType) :: this character(len=*), intent(in) :: modeltype @@ -350,13 +335,14 @@ subroutine modelpkgs_init(this, modeltype, modelfname, modelname, iout) this%modeltype = modeltype this%modelfname = modelfname this%modelname = modelname - this%component_type = component_type(modeltype) + this%component_type = idm_component_type(modeltype) this%iout = iout ! ! -- allocate and set model supported package types call supported_model_packages(modeltype, this%cunit, this%niunit) ! - ! -- set model memory path + ! -- set memory paths + this%input_mempath = create_mem_path(this%modelname, 'NAM', idm_context) this%model_mempath = create_mem_path(component=this%modelname, & context=idm_context) ! @@ -390,7 +376,6 @@ subroutine modelpkgs_create(this, ftypes) character(len=LENPACKAGETYPE) :: ftype integer(I4B) :: n, m logical(LGP) :: found - character(len=LINELENGTH) :: errmsg ! ! -- allocate allocate (cunit_idxs(0)) @@ -398,7 +383,7 @@ subroutine modelpkgs_create(this, ftypes) ! -- identify input packages and check that each is supported do n = 1, size(ftypes) ! - ! -- type from model name file packages block + ! -- type from model nam file packages block ftype = ftypes(n) found = .false. ! @@ -440,7 +425,8 @@ subroutine modelpkgs_create(this, ftypes) ! ! -- create sorted LoadablePackageType object list do n = 1, size(cunit_idxs) - call this%pkglist(n)%create(this%modelname, this%cunit(cunit_idxs(n))) + call this%pkglist(n)%create(this%modeltype, this%modelname, & + this%cunit(cunit_idxs(n))) end do ! ! -- cleanup @@ -482,9 +468,7 @@ end subroutine modelpkgs_add !< subroutine modelpkgs_addpkgs(this) ! -- modules - use MemoryHelperModule, only: create_mem_path use MemoryManagerModule, only: mem_setptr - use SimVariablesModule, only: idm_context ! -- dummy class(ModelPackageInputsType) :: this ! -- local @@ -494,17 +478,13 @@ subroutine modelpkgs_addpkgs(this) pointer :: fnames !< file names type(CharacterStringType), dimension(:), contiguous, & pointer :: pnames !< package names - character(len=LENMEMPATH) :: input_mempath character(len=LINELENGTH) :: ftype, fname, pname integer(I4B) :: n ! - ! -- set input memory path - input_mempath = create_mem_path(this%modelname, 'NAM', idm_context) - ! ! -- set pointers to input context model package attribute arrays - call mem_setptr(ftypes, 'FTYPE', input_mempath) - call mem_setptr(fnames, 'FNAME', input_mempath) - call mem_setptr(pnames, 'PNAME', input_mempath) + call mem_setptr(ftypes, 'FTYPE', this%input_mempath) + call mem_setptr(fnames, 'FNAME', this%input_mempath) + call mem_setptr(pnames, 'PNAME', this%input_mempath) ! ! -- create the package list call this%create(ftypes) @@ -517,9 +497,6 @@ subroutine modelpkgs_addpkgs(this) fname = fnames(n) pname = pnames(n) ! - ! TODO: name pkg here if not provided, this is expected to cause - ! failures for multi-pkg types when names aren't provided - ! ! -- add this instance to package list call this%add(ftype, fname, pname) end do @@ -539,7 +516,6 @@ function modelpkgs_pkgcount(this) result(pnum) integer(I4B) :: pnum ! -- local integer(I4B) :: n - character(len=LINELENGTH) :: errmsg ! ! -- initialize pnum = 0 @@ -548,7 +524,7 @@ function modelpkgs_pkgcount(this) result(pnum) do n = 1, size(this%pkglist) ! if (multi_pkg_type(this%component_type, & - this%pkglist(n)%component_type, & + this%pkglist(n)%subcomponent_type, & this%pkglist(n)%pkgtype)) then ! multiple instances ok else diff --git a/src/Utilities/Idm/ModflowInput.f90 b/src/Utilities/Idm/ModflowInput.f90 index d8c316ecfc0..9500fc5dcb6 100644 --- a/src/Utilities/Idm/ModflowInput.f90 +++ b/src/Utilities/Idm/ModflowInput.f90 @@ -38,6 +38,7 @@ module ModflowInputModule character(len=LENCOMPONENTNAME) :: component_name character(len=LENCOMPONENTNAME) :: subcomponent_name character(len=LENMEMPATH) :: mempath + character(len=LENMEMPATH) :: component_mempath type(InputBlockDefinitionType), dimension(:), pointer :: block_dfns type(InputParamDefinitionType), dimension(:), pointer :: aggregate_dfns type(InputParamDefinitionType), dimension(:), pointer :: param_dfns @@ -47,29 +48,120 @@ module ModflowInputModule !> @brief function to return ModflowInputType !< - function getModflowInput(pkgtype, component_type, & - subcomponent_type, component_name, subcomponent_name) & + function getModflowInput(pkgtype, component_type, subcomponent_type, & + component_name, subcomponent_name, filename) & result(mf6_input) character(len=*), intent(in) :: pkgtype !< package type to load, such as DIS6, DISV6, NPF6 character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE + character(len=*), optional, intent(in) :: filename !< optional name of package input file type(ModflowInputType) :: mf6_input + character(len=LENPACKAGETYPE) :: dfn_subcomponent_type + ! -- set subcomponent type + if (present(filename)) then + dfn_subcomponent_type = update_sc_type(pkgtype, filename, component_type, & + subcomponent_type) + else + dfn_subcomponent_type = trim(subcomponent_type) + end if + + ! -- set input attributes mf6_input%pkgtype = trim(pkgtype) mf6_input%component_type = trim(component_type) - mf6_input%subcomponent_type = trim(subcomponent_type) + mf6_input%subcomponent_type = trim(dfn_subcomponent_type) mf6_input%component_name = trim(component_name) mf6_input%subcomponent_name = trim(subcomponent_name) + ! -- set mempaths mf6_input%mempath = create_mem_path(component_name, subcomponent_name, & idm_context) + mf6_input%component_mempath = create_mem_path(component=component_name, & + context=idm_context) - mf6_input%block_dfns => block_definitions(component_type, subcomponent_type) - mf6_input%aggregate_dfns => aggregate_definitions(component_type, & - subcomponent_type) - mf6_input%param_dfns => param_definitions(component_type, subcomponent_type) + ! -- set input definitions + mf6_input%block_dfns => block_definitions(mf6_input%component_type, & + mf6_input%subcomponent_type) + mf6_input%aggregate_dfns => aggregate_definitions(mf6_input%component_type, & + mf6_input%subcomponent_type) + mf6_input%param_dfns => param_definitions(mf6_input%component_type, & + mf6_input%subcomponent_type) end function getModflowInput + function update_sc_type(filetype, filename, component_type, subcomponent_type) & + result(sc_type) + character(len=*), intent(in) :: component_type + character(len=*), intent(in) :: subcomponent_type + character(len=*), intent(in) :: filetype + character(len=*), intent(in) :: filename + ! -- result + character(len=LENPACKAGETYPE) :: sc_type + ! + sc_type = subcomponent_type + ! + select case (subcomponent_type) + case ('RCH', 'EVT', 'SCP') + sc_type = read_as_arrays(filetype, filename, component_type, & + subcomponent_type) + case default + end select + ! + ! -- return + return + end function update_sc_type + + function read_as_arrays(filetype, filename, component_type, subcomponent_type) & + result(sc_type) + use ConstantsModule, only: LINELENGTH + use InputOutputModule, only: openfile, getunit + use BlockParserModule, only: BlockParserType + character(len=*), intent(in) :: component_type + character(len=*), intent(in) :: subcomponent_type + character(len=*), intent(in) :: filetype + character(len=*), intent(in) :: filename + ! -- result + character(len=LENPACKAGETYPE) :: sc_type + type(BlockParserType) :: parser + integer(I4B) :: ierr, inunit + logical(LGP) :: isfound + logical(LGP) :: endOfBlock + character(len=LINELENGTH) :: keyword + ! + sc_type = subcomponent_type + ! + inunit = getunit() + ! + call openfile(inunit, 0, trim(adjustl(filename)), filetype, & + 'FORMATTED', 'SEQUENTIAL', 'OLD') + ! + call parser%Initialize(inunit, 0) + ! + ! -- get options block + call parser%GetBlock('OPTIONS', isfound, ierr, & + supportOpenClose=.true., blockRequired=.false.) + ! + ! -- parse options block if detected + if (isfound) then + do + call parser%GetNextLine(endOfBlock) + ! + if (endOfBlock) exit + ! + call parser%GetStringCaps(keyword) + ! + if (keyword == 'READASARRAYS') then + write (sc_type, '(a)') trim(subcomponent_type)//'A' + exit + end if + end do + end if + ! + call parser%clear() + ! + ! -- return + return + end function read_as_arrays + end module ModflowInputModule diff --git a/src/Utilities/Idm/SourceCommon.f90 b/src/Utilities/Idm/SourceCommon.f90 new file mode 100644 index 00000000000..e16f22ee61a --- /dev/null +++ b/src/Utilities/Idm/SourceCommon.f90 @@ -0,0 +1,380 @@ +!> @brief This module contains the SourceCommonModule +!! +!! This module contains source independent input +!! processing helper routines. +!! +!< +module SourceCommonModule + + use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, LENFTYPE, & + LENPACKAGETYPE, LENPACKAGENAME + use SimModule, only: store_error, store_error_filename + + implicit none + private + public :: package_source_type + public :: idm_component_type, idm_subcomponent_type, subcomponent_name + public :: set_model_shape + public :: get_shape_from_string + public :: mem_allocate_naux + public :: file_ext + public :: ifind_charstr + +contains + + !> @brief source identifier from model namfile FNAME array + !! + !! Return the source type for a package listed in the + !! model nam file packages block FNAME field. + !! + !< + function package_source_type(sourcename) result(sourcetype) + ! -- modules + use InputOutputModule, only: upcase + ! -- dummy + character(len=*), intent(in) :: sourcename + ! -- result + character(len=LENPACKAGENAME) :: sourcetype + ! -- locals + ! + sourcetype = sourcename + call upcase(sourcetype) + ! + select case (sourcetype) + case default + sourcetype = 'MF6FILE' + end select + ! + ! -- return + return + end function package_source_type + + !> @brief component from package or model type + !! + !! Return the component type typically derived from package file type, + !! i.e. return GWF when input is GWF6. This function checks the + !! resultant commponent type and throws a terminating error if not + !! supported by IDM in some capacity. + !! + !< + function idm_component_type(component) result(component_type) + ! -- modules + use IdmDfnSelectorModule, only: idm_component + ! -- dummy + character(len=LENPACKAGETYPE), intent(in) :: component + ! -- return + character(len=LENFTYPE) :: component_type + ! -- local + integer(I4B) :: i, ilen + ! + ! -- initialize + component_type = '' + ! + ilen = len_trim(component) + do i = 1, ilen + if (component(i:i) == '6') then + component_type = '' + write (component_type, '(a)') trim(component(1:i - 1)) + end if + end do + ! + if (.not. idm_component(component_type)) then + write (errmsg, '(a)') & + 'IDP input error, unrecognized component: "'//trim(component)//'"' + call store_error(errmsg, .true.) + end if + ! + ! -- return + return + end function idm_component_type + + !> @brief component from package or model type + !! + !! Return the subcomponent type typically derived from package file type, + !! i.e. return CHD when input is CHD6. Note this function is called on + !! file types that are both idm integrated and not and should not set + !! an error based on this difference. + !! + !< + function idm_subcomponent_type(component, subcomponent) & + result(subcomponent_type) + ! -- modules + ! -- dummy + character(len=LENPACKAGETYPE), intent(in) :: component !< component, e.g. GWF6 + character(len=LENPACKAGETYPE), intent(in) :: subcomponent !< subcomponent, e.g. CHD6 + ! -- return + character(len=LENFTYPE) :: subcomponent_type + ! -- local + character(len=LENFTYPE) :: component_type + integer(I4B) :: i, ilen + ! + ! -- initialize + subcomponent_type = '' + ! + ! -- verify component + component_type = idm_component_type(component) + ! + ilen = len_trim(subcomponent) + do i = 1, ilen + if (subcomponent(i:i) == '6') then + subcomponent_type = '' + write (subcomponent_type, '(a)') trim(subcomponent(1:i - 1)) + end if + end do + ! + ! -- return + return + end function idm_subcomponent_type + + !> @brief model package subcomponent name + !! + !! Return the IDM component name, which is the pacage type for + !! base packages and the package name for mutli package (i.e. + !! stress) types. + !! + !< + function subcomponent_name(component_type, subcomponent_type, pkgname) + ! -- modules + use IdmDfnSelectorModule, only: idm_multi_package + ! -- dummy + character(len=*), intent(in) :: component_type + character(len=*), intent(in) :: subcomponent_type + character(len=*), intent(in) :: pkgname + ! -- return + character(len=LENPACKAGENAME) :: subcomponent_name + ! -- local + ! + subcomponent_name = '' + ! + if (idm_multi_package(component_type, subcomponent_type)) then + ! + subcomponent_name = pkgname + else + ! + subcomponent_name = subcomponent_type + end if + ! + ! -- return + return + end function subcomponent_name + + !> @brief input file extension + !! + !! Return the input file extension, or an empty string if + !! not identified. + !! + !< + function file_ext(filename) result(ext) + ! -- modules + use IdmDfnSelectorModule, only: idm_multi_package + ! -- dummy + character(len=*), intent(in) :: filename + ! -- return + character(len=LENPACKAGETYPE) :: ext + ! -- local + integer(I4B) :: i, istart, istop + ! + ! -- initialize + ext = '' + istart = 0 + istop = len_trim(filename) + ! + ! -- identify '.' character position from back of string + do i = istop, 1, -1 + if (filename(i:i) == '.') then + istart = i + exit + end if + end do + ! + ! + if (istart > 0) then + ext = filename(istart + 1:istop) + end if + ! + ! -- return + return + end function file_ext + + subroutine get_shape_from_string(shape_string, array_shape, memoryPath) + use InputOutputModule, only: parseline + use MemoryManagerModule, only: mem_setptr + character(len=*), intent(in) :: shape_string + integer(I4B), dimension(:), allocatable, intent(inout) :: array_shape + character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information + integer(I4B) :: ndim + integer(I4B) :: i + integer(I4B), pointer :: int_ptr + character(len=16), dimension(:), allocatable :: array_shape_string + character(len=:), allocatable :: shape_string_copy + ! + ! -- parse the string into multiple words + shape_string_copy = trim(shape_string)//' ' + call ParseLine(shape_string_copy, ndim, array_shape_string) + allocate (array_shape(ndim)) + ! + ! -- find shape in memory manager and put into array_shape + do i = 1, ndim + call mem_setptr(int_ptr, array_shape_string(i), memoryPath) + array_shape(i) = int_ptr + end do + ! + ! -- return + return + end subroutine get_shape_from_string + + !> @brief routine for setting the model shape + !! + !! The model shape must be set in the memory manager because + !! individual packages need to know the shape of the arrays + !! to read. + !! + !< + subroutine set_model_shape(ftype, fname, model_mempath, dis_mempath, & + model_shape) + use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize + character(len=*), intent(in) :: ftype + character(len=*), intent(in) :: fname + character(len=*), intent(in) :: model_mempath + character(len=*), intent(in) :: dis_mempath + integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: model_shape + integer(I4B), pointer :: ndim1 + integer(I4B), pointer :: ndim2 + integer(I4B), pointer :: ndim3 + integer(I4B), pointer :: ncelldim + integer(I4B) :: dim1_size, dim2_size, dim3_size + ! + ! -- allocate and set model shape in model input context + select case (ftype) + case ('DIS6') + ! + call get_isize('NLAY', dis_mempath, dim1_size) + call get_isize('NROW', dis_mempath, dim2_size) + call get_isize('NCOL', dis_mempath, dim3_size) + ! + if (dim1_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NLAY" not found.' + call store_error(errmsg) + end if + ! + if (dim2_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NROW" not found.' + call store_error(errmsg) + end if + ! + if (dim3_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NCOL" not found.' + call store_error(errmsg) + end if + ! + if (dim1_size >= 1 .and. dim2_size >= 1 .and. dim3_size >= 1) then + call mem_allocate(model_shape, 3, 'MODEL_SHAPE', model_mempath) + call mem_setptr(ndim1, 'NLAY', dis_mempath) + call mem_setptr(ndim2, 'NROW', dis_mempath) + call mem_setptr(ndim3, 'NCOL', dis_mempath) + model_shape = [ndim1, ndim2, ndim3] + else + call store_error_filename(fname) + end if + ! + case ('DISV6') + ! + call get_isize('NLAY', dis_mempath, dim1_size) + call get_isize('NCPL', dis_mempath, dim2_size) + ! + if (dim1_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NLAY" not found.' + call store_error(errmsg) + end if + ! + if (dim2_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NCPL" not found.' + call store_error(errmsg) + end if + ! + if (dim1_size >= 1 .and. dim2_size >= 1) then + call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath) + call mem_setptr(ndim1, 'NLAY', dis_mempath) + call mem_setptr(ndim2, 'NCPL', dis_mempath) + model_shape = [ndim1, ndim2] + else + call store_error_filename(fname) + end if + case ('DISU6') + ! + call get_isize('NODES', dis_mempath, dim1_size) + ! + if (dim1_size <= 0) then + write (errmsg, '(a)') & + 'Required input dimension "NODES" not found.' + call store_error(errmsg) + call store_error_filename(fname) + end if + ! + call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath) + call mem_setptr(ndim1, 'NODES', dis_mempath) + model_shape = [ndim1] + end select + ! + ! -- allocate and set ncelldim in model input context + call mem_allocate(ncelldim, 'NCELLDIM', model_mempath) + ncelldim = size(model_shape) + ! + ! -- return + return + end subroutine set_model_shape + + subroutine mem_allocate_naux(mempath) + use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize + character(len=*), intent(in) :: mempath + integer(I4B), pointer :: naux => null() + integer(I4B) :: isize + ! + ! -- allocate optional input scalars locally + call get_isize('NAUX', mempath, isize) + if (isize < 0) then + call mem_allocate(naux, 'NAUX', mempath) + naux = 0 + end if + ! + ! -- return + return + end subroutine mem_allocate_naux + + function ifind_charstr(array, str) + use CharacterStringModule, only: CharacterStringType + ! -- Find the first array element containing str + ! -- Return -1 if not found. + implicit none + ! -- return + integer(I4B) :: ifind_charstr + ! -- dummy + type(CharacterStringType), dimension(:), intent(in) :: array + character(len=*) :: str + character(len=LINELENGTH) :: compare_str + ! -- local + integer(I4B) :: i + ! + ! -- initialize + ifind_charstr = -1 + ! + findloop: do i = 1, size(array) + compare_str = array(i) + if (compare_str == str) then + ifind_charstr = i + exit findloop + end if + end do findloop + ! + ! -- return + return + end function ifind_charstr + +end module SourceCommonModule diff --git a/src/Utilities/Idm/SourceLoad.F90 b/src/Utilities/Idm/SourceLoad.F90 new file mode 100644 index 00000000000..236607806c7 --- /dev/null +++ b/src/Utilities/Idm/SourceLoad.F90 @@ -0,0 +1,175 @@ +!> @brief This module contains the SourceLoadModule +!! +!! This module contains the routines needed to generate +!! a loader object for an input source and routines +!! that distribute processing to a particular source. +!! +!< +module SourceLoadModule + + use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, LENFTYPE, & + LENPACKAGETYPE, LENPACKAGENAME + use SimModule, only: store_error, store_error_filename + use ModflowInputModule, only: ModflowInputType, getModflowInput + + implicit none + private + public :: create_pkg_loader + public :: open_source_file + public :: load_modelnam, load_simnam + +contains + + !> @brief factory function to create and setup model package static loader + !< + function create_pkg_loader(component_type, subcomponent_type, pkgname, & + pkgtype, filename, modelname, modelfname) & + result(loader) + use SourceCommonModule, only: package_source_type, subcomponent_name + use InputLoadTypeModule, only: StaticPkgLoadBaseType + character(len=*), intent(in) :: component_type + character(len=*), intent(in) :: subcomponent_type + character(len=*), intent(in) :: pkgname + character(len=*), intent(in) :: pkgtype + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + class(StaticPkgLoadBaseType), pointer :: loader + type(ModflowInputType) :: mf6_input + character(len=LENPACKAGENAME) :: source_type + character(len=LENPACKAGENAME) :: sc_name + ! + ! -- set subcomponent name + sc_name = subcomponent_name(component_type, subcomponent_type, pkgname) + ! + ! -- create description of input + mf6_input = getModflowInput(pkgtype, component_type, subcomponent_type, & + modelname, sc_name, filename) + ! + ! -- set package source + source_type = package_source_type(filename) + ! + ! -- set source loader for model package + loader => package_loader(source_type) + ! + ! -- initialize loader + call loader%init(mf6_input, modelname, modelfname, filename) + ! + ! -- return + return + end function create_pkg_loader + + !> @brief allocate source model package static loader + !< + function package_loader(source_type) result(loader) + use InputLoadTypeModule, only: StaticPkgLoadBaseType + use IdmMf6FileModule, only: Mf6FileStaticPkgLoadType + character(len=*), intent(inout) :: source_type + class(Mf6FileStaticPkgLoadType), pointer :: mf6file_loader + class(StaticPkgLoadBaseType), pointer :: loader + ! + ! -- initialize + nullify (loader) + ! + ! -- allocate derived object + select case (source_type) + case ('MF6FILE') + allocate (mf6file_loader) + loader => mf6file_loader + case default + write (errmsg, '(a)') & + 'Simulation package input source type "'//trim(source_type)// & + '" not currently supported.' + call store_error(errmsg, .true.) + end select + ! + ! -- return + return + end function package_loader + + function open_source_file(pkgtype, filename, modelfname, iout) result(fd) + use SourceCommonModule, only: package_source_type + use IdmMf6FileModule, only: open_mf6file + character(len=*), intent(in) :: pkgtype + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: modelfname + integer(I4B), intent(in) :: iout + integer(I4B) :: fd + character(len=LENPACKAGENAME) :: source_type + ! + ! -- initialize + fd = 0 + ! + ! -- set source type + source_type = package_source_type(filename) + ! + select case (source_type) + case ('MF6FILE') + fd = open_mf6file(pkgtype, filename, modelfname, iout) + case default + end select + ! + ! -- return + return + end function open_source_file + + subroutine load_modelnam(mtype, mfname, mname, iout) + use SimVariablesModule, only: simfile + use SourceCommonModule, only: package_source_type, idm_component_type + use IdmMf6FileModule, only: input_load + character(len=*), intent(in) :: mtype + character(len=*), intent(in) :: mfname + character(len=*), intent(in) :: mname + integer(I4B), intent(in) :: iout + type(ModflowInputType) :: mf6_input + character(len=LENPACKAGENAME) :: source_type + ! + ! -- set source type + source_type = package_source_type(mfname) + ! + ! -- create description of input + mf6_input = getModflowInput(mtype, idm_component_type(mtype), 'NAM', & + mname, 'NAM', mfname) + ! + select case (source_type) + case ('MF6FILE') + call input_load(mfname, mf6_input, simfile, iout) + case default + end select + ! + ! -- return + return + end subroutine load_modelnam + + subroutine load_simnam() + use SimVariablesModule, only: simfile, iout + use GenericUtilitiesModule, only: sim_message + use IdmMf6FileModule, only: input_load + type(ModflowInputType) :: mf6_input + character(len=LINELENGTH) :: line + logical :: lexist + ! + ! -- load mfsim.nam if it exists + inquire (file=trim(adjustl(simfile)), exist=lexist) + ! + if (lexist) then + ! + ! -- write name of namfile to stdout + write (line, '(2(1x,a))') 'Using Simulation name file:', & + trim(adjustl(simfile)) + call sim_message(line, skipafter=1) + ! + ! -- create description of input + mf6_input = getModflowInput('NAM6', 'SIM', 'NAM', 'SIM', 'NAM', simfile) + ! + ! -- open namfile and load to input context + call input_load(simfile, mf6_input, simfile, iout) + end if + ! + ! -- return + return + end subroutine load_simnam + +end module SourceLoadModule diff --git a/src/Utilities/Idm/mf6blockfile/AsciiInputLoadType.f90 b/src/Utilities/Idm/mf6blockfile/AsciiInputLoadType.f90 new file mode 100644 index 00000000000..081f31f1579 --- /dev/null +++ b/src/Utilities/Idm/mf6blockfile/AsciiInputLoadType.f90 @@ -0,0 +1,34 @@ +!> @brief This module contains the AsciiInputLoadTypeModule +!! +!! This module defines an abstract type that support generic +!! IDP dynamic input loading for traditional MODFLOW 6 ascii +!! files. +!! +!< +module AsciiInputLoadTypeModule + + use KindModule, only: DP, I4B, LGP + use InputLoadTypeModule, only: DynamicPkgLoadType + use BlockParserModule, only: BlockParserType + + implicit none + private + public :: AsciiDynamicPkgLoadBaseType + + !> @brief base abstract type for ascii source dynamic load + !! + !< + type, abstract, extends(DynamicPkgLoadType) :: AsciiDynamicPkgLoadBaseType + contains + procedure(ascii_period_load_if), deferred :: rp + end type AsciiDynamicPkgLoadBaseType + + abstract interface + subroutine ascii_period_load_if(this, parser) + import AsciiDynamicPkgLoadBaseType, BlockParserType + class(AsciiDynamicPkgLoadBaseType), intent(inout) :: this + type(BlockParserType), pointer, intent(inout) :: parser !< block parser + end subroutine + end interface + +end module AsciiInputLoadTypeModule diff --git a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 index 4e844c23fed..af09f48304c 100644 --- a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 @@ -1,25 +1,31 @@ !> @brief This module contains the IdmMf6FileModule !! -!! This module contains the high-level routines for loading -!! a MODFLOW input file to the input context. +!! This module contains high-level routines for loading +!! MODFLOW 6 ASCII source input. !! !< module IdmMf6FileModule use KindModule, only: DP, I4B, LGP + use SimVariablesModule, only: errmsg use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENMODELNAME, & - LENPACKAGENAME, LENFTYPE, LENPACKAGETYPE + LENPACKAGENAME, LENFTYPE, LENPACKAGETYPE, & + LENAUXNAME, LENBOUNDNAME, LENTIMESERIESNAME, & + LENLISTLABEL, LENVARNAME, DNODATA, & + DZERO, IZERO use SimModule, only: store_error, store_error_filename use InputOutputModule, only: openfile, getunit use BlockParserModule, only: BlockParserType use ModflowInputModule, only: ModflowInputType, getModflowInput use CharacterStringModule, only: CharacterStringType - use ModelPackageInputsModule, only: ModelPackageInputsType + use InputLoadTypeModule, only: StaticPkgLoadBaseType, DynamicPkgLoadBaseType + use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType implicit none private - public :: input_load ! TODO: remove - public :: load_models_mf6 + public :: input_load + public :: Mf6FileStaticPkgLoadType, Mf6FileDynamicPkgLoadType + public :: open_mf6file !> @brief derived type for storing package loader !! @@ -39,11 +45,38 @@ subroutine IPackageLoad(parser, mf6_input, iout) use BlockParserModule, only: BlockParserType use ModflowInputModule, only: ModflowInputType type(BlockParserType), intent(inout) :: parser !< block parser - type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType object that describes the input + type(ModflowInputType), intent(in) :: mf6_input !< description of input integer(I4B), intent(in) :: iout !< unit number for output end subroutine IPackageLoad end interface + !> @brief MF6File static loader derived type + !< + type, extends(StaticPkgLoadBaseType) :: Mf6FileStaticPkgLoadType + contains + procedure :: init => static_init + procedure :: load => static_load + procedure :: destroy => static_destroy + end type Mf6FileStaticPkgLoadType + + !> @brief MF6File dynamic loader derived type + !< + type, extends(DynamicPkgLoadBaseType) :: Mf6FileDynamicPkgLoadType + type(BlockParserType), pointer :: parser !< parser for MF6File period blocks + integer(I4B), pointer :: iper => null() + integer(I4B), pointer :: ionper => null() + class(AsciiDynamicPkgLoadBaseType), pointer :: block_loader => null() + contains + procedure :: init => dynamic_init + procedure :: df => dynamic_df + procedure :: ad => dynamic_ad + procedure :: set => dynamic_set + procedure :: rp => dynamic_rp + procedure :: read_ionper => dynamic_read_ionper + procedure :: create_loader => dynamic_create_loader + procedure :: destroy => dynamic_destroy + end type Mf6FileDynamicPkgLoadType + contains !> @brief generic procedure to MODFLOW 6 load routine @@ -51,286 +84,367 @@ end subroutine IPackageLoad subroutine generic_mf6_load(parser, mf6_input, iout) use LoadMf6FileModule, only: idm_load type(BlockParserType), intent(inout) :: parser !< block parser - type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType object that describes the input + type(ModflowInputType), intent(in) :: mf6_input !< description of input integer(I4B), intent(in) :: iout !< unit number for output - call idm_load(parser, mf6_input%pkgtype, & - mf6_input%component_type, mf6_input%subcomponent_type, & - mf6_input%component_name, mf6_input%subcomponent_name, & - iout) + call idm_load(parser, mf6_input, iout) end subroutine generic_mf6_load !> @brief input load for traditional mf6 simulation input file !< - subroutine input_load(pkgtype, & - component_type, subcomponent_type, & - component_name, subcomponent_name, & - inunit, iout) - character(len=*), intent(in) :: pkgtype !< pkgtype to load, such as DIS6, DISV6, NPF6 - character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT - character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF - character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL - character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE - integer(I4B), intent(in) :: inunit !< unit number for input + subroutine input_load(filename, mf6_input, component_filename, iout, & + mf6_parser) + character(len=*), intent(in) :: filename + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: component_filename !< component (e.g. model) filename integer(I4B), intent(in) :: iout !< unit number for output - type(BlockParserType), allocatable :: parser !< block parser - type(ModflowInputType) :: mf6_input + type(BlockParserType), pointer, optional, intent(inout) :: mf6_parser + type(BlockParserType), allocatable, target :: parser !< block parser type(PackageLoad) :: pkgloader + integer(I4B) :: inunit ! - ! -- create description of input - mf6_input = getModflowInput(pkgtype, component_type, & - subcomponent_type, component_name, & - subcomponent_name) - ! - ! -- set mf6 parser based package loader by file type - select case (pkgtype) + ! -- set parser based package loader by file type + select case (mf6_input%pkgtype) case default + ! + ! -- open input file + inunit = open_mf6file(mf6_input%pkgtype, filename, component_filename, iout) + ! + ! -- allocate and initialize parser allocate (parser) call parser%Initialize(inunit, iout) + ! + ! -- set load interface pkgloader%load_package => generic_mf6_load + ! end select ! ! -- invoke the selected load routine call pkgloader%load_package(parser, mf6_input, iout) ! - ! -- close files and deallocate - if (allocated(parser)) then - !call parser%clear() - deallocate (parser) + ! -- generate a dynamic loader parser if requested + if (present(mf6_parser)) then + ! + ! -- create dynamic parser + allocate (mf6_parser, source=parser) + else + ! + ! -- clear parser file handles + call parser%clear() end if ! + ! -- cleanup + deallocate (parser) + ! ! -- return return end subroutine input_load - !> @brief input load model idm supported package files + !> @brief static loader init !< - subroutine load_model_pkgfiles(model_pkg_inputs, iout) - ! -- modules - use IdmDfnSelectorModule, only: idm_integrated, idm_multi_package - ! -- dummy - type(ModelPackageInputsType), intent(inout) :: model_pkg_inputs + subroutine static_init(this, mf6_input, modelname, modelfname, source) + class(Mf6FileStaticPkgLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + ! + call this%StaticPkgLoadType%init(mf6_input, modelname, modelfname, source) + ! + end subroutine static_init + + !> @brief load routine for static loader + !< + function static_load(this, iout) result(period_loader) + class(Mf6FileStaticPkgLoadType), intent(inout) :: this integer(I4B), intent(in) :: iout - ! -- locals - integer(I4B) :: n, m - character(len=LENPACKAGETYPE) :: pkgtype - character(len=LENPACKAGENAME) :: sc_name + class(DynamicPkgLoadBaseType), pointer :: period_loader + class(Mf6FileDynamicPkgLoadType), pointer :: mf6_loader => null() + type(BlockParserType), pointer :: parser => null() + ! + ! -- initialize + nullify (period_loader) ! - do n = 1, size(model_pkg_inputs%pkglist) + ! -- load model package to input context + if (this%iperblock > 0) then + ! + ! -- package is dynamic, allocate loader + allocate (mf6_loader) + ! + ! -- load static input + call input_load(this%sourcename, this%mf6_input, & + this%modelfname, iout, parser) + ! + ! -- initialize dynamic loader + call mf6_loader%init(this%mf6_input, this%modelname, & + this%modelfname, this%sourcename, & + this%iperblock, iout) + ! + ! -- set parser + call mf6_loader%set(parser) ! - ! -- this list package type - pkgtype = model_pkg_inputs%pkglist(n)%pkgtype + ! -- set return pointer to base dynamic loader + period_loader => mf6_loader ! - ! -- load all idm integrated package type file instances - do m = 1, model_pkg_inputs%pkglist(n)%pnum - ! - if (idm_integrated(model_pkg_inputs%component_type, & - model_pkg_inputs%pkglist(n)%component_type)) then - ! - ! -- set subcomponent name - if (idm_multi_package(model_pkg_inputs%component_type, & - model_pkg_inputs%pkglist(n)%component_type)) then - ! - sc_name = model_pkg_inputs%pkglist(n)%pkgnames(m) - else - ! - sc_name = model_pkg_inputs%pkglist(n)%component_type - end if - ! - ! -- load model package to input context - call input_load(pkgtype, model_pkg_inputs%component_type, & - model_pkg_inputs%pkglist(n)%component_type, & - model_pkg_inputs%modelname, sc_name, & - model_pkg_inputs%pkglist(n)%inunits(m), iout) - ! - ! -- close file and update unit number - close (model_pkg_inputs%pkglist(n)%inunits(m)) - model_pkg_inputs%pkglist(n)%inunits(m) = 0 - ! - else - ! Not an IDM supported package, leave inunit open - end if - end do - end do + else + ! + ! -- load static input + call input_load(this%sourcename, this%mf6_input, & + this%modelfname, iout) + end if ! ! -- return return - end subroutine load_model_pkgfiles + end function static_load - !> @brief open all model package files + !> @brief static loader destroy !< - subroutine open_model_pkgfiles(model_pkg_inputs, iout) - ! -- modules - ! -- dummy - type(ModelPackageInputsType), intent(inout) :: model_pkg_inputs + subroutine static_destroy(this) + class(Mf6FileStaticPkgLoadType), intent(inout) :: this + ! + call this%StaticPkgLoadType%destroy() + ! + end subroutine static_destroy + + !> @brief dynamic loader init + !< + subroutine dynamic_init(this, mf6_input, modelname, modelfname, source, & + iperblock, iout) + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use MemoryManagerModule, only: mem_allocate + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B), intent(in) :: iperblock integer(I4B), intent(in) :: iout - ! -- locals - integer(I4B) :: n, m - character(len=LINELENGTH) :: filename - character(len=LENPACKAGETYPE) :: filetype - character(len=LINELENGTH) :: errmsg ! - do n = 1, size(model_pkg_inputs%pkglist) - ! - ! -- this package type - filetype = model_pkg_inputs%pkglist(n)%pkgtype - ! - ! -- open each package type file instance - do m = 1, model_pkg_inputs%pkglist(n)%pnum - ! - ! -- set filename - filename = model_pkg_inputs%pkglist(n)%filenames(m) - ! - if (filename /= '') then - ! - ! -- get unit number, update object and open file - model_pkg_inputs%pkglist(n)%inunits(m) = getunit() - call openfile(model_pkg_inputs%pkglist(n)%inunits(m), iout, & - trim(adjustl(filename)), filetype, 'FORMATTED', & - 'SEQUENTIAL', 'OLD') - ! - else - write (errmsg, '(a,a,a,a,a)') & - 'Package file unspecified, cannot load model package & - &[model=', trim(model_pkg_inputs%modelname), & - ', type=', trim(filetype), '].' - call store_error(errmsg) - call store_error_filename(model_pkg_inputs%modelfname) - end if - end do - end do - ! - ! -- returh + call this%DynamicPkgLoadType%init(mf6_input, modelname, modelfname, & + source, iperblock, iout) + ! + call mem_allocate(this%iper, 'IPER', this%mf6_input%mempath) + call mem_allocate(this%ionper, 'IONPER', this%mf6_input%mempath) + ! + this%iper = 0 + this%ionper = 0 + ! + ! -- allocate and initialize loader + call this%create_loader() + ! + ! -- return + return + end subroutine dynamic_init + + !> @brief dynamic loader set parser object + !< + subroutine dynamic_set(this, parser) + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + type(BlockParserType), pointer, intent(inout) :: parser + ! + ! -- set the parser + this%parser => parser + ! + ! -- read first iper + call this%read_ionper() + ! + ! -- return + return + end subroutine dynamic_set + + !> @brief define routine for dynamic loader + !< + subroutine dynamic_df(this) + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + ! + call this%block_loader%df() + ! + ! -- return return - end subroutine open_model_pkgfiles + end subroutine dynamic_df - !> @brief load and make pkg info available to models + !> @brief advance routine for dynamic loader !< - subroutine modelpkgs_load(mtype, mfname, mname, iout) + subroutine dynamic_ad(this) + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + ! + call this%block_loader%ad() + ! + ! -- return + return + end subroutine dynamic_ad + + !> @brief read and prepare routine for dynamic loader + !< + subroutine dynamic_rp(this) ! -- modules + use TdisModule, only: kper, nper + use MemoryManagerModule, only: mem_setptr ! -- dummy - character(len=*), intent(in) :: mtype - character(len=*), intent(in) :: mfname - character(len=*), intent(in) :: mname - integer(I4B), intent(in) :: iout + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this ! -- locals - type(ModelPackageInputsType) :: model_pkg_inputs - ! - ! -- set baseline state for model package instances - call model_pkg_inputs%init(mtype, mfname, mname, iout) ! - ! -- open model package files - call open_model_pkgfiles(model_pkg_inputs, iout) + ! -- check if ready to load + if (this%ionper /= kper) return ! - ! -- load model idm integrated package files - call load_model_pkgfiles(model_pkg_inputs, iout) + ! -- dynamic load + call this%block_loader%rp(this%parser) ! - ! -- load descriptions of packages to model input context - call model_pkg_inputs%memload() + ! -- update loaded iper + this%iper = kper ! - ! -- cleanup - call model_pkg_inputs%destroy() + ! -- read next iper + if (kper < nper) then + call this%read_ionper() + else + this%ionper = nper + 1 + end if ! ! -- return return - end subroutine modelpkgs_load + end subroutine dynamic_rp - !> @brief input load a single model namfile and model package files + !> @brief dynamic loader read ionper of next period block !< - subroutine model_load(mtype, mfname, mname, iout) + subroutine dynamic_read_ionper(this) ! -- modules - use SimVariablesModule, only: simfile + use TdisModule, only: kper, nper ! -- dummy - character(len=*), intent(in) :: mtype - character(len=*), intent(in) :: mfname - character(len=*), intent(in) :: mname - integer(I4B), intent(in) :: iout + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this ! -- locals - character(len=LINELENGTH) :: errmsg - integer(I4B) :: inunit + character(len=LINELENGTH) :: line + logical(LGP) :: isblockfound + integer(I4B) :: ierr + character(len=*), parameter :: fmtblkerr = & + &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')" ! - ! -- open namfile - inunit = getunit() - call openfile(inunit, iout, trim(mfname), 'NAM') + call this%parser%GetBlock('PERIOD', isblockfound, ierr, & + supportOpenClose=.true., & + blockRequired=.false.) ! - select case (mtype) - case ('GWF6') + ! -- set first period block IPER + if (isblockfound) then ! - ! -- load model namfile to the input context - call input_load('GWF6', 'GWF', 'NAM', mname, 'NAM', inunit, iout) + this%ionper = this%parser%GetInteger() ! - ! -- load and create descriptions of model package files - call modelpkgs_load(mtype, mfname, mname, iout) - ! - case ('GWT6') - ! - call input_load('GWT6', 'GWT', 'NAM', mname, 'NAM', inunit, iout) + if (this%ionper <= this%iper) then + write (errmsg, '(a, i0, a, i0, a, i0, a)') & + 'Error in stress period ', kper, & + '. Period numbers not increasing. Found ', this%ionper, & + ' but last period block was assigned ', this%iper, '.' + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end if ! - call modelpkgs_load(mtype, mfname, mname, iout) + else ! - case default - write (errmsg, '(a,a,a,a,a)') & - 'Unknown simulation model type & - &[model=', trim(mname), & - ', type=', trim(mtype), '].' - call store_error(errmsg) - call store_error_filename(simfile) - end select + ! -- PERIOD block not found + if (ierr < 0) then + ! -- End of file found; data applies for remainder of simulation. + this%ionper = nper + 1 + else + ! -- Found invalid block + call this%parser%GetCurrentLine(line) + write (errmsg, fmtblkerr) adjustl(trim(line)) + call store_error(errmsg) + call this%parser%StoreErrorUnit() + end if + end if ! - ! -- close namfile - close (inunit) + ! -- return + return + end subroutine dynamic_read_ionper + + !> @brief allocate a dynamic loader based on load context + !< + subroutine dynamic_create_loader(this) + use StressListInputModule, only: StressListInputType + use StressGridInputModule, only: StressGridInputType + ! -- dummy + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + class(StressListInputType), pointer :: list_loader + class(StressGridInputType), pointer :: grid_loader + ! + ! -- allocate and set loader + if (this%readasarrays) then + allocate (grid_loader) + this%block_loader => grid_loader + else + allocate (list_loader) + this%block_loader => list_loader + end if + ! + ! -- initialize loader + call this%block_loader%init(this%mf6_input, & + this%modelname, & + this%modelfname, & + this%sourcename, & + this%iperblock, & + this%iout) ! ! -- return return - end subroutine model_load + end subroutine dynamic_create_loader - !> @brief input load model namfiles and model package files + !> @brief dynamic loader destroy !< - subroutine load_models_mf6(model_loadmask, iout) + subroutine dynamic_destroy(this) + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + ! + ! -- deallocate input context + !call this%DynamicPkgLoadType%destroy() + ! + ! -- deallocate loader + call this%block_loader%destroy() + deallocate (this%block_loader) + ! + ! -- deallocate parser + call this%parser%clear() + deallocate (this%parser) + ! + ! -- deallocate input context + call this%DynamicPkgLoadType%destroy() + ! + ! -- return + return + end subroutine dynamic_destroy + + !> @brief open a model package files + !< + function open_mf6file(filetype, filename, component_fname, iout) result(inunit) ! -- modules - use MemoryHelperModule, only: create_mem_path - use MemoryManagerModule, only: mem_setptr - use CharacterStringModule, only: CharacterStringType - use SimVariablesModule, only: idm_context ! -- dummy - integer(I4B), dimension(:), intent(in) :: model_loadmask + character(len=*), intent(in) :: filetype + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: component_fname integer(I4B), intent(in) :: iout + ! -- return + integer(I4B) :: inunit ! -- locals - character(len=LENMEMPATH) :: input_mempath - type(CharacterStringType), dimension(:), contiguous, & - pointer :: mtypes !< model types - type(CharacterStringType), dimension(:), contiguous, & - pointer :: mfnames !< model file names - type(CharacterStringType), dimension(:), contiguous, & - pointer :: mnames !< model names - character(len=LINELENGTH) :: mtype, mfname - character(len=LENMODELNAME) :: mname - integer(I4B) :: n - ! - ! -- set input memory path - input_mempath = create_mem_path('SIM', 'NAM', idm_context) - ! - ! -- set pointers to input context model attribute arrays - call mem_setptr(mtypes, 'MTYPE', input_mempath) - call mem_setptr(mfnames, 'MFNAME', input_mempath) - call mem_setptr(mnames, 'MNAME', input_mempath) - ! - do n = 1, size(mtypes) - ! - ! -- attributes for this model - mtype = mtypes(n) - mfname = mfnames(n) - mname = mnames(n) + ! + ! -- initialize + inunit = 0 + ! + if (filename /= '') then ! - ! -- load model namfile - if (model_loadmask(n) > 0) then - call model_load(mtype, mfname, mname, iout) - end if - end do + ! -- get unit number, update object and open file + inunit = getunit() + call openfile(inunit, iout, trim(adjustl(filename)), filetype, & + 'FORMATTED', 'SEQUENTIAL', 'OLD') + else + write (errmsg, '(a,a,a)') & + 'File unspecified, cannot load model or package & + &type "', trim(filetype), '".' + call store_error(errmsg) + call store_error_filename(component_fname) + end if ! ! -- return return - end subroutine load_models_mf6 + end function open_mf6file end module IdmMf6FileModule diff --git a/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 b/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 index 41c7d84b622..81e8214860e 100644 --- a/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 @@ -8,9 +8,9 @@ module LoadMf6FileModule use KindModule, only: DP, I4B, LGP - use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENVARNAME use SimVariablesModule, only: errmsg use SimModule, only: store_error + use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENVARNAME use BlockParserModule, only: BlockParserType use LayeredArrayReaderModule, only: read_dbl1d_layered, & read_dbl2d_layered, & @@ -43,29 +43,17 @@ module LoadMf6FileModule !! memory context location of the memory manager. !! !< - subroutine idm_load(parser, pkgtype, & - component_type, subcomponent_type, & - component_name, subcomponent_name, & - iout) + subroutine idm_load(parser, mf6_input, iout) use SimVariablesModule, only: idm_context + use SourceCommonModule, only: set_model_shape, mem_allocate_naux type(BlockParserType), intent(inout) :: parser !< block parser - character(len=*), intent(in) :: pkgtype !< file type to load, such as DIS6, DISV6, NPF6 - character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT - character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF - character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL - character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE + type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType integer(I4B), intent(in) :: iout !< unit number for output integer(I4B) :: iblock !< consecutive block number as defined in definition file - type(ModflowInputType) :: mf6_input !< ModflowInputType character(len=LENMEMPATH) :: componentMemPath integer(I4B), dimension(:), contiguous, pointer :: mshape => null() character(len=LINELENGTH) :: filename !< input filename ! - ! -- construct input object - mf6_input = getModflowInput(pkgtype, component_type, & - subcomponent_type, component_name, & - subcomponent_name) - ! ! -- model shape memory path componentMemPath = create_mem_path(component=mf6_input%component_name, & context=idm_context) @@ -79,14 +67,17 @@ subroutine idm_load(parser, pkgtype, & ! ! -- process blocks do iblock = 1, size(mf6_input%block_dfns) + ! + ! -- don't load dynamic input data + if (mf6_input%block_dfns(iblock)%blockname == 'PERIOD') exit + ! + ! -- load the block call parse_block(parser, mf6_input, iblock, mshape, filename, iout, .false.) ! - ! -- set model shape if discretization dimensions have been read - if (mf6_input%block_dfns(iblock)%blockname == 'DIMENSIONS' .and. & - pkgtype(1:3) == 'DIS') then - call set_model_shape(mf6_input%pkgtype, componentMemPath, & - mf6_input%mempath, mshape) - end if + ! -- + call block_post_process(mf6_input, mf6_input%block_dfns(iblock)%blockname, & + mshape, filename) + ! end do ! ! -- close logging statement @@ -94,6 +85,41 @@ subroutine idm_load(parser, pkgtype, & mf6_input%subcomponent_name, iout) end subroutine idm_load + subroutine block_post_process(mf6_input, blockname, mshape, filename) + use SourceCommonModule, only: set_model_shape, mem_allocate_naux + type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType + character(len=*), intent(in) :: blockname + integer(I4B), dimension(:), contiguous, pointer, intent(inout) :: mshape + character(len=*), intent(in) :: filename + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iparam + ! + select case (blockname) + case ('OPTIONS') + ! -- allocate naux and set to 0 if not allocated + do iparam = 1, size(mf6_input%param_dfns) + idt => mf6_input%param_dfns(iparam) + ! + if (idt%blockname == 'OPTIONS' .and. & + idt%tagname == 'AUXILIARY') then + call mem_allocate_naux(mf6_input%mempath) + exit + end if + end do + case ('DIMENSIONS') + ! -- set model shape if discretization dimensions have been read + if (mf6_input%pkgtype(1:3) == 'DIS') then + call set_model_shape(mf6_input%pkgtype, filename, & + mf6_input%component_mempath, & + mf6_input%mempath, mshape) + end if + case default + end select + ! + ! -- return + return + end subroutine block_post_process + !> @brief procedure to load a block !! !! Use parser to load information from a block into the __INPUT__ @@ -218,7 +244,8 @@ subroutine parse_iofile_tag(parser, mf6_input, iblock, mshape, tag, found, & mf6_input%subcomponent_type, & mf6_input%block_dfns(iblock)%blockname, & words(4), filename) - call load_string_type(parser, idt, mf6_input%mempath, iout) + ! + call load_io_tag(parser, idt, mf6_input%mempath, words(3), iout) ! ! -- io tag loaded found = .true. @@ -293,7 +320,11 @@ recursive subroutine parse_tag(parser, mf6_input, iblock, mshape, filename, & call parser%DevOpt() end if case ('STRING') - call load_string_type(parser, idt, mf6_input%mempath, iout) + if (idt%shape == 'NAUX') then + call load_auxvar_names(parser, idt, mf6_input%mempath, iout) + else + call load_string_type(parser, idt, mf6_input%mempath, iout) + end if case ('INTEGER') call load_integer_type(parser, idt, mf6_input%mempath, iout) case ('INTEGER1D') @@ -318,7 +349,7 @@ recursive subroutine parse_tag(parser, mf6_input, iblock, mshape, filename, & ! ! -- continue line if in same record if (idt%in_record) then - + ! ! recursively call parse tag again to read rest of line call parse_tag(parser, mf6_input, iblock, mshape, filename, iout, .true.) end if @@ -327,6 +358,37 @@ recursive subroutine parse_tag(parser, mf6_input, iblock, mshape, filename, & return end subroutine parse_tag + function block_index_dfn(mf6_input, iblock, iout) result(idt) + type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType + integer(I4B), intent(in) :: iblock !< consecutive block number as defined in definition file + integer(I4B), intent(in) :: iout !< unit number for output + type(InputParamDefinitionType) :: idt !< input data type object describing this record + character(len=LENVARNAME) :: varname + integer(I4B) :: ilen + character(len=3) :: block_suffix = 'NUM' + ! + ! -- assign first column as the block number + ilen = len_trim(mf6_input%block_dfns(iblock)%blockname) + ! + if (ilen > (LENVARNAME - len(block_suffix))) then + varname = & + mf6_input%block_dfns(iblock)% & + blockname(1:(LENVARNAME - len(block_suffix)))//block_suffix + else + varname = trim(mf6_input%block_dfns(iblock)%blockname)//block_suffix + end if + ! + idt%component_type = trim(mf6_input%component_type) + idt%subcomponent_type = trim(mf6_input%subcomponent_type) + idt%blockname = trim(mf6_input%block_dfns(iblock)%blockname) + idt%tagname = varname + idt%mf6varname = varname + idt%datatype = 'INTEGER' + ! + ! -- return + return + end function block_index_dfn + !> @brief parse a structured array record into memory manager !! !! A structarray is similar to a numpy recarray. It it used to @@ -346,16 +408,16 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, & character(len=*), intent(in) :: filename !< input filename integer(I4B), intent(in) :: iout !< unit number for output type(InputParamDefinitionType), pointer :: idt !< input data type object describing this record - integer(I4B) :: blocknum, iwords, ilen + type(InputParamDefinitionType), target :: blockvar_idt + integer(I4B) :: blocknum, iwords integer(I4B), pointer :: nrow => null() + integer(I4B) :: nrows, nrowsread integer(I4B) :: icol integer(I4B) :: ncol integer(I4B) :: nwords character(len=16), dimension(:), allocatable :: words type(StructArrayType), pointer :: struct_array character(len=:), allocatable :: parse_str - character(len=100) :: varname - character(len=3) :: block_suffix = 'num' ! ! -- set input definition for this block idt => get_aggregate_definition_type(mf6_input%aggregate_dfns, & @@ -381,11 +443,15 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, & ! -- use shape to set the max num of rows if (idt%shape /= '') then call mem_setptr(nrow, idt%shape, mf6_input%mempath) + nrows = nrow + else + nrows = 0 end if ! ! -- create a structured array - struct_array => constructStructArray(ncol, nrow, blocknum) - nullify (nrow) + struct_array => constructStructArray(ncol, nrows, blocknum, & + mf6_input%mempath, & + mf6_input%component_mempath) ! ! -- create structarray vectors for each column do icol = 1, ncol @@ -394,21 +460,10 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, & if (blocknum > 0) then if (icol == 1) then ! - ! -- assign first column as the block number - ilen = len_trim(mf6_input%block_dfns(iblock)%blockname) - ! - if (ilen > (LENVARNAME - len(block_suffix))) then - varname = & - mf6_input%block_dfns(iblock)% & - blockname(1:(LENVARNAME - len(block_suffix)))//block_suffix - else - varname = trim(mf6_input%block_dfns(iblock)%blockname)//block_suffix - end if + blockvar_idt = block_index_dfn(mf6_input, iblock, iout) + idt => blockvar_idt ! - call struct_array%mem_create_vector(icol, 'INTEGER', & - varname, varname, & - mf6_input%mempath, '', & - .false.) + call struct_array%mem_create_vector(icol, idt) ! ! -- continue as this column managed by internally SA object cycle @@ -430,13 +485,11 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, & words(iwords), filename) ! ! -- allocate variable in memory manager - call struct_array%mem_create_vector(icol, idt%datatype, idt%mf6varname, & - idt%tagname, mf6_input%mempath, & - idt%shape, idt%preserve_case) + call struct_array%mem_create_vector(icol, idt) end do ! ! -- read the structured array - call struct_array%read_from_parser(parser, iout) + nrowsread = struct_array%read_from_parser(parser, .false., iout) ! ! -- destroy the structured array reader call destructStructArray(struct_array) @@ -475,6 +528,76 @@ subroutine load_string_type(parser, idt, memoryPath, iout) return end subroutine load_string_type + !> @brief load type string + !< + subroutine load_io_tag(parser, idt, memoryPath, which, iout) + use MemoryManagerModule, only: mem_allocate, mem_reallocate, & + mem_setptr, get_isize + use CharacterStringModule, only: CharacterStringType + type(BlockParserType), intent(inout) :: parser !< block parser + type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record + character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information + character(len=*), intent(in) :: which + integer(I4B), intent(in) :: iout !< unit number for output + character(len=LINELENGTH) :: cstr + type(CharacterStringType), dimension(:), pointer, contiguous :: charstr1d + integer(I4B) :: ilen, isize, idx + ilen = LINELENGTH + if (which == 'FILEIN') then + call get_isize(idt%mf6varname, memoryPath, isize) + if (isize < 0) then + call mem_allocate(charstr1d, ilen, 1, idt%mf6varname, memoryPath) + idx = 1 + else + call mem_setptr(charstr1d, idt%mf6varname, memoryPath) + call mem_reallocate(charstr1d, ilen, isize + 1, idt%mf6varname, & + memoryPath) + idx = isize + 1 + end if + call parser%GetString(cstr, (.not. idt%preserve_case)) + charstr1d(idx) = cstr + else if (which == 'FILEOUT') then + call load_string_type(parser, idt, memoryPath, iout) + end if + return + end subroutine load_io_tag + + !> @brief load aux variable names + !! + !< + subroutine load_auxvar_names(parser, idt, memoryPath, iout) + use ConstantsModule, only: LENAUXNAME, LINELENGTH, LENPACKAGENAME + use InputOutputModule, only: urdaux + use CharacterStringModule, only: CharacterStringType + type(BlockParserType), intent(inout) :: parser !< block parser + type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record + character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information + integer(I4B), intent(in) :: iout !< unit number for output + character(len=:), allocatable :: line + character(len=LENAUXNAME), dimension(:), allocatable :: caux + integer(I4B) :: lloc + integer(I4B) :: istart + integer(I4B) :: istop + integer(I4B) :: i + character(len=LENPACKAGENAME) :: text = '' + integer(I4B), pointer :: intvar + type(CharacterStringType), dimension(:), & + pointer, contiguous :: acharstr1d !< variable for allocation + call mem_allocate(intvar, idt%shape, memoryPath) + intvar = 0 + call parser%GetRemainingLine(line) + lloc = 1 + call urdaux(intvar, parser%iuactive, iout, lloc, & + istart, istop, caux, line, text) + call mem_allocate(acharstr1d, LENAUXNAME, intvar, idt%mf6varname, memoryPath) + do i = 1, intvar + acharstr1d(i) = caux(i) + end do + deallocate (line) + deallocate (caux) + return + end subroutine load_auxvar_names + !> @brief load type integer !< subroutine load_integer_type(parser, idt, memoryPath, iout) @@ -492,6 +615,7 @@ end subroutine load_integer_type !> @brief load type 1d integer !< subroutine load_integer1d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -539,6 +663,7 @@ end subroutine load_integer1d_type !> @brief load type 2d integer !< subroutine load_integer2d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -582,6 +707,7 @@ end subroutine load_integer2d_type !> @brief load type 3d integer !< subroutine load_integer3d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -645,6 +771,7 @@ end subroutine load_double_type !> @brief load type 1d double !< subroutine load_double1d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -691,6 +818,7 @@ end subroutine load_double1d_type !> @brief load type 2d double !< subroutine load_double2d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -734,6 +862,7 @@ end subroutine load_double2d_type !> @brief load type 3d double !< subroutine load_double3d_type(parser, idt, memoryPath, mshape, iout) + use SourceCommonModule, only: get_shape_from_string type(BlockParserType), intent(inout) :: parser !< block parser type(InputParamDefinitionType), intent(in) :: idt !< input data type object describing this record character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information @@ -780,45 +909,6 @@ subroutine load_double3d_type(parser, idt, memoryPath, mshape, iout) return end subroutine load_double3d_type - !> @brief routine for setting the model shape - !! - !! The model shape must be set in the memory manager because - !! individual packages need to know the shape of the arrays - !! to read. - !! - !< - subroutine set_model_shape(ftype, model_mempath, dis_mempath, model_shape) - use MemoryTypeModule, only: MemoryType - use MemoryManagerModule, only: get_from_memorylist - character(len=*), intent(in) :: ftype - character(len=*), intent(in) :: model_mempath - character(len=*), intent(in) :: dis_mempath - integer(I4B), dimension(:), pointer, contiguous, intent(inout) :: model_shape - integer(I4B), pointer :: ndim1 - integer(I4B), pointer :: ndim2 - integer(I4B), pointer :: ndim3 - - select case (ftype) - case ('DIS6') - call mem_allocate(model_shape, 3, 'MODEL_SHAPE', model_mempath) - call mem_setptr(ndim1, 'NLAY', dis_mempath) - call mem_setptr(ndim2, 'NROW', dis_mempath) - call mem_setptr(ndim3, 'NCOL', dis_mempath) - model_shape = [ndim1, ndim2, ndim3] - case ('DISV6') - call mem_allocate(model_shape, 2, 'MODEL_SHAPE', model_mempath) - call mem_setptr(ndim1, 'NLAY', dis_mempath) - call mem_setptr(ndim2, 'NCPL', dis_mempath) - model_shape = [ndim1, ndim2] - case ('DISU6') - call mem_allocate(model_shape, 1, 'MODEL_SHAPE', model_mempath) - call mem_setptr(ndim1, 'NODES', dis_mempath) - model_shape = [ndim1] - end select - - return - end subroutine set_model_shape - subroutine get_layered_shape(mshape, nlay, layer_shape) integer(I4B), dimension(:), intent(in) :: mshape integer(I4B), intent(out) :: nlay @@ -845,27 +935,4 @@ subroutine get_layered_shape(mshape, nlay, layer_shape) end subroutine get_layered_shape - subroutine get_shape_from_string(shape_string, array_shape, memoryPath) - character(len=*), intent(in) :: shape_string - integer(I4B), dimension(:), allocatable, intent(inout) :: array_shape - character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information - integer(I4B) :: ndim - integer(I4B) :: i - integer(I4B), pointer :: int_ptr - character(len=16), dimension(:), allocatable :: array_shape_string - character(len=:), allocatable :: shape_string_copy - - ! parse the string into multiple words - shape_string_copy = trim(shape_string)//' ' - call ParseLine(shape_string_copy, ndim, array_shape_string) - allocate (array_shape(ndim)) - - ! find shape in memory manager and put into array_shape - do i = 1, ndim - call mem_setptr(int_ptr, array_shape_string(i), memoryPath) - array_shape(i) = int_ptr - end do - - end subroutine get_shape_from_string - end module LoadMf6FileModule diff --git a/src/Utilities/Idm/mf6blockfile/StressGridInput.f90 b/src/Utilities/Idm/mf6blockfile/StressGridInput.f90 new file mode 100644 index 00000000000..833f0e0ff8c --- /dev/null +++ b/src/Utilities/Idm/mf6blockfile/StressGridInput.f90 @@ -0,0 +1,513 @@ +!> @brief This module contains the StressGridInputModule +!! +!! This module contains the routines for reading period block +!! array based input. +!! +!< +module StressGridInputModule + + use KindModule, only: I4B, DP, LGP + use ConstantsModule, only: DZERO, IZERO, LINELENGTH, LENMEMPATH, LENVARNAME, & + LENTIMESERIESNAME, LENAUXNAME + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, store_error_filename + use InputDefinitionModule, only: InputParamDefinitionType + use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr + use CharacterStringModule, only: CharacterStringType + use BlockParserModule, only: BlockParserType + use ModflowInputModule, only: ModflowInputType, getModflowInput + use BoundInputContextModule, only: BoundInputContextType + use TimeArraySeriesManagerModule, only: TimeArraySeriesManagerType, & + tasmanager_cr + use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType + + implicit none + private + public :: StressGridInputType + + !> @brief Pointer type for read state variable + !< + type ReadStateVar + integer, pointer :: invar + end type ReadStateVar + + !> @brief Ascii grid based dynamic loader type + !< + type, extends(AsciiDynamicPkgLoadBaseType) :: StressGridInputType + integer(I4B) :: tas_active !< Are TAS6 inputs defined + integer(I4B) :: nparam !< number of dynamic parameters other than AUX + type(CharacterStringType), dimension(:), contiguous, & + pointer :: aux_tasnames => null() !< array of AUXVAR TAS names + type(CharacterStringType), dimension(:), contiguous, & + pointer :: param_tasnames => null() !< array of dynamic param TAS names + character(len=LENVARNAME), dimension(:), & + allocatable :: param_names !< dynamic param names + type(ReadStateVar), dimension(:), allocatable :: param_reads !< read states for current load + integer(I4B), dimension(:), allocatable :: idt_idxs !< idt indexes corresponding to dfn param list + type(TimeArraySeriesManagerType), pointer :: tasmanager => null() !< TAS manager object + type(BoundInputContextType) :: bndctx !< boundary package input context + contains + procedure :: init => ingrid_init + procedure :: df => ingrid_df + procedure :: ad => ingrid_ad + procedure :: rp => ingrid_rp + procedure :: destroy => ingrid_destroy + procedure :: reset => ingrid_reset + procedure :: params_alloc => ingrid_params_alloc + procedure :: param_load => ingrid_param_load + procedure :: tas_arrays_alloc => ingrid_tas_arrays_alloc + procedure :: tas_links_create => ingrid_tas_links_create + end type StressGridInputType + +contains + + subroutine ingrid_init(this, mf6_input, modelname, modelfname, & + source, iperblock, iout) + use MemoryManagerModule, only: get_isize + class(StressGridInputType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B), intent(in) :: iperblock + integer(I4B), intent(in) :: iout + type(CharacterStringType), dimension(:), pointer, & + contiguous :: tas_fnames + character(len=LINELENGTH) :: fname + integer(I4B) :: tas6_size, n + ! + call this%DynamicPkgLoadType%init(mf6_input, modelname, modelfname, & + source, iperblock, iout) + ! -- initialize + this%tas_active = 0 + this%nparam = 0 + this%iout = iout + ! + ! -- create tasmanager + allocate (this%tasmanager) + call tasmanager_cr(this%tasmanager, modelname=this%mf6_input%component_name, & + iout=this%iout) + ! + ! -- determine if TAS6 files were provided in OPTIONS block + call get_isize('TAS6_FILENAME', this%mf6_input%mempath, tas6_size) + ! + if (tas6_size > 0) then + ! + this%tas_active = 1 + ! + call mem_setptr(tas_fnames, 'TAS6_FILENAME', this%mf6_input%mempath) + ! + ! -- add files to tasmanager + do n = 1, size(tas_fnames) + fname = tas_fnames(n) + call this%tasmanager%add_tasfile(fname) + end do + ! + end if + ! + ! -- initialize input context memory + call this%bndctx%init(mf6_input, .true.) + ! + ! -- allocate dfn params + call this%params_alloc() + ! + ! -- allocate memory for storing TAS strings + call this%tas_arrays_alloc() + ! + ! -- return + return + end subroutine ingrid_init + + subroutine ingrid_df(this) + ! -- modules + class(StressGridInputType), intent(inout) :: this !< Mf6FileGridInputType + ! + call this%tasmanager%tasmanager_df() + ! + ! -- return + return + end subroutine ingrid_df + + subroutine ingrid_ad(this) + ! -- modules + class(StressGridInputType), intent(inout) :: this !< Mf6FileGridInputType + ! + call this%tasmanager%ad() + ! + ! -- return + return + end subroutine ingrid_ad + + subroutine ingrid_rp(this, parser) + ! -- modules + use MemoryManagerModule, only: mem_setptr + use BlockParserModule, only: BlockParserType + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use ArrayHandlersModule, only: ifind + use SourceCommonModule, only: ifind_charstr + class(StressGridInputType), intent(inout) :: this !< Mf6FileGridInputType + type(BlockParserType), pointer, intent(inout) :: parser + ! -- locals + logical(LGP) :: endOfBlock + character(len=LINELENGTH) :: keyword, param_tag + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iaux, iparam + character(len=LENTIMESERIESNAME) :: tas_name + ! + ! -- reset for this period + call this%reset() + ! + ! -- read array block + do + ! -- initialize + iaux = 0 + ! + ! -- read next line + call parser%GetNextLine(endOfBlock) + if (endOfBlock) exit + ! + ! -- read param_tag + call parser%GetStringCaps(param_tag) + ! + ! -- is param tag an auxvar? + iaux = ifind_charstr(this%bndctx%auxname_cst, param_tag) + ! + ! -- any auvxar corresponds to the definition tag 'AUX' + if (iaux > 0) param_tag = 'AUX' + ! + ! -- set input definition + idt => get_param_definition_type(this%mf6_input%param_dfns, & + this%mf6_input%component_type, & + this%mf6_input%subcomponent_type, & + 'PERIOD', param_tag, this%sourcename) + ! + ! -- look for TAS keyword if tas is active + if (this%tas_active /= 0) then + call parser%GetStringCaps(keyword) + ! + if (keyword == 'TIMEARRAYSERIES') then + call parser%GetStringCaps(tas_name) + ! + if (param_tag == 'AUX') then + this%aux_tasnames(iaux) = tas_name + else + iparam = ifind(this%param_names, param_tag) + this%param_tasnames(iparam) = tas_name + this%param_reads(iparam)%invar = 2 + end if + ! + ! -- cycle to next input param + cycle + end if + ! + end if + ! + ! -- read and load the parameter + call this%param_load(parser, idt%datatype, idt%mf6varname, idt%tagname, & + this%mf6_input%mempath, iaux) + ! + end do + ! + ! + if (this%tas_active /= 0) then + call this%tas_links_create(parser%iuactive) + end if + ! + ! -- return + return + end subroutine ingrid_rp + + subroutine ingrid_destroy(this) + ! -- modules + class(StressGridInputType), intent(inout) :: this !< Mf6FileGridInputType + ! + deallocate (this%tasmanager) + ! + ! -- return + return + end subroutine ingrid_destroy + + subroutine ingrid_reset(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate, mem_setptr, get_isize + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use IdmDfnSelectorModule, only: idm_sfac_param + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + type(InputParamDefinitionType), pointer :: idt + character(len=LENVARNAME) :: sfac_param + integer(I4B) :: n + ! + if (this%tas_active /= 0) then + ! + ! -- reset tasmanager + call this%tasmanager%reset(this%mf6_input%subcomponent_name) + ! + ! -- reinitialize tas name arrays + call this%bndctx%param_init('CHARSTR1D', 'AUXTASNAME', & + this%mf6_input%mempath, this%sourcename) + call this%bndctx%param_init('CHARSTR1D', 'PARAMTASNAME', & + this%mf6_input%mempath, this%sourcename) + end if + ! + ! -- reset input context memory for parameters + do n = 1, this%nparam + if (this%param_reads(n)%invar /= 0) then + ! + ! -- set definition + idt => this%mf6_input%param_dfns(this%idt_idxs(n)) + ! + ! -- set sfac param (e.g. EVT6 'rate', RCH6 'recharge') + sfac_param = idm_sfac_param(this%mf6_input%component_type, & + this%mf6_input%subcomponent_type) + ! + if (idt%mf6varname == sfac_param) then + if (this%tas_active == 0) then + ! -- reinit if TAS is not active + call this%bndctx%param_init(idt%datatype, idt%mf6varname, & + this%mf6_input%mempath, this%sourcename) + end if + end if + ! + ! -- reset read state + this%param_reads(n)%invar = 0 + + end if + end do + ! + ! -- return + return + end subroutine ingrid_reset + + subroutine ingrid_params_alloc(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use ArrayHandlersModule, only: expandarray + ! -- dummy + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + type(InputParamDefinitionType), pointer :: idt + character(len=LENVARNAME), dimension(:), allocatable :: read_state_varnames + integer(I4B), pointer :: intvar + integer(I4B) :: iparam + ! + ! -- allocate period dfn params + call this%bndctx%bound_params_allocate(this%sourcename) + ! + ! -- allocate dfn input params + do iparam = 1, size(this%mf6_input%param_dfns) + ! + ! -- assign param definition pointer + idt => this%mf6_input%param_dfns(iparam) + ! + if (idt%blockname == 'PERIOD') then + ! + ! -- store parameter info + if (idt%tagname /= 'AUX') then + this%nparam = this%nparam + 1 + ! + ! -- reallocate param info arrays + call expandarray(this%param_names) + call expandarray(this%idt_idxs) + call expandarray(read_state_varnames) + ! + ! -- internal mf6 param name + this%param_names(this%nparam) = idt%mf6varname + ! -- idt list index of param + this%idt_idxs(this%nparam) = iparam + ! -- allocate and store name of read state variable + read_state_varnames(this%nparam) = & + this%bndctx%allocate_read_state_var(idt%mf6varname) + ! + end if + ! + end if + end do + ! + ! -- allocate and set param_reads pointer array + allocate (this%param_reads(this%nparam)) + ! + ! store read state variable pointers + do iparam = 1, this%nparam + call mem_setptr(intvar, read_state_varnames(iparam), this%mf6_input%mempath) + this%param_reads(iparam)%invar => intvar + end do + ! + ! -- cleanup + deallocate (read_state_varnames) + ! + ! -- return + return + end subroutine ingrid_params_alloc + + subroutine ingrid_param_load(this, parser, datatype, varname, & + tagname, mempath, iaux) + ! -- modules + use MemoryManagerModule, only: mem_setptr + use ArrayHandlersModule, only: ifind + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + use Double1dReaderModule, only: read_dbl1d + use Double2dReaderModule, only: read_dbl2d + use Integer1dReaderModule, only: read_int1d + use IdmLoggerModule, only: idm_log_var + ! -- dummy + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + type(BlockParserType), intent(in) :: parser + character(len=*), intent(in) :: datatype + character(len=*), intent(in) :: varname + character(len=*), intent(in) :: tagname + character(len=*), intent(in) :: mempath + integer(I4B), intent(in) :: iaux + ! -- locals + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + integer(I4B) :: iparam + ! + select case (datatype) + case ('INTEGER1D') + ! + call mem_setptr(int1d, varname, mempath) + call read_int1d(parser, int1d, varname) + call idm_log_var(int1d, tagname, mempath, this%iout) + ! + case ('DOUBLE1D') + ! + call mem_setptr(dbl1d, varname, mempath) + call read_dbl1d(parser, dbl1d, varname) + call idm_log_var(dbl1d, tagname, mempath, this%iout) + ! + case ('DOUBLE2D') + ! + call mem_setptr(dbl2d, varname, mempath) + call read_dbl1d(parser, dbl2d(iaux, :), varname) + call idm_log_var(dbl2d, tagname, mempath, this%iout) + ! + case default + ! + call store_error('Programming error. (IDM) unsupported memload & + &data type for param='//trim(tagname)) + call store_error_filename(this%sourcename) + ! + end select + ! + iparam = ifind(this%param_names, varname) + ! + ! -- if param is tracked set read state + if (iparam > 0) then + this%param_reads(iparam)%invar = 1 + end if + ! + ! -- return + return + end subroutine ingrid_param_load + + subroutine ingrid_tas_arrays_alloc(this) + ! -- modules + use MemoryManagerModule, only: mem_allocate + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + ! + ! -- count params other than AUX + if (this%tas_active /= 0) then + ! + call mem_allocate(this%aux_tasnames, LENTIMESERIESNAME, this%bndctx%naux, & + 'AUXTASNAME', this%mf6_input%mempath) + call mem_allocate(this%param_tasnames, LENTIMESERIESNAME, this%nparam, & + 'PARAMTASNAME', this%mf6_input%mempath) + ! + call this%bndctx%param_init('CHARSTR1D', 'AUXTASNAME', & + this%mf6_input%mempath, & + this%sourcename) + call this%bndctx%param_init('CHARSTR1D', 'PARAMTASNAME', & + this%mf6_input%mempath, & + this%sourcename) + ! + else + ! + call mem_allocate(this%aux_tasnames, LENTIMESERIESNAME, 0, & + 'AUXTASNAME', this%mf6_input%mempath) + call mem_allocate(this%param_tasnames, LENTIMESERIESNAME, 0, & + 'PARAMTASNAME', this%mf6_input%mempath) + ! + end if + ! + ! -- return + return + end subroutine ingrid_tas_arrays_alloc + + ! FLUX and SFAC are handled in model context + subroutine ingrid_tas_links_create(this, inunit) + ! -- modules + use InputDefinitionModule, only: InputParamDefinitionType + ! -- dummy + class(StressGridInputType), intent(inout) :: this !< StressGridInputType + integer(I4B), intent(in) :: inunit + ! -- locals + type(InputParamDefinitionType), pointer :: idt + ! -- non-contiguous beacuse a slice of bound is passed + real(DP), dimension(:), pointer :: auxArrayPtr, bndArrayPtr + real(DP), dimension(:), pointer, contiguous :: bound + integer(I4B), dimension(:), pointer, contiguous :: nodelist + character(len=LENTIMESERIESNAME) :: tas_name + character(len=LENAUXNAME) :: aux_name + logical :: convertFlux + integer(I4B) :: n + ! + ! -- initialize + nullify (auxArrayPtr) + nullify (bndArrayPtr) + nullify (nodelist) + convertflux = .false. + ! + ! Create AUX Time Array Series links + do n = 1, this%bndctx%naux + tas_name = this%aux_tasnames(n) + ! + if (tas_name /= '') then + ! + ! -- set auxvar pointer + auxArrayPtr => this%bndctx%auxvar(n, :) + ! + aux_name = this%bndctx%auxname_cst(n) + ! + call this%tasmanager%MakeTasLink(this%mf6_input%subcomponent_name, & + auxArrayPtr, this%bndctx%iprpak, & + tas_name, aux_name, convertFlux, & + nodelist, inunit) + end if + ! + end do + ! + ! Create BND Time Array Series links + do n = 1, this%nparam + ! + ! -- assign param definition pointer + idt => this%mf6_input%param_dfns(this%idt_idxs(n)) + ! + if (idt%timeseries) then + ! + if (this%param_reads(n)%invar == 2) then + tas_name = this%param_tasnames(n) + ! + call mem_setptr(bound, idt%mf6varname, this%mf6_input%mempath) + ! + ! -- set bound pointer + bndArrayPtr => bound(:) + ! + call this%tasmanager%MakeTasLink(this%mf6_input%subcomponent_name, & + bndArrayPtr, this%bndctx%iprpak, & + tas_name, idt%mf6varname, & + convertFlux, nodelist, inunit) + end if + end if + end do + + ! + ! -- return + return + end subroutine ingrid_tas_links_create + +end module StressGridInputModule diff --git a/src/Utilities/Idm/mf6blockfile/StressListInput.f90 b/src/Utilities/Idm/mf6blockfile/StressListInput.f90 new file mode 100644 index 00000000000..4adaef51984 --- /dev/null +++ b/src/Utilities/Idm/mf6blockfile/StressListInput.f90 @@ -0,0 +1,430 @@ +!> @brief This module contains the StressListInputModule +!! +!! This module contains the routines for reading period block +!! list based input. +!! +!< +module StressListInputModule + + use KindModule, only: I4B, DP, LGP + use ConstantsModule, only: DZERO, IZERO, LINELENGTH, LENMEMPATH, LENVARNAME, & + LENTIMESERIESNAME, LENAUXNAME, LENBOUNDNAME + use SimVariablesModule, only: errmsg + use SimModule, only: store_error, count_errors, store_error_unit + use InputOutputModule, only: openfile, getunit + use InputDefinitionModule, only: InputParamDefinitionType + use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr + use CharacterStringModule, only: CharacterStringType + use ModflowInputModule, only: ModflowInputType, getModflowInput + use TimeSeriesManagerModule, only: TimeSeriesManagerType, tsmanager_cr + use BoundInputContextModule, only: BoundInputContextType + use StructArrayModule, only: StructArrayType, constructStructArray, & + destructStructArray + use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType + + implicit none + private + public :: StressListInputType + + !> @brief Ascii list based dynamic loader type + !< + type, extends(AsciiDynamicPkgLoadBaseType) :: StressListInputType + integer(I4B) :: ts_active + integer(I4B) :: ibinary + integer(I4B) :: oc_inunit + integer(I4B) :: ncol + integer(I4B) :: iboundname + character(len=LENVARNAME), dimension(:), allocatable :: cols + type(TimeSeriesManagerType), pointer :: tsmanager => null() + type(StructArrayType), pointer :: structarray + type(BoundInputContextType) :: bndctx + contains + procedure :: init => inlist_init + procedure :: df => inlist_df + procedure :: ad => inlist_ad + procedure :: rp => inlist_rp + procedure :: destroy => inlist_destroy + procedure :: reset => inlist_reset + procedure :: ts_link => inlist_ts_link + procedure :: ts_update => inlist_ts_update + procedure :: create_structarray + procedure :: read_control_record + end type StressListInputType + +contains + + subroutine inlist_init(this, mf6_input, modelname, modelfname, & + source, iperblock, iout) + use MemoryManagerModule, only: get_isize + class(StressListInputType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: modelname + character(len=*), intent(in) :: modelfname + character(len=*), intent(in) :: source + integer(I4B), intent(in) :: iperblock + integer(I4B), intent(in) :: iout + type(CharacterStringType), dimension(:), pointer, & + contiguous :: ts_fnames + character(len=LINELENGTH) :: fname + integer(I4B) :: ts6_size, n + ! + call this%DynamicPkgLoadType%init(mf6_input, modelname, modelfname, & + source, iperblock, iout) + ! + ! -- initialize + this%ts_active = 0 + this%ibinary = 0 + this%oc_inunit = 0 + ! + ! -- create tsmanager + allocate (this%tsmanager) + call tsmanager_cr(this%tsmanager, iout) + ! + ! -- determine if TS6 files were provided in OPTIONS block + call get_isize('TS6_FILENAME', this%mf6_input%mempath, ts6_size) + ! + if (ts6_size > 0) then + ! + this%ts_active = 1 + call mem_setptr(ts_fnames, 'TS6_FILENAME', this%mf6_input%mempath) + ! + do n = 1, size(ts_fnames) + fname = ts_fnames(n) + call this%tsmanager%add_tsfile(fname, GetUnit()) + end do + ! + end if + ! + ! -- initialize package input context + call this%bndctx%init(mf6_input, .false.) + ! + ! -- set SA cols in scope for list input + call this%bndctx%filtered_cols(this%cols, this%ncol) + ! + ! -- construct and set up the struct array object + call this%create_structarray() + ! + ! -- finalize input context setup + call this%bndctx%enable() + ! + ! -- return + return + end subroutine inlist_init + + subroutine inlist_df(this) + ! -- modules + class(StressListInputType), intent(inout) :: this !< StressListInputType + ! + ! -- define tsmanager + call this%tsmanager%tsmanager_df() + ! + ! -- return + return + end subroutine inlist_df + + subroutine inlist_ad(this) + ! -- modules + class(StressListInputType), intent(inout) :: this !< StressListInputType + ! + ! -- advance tsmanager + call this%tsmanager%ad() + ! + ! -- return + return + end subroutine inlist_ad + + subroutine inlist_rp(this, parser) + ! -- modules + use BlockParserModule, only: BlockParserType + use StructVectorModule, only: StructVectorType + ! -- dummy + class(StressListInputType), intent(inout) :: this + type(BlockParserType), pointer, intent(inout) :: parser + ! -- locals + logical(LGP) :: ts_active + ! + call this%reset() + ! + call this%read_control_record(parser) + ! + if (this%ibinary == 1) then + ! + this%bndctx%nbound = & + this%structarray%read_from_binary(this%oc_inunit, 0) + ! + call parser%terminateblock() + ! + close (this%oc_inunit) + this%ibinary = 0 + this%oc_inunit = 0 + ! + else + ! + ts_active = (this%ts_active /= 0) + ! + this%bndctx%nbound = & + this%structarray%read_from_parser(parser, & + ts_active, 0) + end if + ! + ! update ts links + if (this%ts_active /= 0) then + call this%ts_update() + end if + ! + ! -- return + return + end subroutine inlist_rp + + subroutine inlist_destroy(this) + ! -- modules + class(StressListInputType), intent(inout) :: this !< StressListInputType + ! + deallocate (this%cols) + deallocate (this%tsmanager) + call destructStructArray(this%structarray) + call this%bndctx%destroy() + ! + ! -- return + return + end subroutine inlist_destroy + + subroutine inlist_reset(this) + ! -- modules + class(StressListInputType), intent(inout) :: this !< StressListInputType + ! + ! -- reset tsmanager + call this%tsmanager%reset(this%mf6_input%subcomponent_name) + ! + ! -- return + return + end subroutine inlist_reset + + subroutine inlist_ts_link(this, structvector, ts_strloc) + ! -- modules + use TimeSeriesLinkModule, only: TimeSeriesLinkType + use TimeSeriesManagerModule, only: read_value_or_time_series + use StructVectorModule, only: StructVectorType, TSStringLocType + !use ArrayHandlersModule, only: ifind + ! -- dummy + class(StressListInputType), intent(inout) :: this + type(StructVectorType), pointer, intent(in) :: structvector + type(TSStringLocType), pointer, intent(in) :: ts_strloc + ! -- locals + real(DP), pointer :: bndElem => null() + type(TimeSeriesLinkType), pointer :: tsLinkBnd => null() + type(TimeSeriesLinkType), pointer :: tsLinkAux => null() + type(StructVectorType), pointer :: sv_bound + character(len=LENBOUNDNAME) :: boundname + ! + select case (structvector%memtype) + case (2) + ! + tsLinkBnd => NULL() + ! + ! -- set bound element + bndElem => structvector%dbl1d(ts_strloc%row) + ! + ! -- set link + call read_value_or_time_series(ts_strloc%token, ts_strloc%row, & + ts_strloc%structarray_col, bndElem, & + this%mf6_input%subcomponent_name, & + 'BND', this%tsmanager, & + this%bndctx%iprpak, tsLinkBnd) + ! + if (associated(tsLinkBnd)) then + ! + ! -- set variable name + tsLinkBnd%Text = structvector%idt%mf6varname + ! + ! -- set boundname if provided + if (this%bndctx%inamedbound > 0) then + sv_bound => this%structarray%get(this%iboundname) + boundname = sv_bound%charstr1d(ts_strloc%row) + tsLinkBnd%BndName = boundname + end if + + ! Flux is handled from model context + + end if + ! + case (6) + ! + tsLinkAux => NULL() + ! + ! -- set bound element + bndElem => structvector%dbl2d(ts_strloc%col, ts_strloc%row) + ! + ! -- set link + call read_value_or_time_series(ts_strloc%token, ts_strloc%row, & + ts_strloc%structarray_col, bndElem, & + this%mf6_input%subcomponent_name, & + 'AUX', this%tsmanager, & + this%bndctx%iprpak, tsLinkAux) + + if (associated(tsLinkAux)) then + ! + ! TODO + ! -- set variable name + tsLinkAux%Text = this%bndctx%auxname_cst(ts_strloc%col) + ! + ! -- set boundname if provided + if (this%bndctx%inamedbound > 0) then + sv_bound => this%structarray%get(this%iboundname) + boundname = sv_bound%charstr1d(ts_strloc%row) + tsLinkAux%BndName = boundname + end if + ! + end if + ! + case default + end select + ! + ! -- return + return + end subroutine inlist_ts_link + + subroutine inlist_ts_update(this) + ! -- modules + use StructVectorModule, only: TSStringLocType + use StructVectorModule, only: StructVectorType + ! -- dummy + class(StressListInputType), intent(inout) :: this + ! -- locals + integer(I4B) :: n, m + type(TSStringLocType), pointer :: ts_strloc + type(StructVectorType), pointer :: sv + ! + ! + do m = 1, this%structarray%count() + + sv => this%structarray%get(m) + + if (sv%idt%timeseries) then + ! + do n = 1, sv%ts_strlocs%count() + ts_strloc => sv%get_ts_strloc(n) + call this%ts_link(sv, ts_strloc) + end do + ! + call sv%clear() + end if + end do + ! + ! -- return + return + end subroutine inlist_ts_update + + subroutine create_structarray(this) + ! -- modules + use InputDefinitionModule, only: InputParamDefinitionType + use DefinitionSelectModule, only: get_param_definition_type + ! -- dummy + class(StressListInputType), intent(inout) :: this + ! -- locals + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: icol + ! + ! -- construct and set up the struct array object + this%structarray => constructStructArray(this%ncol, this%bndctx%maxbound, & + 0, this%mf6_input%mempath, & + this%mf6_input%component_mempath) + ! + ! -- set up struct array + do icol = 1, this%ncol + ! + idt => get_param_definition_type(this%mf6_input%param_dfns, & + this%mf6_input%component_type, & + this%mf6_input%subcomponent_type, & + 'PERIOD', & + this%cols(icol), this%sourcename) + ! + ! -- allocate variable in memory manager + call this%structarray%mem_create_vector(icol, idt) + ! + ! -- store boundname index when found + if (idt%mf6varname == 'BOUNDNAME') this%iboundname = icol + ! + end do + ! + ! -- return + return + end subroutine create_structarray + + subroutine read_control_record(this, parser) + ! -- modules + use InputOutputModule, only: urword + use OpenSpecModule, only: form, access + use ConstantsModule, only: LINELENGTH + use BlockParserModule, only: BlockParserType + ! -- dummy + class(StressListInputType), intent(inout) :: this + type(BlockParserType), intent(inout) :: parser + ! -- local + integer(I4B) :: lloc, istart, istop, idum, inunit, itmp, ierr + integer(I4B) :: nunopn = 99 + character(len=:), allocatable :: line + character(len=LINELENGTH) :: fname + logical :: exists + real(DP) :: r + ! -- formats + character(len=*), parameter :: fmtocne = & + &"('Specified OPEN/CLOSE file ',(A),' does not exist')" + character(len=*), parameter :: fmtobf = & + &"(1X,/1X,'OPENING BINARY FILE ON UNIT ',I0,':',/1X,A)" + ! + inunit = parser%getunit() + ! + ! -- Read to the first non-commented line + lloc = 1 + call parser%line_reader%rdcom(inunit, this%iout, line, ierr) + call urword(line, lloc, istart, istop, 1, idum, r, this%iout, inunit) + ! + if (line(istart:istop) == 'OPEN/CLOSE') then + ! + ! -- get filename + call urword(line, lloc, istart, istop, 0, idum, r, & + this%iout, inunit) + ! + fname = line(istart:istop) + ! + ! -- check to see if file OPEN/CLOSE file exists + inquire (file=fname, exist=exists) + ! + if (.not. exists) then + write (errmsg, fmtocne) line(istart:istop) + call store_error(errmsg) + call store_error('Specified OPEN/CLOSE file does not exist') + call store_error_unit(inunit) + end if + ! + ! -- Check for (BINARY) keyword + call urword(line, lloc, istart, istop, 1, idum, r, & + this%iout, inunit) + ! + if (line(istart:istop) == '(BINARY)') this%ibinary = 1 + ! + ! -- Open the file depending on ibinary flag + if (this%ibinary == 1) then + this%oc_inunit = nunopn + itmp = this%iout + ! + if (this%iout > 0) then + itmp = 0 + write (this%iout, fmtobf) this%oc_inunit, trim(adjustl(fname)) + end if + ! + call openfile(this%oc_inunit, itmp, fname, 'OPEN/CLOSE', & + fmtarg_opt=form, accarg_opt=access) + end if + end if + ! + if (this%ibinary == 0) then + call parser%line_reader%bkspc(parser%getunit()) + end if + ! + ! -- return + return + end subroutine read_control_record + +end module StressListInputModule diff --git a/src/Utilities/Idm/mf6blockfile/StructArray.f90 b/src/Utilities/Idm/mf6blockfile/StructArray.f90 index 5dca7d8becd..2a09a536881 100644 --- a/src/Utilities/Idm/mf6blockfile/StructArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/StructArray.f90 @@ -8,15 +8,15 @@ module StructArrayModule use KindModule, only: I4B, DP, LGP - use ConstantsModule, only: DNODATA, LINELENGTH + use ConstantsModule, only: DZERO, IZERO, LINELENGTH, LENMEMPATH, LENVARNAME use SimVariablesModule, only: errmsg use SimModule, only: store_error use StructVectorModule, only: StructVectorType + use InputDefinitionModule, only: InputParamDefinitionType use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr use CharacterStringModule, only: CharacterStringType use STLVecIntModule, only: STLVecInt use IdmLoggerModule, only: idm_log_var - use MemoryManagerModule, only: mem_setptr use BlockParserModule, only: BlockParserType implicit none @@ -37,14 +37,21 @@ module StructArrayModule integer(I4B) :: blocknum logical(LGP) :: deferred_shape = .false. integer(I4B) :: deferred_size_init = 5 - type(StructVectorType), dimension(:), allocatable :: struct_vector_1d + character(len=LENMEMPATH) :: mempath + character(len=LENMEMPATH) :: component_mempath + type(StructVectorType), dimension(:), allocatable :: struct_vectors + integer(I4B), dimension(:), allocatable :: startidx, numcols contains procedure :: mem_create_vector - procedure :: add_vector_int1d - procedure :: add_vector_dbl1d - procedure :: add_vector_charstr1d - procedure :: add_vector_intvector + procedure :: count + procedure :: get + procedure :: allocate_int_type + procedure :: allocate_dbl_type + procedure :: allocate_charstr_type + procedure :: allocate_int1d_type + procedure :: allocate_dbl1d_type procedure :: read_from_parser + procedure :: read_from_binary procedure :: memload_vectors procedure :: load_deferred_vector procedure :: log_structarray_vars @@ -56,10 +63,13 @@ module StructArrayModule !> @brief constructor for a struct_array !< - function constructStructArray(ncol, nrow, blocknum) result(struct_array) + function constructStructArray(ncol, nrow, blocknum, mempath, & + component_mempath) result(struct_array) integer(I4B), intent(in) :: ncol !< number of columns in the StructArrayType - integer(I4B), pointer, intent(in) :: nrow !< number of rows in the StructArrayType + integer(I4B), intent(in) :: nrow !< number of rows in the StructArrayType integer(I4B), intent(in) :: blocknum !< valid block number or 0 + character(len=*), intent(in) :: mempath !< memory path for storing the vector + character(len=*), intent(in) :: component_mempath type(StructArrayType), pointer :: struct_array !< new StructArrayType ! ! -- allocate StructArrayType @@ -69,10 +79,8 @@ function constructStructArray(ncol, nrow, blocknum) result(struct_array) struct_array%ncol = ncol ! ! -- set rows if known or set deferred - if (associated(nrow)) then - struct_array%nrow = nrow - else - struct_array%nrow = 0 + struct_array%nrow = nrow + if (struct_array%nrow == 0) then struct_array%deferred_shape = .true. end if ! @@ -83,8 +91,14 @@ function constructStructArray(ncol, nrow, blocknum) result(struct_array) struct_array%blocknum = 0 end if ! + ! + struct_array%mempath = mempath + struct_array%component_mempath = component_mempath + ! ! -- allocate StructVectorType objects - allocate (struct_array%struct_vector_1d(ncol)) + allocate (struct_array%struct_vectors(ncol)) + allocate (struct_array%startidx(ncol)) + allocate (struct_array%numcols(ncol)) end function constructStructArray !> @brief destructor for a struct_array @@ -92,317 +106,386 @@ end function constructStructArray subroutine destructStructArray(struct_array) type(StructArrayType), pointer, intent(inout) :: struct_array !< StructArrayType to destroy - deallocate (struct_array%struct_vector_1d) + deallocate (struct_array%struct_vectors) + deallocate (struct_array%startidx) + deallocate (struct_array%numcols) deallocate (struct_array) nullify (struct_array) end subroutine destructStructArray !> @brief create new vector in StructArrayType !< - subroutine mem_create_vector(this, icol, vartype, name, tagname, memoryPath, & - varname_shape, preserve_case) + subroutine mem_create_vector(this, icol, idt) class(StructArrayType) :: this !< StructArrayType integer(I4B), intent(in) :: icol !< column to create - character(len=*), intent(in) :: vartype !< type of column to create - character(len=*), intent(in) :: name !< name of the column to create - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path for storing the vector - character(len=*), intent(in) :: varname_shape !< shape - logical(LGP), optional, intent(in) :: preserve_case !< flag indicating whether or not to preserve case - integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d - type(CharacterStringType), dimension(:), pointer, contiguous :: charstr1d - type(STLVecInt), pointer :: intvector - integer(I4B) :: j - integer(I4B) :: inodata = 999 !todo: create INODATA in constants? + type(InputParamDefinitionType), pointer :: idt + type(StructVectorType) :: sv + integer(I4B) :: numcol + ! + numcol = 1 + ! + sv%idt => idt + sv%icol = icol + ! + ! -- set size + if (this%deferred_shape) then + sv%size = this%deferred_size_init + else + sv%size = this%nrow + end if ! ! -- allocate array memory for StructVectorType - select case (vartype) - ! - case ('INTEGER1D') - ! - ! -- allocate intvector object - allocate (intvector) - ! - ! -- initialize StructVector and add to StructArray - call this%add_vector_intvector(name, tagname, memoryPath, varname_shape, & - icol, intvector) + select case (idt%datatype) ! case ('INTEGER') ! - if (this%deferred_shape) then - ! -- shape not known, allocate locally - allocate (int1d(this%deferred_size_init)) - else - ! -- shape known, allocate in managed memory - call mem_allocate(int1d, this%nrow, name, memoryPath) - end if - ! - ! -- initialize vector values - do j = 1, this%nrow - int1d(j) = inodata - end do - ! - ! -- initialize StructVector and add to StructArray - call this%add_vector_int1d(name, tagname, memoryPath, icol, int1d) + call this%allocate_int_type(sv) ! case ('DOUBLE') ! - call mem_allocate(dbl1d, this%nrow, name, memoryPath) + call this%allocate_dbl_type(sv) ! - do j = 1, this%nrow - dbl1d(j) = DNODATA - end do + case ('STRING', 'KEYWORD') ! - call this%add_vector_dbl1d(name, tagname, memoryPath, icol, dbl1d) + call this%allocate_charstr_type(sv) ! - case ('STRING', 'KEYWORD') + case ('INTEGER1D') ! - if (this%deferred_shape) then - allocate (charstr1d(this%deferred_size_init)) - else - call mem_allocate(charstr1d, LINELENGTH, this%nrow, name, memoryPath) + call this%allocate_int1d_type(sv) + if (sv%memtype == 5) then + numcol = sv%intshape end if ! - do j = 1, this%nrow - charstr1d(j) = '' - end do + case ('DOUBLE1D') + ! + call this%allocate_dbl1d_type(sv) + numcol = sv%intshape ! - call this%add_vector_charstr1d(name, tagname, memoryPath, icol, charstr1d, & - varname_shape, preserve_case) end select - + ! + ! -- set the object in the Struct Array + this%struct_vectors(icol) = sv + ! + this%numcols(icol) = numcol + if (icol == 1) then + this%startidx(icol) = 1 + else + this%startidx(icol) = this%startidx(icol - 1) + this%numcols(icol - 1) + end if + ! + ! -- return return end subroutine mem_create_vector - !> @brief add int1d to StructArrayType + function count(this) + class(StructArrayType) :: this !< StructArrayType + integer(I4B) :: count + count = size(this%struct_vectors) + end function count + + subroutine set_pointer(sv, sv_target) + type(StructVectorType), pointer :: sv + type(StructVectorType), target :: sv_target + sv => sv_target + end subroutine set_pointer + + function get(this, idx) result(sv) + class(StructArrayType) :: this !< StructArrayType + integer(I4B), intent(in) :: idx + type(StructVectorType), pointer :: sv + call set_pointer(sv, this%struct_vectors(idx)) + end function get + + !> @brief allocate integer input type !< - subroutine add_vector_int1d(this, varname, tagname, memoryPath, icol, int1d) + subroutine allocate_int_type(this, sv) class(StructArrayType) :: this !< StructArrayType - character(len=*), intent(in) :: varname !< name of the variable - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path to vector - integer(I4B), intent(in) :: icol !< column of the vector - integer(I4B), dimension(:), pointer, contiguous, intent(in) :: int1d !< vector to add - type(StructVectorType) :: sv - ! - ! -- initialize StructVectorType - sv%varname = varname - sv%tagname = tagname - sv%shapevar = '' - sv%mempath = memoryPath - sv%memtype = 1 - sv%int1d => int1d + type(StructVectorType), intent(inout) :: sv + integer(I4B), dimension(:), pointer, contiguous :: int1d + integer(I4B) :: j ! - ! -- set size if (this%deferred_shape) then - sv%size = this%deferred_size_init + ! -- shape not known, allocate locally + allocate (int1d(this%deferred_size_init)) else - sv%size = this%nrow + ! -- shape known, allocate in managed memory + call mem_allocate(int1d, this%nrow, sv%idt%mf6varname, this%mempath) end if ! - ! -- set the object in the Struct Array - this%struct_vector_1d(icol) = sv + ! -- initialize vector values + do j = 1, this%nrow + int1d(j) = IZERO + end do + ! + sv%memtype = 1 + sv%int1d => int1d ! ! -- return return - end subroutine add_vector_int1d + end subroutine allocate_int_type - !> @brief add dbl1d to StructArrayType + !> @brief allocate double input type !< - subroutine add_vector_dbl1d(this, varname, tagname, memoryPath, icol, dbl1d) + subroutine allocate_dbl_type(this, sv) class(StructArrayType) :: this !< StructArrayType - character(len=*), intent(in) :: varname !< name of the variable - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path to vector - integer(I4B), intent(in) :: icol !< column of the vector - real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d !< vector to add - type(StructVectorType) :: sv + type(StructVectorType), intent(inout) :: sv + real(DP), dimension(:), pointer, contiguous :: dbl1d + integer(I4B) :: j + ! + if (this%deferred_shape) then + ! -- shape not known, allocate locally + allocate (dbl1d(this%deferred_size_init)) + else + ! -- shape known, allocate in managed memory + call mem_allocate(dbl1d, this%nrow, sv%idt%mf6varname, this%mempath) + end if + ! + do j = 1, this%nrow + dbl1d(j) = DZERO + end do ! - ! -- initialize StructVectorType - sv%varname = varname - sv%tagname = tagname - sv%shapevar = '' - sv%mempath = memoryPath sv%memtype = 2 sv%dbl1d => dbl1d - sv%size = this%nrow - ! - ! -- set the object in the Struct Array - this%struct_vector_1d(icol) = sv ! ! -- return return - end subroutine add_vector_dbl1d + end subroutine allocate_dbl_type - !> @brief add charstr1d to StructArrayType + !> @brief allocate charstr input type !< - subroutine add_vector_charstr1d(this, varname, tagname, memoryPath, icol, & - charstr1d, varname_shape, preserve_case) + subroutine allocate_charstr_type(this, sv) class(StructArrayType) :: this !< StructArrayType - integer(I4B), intent(in) :: icol !< column of the vector - character(len=*), intent(in) :: varname !< name of the variable - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path to vector - type(CharacterStringType), dimension(:), pointer, contiguous, intent(in) :: & - charstr1d !< vector to add - character(len=*), intent(in) :: varname_shape !< shape of variable - logical(LGP), intent(in) :: preserve_case - type(StructVectorType) :: sv - ! - ! -- initialize StructVectorType - sv%varname = varname - sv%tagname = tagname - sv%shapevar = varname_shape - sv%mempath = memoryPath - sv%memtype = 3 - sv%preserve_case = preserve_case - sv%charstr1d => charstr1d + type(StructVectorType), intent(inout) :: sv + type(CharacterStringType), dimension(:), pointer, contiguous :: charstr1d + integer(I4B) :: j ! - ! -- set size if (this%deferred_shape) then - sv%size = this%deferred_size_init + allocate (charstr1d(this%deferred_size_init)) else - sv%size = this%nrow + call mem_allocate(charstr1d, LINELENGTH, this%nrow, & + sv%idt%mf6varname, this%mempath) end if ! - ! -- set the object in the Struct Array - this%struct_vector_1d(icol) = sv + do j = 1, this%nrow + charstr1d(j) = '' + end do + ! + sv%memtype = 3 + sv%charstr1d => charstr1d ! ! -- return return - end subroutine add_vector_charstr1d + end subroutine allocate_charstr_type - !> @brief add STLVecInt to StructArrayType + !> @brief allocate int1d input type !< - subroutine add_vector_intvector(this, varname, tagname, memoryPath, & - varname_shape, icol, intvector) + subroutine allocate_int1d_type(this, sv) class(StructArrayType) :: this !< StructArrayType - character(len=*), intent(in) :: varname !< name of the variable - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: memoryPath !< memory path to vector - character(len=*), intent(in) :: varname_shape !< shape of variable - integer(I4B), intent(in) :: icol !< column of the vector - type(STLVecInt), pointer, intent(in) :: intvector !< vector to add - type(StructVectorType) :: sv - ! - ! -- initialize STLVecInt - call intvector%init() + type(StructVectorType), intent(inout) :: sv + integer(I4B), dimension(:, :), pointer, contiguous :: int2d + type(STLVecInt), pointer :: intvector + integer(I4B), pointer :: ncelldim ! - ! -- set pointer to dynamic shape - call mem_setptr(sv%intvector_shape, varname_shape, memoryPath) + if (sv%idt%shape == 'NCELLDIM') then + ! + call mem_setptr(ncelldim, sv%idt%shape, this%component_mempath) + ! + if (this%deferred_shape) then + ! -- shape not known, allocate locally + allocate (int2d(ncelldim, this%deferred_size_init)) + else + ! -- shape known, allocate in managed memory + call mem_allocate(int2d, ncelldim, this%nrow, & + sv%idt%mf6varname, this%mempath) + end if + ! + ! -- initialize + int2d = IZERO + ! + sv%memtype = 5 + sv%int2d => int2d + sv%intshape => ncelldim + ! + else + ! + ! -- allocate intvector object + allocate (intvector) + ! + ! -- initialize STLVecInt + call intvector%init() + ! + sv%memtype = 4 + sv%intvector => intvector + sv%size = -1 + ! + ! -- set pointer to dynamic shape + call mem_setptr(sv%intvector_shape, sv%idt%shape, this%mempath) + end if ! - ! -- initialize StructVectorType - sv%varname = varname - sv%tagname = tagname - sv%shapevar = varname_shape - sv%mempath = memoryPath - sv%memtype = 4 - sv%intvector => intvector - sv%size = -1 + ! -- return + return + end subroutine allocate_int1d_type + + !> @brief allocate dbl1d input type + !< + subroutine allocate_dbl1d_type(this, sv) + use MemoryManagerModule, only: get_isize + class(StructArrayType) :: this !< StructArrayType + type(StructVectorType), intent(inout) :: sv + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + integer(I4B), pointer :: naux, nseg, nseg_1 + integer(I4B) :: nseg1_isize ! - ! -- set the object in the Struct Array - this%struct_vector_1d(icol) = sv + if (sv%idt%shape == 'NAUX') then + call mem_setptr(naux, sv%idt%shape, this%mempath) + ! + call mem_allocate(dbl2d, naux, this%nrow, sv%idt%mf6varname, this%mempath) + ! + ! -- initialize + dbl2d = DZERO + ! + sv%memtype = 6 + sv%dbl2d => dbl2d + sv%intshape => naux + ! + else if (sv%idt%shape == 'NSEG-1') then + call mem_setptr(nseg, 'NSEG', this%mempath) + ! + call get_isize('NSEG_1', this%mempath, nseg1_isize) + ! + if (nseg1_isize < 0) then + call mem_allocate(nseg_1, 'NSEG_1', this%mempath) + nseg_1 = nseg - 1 + else + call mem_setptr(nseg_1, 'NSEG_1', this%mempath) + end if + ! + call mem_allocate(dbl2d, nseg_1, this%nrow, sv%idt%mf6varname, this%mempath) + ! + ! -- initialize + dbl2d = DZERO + ! + sv%memtype = 6 + sv%dbl2d => dbl2d + sv%intshape => nseg_1 + ! + else + errmsg = 'Programming error. IDM SA 2d real input param unsupported & + &shape "'//trim(sv%idt%shape)//'".' + call store_error(errmsg, terminate=.TRUE.) + end if ! ! -- return return - end subroutine add_vector_intvector + end subroutine allocate_dbl1d_type subroutine load_deferred_vector(this, icol) use MemoryManagerModule, only: get_isize class(StructArrayType) :: this !< StructArrayType integer(I4B), intent(in) :: icol - integer(I4B) :: i, isize + integer(I4B) :: i, j, isize integer(I4B), dimension(:), pointer, contiguous :: p_int1d + integer(I4B), dimension(:, :), pointer, contiguous :: p_int2d real(DP), dimension(:), pointer, contiguous :: p_dbl1d type(CharacterStringType), dimension(:), pointer, contiguous :: p_charstr1d + character(len=LENVARNAME) :: varname + ! + ! -- set varname + varname = this%struct_vectors(icol)%idt%mf6varname ! ! -- check if already mem managed variable - call get_isize(this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath, isize) + call get_isize(varname, this%mempath, isize) ! ! -- allocate and load based on memtype - select case (this%struct_vector_1d(icol)%memtype) + select case (this%struct_vectors(icol)%memtype) ! case (1) ! -- memtype integer ! if (isize > 0) then ! -- variable exists, reallocate and append - call mem_setptr(p_int1d, this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_setptr(p_int1d, varname, this%mempath) ! -- Currently deferred vectors are appended to managed ! memory vectors when they are already allocated ! (e.g. SIMNAM SolutionGroup) - call mem_reallocate(p_int1d, this%nrow + isize, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_reallocate(p_int1d, this%nrow + isize, varname, this%mempath) do i = 1, this%nrow - p_int1d(isize + i) = this%struct_vector_1d(icol)%int1d(i) + p_int1d(isize + i) = this%struct_vectors(icol)%int1d(i) end do else ! ! -- allocate memory manager vector - call mem_allocate(p_int1d, this%nrow, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_allocate(p_int1d, this%nrow, varname, this%mempath) ! ! -- load local vector to managed memory do i = 1, this%nrow - p_int1d(i) = this%struct_vector_1d(icol)%int1d(i) + p_int1d(i) = this%struct_vectors(icol)%int1d(i) end do end if ! ! -- deallocate local memory - deallocate (this%struct_vector_1d(icol)%int1d) + deallocate (this%struct_vectors(icol)%int1d) ! ! -- update structvector - this%struct_vector_1d(icol)%int1d => p_int1d - this%struct_vector_1d(icol)%size = this%nrow + this%struct_vectors(icol)%int1d => p_int1d + this%struct_vectors(icol)%size = this%nrow ! case (2) ! -- memtype real ! - call mem_allocate(p_dbl1d, this%nrow, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_allocate(p_dbl1d, this%nrow, varname, this%mempath) ! do i = 1, this%nrow - p_dbl1d(i) = this%struct_vector_1d(icol)%dbl1d(i) + p_dbl1d(i) = this%struct_vectors(icol)%dbl1d(i) end do ! - deallocate (this%struct_vector_1d(icol)%dbl1d) + deallocate (this%struct_vectors(icol)%dbl1d) ! ! -- - this%struct_vector_1d(icol)%dbl1d => p_dbl1d - this%struct_vector_1d(icol)%size = this%nrow + this%struct_vectors(icol)%dbl1d => p_dbl1d + this%struct_vectors(icol)%size = this%nrow ! case (3) ! -- memtype charstring if (isize > 0) then - call mem_setptr(p_charstr1d, this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) - call mem_reallocate(p_charstr1d, LINELENGTH, this%nrow + isize, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_setptr(p_charstr1d, varname, this%mempath) + call mem_reallocate(p_charstr1d, LINELENGTH, this%nrow + isize, varname, & + this%mempath) do i = 1, this%nrow - p_charstr1d(isize + i) = this%struct_vector_1d(icol)%charstr1d(i) + p_charstr1d(isize + i) = this%struct_vectors(icol)%charstr1d(i) end do else ! - call mem_allocate(p_charstr1d, LINELENGTH, this%nrow, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + call mem_allocate(p_charstr1d, LINELENGTH, this%nrow, varname, & + this%mempath) ! do i = 1, this%nrow - p_charstr1d(i) = this%struct_vector_1d(icol)%charstr1d(i) + p_charstr1d(i) = this%struct_vectors(icol)%charstr1d(i) end do end if ! - deallocate (this%struct_vector_1d(icol)%charstr1d) + deallocate (this%struct_vectors(icol)%charstr1d) ! case (4) ! -- memtype intvector ! no-op + case (5) + call mem_allocate(p_int2d, this%struct_vectors(icol)%intshape, this%nrow, & + varname, this%mempath) + ! + do i = 1, this%nrow + do j = 1, this%struct_vectors(icol)%intshape + p_int2d(j, i) = this%struct_vectors(icol)%int2d(j, i) + end do + end do + ! + deallocate (this%struct_vectors(icol)%int2d) + ! + this%struct_vectors(icol)%int2d => p_int2d + this%struct_vectors(icol)%size = this%nrow + ! + ! TODO: case (6) case default + errmsg = 'Programming error. IDM load_deferred_vector unsupported memtype.' + call store_error(errmsg, terminate=.TRUE.) end select ! ! -- return @@ -415,30 +498,33 @@ subroutine memload_vectors(this) class(StructArrayType) :: this !< StructArrayType integer(I4B) :: icol, j integer(I4B), dimension(:), pointer, contiguous :: p_intvector + character(len=LENVARNAME) :: varname ! do icol = 1, this%ncol ! - if (this%struct_vector_1d(icol)%memtype == 4) then + ! -- set varname + varname = this%struct_vectors(icol)%idt%mf6varname + ! + if (this%struct_vectors(icol)%memtype == 4) then ! -- intvectors always need to be loaded ! ! -- size intvector to number of values read - call this%struct_vector_1d(icol)%intvector%shrink_to_fit() + call this%struct_vectors(icol)%intvector%shrink_to_fit() ! ! -- allocate memory manager vector call mem_allocate(p_intvector, & - this%struct_vector_1d(icol)%intvector%size, & - this%struct_vector_1d(icol)%varname, & - this%struct_vector_1d(icol)%mempath) + this%struct_vectors(icol)%intvector%size, & + varname, this%mempath) ! ! -- load local vector to managed memory - do j = 1, this%struct_vector_1d(icol)%intvector%size - p_intvector(j) = this%struct_vector_1d(icol)%intvector%at(j) + do j = 1, this%struct_vectors(icol)%intvector%size + p_intvector(j) = this%struct_vectors(icol)%intvector%at(j) end do ! ! -- cleanup local memory - call this%struct_vector_1d(icol)%intvector%destroy() - deallocate (this%struct_vector_1d(icol)%intvector) - nullify (this%struct_vector_1d(icol)%intvector_shape) + call this%struct_vectors(icol)%intvector%destroy() + deallocate (this%struct_vectors(icol)%intvector) + nullify (this%struct_vectors(icol)%intvector_shape) ! else if (this%deferred_shape) then ! @@ -463,27 +549,39 @@ subroutine log_structarray_vars(this, iout) do j = 1, this%ncol ! ! -- log based on memtype - select case (this%struct_vector_1d(j)%memtype) + select case (this%struct_vectors(j)%memtype) ! case (1) ! -- memtype integer ! - call idm_log_var(this%struct_vector_1d(j)%int1d, & - this%struct_vector_1d(j)%tagname, & - this%struct_vector_1d(j)%mempath, iout) + call idm_log_var(this%struct_vectors(j)%int1d, & + this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) ! case (2) ! -- memtype real ! - call idm_log_var(this%struct_vector_1d(j)%dbl1d, & - this%struct_vector_1d(j)%tagname, & - this%struct_vector_1d(j)%mempath, iout) + call idm_log_var(this%struct_vectors(j)%dbl1d, & + this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) ! case (4) ! -- memtype intvector ! - call mem_setptr(int1d, this%struct_vector_1d(j)%varname, & - this%struct_vector_1d(j)%mempath) + call mem_setptr(int1d, this%struct_vectors(j)%idt%mf6varname, & + this%mempath) + ! + call idm_log_var(int1d, this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) + ! + case (5) ! -- memtype int2d ! - call idm_log_var(int1d, this%struct_vector_1d(j)%tagname, & - this%struct_vector_1d(j)%mempath, iout) + call idm_log_var(this%struct_vectors(j)%int2d, & + this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) + ! + case (6) ! -- memtype dbl2d + ! + call idm_log_var(this%struct_vectors(j)%dbl2d, & + this%struct_vectors(j)%idt%tagname, & + this%mempath, iout) ! end select ! @@ -497,8 +595,9 @@ end subroutine log_structarray_vars !< subroutine check_reallocate(this) class(StructArrayType) :: this !< StructArrayType - integer(I4B) :: i, j, newsize + integer(I4B) :: i, j, k, newsize integer(I4B), dimension(:), pointer, contiguous :: p_int1d + integer(I4B), dimension(:, :), pointer, contiguous :: p_int2d real(DP), dimension(:), pointer, contiguous :: p_dbl1d type(CharacterStringType), dimension(:), pointer, contiguous :: p_charstr1d integer(I4B) :: reallocate_mult @@ -509,66 +608,87 @@ subroutine check_reallocate(this) do j = 1, this%ncol ! ! -- reallocate based on memtype - select case (this%struct_vector_1d(j)%memtype) + select case (this%struct_vectors(j)%memtype) ! case (1) ! -- memtype integer ! ! -- check if more space needed - if (this%nrow > this%struct_vector_1d(j)%size) then + if (this%nrow > this%struct_vectors(j)%size) then ! ! -- calculate new size - newsize = this%struct_vector_1d(j)%size * reallocate_mult + newsize = this%struct_vectors(j)%size * reallocate_mult ! ! -- allocate new vector allocate (p_int1d(newsize)) ! ! -- copy from old to new - do i = 1, this%struct_vector_1d(j)%size - p_int1d(i) = this%struct_vector_1d(j)%int1d(i) + do i = 1, this%struct_vectors(j)%size + p_int1d(i) = this%struct_vectors(j)%int1d(i) end do ! ! -- deallocate old vector - deallocate (this%struct_vector_1d(j)%int1d) + deallocate (this%struct_vectors(j)%int1d) ! ! -- update struct array object - this%struct_vector_1d(j)%int1d => p_int1d - this%struct_vector_1d(j)%size = newsize + this%struct_vectors(j)%int1d => p_int1d + this%struct_vectors(j)%size = newsize end if ! case (2) ! -- memtype real - if (this%nrow > this%struct_vector_1d(j)%size) then + if (this%nrow > this%struct_vectors(j)%size) then ! - newsize = this%struct_vector_1d(j)%size * reallocate_mult + newsize = this%struct_vectors(j)%size * reallocate_mult ! allocate (p_dbl1d(newsize)) ! - do i = 1, this%struct_vector_1d(j)%size - p_dbl1d(i) = this%struct_vector_1d(j)%dbl1d(i) + do i = 1, this%struct_vectors(j)%size + p_dbl1d(i) = this%struct_vectors(j)%dbl1d(i) end do ! - deallocate (this%struct_vector_1d(j)%dbl1d) + deallocate (this%struct_vectors(j)%dbl1d) ! - this%struct_vector_1d(j)%dbl1d => p_dbl1d - this%struct_vector_1d(j)%size = newsize + this%struct_vectors(j)%dbl1d => p_dbl1d + this%struct_vectors(j)%size = newsize end if ! case (3) ! -- memtype charstring - if (this%nrow > this%struct_vector_1d(j)%size) then + if (this%nrow > this%struct_vectors(j)%size) then ! - newsize = this%struct_vector_1d(j)%size * reallocate_mult + newsize = this%struct_vectors(j)%size * reallocate_mult ! allocate (p_charstr1d(newsize)) ! - do i = 1, this%struct_vector_1d(j)%size - p_charstr1d(i) = this%struct_vector_1d(j)%charstr1d(i) + do i = 1, this%struct_vectors(j)%size + p_charstr1d(i) = this%struct_vectors(j)%charstr1d(i) end do ! - deallocate (this%struct_vector_1d(j)%charstr1d) + deallocate (this%struct_vectors(j)%charstr1d) ! - this%struct_vector_1d(j)%charstr1d => p_charstr1d - this%struct_vector_1d(j)%size = newsize + this%struct_vectors(j)%charstr1d => p_charstr1d + this%struct_vectors(j)%size = newsize end if + case (5) + if (this%nrow > this%struct_vectors(j)%size) then + ! + newsize = this%struct_vectors(j)%size * reallocate_mult + ! + allocate (p_int2d(this%struct_vectors(j)%intshape, newsize)) + ! + do i = 1, this%struct_vectors(j)%size + do k = 1, this%struct_vectors(j)%intshape + p_int2d(k, i) = this%struct_vectors(j)%int2d(k, i) + end do + end do + ! + deallocate (this%struct_vectors(j)%int2d) + ! + this%struct_vectors(j)%int2d => p_int2d + this%struct_vectors(j)%size = newsize + end if + ! TODO: case (6) case default + errmsg = 'Programming error. IDM check_reallocate unsupported memtype.' + call store_error(errmsg, terminate=.TRUE.) end select end do ! @@ -578,12 +698,14 @@ end subroutine check_reallocate !> @brief read from the block parser to fill the StructArrayType !< - subroutine read_from_parser(this, parser, iout) + function read_from_parser(this, parser, timeseries, iout) result(irow) class(StructArrayType) :: this !< StructArrayType type(BlockParserType) :: parser !< block parser to read from + logical(LGP), intent(in) :: timeseries integer(I4B), intent(in) :: iout !< unit number for output - logical(LGP) :: endOfBlock - integer(I4B) :: irow, j, k + integer(I4B) :: irow + logical(LGP) :: endOfBlock, preserve_case + integer(I4B) :: j, k integer(I4B) :: intval, numval character(len=LINELENGTH) :: str character(len=:), allocatable :: line @@ -616,51 +738,79 @@ subroutine read_from_parser(this, parser, iout) ! -- handle line reads by column memtype do j = 1, this%ncol ! - select case (this%struct_vector_1d(j)%memtype) + select case (this%struct_vectors(j)%memtype) ! case (1) ! -- memtype integer ! ! -- if reloadable block and first col, store blocknum if (j == 1 .and. this%blocknum > 0) then ! -- store blocknum - this%struct_vector_1d(j)%int1d(irow) = this%blocknum + this%struct_vectors(j)%int1d(irow) = this%blocknum else ! -- read and store int - this%struct_vector_1d(j)%int1d(irow) = parser%GetInteger() + this%struct_vectors(j)%int1d(irow) = parser%GetInteger() end if ! case (2) ! -- memtype real ! - this%struct_vector_1d(j)%dbl1d(irow) = parser%GetDouble() + if (this%struct_vectors(j)%idt%timeseries .and. timeseries) then + call parser%GetString(str) + this%struct_vectors(j)%dbl1d(irow) = & + this%struct_vectors(j)%read_token(str, this%startidx(j), 1, irow) + else + this%struct_vectors(j)%dbl1d(irow) = parser%GetDouble() + end if ! case (3) ! -- memtype charstring ! - !if (this%struct_vector_1d(j)%shapevar == ':') then - if (this%struct_vector_1d(j)%shapevar /= '') then + !if (this%struct_vectors(j)%idt%shape == ':') then + if (this%struct_vectors(j)%idt%shape /= '') then ! -- if last column with any shape, store rest of line if (j == this%ncol) then call parser%GetRemainingLine(line) - this%struct_vector_1d(j)%charstr1d(irow) = line + this%struct_vectors(j)%charstr1d(irow) = line deallocate (line) end if else ! ! -- read string token - call parser%GetString(str, & - (.not. this%struct_vector_1d(j)%preserve_case)) - this%struct_vector_1d(j)%charstr1d(irow) = str + preserve_case = (.not. this%struct_vectors(j)%idt%preserve_case) + call parser%GetString(str, preserve_case) + this%struct_vectors(j)%charstr1d(irow) = str end if ! case (4) ! -- memtype intvector ! ! -- get shape for this row - numval = this%struct_vector_1d(j)%intvector_shape(irow) + numval = this%struct_vectors(j)%intvector_shape(irow) ! ! -- read and store row values do k = 1, numval intval = parser%GetInteger() - call this%struct_vector_1d(j)%intvector%push_back(intval) + call this%struct_vectors(j)%intvector%push_back(intval) + end do + ! + case (5) ! -- memtype int2d + ! + ! -- read and store row values + do k = 1, this%struct_vectors(j)%intshape + this%struct_vectors(j)%int2d(k, irow) = parser%GetInteger() end do + ! + case (6) ! -- memtype dbl2d + ! + ! -- read and store row values + do k = 1, this%struct_vectors(j)%intshape + if (this%struct_vectors(j)%idt%timeseries .and. timeseries) then + call parser%GetString(str) + this%struct_vectors(j)%dbl2d(k, irow) = & + this%struct_vectors(j)%read_token(str, this%startidx(j) + k - 1, & + k, irow) + else + this%struct_vectors(j)%dbl2d(k, irow) = parser%GetDouble() + end if + end do + ! end select end do end do @@ -669,8 +819,132 @@ subroutine read_from_parser(this, parser, iout) call this%memload_vectors() ! ! -- log loaded variables - call this%log_structarray_vars(iout) + if (iout > 0) then + call this%log_structarray_vars(iout) + end if + ! + ! -- return + return + end function read_from_parser - end subroutine read_from_parser + !> @brief read from binary input to fill the StructArrayType + !< + function read_from_binary(this, inunit, iout) result(irow) + class(StructArrayType) :: this !< StructArrayType + integer(I4B), intent(in) :: inunit !< unit number for binary input + integer(I4B), intent(in) :: iout !< unit number for output + integer(I4B) :: irow, ierr + integer(I4B) :: j, k + integer(I4B) :: intval, numval + character(len=LINELENGTH) :: fname + character(len=*), parameter :: fmtlsterronly = & + "('Error reading LIST from file: ',& + &1x,a,1x,' on UNIT: ',I0)" + ! + ! -- set error and exit if deferred shape + if (this%deferred_shape) then + ! + errmsg = 'Programming error. IDM SA deferred shape currently not & + &supported for binary inputs.' + call store_error(errmsg, terminate=.TRUE.) + ! + end if + ! + ! -- initialize + irow = 0 + ierr = 0 + ! + readloop: do + ! + ! -- update irow index + irow = irow + 1 + ! + ! -- handle line reads by column memtype + do j = 1, this%ncol + ! + select case (this%struct_vectors(j)%memtype) + ! + case (1) ! -- memtype integer + read (inunit, iostat=ierr) this%struct_vectors(j)%int1d(irow) + case (2) ! -- memtype real + read (inunit, iostat=ierr) this%struct_vectors(j)%dbl1d(irow) + case (3) ! -- memtype charstring + ! + errmsg = 'Programming error. IDM SA input string types currently not & + &supported for binary inputs.' + call store_error(errmsg, terminate=.TRUE.) + ! + case (4) ! -- memtype intvector + ! + ! -- get shape for this row + numval = this%struct_vectors(j)%intvector_shape(irow) + ! + ! -- read and store row values + do k = 1, numval + if (ierr == 0) then + read (inunit, iostat=ierr) intval + call this%struct_vectors(j)%intvector%push_back(intval) + end if + end do + ! + case (5) ! -- memtype int2d + ! + ! -- read and store row values + do k = 1, this%struct_vectors(j)%intshape + if (ierr == 0) then + read (inunit, iostat=ierr) this%struct_vectors(j)%int2d(k, irow) + end if + end do + ! + case (6) ! -- memtype dbl2d + do k = 1, this%struct_vectors(j)%intshape + if (ierr == 0) then + read (inunit, iostat=ierr) this%struct_vectors(j)%dbl2d(k, irow) + end if + end do + end select + ! + ! -- handle error cases + select case (ierr) + case (0) + ! no error + case (:-1) + ! + ! -- End of block was encountered + irow = irow - 1 + exit readloop + ! + case (1:) + ! + ! -- Error + inquire (unit=inunit, name=fname) + write (errmsg, fmtlsterronly) trim(adjustl(fname)), inunit + call store_error(errmsg, terminate=.TRUE.) + ! + case default + end select + ! + end do + ! + if (irow == this%nrow) exit readloop + ! + end do readloop + ! + ! -- Stop if errors were detected + !if (count_errors() > 0) then + ! call store_error_unit(inunit) + !end if + ! + ! -- if deferred shape vectors were read, load to input path + call this%memload_vectors() + ! + ! -- log loaded variables + if (iout > 0) then + call this%log_structarray_vars(iout) + end if + ! + ! -- return + return + end function read_from_binary end module StructArrayModule diff --git a/src/Utilities/Idm/mf6blockfile/StructVector.f90 b/src/Utilities/Idm/mf6blockfile/StructVector.f90 index a6c0223b2b7..d9618d4fba9 100644 --- a/src/Utilities/Idm/mf6blockfile/StructVector.f90 +++ b/src/Utilities/Idm/mf6blockfile/StructVector.f90 @@ -7,13 +7,27 @@ module StructVectorModule use KindModule, only: I4B, DP, LGP - use ConstantsModule, only: LENMEMPATH, LENVARNAME + use ConstantsModule, only: DNODATA, LENMEMPATH, LENVARNAME, LINELENGTH, & + LENTIMESERIESNAME + use ListModule, only: ListType + use InputDefinitionModule, only: InputParamDefinitionType use CharacterStringModule, only: CharacterStringType use STLVecIntModule, only: STLVecInt + use ArrayHandlersModule, only: expandarray implicit none private - public :: StructVectorType + public :: StructVectorType, TSStringLocType + + !> @brief derived type which describes time series string field + !< + type :: TSStringLocType + integer(I4B) :: structarray_col !< global SA column index + integer(I4B) :: col !< SV column (1 if 1d array) + integer(I4B) :: row !< SV row + character(LINELENGTH) :: token !< TS string token + contains + end type TSStringLocType !> @brief derived type for generic vector !! @@ -22,20 +36,127 @@ module StructVectorModule !! !< type StructVectorType - character(len=LENVARNAME) :: varname - character(len=100) :: tagname - character(len=LENVARNAME) :: shapevar - character(len=LENMEMPATH) :: mempath - integer(I4B) :: memtype = 0 - integer(I4B) :: size = 0 - logical(LGP) :: preserve_case = .false. + type(InputParamDefinitionType), pointer :: idt !< input definition + ! SA vector attributes + integer(I4B) :: memtype = 0 !< SA memtype + integer(I4B) :: icol = 0 !< SA column + integer(I4B) :: size = 0 !< size of array + ! Data pointers integer(I4B), dimension(:), pointer, contiguous :: int1d => null() + integer(I4B), dimension(:, :), pointer, contiguous :: int2d => null() real(DP), dimension(:), pointer, contiguous :: dbl1d => null() + real(DP), dimension(:, :), pointer, contiguous :: dbl2d => null() type(CharacterStringType), dimension(:), pointer, contiguous :: & charstr1d => null() type(STLVecInt), pointer :: intvector => null() + ! Shape data pointers + integer(I4B), pointer :: intshape => null() integer(I4B), dimension(:), pointer, contiguous :: intvector_shape => null() - + ! TimeSeries strings + type(ListType) :: ts_strlocs + contains + procedure :: clear => sv_clear + procedure :: read_token => sv_read_token + procedure :: add_ts_strloc => sv_add_ts_strloc + procedure :: get_ts_strloc => sv_get_ts_strloc end type StructVectorType +contains + + function sv_read_token(this, token, structarray_col, col, row) result(val) + ! -- modules + ! -- dummy + class(StructVectorType) :: this + character(len=*), intent(in) :: token + integer(I4B), intent(in) :: structarray_col + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + real(DP) :: val + ! -- local + integer(I4B) :: istat + real(DP) :: r + ! + ! -- initialize + val = DNODATA + ! + read (token, *, iostat=istat) r + if (istat == 0) then + val = r + else + call this%add_ts_strloc(token, structarray_col, col, row) + end if + ! + ! -- return + return + end function sv_read_token + + subroutine sv_add_ts_strloc(this, token, structarray_col, col, row) + ! -- dummy variables + class(StructVectorType) :: this + character(len=*), intent(in) :: token + integer(I4B), intent(in) :: structarray_col + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + class(TSStringLocType), pointer :: str_field + ! -- local variables + class(*), pointer :: obj + ! + ! -- + allocate (str_field) + str_field%structarray_col = structarray_col + str_field%col = col + str_field%row = row + str_field%token = token + ! + obj => str_field + call this%ts_strlocs%Add(obj) + ! + ! -- return + return + end subroutine sv_add_ts_strloc + + function sv_get_ts_strloc(this, idx) result(res) + ! -- dummy variables + class(StructVectorType) :: this + integer(I4B), intent(in) :: idx !< package number + class(TSStringLocType), pointer :: res + ! -- local variables + class(*), pointer :: obj + ! + ! -- initialize res + res => null() + ! + ! -- get the package from the list + obj => this%ts_strlocs%GetItem(idx) + if (associated(obj)) then + select type (obj) + class is (TSStringLocType) + res => obj + end select + end if + ! + ! -- return + return + end function sv_get_ts_strloc + + !> @brief + !< + subroutine sv_clear(this) + ! -- modules + ! -- dummy + class(StructVectorType) :: this + class(TSStringLocType), pointer :: ts_strloc + integer(I4B) :: n + ! + do n = 1, this%ts_strlocs%Count() + ts_strloc => this%get_ts_strloc(n) + deallocate (ts_strloc) + nullify (ts_strloc) + end do + ! + call this%ts_strlocs%Clear() + ! + return + end subroutine sv_clear + end module StructVectorModule diff --git a/src/Utilities/Idm/selector/IdmDfnSelector.f90 b/src/Utilities/Idm/selector/IdmDfnSelector.f90 index a3e13b0ead0..6c57db9a78b 100644 --- a/src/Utilities/Idm/selector/IdmDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmDfnSelector.f90 @@ -1,24 +1,13 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module IdmDfnSelectorModule + use ConstantsModule, only: LENVARNAME use SimModule, only: store_error use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType - use IdmGwfDfnSelectorModule, only: gwf_param_definitions, & - gwf_aggregate_definitions, & - gwf_block_definitions, & - gwf_idm_multi_package, & - gwf_idm_integrated - use IdmGwtDfnSelectorModule, only: gwt_param_definitions, & - gwt_aggregate_definitions, & - gwt_block_definitions, & - gwt_idm_multi_package, & - gwt_idm_integrated - use IdmSimDfnSelectorModule, only: sim_param_definitions, & - sim_aggregate_definitions, & - sim_block_definitions, & - sim_idm_multi_package, & - sim_idm_integrated + use IdmGwfDfnSelectorModule + use IdmGwtDfnSelectorModule + use IdmSimDfnSelectorModule implicit none private @@ -26,7 +15,9 @@ module IdmDfnSelectorModule public :: aggregate_definitions public :: block_definitions public :: idm_multi_package + public :: idm_sfac_param public :: idm_integrated + public :: idm_component contains @@ -100,6 +91,25 @@ function idm_multi_package(component, subcomponent) result(multi_package) return end function idm_multi_package + function idm_sfac_param(component, subcomponent) result(sfac_param) + character(len=*), intent(in) :: component + character(len=*), intent(in) :: subcomponent + character(len=LENVARNAME) :: sfac_param + select case (component) + case ('GWF') + sfac_param = gwf_idm_sfac_param(subcomponent) + case ('GWT') + sfac_param = gwt_idm_sfac_param(subcomponent) + case ('SIM') + sfac_param = sim_idm_sfac_param(subcomponent) + case default + call store_error('Idm selector component not found; '//& + &'component="'//trim(component)//& + &'", subcomponent="'//trim(subcomponent)//'".', .true.) + end select + return + end function idm_sfac_param + function idm_integrated(component, subcomponent) result(integrated) character(len=*), intent(in) :: component character(len=*), intent(in) :: subcomponent @@ -117,4 +127,20 @@ function idm_integrated(component, subcomponent) result(integrated) return end function idm_integrated + function idm_component(component) result(integrated) + character(len=*), intent(in) :: component + logical :: integrated + integrated = .false. + select case (component) + case ('GWF') + integrated = .true. + case ('GWT') + integrated = .true. + case ('SIM') + integrated = .true. + case default + end select + return + end function idm_component + end module IdmDfnSelectorModule diff --git a/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 b/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 index 4ff5996addd..5d79675b9e8 100644 --- a/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmGwfDfnSelector.f90 @@ -1,38 +1,110 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module IdmGwfDfnSelectorModule + use ConstantsModule, only: LENVARNAME use SimModule, only: store_error use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType - use GwfDisInputModule, only: gwf_dis_param_definitions, & - gwf_dis_aggregate_definitions, & - gwf_dis_block_definitions, & - gwf_dis_multi_package - use GwfDisuInputModule, only: gwf_disu_param_definitions, & - gwf_disu_aggregate_definitions, & - gwf_disu_block_definitions, & - gwf_disu_multi_package - use GwfDisvInputModule, only: gwf_disv_param_definitions, & - gwf_disv_aggregate_definitions, & - gwf_disv_block_definitions, & - gwf_disv_multi_package - use GwfNpfInputModule, only: gwf_npf_param_definitions, & - gwf_npf_aggregate_definitions, & - gwf_npf_block_definitions, & - gwf_npf_multi_package - use GwfNamInputModule, only: gwf_nam_param_definitions, & - gwf_nam_aggregate_definitions, & - gwf_nam_block_definitions, & - gwf_nam_multi_package + use GwfDisInputModule + use GwfDisuInputModule + use GwfDisvInputModule + use GwfNpfInputModule + use GwfNamInputModule implicit none private + public :: GwfParamFoundType public :: gwf_param_definitions public :: gwf_aggregate_definitions public :: gwf_block_definitions public :: gwf_idm_multi_package + public :: gwf_idm_sfac_param public :: gwf_idm_integrated + type GwfParamFoundType + 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. + logical :: voffsettol = .false. + logical :: nodes = .false. + logical :: nja = .false. + logical :: nvert = .false. + logical :: bot = .false. + logical :: area = .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. + logical :: ncpl = .false. + 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. + logical :: list = .false. + logical :: print_input = .false. + logical :: print_flows = .false. + logical :: save_flows = .false. + logical :: newtonoptions = .false. + logical :: newton = .false. + logical :: under_relaxation = .false. + logical :: ftype = .false. + logical :: fname = .false. + logical :: pname = .false. + end type GwfParamFoundType + contains subroutine set_param_pointer(input_dfn, input_dfn_target) @@ -129,6 +201,28 @@ function gwf_idm_multi_package(subcomponent) result(multi_package) return end function gwf_idm_multi_package + function gwf_idm_sfac_param(subcomponent) result(sfac_param) + character(len=*), intent(in) :: subcomponent + character(len=LENVARNAME) :: sfac_param + select case (subcomponent) + case ('DIS') + sfac_param = gwf_dis_aux_sfac_param + case ('DISU') + sfac_param = gwf_disu_aux_sfac_param + case ('DISV') + sfac_param = gwf_disv_aux_sfac_param + case ('NPF') + sfac_param = gwf_npf_aux_sfac_param + case ('NAM') + sfac_param = gwf_nam_aux_sfac_param + case default + call store_error('Idm selector subcomponent not found; '//& + &'component="GWF"'//& + &', subcomponent="'//trim(subcomponent)//'".', .true.) + end select + return + end function gwf_idm_sfac_param + function gwf_idm_integrated(subcomponent) result(integrated) character(len=*), intent(in) :: subcomponent logical :: integrated diff --git a/src/Utilities/Idm/selector/IdmGwtDfnSelector.f90 b/src/Utilities/Idm/selector/IdmGwtDfnSelector.f90 index 9c46a00b9b7..0e089317fa7 100644 --- a/src/Utilities/Idm/selector/IdmGwtDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmGwtDfnSelector.f90 @@ -1,38 +1,78 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module IdmGwtDfnSelectorModule + use ConstantsModule, only: LENVARNAME use SimModule, only: store_error use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType - use GwtDisInputModule, only: gwt_dis_param_definitions, & - gwt_dis_aggregate_definitions, & - gwt_dis_block_definitions, & - gwt_dis_multi_package - use GwtDisuInputModule, only: gwt_disu_param_definitions, & - gwt_disu_aggregate_definitions, & - gwt_disu_block_definitions, & - gwt_disu_multi_package - use GwtDisvInputModule, only: gwt_disv_param_definitions, & - gwt_disv_aggregate_definitions, & - gwt_disv_block_definitions, & - gwt_disv_multi_package - use GwtDspInputModule, only: gwt_dsp_param_definitions, & - gwt_dsp_aggregate_definitions, & - gwt_dsp_block_definitions, & - gwt_dsp_multi_package - use GwtNamInputModule, only: gwt_nam_param_definitions, & - gwt_nam_aggregate_definitions, & - gwt_nam_block_definitions, & - gwt_nam_multi_package + use GwtDisInputModule + use GwtDisuInputModule + use GwtDisvInputModule + use GwtDspInputModule + use GwtNamInputModule implicit none private + public :: GwtParamFoundType public :: gwt_param_definitions public :: gwt_aggregate_definitions public :: gwt_block_definitions public :: gwt_idm_multi_package + public :: gwt_idm_sfac_param public :: gwt_idm_integrated + type GwtParamFoundType + 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. + logical :: voffsettol = .false. + logical :: nodes = .false. + logical :: nja = .false. + logical :: nvert = .false. + logical :: bot = .false. + logical :: area = .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. + logical :: ncpl = .false. + 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. + logical :: list = .false. + logical :: print_input = .false. + logical :: print_flows = .false. + logical :: save_flows = .false. + logical :: ftype = .false. + logical :: fname = .false. + logical :: pname = .false. + end type GwtParamFoundType + contains subroutine set_param_pointer(input_dfn, input_dfn_target) @@ -129,6 +169,28 @@ function gwt_idm_multi_package(subcomponent) result(multi_package) return end function gwt_idm_multi_package + function gwt_idm_sfac_param(subcomponent) result(sfac_param) + character(len=*), intent(in) :: subcomponent + character(len=LENVARNAME) :: sfac_param + select case (subcomponent) + case ('DIS') + sfac_param = gwt_dis_aux_sfac_param + case ('DISU') + sfac_param = gwt_disu_aux_sfac_param + case ('DISV') + sfac_param = gwt_disv_aux_sfac_param + case ('DSP') + sfac_param = gwt_dsp_aux_sfac_param + case ('NAM') + sfac_param = gwt_nam_aux_sfac_param + case default + call store_error('Idm selector subcomponent not found; '//& + &'component="GWT"'//& + &', subcomponent="'//trim(subcomponent)//'".', .true.) + end select + return + end function gwt_idm_sfac_param + function gwt_idm_integrated(subcomponent) result(integrated) character(len=*), intent(in) :: subcomponent logical :: integrated diff --git a/src/Utilities/Idm/selector/IdmSimDfnSelector.f90 b/src/Utilities/Idm/selector/IdmSimDfnSelector.f90 index dc216101720..297cf83564f 100644 --- a/src/Utilities/Idm/selector/IdmSimDfnSelector.f90 +++ b/src/Utilities/Idm/selector/IdmSimDfnSelector.f90 @@ -1,22 +1,42 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module IdmSimDfnSelectorModule + use ConstantsModule, only: LENVARNAME use SimModule, only: store_error use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType - use SimNamInputModule, only: sim_nam_param_definitions, & - sim_nam_aggregate_definitions, & - sim_nam_block_definitions, & - sim_nam_multi_package + use SimNamInputModule implicit none private + public :: SimParamFoundType public :: sim_param_definitions public :: sim_aggregate_definitions public :: sim_block_definitions public :: sim_idm_multi_package + public :: sim_idm_sfac_param public :: sim_idm_integrated + type SimParamFoundType + logical :: continue = .false. + logical :: nocheck = .false. + logical :: prmem = .false. + logical :: maxerrors = .false. + logical :: print_input = .false. + logical :: tdis6 = .false. + logical :: mtype = .false. + logical :: mfname = .false. + logical :: mname = .false. + logical :: exgtype = .false. + logical :: exgfile = .false. + logical :: exgmnamea = .false. + logical :: exgmnameb = .false. + logical :: mxiter = .false. + logical :: slntype = .false. + logical :: slnfname = .false. + logical :: slnmnames = .false. + end type SimParamFoundType + contains subroutine set_param_pointer(input_dfn, input_dfn_target) @@ -81,6 +101,20 @@ function sim_idm_multi_package(subcomponent) result(multi_package) return end function sim_idm_multi_package + function sim_idm_sfac_param(subcomponent) result(sfac_param) + character(len=*), intent(in) :: subcomponent + character(len=LENVARNAME) :: sfac_param + select case (subcomponent) + case ('NAM') + sfac_param = sim_nam_aux_sfac_param + case default + call store_error('Idm selector subcomponent not found; '//& + &'component="SIM"'//& + &', subcomponent="'//trim(subcomponent)//'".', .true.) + end select + return + end function sim_idm_sfac_param + function sim_idm_integrated(subcomponent) result(integrated) character(len=*), intent(in) :: subcomponent logical :: integrated diff --git a/src/Utilities/Memory/MemoryManager.f90 b/src/Utilities/Memory/MemoryManager.f90 index e20b1efe9c6..0961dfc8533 100644 --- a/src/Utilities/Memory/MemoryManager.f90 +++ b/src/Utilities/Memory/MemoryManager.f90 @@ -67,6 +67,7 @@ module MemoryManagerModule interface mem_checkin module procedure & checkin_int1d, & + checkin_int2d, & checkin_dbl1d, & checkin_dbl2d end interface mem_checkin @@ -997,6 +998,49 @@ subroutine checkin_int1d(aint, name, mem_path, name2, mem_path2) return end subroutine checkin_int1d + !> @brief Check in an existing 2d integer array with a new address (name + path) + !< + subroutine checkin_int2d(aint2d, name, mem_path, name2, mem_path2) + integer(I4B), dimension(:, :), pointer, contiguous, intent(inout) :: aint2d !< the existing 2d array + character(len=*), intent(in) :: name !< new variable name + character(len=*), intent(in) :: mem_path !< new path where variable is stored + character(len=*), intent(in) :: name2 !< existing variable name + character(len=*), intent(in) :: mem_path2 !< existing path where variable is stored + ! -- local + type(MemoryType), pointer :: mt + integer(I4B) :: ncol, nrow, isize + ! -- code + ! + ! -- check the variable name length + call mem_check_length(name, LENVARNAME, "variable") + ! + ! -- set isize + ncol = size(aint2d, dim=1) + nrow = size(aint2d, dim=2) + isize = ncol * nrow + ! + ! -- allocate memory type + allocate (mt) + ! + ! -- set memory type + mt%aint2d => aint2d + mt%isize = isize + mt%name = name + mt%path = mem_path + write (mt%memtype, "(a,' (',i0,',',i0,')')") 'INTEGER', ncol, nrow + ! + ! -- set master information + mt%master = .false. + mt%mastername = name2 + mt%masterPath = mem_path2 + ! + ! -- add memory type to the memory list + call memorylist%add(mt) + ! + ! -- return + return + end subroutine checkin_int2d + !> @brief Check in an existing 1d double precision array with a new address (name + path) !< subroutine checkin_dbl1d(adbl, name, mem_path, name2, mem_path2) diff --git a/src/Utilities/Memory/MemoryManagerExt.f90 b/src/Utilities/Memory/MemoryManagerExt.f90 index d169449466b..ded5862e4f5 100644 --- a/src/Utilities/Memory/MemoryManagerExt.f90 +++ b/src/Utilities/Memory/MemoryManagerExt.f90 @@ -16,7 +16,8 @@ module MemoryManagerExtModule mem_set_value_int1d, mem_set_value_int1d_mapped, & mem_set_value_int2d, mem_set_value_int3d, mem_set_value_dbl, & mem_set_value_dbl1d, mem_set_value_dbl1d_mapped, & - mem_set_value_dbl2d, mem_set_value_dbl3d, mem_set_value_str + mem_set_value_dbl2d, mem_set_value_dbl3d, mem_set_value_str, & + mem_set_value_charstr1d end interface mem_set_value contains @@ -41,8 +42,6 @@ subroutine memorylist_remove(component, subcomponent, context) mt => memorylist%Get(ipos) if (mt%path == memory_path .and. mt%mt_associated()) then call mt%mt_deallocate() - deallocate (mt) - call memorylist%remove(ipos, .false.) removed = .true. exit end if @@ -61,8 +60,12 @@ subroutine mem_set_value_logical(p_mem, varname, memory_path, found) logical(LGP) :: checkfail = .false. call get_from_memorylist(varname, memory_path, mt, found, checkfail) - if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'LOGICAL') then - p_mem = mt%logicalsclr + if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'INTEGER') then + if (mt%intsclr == 0) then + p_mem = .false. + else + p_mem = .true. + end if end if end subroutine mem_set_value_logical @@ -366,4 +369,23 @@ subroutine mem_set_value_str(p_mem, varname, memory_path, found) end if end subroutine mem_set_value_str + subroutine mem_set_value_charstr1d(p_mem, varname, memory_path, found) + use CharacterStringModule, only: CharacterStringType + type(CharacterStringType), dimension(:), & + pointer, contiguous, intent(inout) :: p_mem !< pointer to charstr 1d array + character(len=*), intent(in) :: varname !< variable name + character(len=*), intent(in) :: memory_path !< path where variable is stored + logical(LGP), intent(inout) :: found + type(MemoryType), pointer :: mt + logical(LGP) :: checkfail = .false. + integer(I4B) :: n + + call get_from_memorylist(varname, memory_path, mt, found, checkfail) + if (found .and. mt%memtype(1:index(mt%memtype, ' ')) == 'STRING') then + do n = 1, size(mt%acharstr1d) + p_mem(n) = mt%acharstr1d(n) + end do + end if + end subroutine mem_set_value_charstr1d + end module MemoryManagerExtModule diff --git a/src/Utilities/TimeSeries/TimeArray.f90 b/src/Utilities/TimeSeries/TimeArray.f90 index 49b7ee99e4c..5a54aa17c4f 100644 --- a/src/Utilities/TimeSeries/TimeArray.f90 +++ b/src/Utilities/TimeSeries/TimeArray.f90 @@ -1,6 +1,5 @@ module TimeArrayModule - use BaseDisModule, only: DisBaseType use KindModule, only: DP, I4B use ListModule, only: ListType use SimVariablesModule, only: errmsg @@ -25,7 +24,7 @@ module TimeArrayModule contains - subroutine ConstructTimeArray(newTa, dis) + subroutine ConstructTimeArray(newTa, modelname) ! ****************************************************************************** ! ConstructTimeArray -- construct time array ! Allocate and assign members of a new TimeArrayType object. @@ -35,20 +34,39 @@ subroutine ConstructTimeArray(newTa, dis) ! ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ + ! -- modules + use ConstantsModule, only: LENMEMPATH + use MemoryManagerModule, only: mem_setptr + use MemoryHelperModule, only: create_mem_path ! -- dummy type(TimeArrayType), pointer, intent(out) :: newTa - class(DisBaseType), pointer, intent(in) :: dis + character(len=*), intent(in) :: modelname ! -- local + integer(I4B), dimension(:), contiguous, & + pointer :: mshape + character(len=LENMEMPATH) :: mempath integer(I4B) :: isize ! ------------------------------------------------------------------------------ + ! + ! -- initialize + nullify (mshape) + ! + ! -- create mempath + mempath = create_mem_path(component=modelname, subcomponent='DIS') + ! + ! -- set mshape pointer + call mem_setptr(mshape, 'MSHAPE', mempath) ! ! Get dimensions for supported discretization type - if (dis%supports_layers()) then - isize = dis%get_ncpl() + if (size(mshape) == 2) then + isize = mshape(2) + else if (size(mshape) == 3) then + isize = mshape(2) * mshape(3) else errmsg = 'Time array series is not supported for discretization type' call store_error(errmsg, terminate=.TRUE.) end if + ! allocate (newTa) allocate (newTa%taArray(isize)) return diff --git a/src/Utilities/TimeSeries/TimeArraySeries.f90 b/src/Utilities/TimeSeries/TimeArraySeries.f90 index 34119ffa65a..9bbf23ddd9e 100644 --- a/src/Utilities/TimeSeries/TimeArraySeries.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeries.f90 @@ -3,7 +3,7 @@ module TimeArraySeriesModule use ArrayReadersModule, only: ReadArray use BlockParserModule, only: BlockParserType use ConstantsModule, only: LINELENGTH, UNDEFINED, STEPWISE, LINEAR, & - LENTIMESERIESNAME, DZERO, DONE + LENTIMESERIESNAME, LENMODELNAME, DZERO, DONE use GenericUtilitiesModule, only: is_same use InputOutputModule, only: GetUnit, openfile use KindModule, only: DP, I4B @@ -13,7 +13,6 @@ module TimeArraySeriesModule use TimeArrayModule, only: TimeArrayType, ConstructTimeArray, & AddTimeArrayToList, CastAsTimeArrayType, & GetTimeArrayFromList - use BaseDisModule, only: DisBaseType use, intrinsic :: iso_fortran_env, only: IOSTAT_END implicit none @@ -32,7 +31,7 @@ module TimeArraySeriesModule character(len=LINELENGTH), private :: dataFile = '' logical, private :: autoDeallocate = .true. type(ListType), pointer, private :: list => null() - class(DisBaseType), pointer, private :: dis => null() + character(len=LENMODELNAME) :: modelname type(BlockParserType), private :: parser contains ! -- Public procedures @@ -86,7 +85,7 @@ end subroutine ConstructTimeArraySeries ! -- Public procedures - subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) + subroutine tas_init(this, fname, modelname, iout, tasname, autoDeallocate) ! ****************************************************************************** ! tas_init -- initialize the time array series ! ****************************************************************************** @@ -96,7 +95,7 @@ subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) ! -- dummy class(TimeArraySeriesType), intent(inout) :: this character(len=*), intent(in) :: fname - class(DisBaseType), pointer, intent(inout) :: dis + character(len=*), intent(in) :: modelname integer(I4B), intent(in) :: iout character(len=*), intent(inout) :: tasname logical, optional, intent(in) :: autoDeallocate @@ -114,7 +113,7 @@ subroutine tas_init(this, fname, dis, iout, tasname, autoDeallocate) allocate (this%list) ! ! -- assign members - this%dis => dis + this%modelname = modelname this%iout = iout ! ! -- open time-array series input file @@ -371,28 +370,43 @@ logical function read_next_array(this) ! ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ + ! -- modules + use ConstantsModule, only: LENMEMPATH + use MemoryManagerModule, only: mem_setptr + use MemoryHelperModule, only: create_mem_path ! -- dummy class(TimeArraySeriesType), intent(inout) :: this ! -- local integer(I4B) :: i, ierr, istart, istat, istop, lloc, nrow, ncol, nodesperlayer logical :: lopen, isFound type(TimeArrayType), pointer :: ta => null() + character(len=LENMEMPATH) :: mempath + integer(I4B), dimension(:), contiguous, & + pointer :: mshape ! ------------------------------------------------------------------------------ ! + ! -- initialize istart = 1 istat = 0 istop = 1 lloc = 1 + nullify (mshape) + ! + ! -- create mempath + mempath = create_mem_path(component=this%modelname, subcomponent='DIS') + ! + ! -- set mshape pointer + call mem_setptr(mshape, 'MSHAPE', mempath) + ! ! Get dimensions for supported discretization type - if (this%dis%supports_layers()) then - nodesperlayer = this%dis%get_ncpl() - if (size(this%dis%mshape) == 3) then - nrow = this%dis%mshape(2) - ncol = this%dis%mshape(3) - else - nrow = 1 - ncol = this%dis%mshape(2) - end if + if (size(mshape) == 2) then + nodesperlayer = mshape(2) + nrow = 1 + ncol = mshape(2) + else if (size(mshape) == 3) then + nodesperlayer = mshape(2) * mshape(3) + nrow = mshape(2) + ncol = mshape(3) else errmsg = 'Time array series is not supported for selected & &discretization type.' @@ -403,7 +417,7 @@ logical function read_next_array(this) read_next_array = .false. inquire (unit=this%inunit, opened=lopen) if (lopen) then - call ConstructTimeArray(ta, this%dis) + call ConstructTimeArray(ta, this%modelname) ! -- read a time and an array from the input file ! -- Get a TIME block and read the time call this%parser%GetBlock('TIME', isFound, ierr, & @@ -412,7 +426,7 @@ logical function read_next_array(this) ta%taTime = this%parser%GetDouble() ! -- Read the array call ReadArray(this%parser%iuactive, ta%taArray, this%Name, & - this%dis%ndim, ncol, nrow, 1, nodesperlayer, & + size(mshape), ncol, nrow, 1, nodesperlayer, & this%iout, 0, 0) ! ! -- multiply values by sfac diff --git a/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 b/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 index 46040ca4cde..562aa9d8542 100644 --- a/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 +++ b/src/Utilities/TimeSeries/TimeArraySeriesManager.f90 @@ -3,7 +3,7 @@ module TimeArraySeriesManagerModule use KindModule, only: DP, I4B use SimVariablesModule, only: errmsg use ConstantsModule, only: DZERO, LENTIMESERIESNAME, LINELENGTH, & - LENHUGELINE + LENHUGELINE, LENMODELNAME use ListModule, only: ListType use SimModule, only: store_error, store_error_unit use TdisModule, only: delt, totimc, kper, kstp @@ -22,7 +22,8 @@ module TimeArraySeriesManagerModule type TimeArraySeriesManagerType ! -- Public members integer(I4B), public :: iout = 0 ! output unit num - class(DisBaseType), pointer, public :: dis => null() ! pointer to dis + class(DisBaseType), pointer :: dis => null() ! pointer to dis + character(len=LENMODELNAME) :: modelname ! -- Private members type(ListType), pointer, private :: boundTasLinks => null() ! list of TAS links character(len=LINELENGTH), allocatable, dimension(:) :: tasfiles ! list of TA file names @@ -49,7 +50,7 @@ module TimeArraySeriesManagerModule ! -- Public procedures - subroutine tasmanager_cr(this, dis, iout) + subroutine tasmanager_cr(this, dis, modelname, iout) ! ****************************************************************************** ! tasmanager_cr -- create the tasmanager ! ****************************************************************************** @@ -58,12 +59,17 @@ subroutine tasmanager_cr(this, dis, iout) ! ------------------------------------------------------------------------------ ! -- dummy type(TimeArraySeriesManagerType) :: this - class(DisBaseType), pointer :: dis + class(DisBaseType), pointer, optional :: dis + character(len=*), intent(in) :: modelname integer(I4B), intent(in) :: iout ! ------------------------------------------------------------------------------ ! + if (present(dis)) then + this%dis => dis + end if + ! + this%modelname = modelname this%iout = iout - this%dis => dis allocate (this%boundTasLinks) allocate (this%tasfiles(0)) ! @@ -94,7 +100,7 @@ subroutine tasmanager_df(this) ! -- Setup a time array series for each file specified do i = 1, nfiles tasptr => this%taslist(i) - call tasptr%tas_init(this%tasfiles(i), this%dis, & + call tasptr%tas_init(this%tasfiles(i), this%modelname, & this%iout, this%tasnames(i)) end do ! @@ -413,6 +419,7 @@ subroutine tasmgr_convert_flux(this, tasLink) ! ! SPECIFICATIONS: ! ------------------------------------------------------------------------------ + ! -- modules ! -- dummy class(TimeArraySeriesManagerType) :: this type(TimeArraySeriesLinkType), pointer, intent(inout) :: tasLink @@ -420,6 +427,13 @@ subroutine tasmgr_convert_flux(this, tasLink) integer(I4B) :: i, n, noder real(DP) :: area ! ------------------------------------------------------------------------------ + if (.not. (associated(this%dis) .and. & + associated(tasLink%nodelist))) then + errmsg = 'Programming error. Cannot convert flux. Verify that '& + &'a valid DIS instance and nodelist were provided.' + call store_error(errmsg) + call store_error_unit(tasLink%TimeArraySeries%GetInunit()) + end if ! n = size(tasLink%BndArray) do i = 1, n diff --git a/src/meson.build b/src/meson.build index 08417b774e9..232e58c7bcc 100644 --- a/src/meson.build +++ b/src/meson.build @@ -148,14 +148,21 @@ modflow_sources = files( 'Utilities' / 'ArrayRead' / 'Integer1dReader.f90', 'Utilities' / 'ArrayRead' / 'Integer2dReader.f90', 'Utilities' / 'ArrayRead' / 'LayeredArrayReader.f90', + 'Utilities' / 'Idm' / 'BoundInputContext.f90', 'Utilities' / 'Idm' / 'DefinitionSelect.f90', + 'Utilities' / 'Idm' / 'IdmLoad.f90', 'Utilities' / 'Idm' / 'IdmLogger.f90', - 'Utilities' / 'Idm' / 'IdmSimulation.f90', 'Utilities' / 'Idm' / 'InputDefinition.f90', + 'Utilities' / 'Idm' / 'InputLoadType.f90', 'Utilities' / 'Idm' / 'ModelPackageInputs.f90', 'Utilities' / 'Idm' / 'ModflowInput.f90', + 'Utilities' / 'Idm' / 'SourceCommon.f90', + 'Utilities' / 'Idm' / 'SourceLoad.F90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'AsciiInputLoadType.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'IdmMf6File.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'LoadMf6File.f90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'StressGridInput.f90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'StressListInput.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'StructArray.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'StructVector.f90', 'Utilities' / 'Idm' / 'selector' / 'IdmDfnSelector.f90', diff --git a/src/mf6core.f90 b/src/mf6core.f90 index 6ec3d061e3e..a718496ba3a 100644 --- a/src/mf6core.f90 +++ b/src/mf6core.f90 @@ -130,6 +130,8 @@ subroutine Mf6Finalize() use ListsModule, only: lists_da use SimulationCreateModule, only: simulation_da use TdisModule, only: tdis_da + use IdmLoadModule, only: idm_da + use SimVariablesModule, only: iout ! -- local variables integer(I4B) :: im integer(I4B) :: ic @@ -141,6 +143,7 @@ subroutine Mf6Finalize() class(BaseExchangeType), pointer :: ep => null() class(SpatialModelConnectionType), pointer :: mc => null() ! + ! ! -- FINAL PROCESSING (FP) ! -- Final processing for each model do im = 1, basemodellist%Count() @@ -198,6 +201,8 @@ subroutine Mf6Finalize() call sgp%sgp_da() deallocate (sgp) end do + ! + call idm_da(iout) call simulation_da() call lists_da() ! @@ -263,7 +268,7 @@ subroutine static_input_load() ! -- modules use ConstantsModule, only: LENMEMPATH use SimVariablesModule, only: iout - use IdmSimulationModule, only: simnam_load, load_models + use IdmLoadModule, only: simnam_load, load_models use MemoryHelperModule, only: create_mem_path use MemoryManagerModule, only: mem_setptr, mem_allocate use SimVariablesModule, only: idm_context, iparamlog @@ -302,6 +307,8 @@ end subroutine static_input_load !! !< subroutine simulation_df() + ! -- modules + use IdmLoadModule, only: idm_df ! -- local variables integer(I4B) :: im integer(I4B) :: ic @@ -357,6 +364,9 @@ subroutine simulation_df() call sp%sln_df() end do + ! idm df + call idm_df() + end subroutine simulation_df !> @brief Simulation allocate and read @@ -468,6 +478,7 @@ subroutine Mf6PrepareTimestep() use BaseSolutionModule, only: BaseSolutionType, GetBaseSolutionFromList use SimModule, only: converge_reset use SimVariablesModule, only: isim_mode + use IdmLoadModule, only: idm_rp ! -- local variables class(BaseModelType), pointer :: mp => null() class(BaseExchangeType), pointer :: ep => null() @@ -498,6 +509,9 @@ subroutine Mf6PrepareTimestep() line = trim(line)//'normal"' end select + ! -- load dynamic input + call idm_rp() + ! -- Read and prepare each model do im = 1, basemodellist%Count() mp => GetBaseModelFromList(basemodellist, im) @@ -563,6 +577,7 @@ subroutine Mf6DoTimestep() use ListsModule, only: solutiongrouplist use SimVariablesModule, only: iFailedStepRetry use SolutionGroupModule, only: SolutionGroupType, GetSolutionGroupFromList + use IdmLoadModule, only: idm_ad ! -- local variables class(SolutionGroupType), pointer :: sgp => null() integer(I4B) :: isg @@ -576,6 +591,9 @@ subroutine Mf6DoTimestep() iFailedStepRetry = 0 retryloop: do + ! -- idm advance + call idm_ad() + do isg = 1, solutiongrouplist%Count() sgp => GetSolutionGroupFromList(solutiongrouplist, isg) call sgp%sgp_ca() diff --git a/src/simnamidm.f90 b/src/simnamidm.f90 index 86c6f058f37..984eea00804 100644 --- a/src/simnamidm.f90 +++ b/src/simnamidm.f90 @@ -1,5 +1,6 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** module SimNamInputModule + use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private @@ -8,6 +9,7 @@ module SimNamInputModule public sim_nam_block_definitions public SimNamParamFoundType public sim_nam_multi_package + public sim_nam_aux_sfac_param type SimNamParamFoundType logical :: continue = .false. @@ -31,6 +33,8 @@ module SimNamInputModule logical :: sim_nam_multi_package = .false. + character(len=LENVARNAME) :: sim_nam_aux_sfac_param = '' + type(InputParamDefinitionType), parameter :: & simnam_continue = InputParamDefinitionType & ( & @@ -44,7 +48,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -60,7 +65,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -76,7 +82,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -92,7 +99,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -108,7 +116,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -124,7 +133,8 @@ module SimNamInputModule .true., & ! required .false., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -140,7 +150,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -156,7 +167,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -172,7 +184,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -188,7 +201,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -204,7 +218,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -220,7 +235,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -236,7 +252,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -252,7 +269,8 @@ module SimNamInputModule .false., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -268,7 +286,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -284,7 +303,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .true., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -300,7 +320,8 @@ module SimNamInputModule .true., & ! required .true., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -338,7 +359,8 @@ module SimNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -354,7 +376,8 @@ module SimNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & @@ -370,7 +393,8 @@ module SimNamInputModule .true., & ! required .false., & ! multi-record .false., & ! preserve case - .false. & ! layered + .false., & ! layered + .false. & ! timeseries ) type(InputParamDefinitionType), parameter :: & diff --git a/utils/idmloader/scripts/dfn2f90.py b/utils/idmloader/scripts/dfn2f90.py index 6f59df4b38b..3e8e063e04e 100644 --- a/utils/idmloader/scripts/dfn2f90.py +++ b/utils/idmloader/scripts/dfn2f90.py @@ -28,6 +28,7 @@ def __init__( self._aggregate_varnames = [] self._warnings = [] self._multi_package = False + self._aux_sfac_param = f"''" self.component, self.subcomponent = self._dfnfspec.stem.upper().split("-") @@ -35,7 +36,7 @@ def __init__( self._set_var_d() self._set_param_strs() - def add_dfn_entry(self, dfn_d=None): + def add_dfn_entry(self, dfn_d=None, varnames=None): c_key = f"{self.component.upper()}" sc_key = f"{self.subcomponent.upper()}" @@ -44,6 +45,14 @@ def add_dfn_entry(self, dfn_d=None): dfn_d[c_key].append(sc_key) + for var in self._param_varnames: + v = var.split( + f"{self.component.lower()}{self.subcomponent.lower()}_" + )[1] + v = f"{self.component.lower()}_{v}" + if v not in varnames: + varnames.append(v) + def write_f90(self, ofspec=None): with open(ofspec, "w") as f: @@ -74,6 +83,12 @@ def write_f90(self, ofspec=None): f"{self.subcomponent.lower()}_multi_package = {smult}\n\n" ) + # aux sfac col + f.write( + f" character(len=LENVARNAME) :: {self.component.lower()}_" + f"{self.subcomponent.lower()}_aux_sfac_param = {self._aux_sfac_param}\n\n" + ) + # params if len(self._param_varnames): f.write(self._param_str) @@ -161,6 +176,8 @@ def _set_var_d(self): # flopy multi-package if "flopy multi-package" in line.strip(): self._multi_package = True + if "modflow6 aux-sfac-param" in line.strip(): + self._aux_sfac_param = f"'{line.strip().split()[-1].upper()}'" continue ll = line.strip().split() @@ -256,7 +273,8 @@ def _set_param_strs(self): self._param_str += " .false., & ! required\n" self._param_str += " .false., & ! multi-record\n" self._param_str += " .false., & ! preserve case\n" - self._param_str += " .false. & ! layered\n" + self._param_str += " .false., & ! layered\n" + self._param_str += " .false. & ! timeseries\n" self._param_str += " ), &\n" if not self._aggregate_str: @@ -272,7 +290,8 @@ def _set_param_strs(self): self._aggregate_str += " .false., & ! required\n" self._aggregate_str += " .false., & ! multi-record\n" self._aggregate_str += " .false., & ! preserve case\n" - self._aggregate_str += " .false. & ! layered\n" + self._aggregate_str += " .false., & ! layered\n" + self._aggregate_str += " .false. & ! timeseries\n" self._aggregate_str += " ), &\n" if not self._block_str: @@ -339,6 +358,13 @@ def _set_blk_param_strs(self, blockname, component, subcomponent): shape = shape.replace(")", "") shape = shape.replace(",", "") shape = shape.upper() + if (shape == "NCOL*NROW; NCPL"): + # grid array input syntax + if mf6vn == "AUXVAR": + # for grid, set AUX as DOUBLE2D + shape = "NAUX NCPL" + else: + shape = "NCPL" shapelist = shape.strip().split() ndim = len(shapelist) @@ -375,6 +401,13 @@ def _set_blk_param_strs(self, blockname, component, subcomponent): else: layered = ".false." + timeseries = ".false." + if "time_series" in v: + if v["time_series"] == "true": + timeseries = ".true." + else: + timeseries = ".false." + if inrec == ".false.": required_l.append(r) tuple_list = [ @@ -389,6 +422,7 @@ def _set_blk_param_strs(self, blockname, component, subcomponent): (inrec, "multi-record"), (preserve_case, "preserve case"), (layered, "layered"), + (timeseries, "timeseries"), ] if aggregate_t: @@ -443,6 +477,7 @@ def _source_file_header(self, component, subcomponent): s = ( f"! ** Do Not Modify! MODFLOW 6 system generated file. **\n" f"module {component.title()}{subcomponent.title()}InputModule\n" + f" use ConstantsModule, only: LENVARNAME\n" f" use InputDefinitionModule, only: InputParamDefinitionType, &\n" f" InputBlockDefinitionType\n" f" private\n" @@ -455,7 +490,9 @@ def _source_file_header(self, component, subcomponent): f" public {component.capitalize()}{subcomponent.capitalize()}" f"ParamFoundType\n" f" public {component.lower()}_{subcomponent.lower()}_" - f"multi_package\n\n" + f"multi_package\n" + f" public {component.lower()}_{subcomponent.lower()}_" + f"aux_sfac_param\n\n" ) return s @@ -505,10 +542,12 @@ class IdmDfnSelector: def __init__( self, dfn_d: dict = None, + varnames: list = None, ): """IdmDfnSelector init""" self._d = dfn_d + self._v = varnames def write(self): self._write_selectors() @@ -522,16 +561,25 @@ def _write_master(self): self._write_master_defn(fh, defn="aggregate", dtype="param") self._write_master_defn(fh, defn="block", dtype="block") self._write_master_multi(fh) + self._write_master_sfaccol(fh) self._write_master_integration(fh) + self._write_master_component(fh) fh.write(f"end module IdmDfnSelectorModule\n") def _write_selectors(self): for c in self._d: + component_vars = [] + for var in self._v: + tokens = var.split("_", 1) + if (tokens[0].upper() == c): + component_vars.append(tokens[1]) + ofspec = ( f"../../../src/Utilities/Idm/selector/Idm{c.title()}DfnSelector.f90" ) with open(ofspec, "w") as fh: self._write_selector_decl(fh, component=c, sc_list=self._d[c]) + self._write_selector_foundtype(fh, component=c, varnames=component_vars) self._write_selector_helpers(fh) self._write_selector_defn( fh, component=c, sc_list=self._d[c], defn="param", dtype="param" @@ -543,6 +591,7 @@ def _write_selectors(self): fh, component=c, sc_list=self._d[c], defn="block", dtype="block" ) self._write_selector_multi(fh, component=c, sc_list=self._d[c]) + self._write_selector_sfaccol(fh, component=c, sc_list=self._d[c]) self._write_selector_integration(fh, component=c, sc_list=self._d[c]) fh.write(f"end module Idm{c.title()}DfnSelectorModule\n") @@ -554,6 +603,7 @@ def _write_selector_decl(self, fh=None, component=None, sc_list=None): s = ( f"! ** Do Not Modify! MODFLOW 6 system generated file. **\n" f"module Idm{c.title()}DfnSelectorModule\n\n" + f" use ConstantsModule, only: LENVARNAME\n" f" use SimModule, only: store_error\n" f" use InputDefinitionModule, only: InputParamDefinitionType, &\n" f" InputBlockDefinitionType\n" @@ -564,29 +614,37 @@ def _write_selector_decl(self, fh=None, component=None, sc_list=None): spacer = space * (len_c + len_sc) s += ( - f" use {c.title()}{sc.title()}InputModule, only: " - f"{c.lower()}_{sc.lower()}_param_definitions, &" - f"\n {spacer}" - f"{c.lower()}_{sc.lower()}_aggregate_definitions, &" - f"\n {spacer}" - f"{c.lower()}_{sc.lower()}_block_definitions, &" - f"\n {spacer}" - f"{c.lower()}_{sc.lower()}_multi_package\n" + f" use {c.title()}{sc.title()}InputModule\n" ) s += ( f"\n implicit none\n" f" private\n" + f" public :: {c.capitalize()}ParamFoundType\n" f" public :: {c.lower()}_param_definitions\n" f" public :: {c.lower()}_aggregate_definitions\n" f" public :: {c.lower()}_block_definitions\n" f" public :: {c.lower()}_idm_multi_package\n" + f" public :: {c.lower()}_idm_sfac_param\n" f" public :: {c.lower()}_idm_integrated\n\n" - f"contains\n\n" ) fh.write(s) + def _write_selector_foundtype(self, fh=None, component=None, varnames=None): + + fh.write( + f" type {component.capitalize()}" + f"ParamFoundType\n" + ) + for var in varnames: + fh.write(f" logical :: {var} = .false.\n") + fh.write( + f" end type {component.capitalize()}" + f"ParamFoundType\n\n" + ) + fh.write(f"contains\n\n") + def _write_selector_helpers(self, fh=None): s = ( f" subroutine set_param_pointer(input_dfn, input_dfn_target)\n" @@ -673,6 +731,38 @@ def _write_selector_multi(self, fh=None, component=None, sc_list=None): fh.write(s) + def _write_selector_sfaccol(self, fh=None, component=None, sc_list=None): + c = component + + s = ( + f" function {c.lower()}_idm_sfac_param(subcomponent) " + f"result(sfac_param)\n" + f" character(len=*), intent(in) :: subcomponent\n" + f" character(len=LENVARNAME) :: sfac_param\n" + f" select case (subcomponent)\n" + ) + + for sc in sc_list: + s += ( + f" case ('{sc}')\n" + f" sfac_param = {c.lower()}_{sc.lower()}_" + f"aux_sfac_param\n" + ) + + s += ( + f" case default\n" + f" call store_error('Idm selector subcomponent " + f"not found; '//&\n" + f" &'component=\"{c.upper()}\"'//&\n" + f" &', subcomponent=\"'//trim(subcomponent)" + f"//'\".', .true.)\n" + f" end select\n" + f" return\n" + f" end function {c.lower()}_idm_sfac_param\n\n" + ) + + fh.write(s) + def _write_selector_integration(self, fh=None, component=None, sc_list=None): c = component @@ -704,6 +794,7 @@ def _write_master_decl(self, fh=None): s = ( f"! ** Do Not Modify! MODFLOW 6 system generated file. **\n" f"module IdmDfnSelectorModule\n\n" + f" use ConstantsModule, only: LENVARNAME\n" f" use SimModule, only: store_error\n" f" use InputDefinitionModule, only: InputParamDefinitionType, &\n" f" InputBlockDefinitionType\n" @@ -713,16 +804,7 @@ def _write_master_decl(self, fh=None): len_c = len(c) spacer = space * (len_c) s += ( - f" use Idm{c.title()}DfnSelectorModule, only: " - f"{c.lower()}_param_definitions, &" - f"\n {spacer}" - f"{c.lower()}_aggregate_definitions, &" - f"\n {spacer}" - f"{c.lower()}_block_definitions, &" - f"\n {spacer}" - f"{c.lower()}_idm_multi_package, &" - f"\n {spacer}" - f"{c.lower()}_idm_integrated\n" + f" use Idm{c.title()}DfnSelectorModule\n" ) s += ( @@ -732,7 +814,9 @@ def _write_master_decl(self, fh=None): f" public :: aggregate_definitions\n" f" public :: block_definitions\n" f" public :: idm_multi_package\n" - f" public :: idm_integrated\n\n" + f" public :: idm_sfac_param\n" + f" public :: idm_integrated\n" + f" public :: idm_component\n\n" f"contains\n\n" ) @@ -796,6 +880,36 @@ def _write_master_multi(self, fh=None): fh.write(s) + def _write_master_sfaccol(self, fh=None): + s = ( + f" function idm_sfac_param(component, subcomponent) " + f"result(sfac_param)\n" + f" character(len=*), intent(in) :: component\n" + f" character(len=*), intent(in) :: subcomponent\n" + f" character(len=LENVARNAME) :: sfac_param\n" + f" select case (component)\n" + ) + + for c in dfn_d: + s += ( + f" case ('{c}')\n" + f" sfac_param = {c.lower()}_idm_" + f"sfac_param(subcomponent)\n" + ) + + s += ( + f" case default\n" + f" call store_error('Idm selector component not found; '//&\n" + f" &'component=\"'//trim(component)//&\n" + f" &'\", subcomponent=\"'//trim(subcomponent)" + f"//'\".', .true.)\n" + f" end select\n" + f" return\n" + f" end function idm_sfac_param\n\n" + ) + + fh.write(s) + def _write_master_integration(self, fh=None): s = ( f" function idm_integrated(component, subcomponent) " @@ -823,6 +937,31 @@ def _write_master_integration(self, fh=None): fh.write(s) + def _write_master_component(self, fh=None): + s = ( + f" function idm_component(component) " + f"result(integrated)\n" + f" character(len=*), intent(in) :: component\n" + f" logical :: integrated\n" + f" integrated = .false.\n" + f" select case (component)\n" + ) + + for c in dfn_d: + s += ( + f" case ('{c}')\n" + f" integrated = .true.\n" + ) + + s += ( + f" case default\n" + f" end select\n" + f" return\n" + f" end function idm_component\n\n" + ) + + fh.write(s) + if __name__ == "__main__": @@ -876,12 +1015,13 @@ def _write_master_integration(self, fh=None): ] dfn_d = {} + varnames = [] for dfn in dfns: converter = Dfn2F90(dfnfspec=dfn[0]) converter.write_f90(ofspec=dfn[1]) converter.warn() - converter.add_dfn_entry(dfn_d=dfn_d) + converter.add_dfn_entry(dfn_d=dfn_d, varnames=varnames) - selectors = IdmDfnSelector(dfn_d=dfn_d) + selectors = IdmDfnSelector(dfn_d=dfn_d, varnames=varnames) selectors.write() print("\n...done.") diff --git a/utils/mf5to6/make/makedefaults b/utils/mf5to6/make/makedefaults index bcea1425b67..e7b3710e4ab 100644 --- a/utils/mf5to6/make/makedefaults +++ b/utils/mf5to6/make/makedefaults @@ -64,12 +64,9 @@ else FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp MODSWITCH = -module $(MODDIR) endif - ifeq ($(FC), $(filter $(FC), ftn)) - FFLAGS ?= -h noheap_allocate - endif endif # set the ldflgs @@ -84,9 +81,6 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif - ifeq ($(FC), $(filter $(FC), ftn)) - LDFLAGS ?= -lc - endif endif # check for Windows error condition diff --git a/utils/mf5to6/make/makefile b/utils/mf5to6/make/makefile index c455f6d76b0..6aeb41e0a59 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/Preproc +SOURCEDIR4=../src/MF2005 +SOURCEDIR5=../src/NWT SOURCEDIR6=../../../src/Utilities/Memory SOURCEDIR7=../../../src/Utilities/TimeSeries SOURCEDIR8=../../../src/Utilities diff --git a/utils/zonebudget/make/makedefaults b/utils/zonebudget/make/makedefaults index e27dfca39de..c0eadf7ac21 100644 --- a/utils/zonebudget/make/makedefaults +++ b/utils/zonebudget/make/makedefaults @@ -57,19 +57,16 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp + FFLAGS ?= -static -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp endif else ifeq ($(FC), gfortran) - FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid $(OS_macro) -fall-intrinsics -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -pedantic -std=f2008 -Wcharacter-truncation -cpp + FFLAGS ?= -fbacktrace -ffpe-summary=overflow -ffpe-trap=overflow,zero,invalid -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2008 -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) - FFLAGS ?= -no-heap-arrays -fpe0 -traceback -fpp + FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp MODSWITCH = -module $(MODDIR) endif - ifeq ($(FC), $(filter $(FC), ftn)) - FFLAGS ?= -h noheap_allocate - endif endif # set the ldflgs @@ -84,9 +81,6 @@ else ifeq ($(FC), $(filter $(FC), ifort mpiifort)) LDFLAGS ?= -lc endif - ifeq ($(FC), $(filter $(FC), ftn)) - LDFLAGS ?= -lc - endif endif # check for Windows error condition