diff --git a/make/makefile b/make/makefile index 310b460c214..f04610d350f 100644 --- a/make/makefile +++ b/make/makefile @@ -108,16 +108,33 @@ $(OBJDIR)/SmoothingFunctions.o \ $(OBJDIR)/MatrixBase.o \ $(OBJDIR)/ListReader.o \ $(OBJDIR)/Connections.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 \ @@ -126,29 +143,27 @@ $(OBJDIR)/Budget.o \ $(OBJDIR)/sort.o \ $(OBJDIR)/SfrCrossSectionUtils.o \ $(OBJDIR)/BudgetTerm.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)/SfrCrossSectionManager.o \ $(OBJDIR)/dag_module.o \ $(OBJDIR)/BudgetObject.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)/PackageBudget.o \ $(OBJDIR)/HeadFileReader.o \ $(OBJDIR)/PrintSaveManager.o \ @@ -163,25 +178,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 \ @@ -201,7 +219,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 \ @@ -240,7 +258,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 \ @@ -249,12 +267,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 \ @@ -264,16 +278,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 \ @@ -282,17 +291,11 @@ $(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)/InputLoadType.o \ $(OBJDIR)/mf6core.o \ -$(OBJDIR)/BoundInputContext.o \ -$(OBJDIR)/AsciiInputLoadType.o \ -$(OBJDIR)/SourceCommon.o \ $(OBJDIR)/BaseGeometry.o \ $(OBJDIR)/mf6.o \ $(OBJDIR)/StringList.o \ @@ -302,8 +305,6 @@ $(OBJDIR)/sparsekit.o \ $(OBJDIR)/rcm.o \ $(OBJDIR)/blas1_d.o \ $(OBJDIR)/Iunit.o \ -$(OBJDIR)/StressListInput.o \ -$(OBJDIR)/StressGridInput.o \ $(OBJDIR)/RectangularGeometry.o \ $(OBJDIR)/CircularGeometry.o diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index 25f9779e336..c94c13b76d4 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -280,13 +280,14 @@ - + - + + 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/Solution/ExplicitSolution.f90 b/src/Solution/ExplicitSolution.f90 index 8cd8fb7f24b..b85ff8ba2ff 100644 --- a/src/Solution/ExplicitSolution.f90 +++ b/src/Solution/ExplicitSolution.f90 @@ -259,12 +259,17 @@ end subroutine sln_ca !> @ brief Solution prepare to solve !< subroutine prepareSolve(this) + ! -- modules + use IdmLoadModule, only: idm_ad ! -- dummy variables class(ExplicitSolutionType) :: this !< ExplicitSolutionType instance ! -- local variables integer(I4B) :: im class(ExplicitModelType), pointer :: mp => null() + ! -- IDM advance + call idm_ad() + ! -- Model advance do im = 1, this%modellist%Count() mp => GetExplicitModelFromList(this%modellist, im) diff --git a/src/Solution/NumericalSolution.f90 b/src/Solution/NumericalSolution.f90 index d2ac2afa3d7..52b2073b372 100644 --- a/src/Solution/NumericalSolution.f90 +++ b/src/Solution/NumericalSolution.f90 @@ -1467,6 +1467,8 @@ end subroutine writePTCInfoToFile !! !< subroutine prepareSolve(this) + ! -- modules + use IdmLoadModule, only: idm_ad ! -- dummy variables class(NumericalSolutionType) :: this !< NumericalSolutionType instance ! -- local variables @@ -1478,6 +1480,9 @@ subroutine prepareSolve(this) ! synchronize for AD call this%synchronize(STG_BFR_EXG_AD, this%synchronize_ctx) + ! -- IDM advance + call idm_ad() + ! -- Exchange advance do ic = 1, this%exchangelist%Count() cp => GetNumericalExchangeFromList(this%exchangelist, ic) diff --git a/src/Utilities/Idm/IdmLoad.f90 b/src/Utilities/Idm/IdmLoad.f90 new file mode 100644 index 00000000000..00084b744af --- /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. Idm Load 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/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/SourceLoad.F90 b/src/Utilities/Idm/SourceLoad.F90 new file mode 100644 index 00000000000..ae93d6813a0 --- /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 loading 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/IdmMf6File.f90 b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 index 4e844c23fed..82fe8e61eaf 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,396 @@ 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 allocate dynamic load parser if expecting dynamic input + !< + function create_dynamic_parser(mf6_input, mf6_parser, static_parser) & + result(created) + type(ModflowInputType), intent(in) :: mf6_input + type(BlockParserType), pointer, intent(inout) :: mf6_parser + type(BlockParserType), allocatable, target, intent(inout) :: static_parser + logical(LGP) :: created + integer(I4B) :: iblock + ! + ! -- initialize + nullify (mf6_parser) + created = .false. + ! + ! -- check if package has dynamic input + do iblock = 1, size(mf6_input%block_dfns) + ! + if (mf6_input%block_dfns(iblock)%blockname == 'PERIOD') then + ! + ! -- dynamic package, allocate parser + allocate (mf6_parser, source=static_parser) + created = .true. + ! + exit + ! + end if + end do + ! + ! -- return + return + end function + !> @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 + logical(LGP) :: created ! - ! -- create description of input - mf6_input = getModflowInput(pkgtype, component_type, & - subcomponent_type, component_name, & - subcomponent_name) + ! -- initialize + created = .false. ! - ! -- 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 + ! -- generate a dynamic loader parser if requested and relevant + if (present(mf6_parser)) then + ! + ! -- create dynamic parser + created = create_dynamic_parser(mf6_input, mf6_parser, parser) + end if + ! + ! -- deallocate static load parser if (allocated(parser)) then - !call parser%clear() + ! + if (.not. created) call parser%clear() deallocate (parser) + ! end if ! ! -- 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 :: mf6file_period_loader => null() + type(BlockParserType), pointer :: parser => null() ! - do n = 1, size(model_pkg_inputs%pkglist) + ! -- initialize + nullify (period_loader) + ! + ! -- load model package to input context + call input_load(this%sourcename, this%mf6_input, & + this%modelfname, iout, parser) + ! + ! + if (associated(parser)) then ! - ! -- this list package type - pkgtype = model_pkg_inputs%pkglist(n)%pkgtype + ! -- package is dynamic, allocate loader + allocate (mf6file_period_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 + ! -- initialize dynamic loader + call mf6file_period_loader%init(this%mf6_input, this%modelname, & + this%modelfname, this%sourcename, & + iout) + ! + ! -- set parser + call mf6file_period_loader%set(parser) + ! + ! -- set return pointer to base dynamic loader + period_loader => mf6file_period_loader + ! + end if + ! + end function static_load + + !> @brief static loader destroy + !< + 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, 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) :: iout + ! + call this%DynamicPkgLoadType%init(mf6_input, modelname, modelfname, & + source, 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 load_model_pkgfiles + end subroutine dynamic_init - !> @brief open all model package files + !> @brief dynamic loader set parser object !< - subroutine open_model_pkgfiles(model_pkg_inputs, iout) - ! -- modules - ! -- dummy - type(ModelPackageInputsType), intent(inout) :: model_pkg_inputs - integer(I4B), intent(in) :: iout - ! -- locals - integer(I4B) :: n, m - character(len=LINELENGTH) :: filename - character(len=LENPACKAGETYPE) :: filetype - character(len=LINELENGTH) :: errmsg + 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 ! - 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 + ! -- 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 dynamic_df + + !> @brief advance routine for dynamic loader + !< + subroutine dynamic_ad(this) + class(Mf6FileDynamicPkgLoadType), intent(inout) :: this + ! + call this%block_loader%ad() ! - ! -- returh + ! -- return return - end subroutine open_model_pkgfiles + end subroutine dynamic_ad - !> @brief load and make pkg info available to models + !> @brief read and prepare routine for dynamic loader !< - subroutine modelpkgs_load(mtype, mfname, mname, iout) + subroutine dynamic_rp(this) ! -- modules + use TdisModule, only: kper, nper + !use TdisModule, only: readnewdata + 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 + !if (.not. readnewdata) 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') - ! - ! -- load model namfile to the input context - call input_load('GWF6', 'GWF', 'NAM', mname, 'NAM', inunit, iout) + ! -- set first period block IPER + if (isblockfound) then ! - ! -- load and create descriptions of model package files - call modelpkgs_load(mtype, mfname, mname, iout) + this%ionper = this%parser%GetInteger() ! - 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%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 8ee55f523db..df62ccb6a5b 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) + ! end do ! ! -- close logging statement @@ -94,6 +85,40 @@ subroutine idm_load(parser, pkgtype, & mf6_input%subcomponent_name, iout) end subroutine idm_load + subroutine block_post_process(mf6_input, blockname, mshape) + 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 + 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, & + 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 +243,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 +319,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 +348,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 @@ -497,6 +527,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) @@ -514,6 +614,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 @@ -561,6 +662,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 @@ -604,6 +706,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 @@ -667,6 +770,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 @@ -713,6 +817,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 @@ -756,6 +861,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 @@ -802,45 +908,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 @@ -867,27 +934,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/meson.build b/src/meson.build index 763c9a615e9..544930fdf1d 100644 --- a/src/meson.build +++ b/src/meson.build @@ -149,13 +149,14 @@ modflow_sources = files( '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', diff --git a/src/mf6core.f90 b/src/mf6core.f90 index 6ec3d061e3e..747660cf77a 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)