From 6f59ec370717d6765e71bdd18c0f05730f4b2a50 Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 17 Mar 2025 08:04:38 -0400 Subject: [PATCH 01/22] add ghba package --- msvs/mf6core.vfproj | 7 +- src/Idm/gwf-ghbaidm.f90 | 408 ++++++++++++++ src/Idm/selector/IdmGwfDfnSelector.f90 | 13 + src/Model/GroundWaterFlow/gwf-buy.f90 | 66 +++ src/Model/GroundWaterFlow/gwf-evt.f90 | 2 +- src/Model/GroundWaterFlow/gwf-ghba.f90 | 497 ++++++++++++++++++ src/Model/GroundWaterFlow/gwf-vsc.f90 | 24 +- src/Model/GroundWaterFlow/gwf.f90 | 12 +- src/Utilities/Idm/BoundInputContext.f90 | 50 +- src/Utilities/Idm/InputLoadType.f90 | 23 +- src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 | 24 +- .../Idm/mf6blockfile/Mf6FileGridArray.f90 | 299 +++++++++++ ...ileGridInput.f90 => Mf6FileLayerArray.f90} | 107 ++-- .../{Mf6FileListInput.f90 => Mf6FileList.f90} | 104 ++-- src/meson.build | 7 +- utils/idmloader/dfns.txt | 1 + utils/idmloader/scripts/dfn2f90.py | 12 +- 17 files changed, 1500 insertions(+), 156 deletions(-) create mode 100644 src/Idm/gwf-ghbaidm.f90 create mode 100644 src/Model/GroundWaterFlow/gwf-ghba.f90 create mode 100644 src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 rename src/Utilities/Idm/mf6blockfile/{Mf6FileGridInput.f90 => Mf6FileLayerArray.f90} (85%) rename src/Utilities/Idm/mf6blockfile/{Mf6FileListInput.f90 => Mf6FileList.f90} (80%) diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index d9eb6c77695..fb0e37f701a 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -175,6 +175,7 @@ + @@ -276,6 +277,7 @@ + @@ -511,8 +513,9 @@ - - + + + diff --git a/src/Idm/gwf-ghbaidm.f90 b/src/Idm/gwf-ghbaidm.f90 new file mode 100644 index 00000000000..4c1b4eba317 --- /dev/null +++ b/src/Idm/gwf-ghbaidm.f90 @@ -0,0 +1,408 @@ +! ** Do Not Modify! MODFLOW 6 system generated file. ** +module GwfGhbaInputModule + use ConstantsModule, only: LENVARNAME + use InputDefinitionModule, only: InputParamDefinitionType, & + InputBlockDefinitionType + private + public gwf_ghba_param_definitions + public gwf_ghba_aggregate_definitions + public gwf_ghba_block_definitions + public GwfGhbaParamFoundType + public gwf_ghba_multi_package + public gwf_ghba_subpackages + + type GwfGhbaParamFoundType + logical :: auxiliary = .false. + logical :: auxmultname = .false. + logical :: iprpak = .false. + logical :: iprflow = .false. + logical :: ipakcb = .false. + logical :: tas_filerecord = .false. + logical :: tas6 = .false. + logical :: filein = .false. + logical :: tas6_filename = .false. + logical :: obs_filerecord = .false. + logical :: obs6 = .false. + logical :: obs6_filename = .false. + logical :: mover = .false. + logical :: export_nc = .false. + logical :: bhead = .false. + logical :: cond = .false. + logical :: auxvar = .false. + end type GwfGhbaParamFoundType + + logical :: gwf_ghba_multi_package = .true. + + character(len=16), parameter :: & + gwf_ghba_subpackages(*) = & + [ & + ' ' & + ] + + type(InputParamDefinitionType), parameter :: & + gwfghba_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'AUXILIARY', & ! tag name + 'AUXILIARY', & ! fortran variable + 'STRING', & ! type + 'NAUX', & ! shape + 'keyword to specify aux variables', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_auxmultname = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'AUXMULTNAME', & ! tag name + 'AUXMULTNAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + 'name of auxiliary variable for multiplier', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_iprpak = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_INPUT', & ! tag name + 'IPRPAK', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + 'print input to listing file', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_iprflow = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'PRINT_FLOWS', & ! tag name + 'IPRFLOW', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + 'print calculated flows to listing file', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_ipakcb = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'SAVE_FLOWS', & ! tag name + 'IPAKCB', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + 'save CHD flows to budget file', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_tas_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS_FILERECORD', & ! tag name + 'TAS_FILERECORD', & ! fortran variable + 'RECORD TAS6 FILEIN TAS6_FILENAME', & ! type + '', & ! shape + '', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_tas6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS6', & ! tag name + 'TAS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + 'head keyword', & ! longname + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_filein = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'FILEIN', & ! tag name + 'FILEIN', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + 'file keyword', & ! longname + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_tas6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'TAS6_FILENAME', & ! tag name + 'TAS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + 'file name of time series information', & ! longname + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_obs_filerecord = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type + '', & ! shape + '', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_obs6 = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + 'obs keyword', & ! longname + .true., & ! required + .true., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_obs6_filename = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'OBS6_FILENAME', & ! tag name + 'OBS6_FILENAME', & ! fortran variable + 'STRING', & ! type + '', & ! shape + 'obs6 input filename', & ! longname + .true., & ! required + .true., & ! multi-record + .true., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_mover = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'MOVER', & ! tag name + 'MOVER', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + '', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_export_nc = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'OPTIONS', & ! block + 'EXPORT_ARRAY_NETCDF', & ! tag name + 'EXPORT_NC', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + 'export array variables to netcdf output files.', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_bhead = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'PERIOD', & ! block + 'BHEAD', & ! tag name + 'BHEAD', & ! fortran variable + 'DOUBLE1D', & ! type + 'NODES', & ! shape + 'boundary head', & ! longname + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_cond = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'PERIOD', & ! block + 'COND', & ! tag name + 'COND', & ! fortran variable + 'DOUBLE1D', & ! type + 'NODES', & ! shape + 'boundary conductance', & ! longname + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghba_auxvar = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'PERIOD', & ! block + 'AUX', & ! tag name + 'AUXVAR', & ! fortran variable + 'DOUBLE2D', & ! type + 'NAUX NODES', & ! shape + 'recharge auxiliary variable iaux', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .true., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwf_ghba_param_definitions(*) = & + [ & + gwfghba_auxiliary, & + gwfghba_auxmultname, & + gwfghba_iprpak, & + gwfghba_iprflow, & + gwfghba_ipakcb, & + gwfghba_tas_filerecord, & + gwfghba_tas6, & + gwfghba_filein, & + gwfghba_tas6_filename, & + gwfghba_obs_filerecord, & + gwfghba_obs6, & + gwfghba_obs6_filename, & + gwfghba_mover, & + gwfghba_export_nc, & + gwfghba_bhead, & + gwfghba_cond, & + gwfghba_auxvar & + ] + + type(InputParamDefinitionType), parameter :: & + gwf_ghba_aggregate_definitions(*) = & + [ & + InputParamDefinitionType & + ( & + '', & ! component + '', & ! subcomponent + '', & ! block + '', & ! tag name + '', & ! fortran variable + '', & ! type + '', & ! shape + '', & ! longname + .false., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) & + ] + + type(InputBlockDefinitionType), parameter :: & + gwf_ghba_block_definitions(*) = & + [ & + InputBlockDefinitionType( & + 'OPTIONS', & ! blockname + .false., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & + 'PERIOD', & ! blockname + .true., & ! required + .false., & ! aggregate + .true. & ! block_variable + ) & + ] + +end module GwfGhbaInputModule diff --git a/src/Idm/selector/IdmGwfDfnSelector.f90 b/src/Idm/selector/IdmGwfDfnSelector.f90 index bf9998308c7..ac5a7de83a6 100644 --- a/src/Idm/selector/IdmGwfDfnSelector.f90 +++ b/src/Idm/selector/IdmGwfDfnSelector.f90 @@ -14,6 +14,7 @@ module IdmGwfDfnSelectorModule use GwfEvtInputModule use GwfEvtaInputModule use GwfGhbInputModule + use GwfGhbaInputModule use GwfIcInputModule use GwfNpfInputModule use GwfRchInputModule @@ -74,6 +75,8 @@ function gwf_param_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, gwf_evta_param_definitions) case ('GHB') call set_param_pointer(input_definition, gwf_ghb_param_definitions) + case ('GHBA') + call set_param_pointer(input_definition, gwf_ghba_param_definitions) case ('IC') call set_param_pointer(input_definition, gwf_ic_param_definitions) case ('NPF') @@ -116,6 +119,8 @@ function gwf_aggregate_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, gwf_evta_aggregate_definitions) case ('GHB') call set_param_pointer(input_definition, gwf_ghb_aggregate_definitions) + case ('GHBA') + call set_param_pointer(input_definition, gwf_ghba_aggregate_definitions) case ('IC') call set_param_pointer(input_definition, gwf_ic_aggregate_definitions) case ('NPF') @@ -158,6 +163,8 @@ function gwf_block_definitions(subcomponent) result(input_definition) call set_block_pointer(input_definition, gwf_evta_block_definitions) case ('GHB') call set_block_pointer(input_definition, gwf_ghb_block_definitions) + case ('GHBA') + call set_block_pointer(input_definition, gwf_ghba_block_definitions) case ('IC') call set_block_pointer(input_definition, gwf_ic_block_definitions) case ('NPF') @@ -199,6 +206,8 @@ function gwf_idm_multi_package(subcomponent) result(multi_package) multi_package = gwf_evta_multi_package case ('GHB') multi_package = gwf_ghb_multi_package + case ('GHBA') + multi_package = gwf_ghba_multi_package case ('IC') multi_package = gwf_ic_multi_package case ('NPF') @@ -243,6 +252,8 @@ function gwf_idm_subpackages(subcomponent) result(subpackages) call set_subpkg_pointer(subpackages, gwf_evta_subpackages) case ('GHB') call set_subpkg_pointer(subpackages, gwf_ghb_subpackages) + case ('GHBA') + call set_subpkg_pointer(subpackages, gwf_ghba_subpackages) case ('IC') call set_subpkg_pointer(subpackages, gwf_ic_subpackages) case ('NPF') @@ -285,6 +296,8 @@ function gwf_idm_integrated(subcomponent) result(integrated) integrated = .true. case ('GHB') integrated = .true. + case ('GHBA') + integrated = .true. case ('IC') integrated = .true. case ('NPF') diff --git a/src/Model/GroundWaterFlow/gwf-buy.f90 b/src/Model/GroundWaterFlow/gwf-buy.f90 index 2559dee5312..b9881183321 100644 --- a/src/Model/GroundWaterFlow/gwf-buy.f90 +++ b/src/Model/GroundWaterFlow/gwf-buy.f90 @@ -353,6 +353,12 @@ subroutine buy_cf_bnd(this, packobj, hnew) !, hcof, rhs, auxnam, auxvar) call buy_cf_ghb(packobj, hnew, this%dense, this%elev, this%denseref, & locelev, locdense, locconc, this%drhodc, this%crhoref, & this%ctemp, this%iform) + case ('GHBA') + ! + ! -- general head boundary + call buy_cf_ghba(packobj, hnew, this%dense, this%elev, this%denseref, & + locelev, locdense, locconc, this%drhodc, this%crhoref, & + this%ctemp, this%iform) case ('RIV') ! ! -- river @@ -491,6 +497,66 @@ subroutine buy_cf_ghb(packobj, hnew, dense, elev, denseref, locelev, & end select end subroutine buy_cf_ghb + !> @brief Fill ghb coefficients + !< + subroutine buy_cf_ghba(packobj, hnew, dense, elev, denseref, locelev, & + locdense, locconc, drhodc, crhoref, ctemp, & + iform) + ! -- modules + use BndModule, only: BndType + use GhbaModule, only: GhbaType + class(BndType), pointer :: packobj + ! -- dummy + real(DP), intent(in), dimension(:) :: hnew + real(DP), intent(in), dimension(:) :: dense + real(DP), intent(in), dimension(:) :: elev + real(DP), intent(in) :: denseref + integer(I4B), intent(in) :: locelev + integer(I4B), intent(in) :: locdense + integer(I4B), dimension(:), intent(in) :: locconc + real(DP), dimension(:), intent(in) :: drhodc + real(DP), dimension(:), intent(in) :: crhoref + real(DP), dimension(:), intent(inout) :: ctemp + integer(I4B), intent(in) :: iform + ! -- local + integer(I4B) :: n + integer(I4B) :: node, nodeuser + real(DP) :: denseghb + real(DP) :: elevghb + real(DP) :: hghb + real(DP) :: cond + real(DP) :: hcofterm, rhsterm + ! + ! -- Process density terms for each GHB + select type (packobj) + type is (GhbaType) + do n = 1, packobj%nbound + node = packobj%nodelist(n) + if (packobj%ibound(node) <= 0) cycle + ! + ! -- density + denseghb = get_bnd_density(n, locdense, locconc, denseref, & + drhodc, crhoref, ctemp, packobj%auxvar) + ! + ! -- elevation + elevghb = elev(node) + if (locelev > 0) elevghb = packobj%auxvar(locelev, n) + ! + ! -- boundary head and conductance + hghb = packobj%bound_value(1, n) + cond = packobj%bound_value(2, n) + ! + ! -- calculate HCOF and RHS terms + call calc_ghb_hcof_rhs_terms(denseref, denseghb, dense(node), & + elevghb, elev(node), hghb, hnew(node), & + cond, iform, rhsterm, hcofterm) + packobj%hcof(n) = packobj%hcof(n) + hcofterm + packobj%rhs(n) = packobj%rhs(n) - rhsterm + ! + end do + end select + end subroutine buy_cf_ghba + !> @brief Calculate density hcof and rhs terms for ghb conditions !< subroutine calc_ghb_hcof_rhs_terms(denseref, denseghb, densenode, & diff --git a/src/Model/GroundWaterFlow/gwf-evt.f90 b/src/Model/GroundWaterFlow/gwf-evt.f90 index 5565ac16ecd..9305a082d55 100644 --- a/src/Model/GroundWaterFlow/gwf-evt.f90 +++ b/src/Model/GroundWaterFlow/gwf-evt.f90 @@ -372,7 +372,7 @@ subroutine evt_rp(this) ! if (this%read_as_arrays) then ! - ! -- update nodelist based on IRCH input + ! -- update nodelist based on IEVT input call nodelist_update(this%nodelist, this%nbound, this%maxbound, & this%dis, this%input_mempath) ! diff --git a/src/Model/GroundWaterFlow/gwf-ghba.f90 b/src/Model/GroundWaterFlow/gwf-ghba.f90 new file mode 100644 index 00000000000..d875d027b42 --- /dev/null +++ b/src/Model/GroundWaterFlow/gwf-ghba.f90 @@ -0,0 +1,497 @@ +module ghbamodule + use KindModule, only: DP, I4B, LGP + use ConstantsModule, only: DZERO, DNODATA, LENFTYPE, LENPACKAGENAME + use SimVariablesModule, only: errmsg + use SimModule, only: count_errors, store_error, store_error_filename + use MemoryHelperModule, only: create_mem_path + use BndModule, only: BndType + use BndExtModule, only: BndExtType + use ObsModule, only: DefaultObsIdProcessor + use MatrixBaseModule + ! + implicit none + ! + private + public :: ghba_create + public :: GhbaType + ! + character(len=LENFTYPE) :: ftype = 'GHBA' + character(len=LENPACKAGENAME) :: text = ' GHBA' + ! + type, extends(BndExtType) :: GhbaType + real(DP), dimension(:), pointer, contiguous :: bhead => null() !< GHB boundary head + real(DP), dimension(:), pointer, contiguous :: cond => null() !< GHB hydraulic conductance + contains + procedure :: allocate_arrays => ghba_allocate_arrays + procedure :: source_options => ghba_options + procedure :: source_dimensions => ghba_dimensions + procedure :: log_ghba_options + procedure :: bnd_rp => ghba_rp + procedure :: bnd_ck => ghba_ck + procedure :: bnd_cf => ghba_cf + procedure :: bnd_fc => ghba_fc + procedure :: bnd_da => ghba_da + procedure :: define_listlabel + procedure :: bound_value => ghba_bound_value + procedure :: cond_mult + ! -- methods for observations + procedure, public :: bnd_obs_supported => ghba_obs_supported + procedure, public :: bnd_df_obs => ghba_df_obs + procedure, public :: ghba_store_user_cond + end type GhbaType + +contains + + !> @brief Create a New Ghb Package and point bndobj to the new package + !< + subroutine ghba_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & + mempath) + ! -- dummy + class(BndType), pointer :: packobj + integer(I4B), intent(in) :: id + integer(I4B), intent(in) :: ibcnum + integer(I4B), intent(in) :: inunit + integer(I4B), intent(in) :: iout + character(len=*), intent(in) :: namemodel + character(len=*), intent(in) :: pakname + character(len=*), intent(in) :: mempath + ! -- local + type(GhbaType), pointer :: ghbobj + ! + ! -- allocate the object and assign values to object variables + allocate (ghbobj) + packobj => ghbobj + ! + ! -- create name and memory path + call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) + packobj%text = text + ! + ! -- allocate scalars + call packobj%allocate_scalars() + ! + ! -- initialize package + call packobj%pack_initialize() + ! + packobj%inunit = inunit + packobj%iout = iout + packobj%id = id + packobj%ibcnum = ibcnum + packobj%ictMemPath = create_mem_path(namemodel, 'NPF') + end subroutine ghba_create + + !> @brief Deallocate memory + !< + subroutine ghba_da(this) + ! -- modules + use MemoryManagerModule, only: mem_deallocate + ! -- dummy + class(GhbaType) :: this + ! + ! -- Deallocate parent package + call this%BndExtType%bnd_da() + ! + ! -- arrays + call mem_deallocate(this%bhead, 'BHEAD', this%memoryPath) + call mem_deallocate(this%cond, 'COND', this%memoryPath) + end subroutine ghba_da + + !> @brief Set options specific to GhbaType + !< + subroutine ghba_options(this) + ! -- modules + use MemoryManagerExtModule, only: mem_set_value + use CharacterStringModule, only: CharacterStringType + use GwfGhbInputModule, only: GwfGhbParamFoundType + ! -- dummy + class(GhbaType), intent(inout) :: this + ! -- local + type(GwfGhbParamFoundType) :: found + ! + ! -- source base class options + call this%BndExtType%source_options() + ! + ! -- source options from input context + call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover) + ! + ! -- log ghb specific options + call this%log_ghba_options(found) + end subroutine ghba_options + + !> @brief Log options specific to GhbaType + !< + subroutine log_ghba_options(this, found) + ! -- modules + use GwfGhbInputModule, only: GwfGhbParamFoundType + ! -- dummy + class(GhbaType), intent(inout) :: this !< BndExtType object + type(GwfGhbParamFoundType), intent(in) :: found + ! + ! -- log found options + write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & + //' OPTIONS' + ! + if (found%mover) then + write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' + end if + ! + ! -- close logging block + write (this%iout, '(1x,a)') & + 'END OF '//trim(adjustl(this%text))//' OPTIONS' + end subroutine log_ghba_options + + !> @brief Set dimensions specific to GhbaType + !< + subroutine ghba_dimensions(this) + ! -- modules + ! -- dummy + class(GhbaType), intent(inout) :: this + ! -- local + ! + this%maxbound = this%dis%nodes + ! + ! -- Call define_listlabel to construct the list label that is written + ! when PRINT_INPUT option is used. + call this%define_listlabel() + end subroutine ghba_dimensions + + !> @brief Allocate arrays + !< + subroutine ghba_allocate_arrays(this, nodelist, auxvar) + ! -- modules + use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin + ! -- dummy + class(GhbaType) :: this + integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist + real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar + integer(I4B) :: n + ! + ! -- call base type allocate arrays + call this%BndType%allocate_arrays(nodelist, auxvar) + ! + ! -- set ghb input context pointers + call mem_setptr(this%bhead, 'BHEAD', this%input_mempath) + call mem_setptr(this%cond, 'COND', this%input_mempath) + ! + ! --checkin ghb input context pointers + call mem_checkin(this%bhead, 'BHEAD', this%memoryPath, & + 'BHEAD', this%input_mempath) + call mem_checkin(this%cond, 'COND', this%memoryPath, & + 'COND', this%input_mempath) + ! + ! -- checkin auxvar input context pointer + call mem_checkin(this%auxvar, 'AUXVAR_IDM', this%memoryPath, & + 'AUXVAR', this%input_mempath) + end subroutine ghba_allocate_arrays + + !> @brief Read and prepare + !< + subroutine ghba_rp(this) + ! -- modules + use TdisModule, only: kper + use ConstantsModule, only: LINELENGTH + use MemoryManagerModule, only: mem_setptr + ! -- dummy + class(GhbaType), intent(inout) :: this + real(DP), dimension(:, :), pointer, contiguous :: auxvar + integer(I4B) :: i, j, noder, nodeuser + character(len=LINELENGTH) :: nodestr + logical(LGP) :: found + ! + if (this%iper /= kper) return + ! + ! -- set auxvar input context pointer + call mem_setptr(auxvar, 'AUXVAR', this%input_mempath) + ! + ! -- Update the nodelist + this%nbound = 0 + do i = 1, this%dis%nodesuser + if (this%bhead(i) == DNODATA) then + ! no-op + else + noder = this%dis%get_nodenumber(i, 1) + if (noder > 0) then + this%nbound = this%nbound + 1 + this%nodelist(this%nbound) = noder + do j = 1, this%naux + this%auxvar(j, this%nbound) = auxvar(j, i) + end do + else + nodeuser = this%dis%get_nodeuser(noder) + call this%dis%nodeu_to_string(nodeuser, nodestr) + write (errmsg, *) & + ' Cell is outside active grid domain: '// & + trim(adjustl(nodestr)) + call store_error(errmsg) + end if + end if + end do + ! + ! -- exit if errors were found + if (count_errors() > 0) then + write (errmsg, *) count_errors(), ' errors encountered.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + ! + ! -- store user cond + if (this%ivsc == 1) then + call this%ghba_store_user_cond() + end if + ! + ! -- Write the list to iout if requested + if (this%iprpak /= 0) then + call this%write_list() + end if + end subroutine ghba_rp + + !> @brief Check ghb boundary condition data + !< + subroutine ghba_ck(this) + ! -- modules + use ConstantsModule, only: LINELENGTH + use SimModule, only: store_error, count_errors, store_error_unit + ! -- dummy + class(GhbaType), intent(inout) :: this + ! -- local + character(len=LINELENGTH) :: errmsg + integer(I4B) :: i + integer(I4B) :: node, noder, nodeuser + character(len=LINELENGTH) :: nodestr + real(DP) :: bt + ! -- formats + character(len=*), parameter :: fmtghberr = & + "('GHB BOUNDARY (',i0,') HEAD (',f10.3,') IS LESS THAN CELL & + &BOTTOM (',f10.3,')')" + character(len=*), parameter :: fmtcondmulterr = & + "('GHB BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS & + &LESS THAN ZERO')" + character(len=*), parameter :: fmtconderr = & + "('GHB BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN & + &ZERO')" + ! + ! -- Check cond data + do i = 1, this%dis%nodes + if (this%nodelist(i) == 0) then + ! verify cond consistent + else + ! verify cond consistent + end if + end do + ! + ! -- check stress period data + do i = 1, this%nbound + node = this%nodelist(i) + nodeuser = this%dis%get_nodeuser(node) + bt = this%dis%bot(node) + ! -- accumulate errors + if (this%bhead(nodeuser) < bt .and. this%icelltype(node) /= 0) then + write (errmsg, fmt=fmtghberr) nodeuser, this%bhead(nodeuser), bt + call store_error(errmsg) + end if + if (this%iauxmultcol > 0) then + if (this%auxvar(this%iauxmultcol, i) < DZERO) then + write (errmsg, fmt=fmtcondmulterr) & + i, this%auxvar(this%iauxmultcol, i) + call store_error(errmsg) + end if + end if + if (this%cond(nodeuser) < DZERO) then + write (errmsg, fmt=fmtconderr) nodeuser, this%cond(nodeuser) + call store_error(errmsg) + end if + end do + ! + !write summary of ghb package error messages + if (count_errors() > 0) then + call store_error_unit(this%inunit) + end if + end subroutine ghba_ck + + !> @brief Formulate the HCOF and RHS terms + !! + !! Skip if no GHBs + !< + subroutine ghba_cf(this) + ! -- dummy + class(GhbaType) :: this + ! -- local + integer(I4B) :: i, node, noder, nodeuser + ! + do i = 1, this%nbound + node = this%nodelist(i) + if (this%ibound(node) .le. 0) then + this%hcof(i) = DZERO + this%rhs(i) = DZERO + cycle + end if + ! TODO or use bound_value? + nodeuser = this%dis%get_nodeuser(node) + this%hcof(i) = -this%cond_mult(i) + this%rhs(i) = -this%cond_mult(i) * this%bhead(nodeuser) + end do + end subroutine ghba_cf + + !> @brief Copy rhs and hcof into solution rhs and amat + !< + subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) + ! -- dummy + class(GhbaType) :: this + real(DP), dimension(:), intent(inout) :: rhs + integer(I4B), dimension(:), intent(in) :: ia + integer(I4B), dimension(:), intent(in) :: idxglo + class(MatrixBaseType), pointer :: matrix_sln + ! -- local + integer(I4B) :: i, n, noder, nodeuser, ipos + real(DP) :: cond, bhead, qghb + ! + ! -- pakmvrobj fc + if (this%imover == 1) then + call this%pakmvrobj%fc() + end if + + do i = 1, this%nbound + n = this%nodelist(i) + nodeuser = this%dis%get_nodeuser(n) + rhs(n) = rhs(n) + this%rhs(i) + ipos = ia(n) + call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) + ! + ! -- If mover is active and this boundary is discharging, + ! store available water (as positive value). + ! TODO or use bound_value? + bhead = this%bhead(nodeuser) + if (this%imover == 1 .and. this%xnew(n) > bhead) then + cond = this%cond_mult(i) + qghb = cond * (this%xnew(n) - bhead) + call this%pakmvrobj%accumulate_qformvr(i, qghb) + end if + end do + end subroutine ghba_fc + + !> @brief Define the list heading that is written to iout when PRINT_INPUT + !! option is used + !< + subroutine define_listlabel(this) + ! -- dummy + class(GhbaType), intent(inout) :: this + ! + ! -- create the header list label + this%listlabel = trim(this%filtyp)//' NO.' + if (this%dis%ndim == 3) then + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER' + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'ROW' + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'COL' + elseif (this%dis%ndim == 2) then + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER' + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'CELL2D' + else + write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE' + end if + write (this%listlabel, '(a, a16)') trim(this%listlabel), 'STAGE' + write (this%listlabel, '(a, a16)') trim(this%listlabel), 'CONDUCTANCE' + if (this%inamedbound == 1) then + write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' + end if + end subroutine define_listlabel + + ! -- Procedures related to observations + + !> @brief Return true because GHB package supports observations + !! + !! Overrides BndType%bnd_obs_supported() + !< + logical function ghba_obs_supported(this) + implicit none + ! -- dummy + class(GhbaType) :: this + ! + ghba_obs_supported = .true. + end function ghba_obs_supported + + !> @brief Store observation type supported by GHB package + !! + !! Overrides BndType%bnd_df_obs + !< + subroutine ghba_df_obs(this) + implicit none + ! -- dummy + class(GhbaType) :: this + ! -- local + integer(I4B) :: indx + ! + call this%obs%StoreObsType('ghb', .true., indx) + this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor + ! + ! -- Store obs type and assign procedure pointer + ! for to-mvr observation type. + call this%obs%StoreObsType('to-mvr', .true., indx) + this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor + end subroutine ghba_df_obs + + !> @brief Store user-specified conductance for GHB boundary type + !< + subroutine ghba_store_user_cond(this) + ! -- modules + ! -- dummy + class(GhbaType), intent(inout) :: this !< BndExtType object + ! -- local + integer(I4B) :: n + ! + ! -- store backup copy of conductance values + do n = 1, this%nbound + this%condinput(n) = this%cond_mult(n) + end do + end subroutine ghba_store_user_cond + + !> @brief Apply multiplier to GHB conductance if option AUXMULTCOL is used + !< + function cond_mult(this, row) result(cond) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy variables + class(GhbaType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: cond + ! -- local + integer(I4B) :: noder, nodeuser + ! + noder = this%nodelist(row) + nodeuser = this%dis%get_nodeuser(noder) + if (this%iauxmultcol > 0) then + cond = this%cond(nodeuser) * this%auxvar(this%iauxmultcol, row) + else + cond = this%cond(nodeuser) + end if + end function cond_mult + + !> @brief Return requested boundary value + !< + function ghba_bound_value(this, col, row) result(bndval) + ! -- modules + use ConstantsModule, only: DZERO + ! -- dummy + class(GhbaType), intent(inout) :: this !< BndExtType object + integer(I4B), intent(in) :: col + integer(I4B), intent(in) :: row + ! -- result + real(DP) :: bndval + ! -- local + integer(I4B) :: noder, nodeuser + ! + select case (col) + case (1) + noder = this%nodelist(row) + nodeuser = this%dis%get_nodeuser(noder) + bndval = this%bhead(nodeuser) + case (2) + bndval = this%cond_mult(row) + case default + errmsg = 'Programming error. GHB bound value requested column '& + &'outside range of ncolbnd (2).' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end select + end function ghba_bound_value + +end module ghbamodule diff --git a/src/Model/GroundWaterFlow/gwf-vsc.f90 b/src/Model/GroundWaterFlow/gwf-vsc.f90 index c29a8651137..666fa55a599 100644 --- a/src/Model/GroundWaterFlow/gwf-vsc.f90 +++ b/src/Model/GroundWaterFlow/gwf-vsc.f90 @@ -234,6 +234,7 @@ subroutine vsc_ar_bnd(this, packobj) use BndModule, only: BndType use DrnModule, only: DrnType use GhbModule, only: GhbType + use GhbaModule, only: GhbaType use RivModule, only: RivType use LakModule, only: LakType use SfrModule, only: SfrType @@ -253,14 +254,21 @@ subroutine vsc_ar_bnd(this, packobj) end select case ('GHB') ! - ! -- activate viscosity for the drain package + ! -- activate viscosity for the general head boundary package select type (packobj) type is (GhbType) call packobj%bnd_activate_viscosity() end select + case ('GHBA') + ! + ! -- activate viscosity for the general head boundary array package + select type (packobj) + type is (GhbaType) + call packobj%bnd_activate_viscosity() + end select case ('RIV') ! - ! -- activate viscosity for the drain package + ! -- activate viscosity for the river package select type (packobj) type is (RivType) call packobj%bnd_activate_viscosity() @@ -413,7 +421,7 @@ subroutine vsc_ad_bnd(this, packobj, hnew) ! ! -- apply viscosity terms to inflow from boundary based on package type select case (packobj%filtyp) - case ('GHB', 'DRN', 'RIV') + case ('GHB', 'GHBA', 'DRN', 'RIV') ! ! -- general head, drain, and river boundary call vsc_ad_standard_bnd(packobj, hnew, this%visc, this%viscref, & @@ -467,6 +475,7 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & use DrnModule, only: DrnType use RivModule, only: RivType use GhbModule, only: GhbType + use GhbaModule, only: GhbaType class(BndType), pointer :: packobj ! -- dummy real(DP), intent(in), dimension(:) :: hnew @@ -482,7 +491,7 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & real(DP), dimension(:), intent(inout) :: ctemp ! -- local integer(I4B) :: n - integer(I4B) :: node + integer(I4B) :: node, nodeuser real(DP) :: viscbnd ! ! -- Process density terms for each GHB @@ -511,6 +520,13 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & packobj%cond(n) = update_bnd_cond(viscbnd, viscref, & packobj%condinput(n)) end select + case ('GHBA') + select type (packobj) + type is (GhbaType) + nodeuser = packobj%dis%get_nodeuser(node) + packobj%cond(nodeuser) = update_bnd_cond(viscbnd, viscref, & + packobj%condinput(n)) + end select case ('RIV') select type (packobj) type is (RivType) diff --git a/src/Model/GroundWaterFlow/gwf.f90 b/src/Model/GroundWaterFlow/gwf.f90 index 2468e18f81d..6dafcdd1d17 100644 --- a/src/Model/GroundWaterFlow/gwf.f90 +++ b/src/Model/GroundWaterFlow/gwf.f90 @@ -118,7 +118,7 @@ module GwfModule !< integer(I4B), parameter :: GWF_NMULTIPKG = 50 character(len=LENPACKAGETYPE), dimension(GWF_NMULTIPKG) :: GWF_MULTIPKG - data GWF_MULTIPKG/'WEL6 ', 'DRN6 ', 'RIV6 ', 'GHB6 ', ' ', & ! 5 + data GWF_MULTIPKG/'WEL6 ', 'DRN6 ', 'RIV6 ', 'GHB6 ', 'GHBA6', & ! 5 &'RCH6 ', 'EVT6 ', 'CHD6 ', 'CSUB6', ' ', & ! 10 &'MAW6 ', 'SFR6 ', 'LAK6 ', 'UZF6 ', 'API6 ', & ! 15 &35*' '/ ! 50 @@ -1219,6 +1219,7 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, & use DrnModule, only: drn_create use RivModule, only: riv_create use GhbModule, only: ghb_create + use GhbaModule, only: ghba_create use RchModule, only: rch_create use EvtModule, only: evt_create use MawModule, only: maw_create @@ -1257,6 +1258,9 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, & case ('GHB6') call ghb_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & pakname, mempath) + case ('GHBA6') + call ghba_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & + pakname, mempath) case ('RCH6') call rch_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & pakname, mempath) @@ -1494,9 +1498,9 @@ subroutine create_packages(this) this%inoc = inunit case ('OBS6') this%inobs = inunit - case ('WEL6', 'DRN6', 'RIV6', 'GHB6', 'RCH6', & - 'EVT6', 'API6', 'CHD6', 'MAW6', 'SFR6', & - 'LAK6', 'UZF6') + case ('WEL6', 'DRN6', 'RIV6', 'GHB6', 'GHBA6', & + 'RCH6', 'EVT6', 'API6', 'CHD6', 'MAW6', & + 'SFR6', 'LAK6', 'UZF6') call expandarray(bndpkgs) bndpkgs(size(bndpkgs)) = n case default diff --git a/src/Utilities/Idm/BoundInputContext.f90 b/src/Utilities/Idm/BoundInputContext.f90 index c30ed6a9e98..e6282c50e84 100644 --- a/src/Utilities/Idm/BoundInputContext.f90 +++ b/src/Utilities/Idm/BoundInputContext.f90 @@ -43,6 +43,7 @@ module BoundInputContextModule 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 + integer(I4B) :: nodes type(CharacterStringType), dimension(:), pointer, & contiguous :: auxname_cst => null() !< array of auxiliary names type(CharacterStringType), dimension(:), pointer, & @@ -126,6 +127,9 @@ subroutine allocate_scalars(this) this%ncpl = this%mshape(2) * this%mshape(3) end if + ! set total user nodes + this%nodes = product(this%mshape) + ! initialize package params object call this%package_params%init(this%mf6_input, 'PERIOD', this%readasarrays, & this%naux, this%inamedbound) @@ -237,7 +241,7 @@ subroutine array_params_create(this, params, nparam, input_name) integer(I4B), intent(in) :: nparam character(len=*), intent(in) :: input_name type(InputParamDefinitionType), pointer :: idt - integer(I4B) :: iparam + integer(I4B) :: iparam, asize ! allocate dfn input params do iparam = 1, nparam @@ -247,24 +251,32 @@ subroutine array_params_create(this, params, nparam, input_name) this%mf6_input%component_type, & this%mf6_input%subcomponent_type, & 'PERIOD', params(iparam), '') - if (idt%blockname == 'PERIOD') then - select case (idt%datatype) - case ('INTEGER1D') - call allocate_param_int1d(this%ncpl, idt%mf6varname, & - this%mf6_input%mempath) - case ('DOUBLE1D') - call allocate_param_dbl1d(this%ncpl, idt%mf6varname, & - this%mf6_input%mempath) - case ('DOUBLE2D') - call allocate_param_dbl2d(this%naux, this%ncpl, idt%mf6varname, & - this%mf6_input%mempath) - case default - errmsg = 'IDM unimplemented. BoundInputContext::array_params_create & - &datatype='//trim(idt%datatype) - call store_error(errmsg) - call store_error_filename(input_name) - end select - end if + + select case (idt%shape) + case ('NCPL', 'NAUX NCPL') + asize = this%ncpl + case ('NODES', 'NAUX NODES') + asize = this%nodes + case default + asize = 0 + end select + + select case (idt%datatype) + case ('INTEGER1D') + call allocate_param_int1d(asize, idt%mf6varname, & + this%mf6_input%mempath) + case ('DOUBLE1D') + call allocate_param_dbl1d(asize, idt%mf6varname, & + this%mf6_input%mempath) + case ('DOUBLE2D') + call allocate_param_dbl2d(this%naux, asize, idt%mf6varname, & + this%mf6_input%mempath) + case default + errmsg = 'IDM unimplemented. BoundInputContext::array_params_create & + &datatype='//trim(idt%datatype) + call store_error(errmsg) + call store_error_filename(input_name) + end select end do end subroutine array_params_create diff --git a/src/Utilities/Idm/InputLoadType.f90 b/src/Utilities/Idm/InputLoadType.f90 index 204f7791eba..98f421ee7b6 100644 --- a/src/Utilities/Idm/InputLoadType.f90 +++ b/src/Utilities/Idm/InputLoadType.f90 @@ -82,7 +82,8 @@ module InputLoadTypeModule character(len=LINELENGTH) :: component_input_name !< component input name, e.g. model name file character(len=LINELENGTH) :: input_name !< input name, e.g. package *.chd file character(len=LINELENGTH), dimension(:), allocatable :: param_names !< dynamic param tagnames - logical(LGP) :: readasarrays !< is this array based input + logical(LGP) :: readarray_layer + logical(LGP) :: readarray_grid integer(I4B) :: iperblock !< index of period block on block definition list integer(I4B) :: iout !< inunit number for logging integer(I4B) :: nparam !< number of in scope params @@ -349,11 +350,14 @@ subroutine dynamic_init(this, mf6_input, component_name, component_input_name, & integer(I4B), intent(in) :: iperblock integer(I4B), intent(in) :: iout type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iparam this%mf6_input = mf6_input this%component_name = component_name this%component_input_name = component_input_name this%input_name = input_name + this%readarray_layer = .false. + this%readarray_grid = .false. this%iperblock = iperblock this%nparam = 0 this%iout = iout @@ -369,8 +373,21 @@ subroutine dynamic_init(this, mf6_input, component_name, component_input_name, & call store_error_filename(this%input_name) end if - ! set readasarrays - this%readasarrays = (.not. mf6_input%block_dfns(iperblock)%aggregate) + ! set readarray_layer and readarray_grid + if (mf6_input%block_dfns(iperblock)%aggregate) then + ! no-op, list based input + else + do iparam = 1, size(mf6_input%param_dfns) + idt => mf6_input%param_dfns(iparam) + if (idt%blockname == 'OPTIONS') then + if (idt%tagname == 'READASARRAYS') then + this%readarray_layer = .true. + exit + end if + end if + end do + if (.not. this%readarray_layer) this%readarray_grid = .true. + end if end subroutine dynamic_init !> @brief dynamic package loader define diff --git a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 index 360fcd47701..9341329cf80 100644 --- a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 @@ -150,7 +150,6 @@ subroutine dynamic_init(this, mf6_input, component_name, component_input_name, & input_name, iperblock, iout) use MemoryManagerModule, only: mem_allocate use InputDefinitionModule, only: InputParamDefinitionType - use DefinitionSelectModule, only: get_param_definition_type class(Mf6FileDynamicPkgLoadType), intent(inout) :: this type(ModflowInputType), intent(in) :: mf6_input character(len=*), intent(in) :: component_name @@ -268,24 +267,29 @@ end subroutine dynamic_read_ionper !> @brief allocate a dynamic loader based on load context !< subroutine dynamic_create_loader(this) - use Mf6FileGridInputModule, only: BoundGridInputType - use Mf6FileListInputModule, only: BoundListInputType + use LayerArrayLoadModule, only: LayerArrayLoadType + use GridArrayLoadModule, only: GridArrayLoadType + use ListLoadModule, only: ListLoadType use Mf6FileStoInputModule, only: StoInputType class(Mf6FileDynamicPkgLoadType), intent(inout) :: this - class(BoundListInputType), pointer :: bndlist_loader - class(BoundGridInputType), pointer :: bndgrid_loader + class(ListLoadType), pointer :: list_loader + class(GridArrayLoadType), pointer :: arrgrid_loader + class(LayerArrayLoadType), pointer :: arrlayer_loader class(StoInputType), pointer :: sto_loader ! allocate and set loader if (this%mf6_input%subcomponent_type == 'STO') then allocate (sto_loader) this%rp_loader => sto_loader - else if (this%readasarrays) then - allocate (bndgrid_loader) - this%rp_loader => bndgrid_loader + else if (this%readarray_layer) then + allocate (arrlayer_loader) + this%rp_loader => arrlayer_loader + else if (this%readarray_grid) then + allocate (arrgrid_loader) + this%rp_loader => arrgrid_loader else - allocate (bndlist_loader) - this%rp_loader => bndlist_loader + allocate (list_loader) + this%rp_loader => list_loader end if ! set nc_vars pointer diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 new file mode 100644 index 00000000000..da4f01467c8 --- /dev/null +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 @@ -0,0 +1,299 @@ +!> @brief This module contains the GridArrayLoadModule +!! +!! This module contains the routines for reading period block +!! array based input associated with the full grid, such as +!! with the GHBA package. +!! +!< +module GridArrayLoadModule + + use KindModule, only: I4B, DP, LGP + use ConstantsModule, only: DZERO, IZERO, LINELENGTH, 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, ReadStateVarType + use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType + + implicit none + private + public :: GridArrayLoadType + + !> @brief Ascii grid based dynamic loader type + !< + type, extends(AsciiDynamicPkgLoadBaseType) :: GridArrayLoadType + type(ReadStateVarType), dimension(:), allocatable :: param_reads !< read states for current load + type(BoundInputContextType) :: bound_context + contains + procedure :: ainit + procedure :: df + procedure :: ad + procedure :: rp + procedure :: destroy + procedure :: reset + procedure :: params_alloc + procedure :: param_load + end type GridArrayLoadType + +contains + + subroutine ainit(this, mf6_input, component_name, & + component_input_name, input_name, & + iperblock, parser, iout) + use MemoryManagerModule, only: get_isize + use BlockParserModule, only: BlockParserType + use LoadMf6FileModule, only: LoadMf6FileType + class(GridArrayLoadType), intent(inout) :: this + type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: component_name + character(len=*), intent(in) :: component_input_name + character(len=*), intent(in) :: input_name + integer(I4B), intent(in) :: iperblock + type(BlockParserType), pointer, intent(inout) :: parser + integer(I4B), intent(in) :: iout + type(LoadMf6FileType) :: loader + integer(I4B) :: n + + ! initialize base type + call this%DynamicPkgLoadType%init(mf6_input, component_name, & + component_input_name, & + input_name, iperblock, iout) + ! initialize + this%iout = iout + + ! load static input + call loader%load(parser, mf6_input, this%nc_vars, this%input_name, iout) + + ! initialize input context memory + call this%bound_context%create(mf6_input, this%readarray_grid) + + ! allocate dfn params + call this%params_alloc() + end subroutine ainit + + subroutine df(this) + class(GridArrayLoadType), intent(inout) :: this + end subroutine df + + subroutine ad(this) + class(GridArrayLoadType), intent(inout) :: this + end subroutine ad + + subroutine rp(this, parser) + 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 + use IdmLoggerModule, only: idm_log_header, idm_log_close, idm_log_var + class(GridArrayLoadType), intent(inout) :: this + type(BlockParserType), pointer, intent(inout) :: parser + logical(LGP) :: endOfBlock, netcdf, layered + character(len=LINELENGTH) :: keyword, param_tag + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iaux, iparam + integer(I4B), dimension(:), pointer, contiguous :: int1d + + ! reset for this period + call this%reset() + + ! log lst file header + call idm_log_header(this%mf6_input%component_name, & + this%mf6_input%subcomponent_name, this%iout) + + ! read array block + do + ! initialize + iaux = 0 + netcdf = .false. + layered = .false. + + ! 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%bound_context%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%input_name) + ! look for Layered and NetCDF keywords + call parser%GetStringCaps(keyword) + if (keyword == 'LAYERED' .and. idt%layered) then + layered = .true. + else if (keyword == 'NETCDF') then + netcdf = .true. + end if + + ! read and load the parameter + call this%param_load(parser, idt, this%mf6_input%mempath, layered, & + netcdf, iaux) + end do + + ! log lst file header + call idm_log_close(this%mf6_input%component_name, & + this%mf6_input%subcomponent_name, this%iout) + end subroutine rp + + subroutine destroy(this) + class(GridArrayLoadType), intent(inout) :: this + end subroutine destroy + + subroutine reset(this) + class(GridArrayLoadType), intent(inout) :: this + integer(I4B) :: n, m + + do n = 1, this%nparam + ! reset read state + this%param_reads(n)%invar = 0 + end do + + ! explicitly reset auxvar array each period + do m = 1, this%bound_context%nodes + do n = 1, this%bound_context%naux + this%bound_context%auxvar(n, m) = DZERO + end do + end do + end subroutine reset + + subroutine params_alloc(this) + class(GridArrayLoadType), intent(inout) :: this + character(len=LENVARNAME) :: rs_varname + integer(I4B), pointer :: intvar + integer(I4B) :: iparam + + ! set in scope param names + call this%bound_context%bound_params(this%param_names, this%nparam, & + this%input_name) + call this%bound_context%allocate_arrays() + + ! allocate and set param_reads pointer array + allocate (this%param_reads(this%nparam)) + + ! store read state variable pointers + do iparam = 1, this%nparam + ! allocate and store name of read state variable + rs_varname = this%bound_context%rsv_alloc(this%param_names(iparam)) + call mem_setptr(intvar, rs_varname, this%mf6_input%mempath) + this%param_reads(iparam)%invar => intvar + this%param_reads(iparam)%invar = 0 + end do + end subroutine params_alloc + + subroutine param_load(this, parser, idt, mempath, layered, netcdf, iaux) + use TdisModule, only: kper + use ConstantsModule, only: DNODATA + 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 LayeredArrayReaderModule, only: read_dbl1d_layered, & + read_int1d_layered + use LoadNCInputModule, only: netcdf_read_array + use SourceCommonModule, only: get_shape_from_string, get_layered_shape + use IdmLoggerModule, only: idm_log_var + class(GridArrayLoadType), intent(inout) :: this + type(BlockParserType), intent(in) :: parser + type(InputParamDefinitionType), intent(in) :: idt + character(len=*), intent(in) :: mempath + logical(LGP), intent(in) :: layered + logical(LGP), intent(in) :: netcdf + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + integer(I4B), dimension(:), allocatable :: layer_shape + integer(I4B) :: iaux, iparam, n, nlay + + select case (idt%datatype) + case ('INTEGER1D') + call mem_setptr(int1d, idt%mf6varname, mempath) + if (netcdf) then + call netcdf_read_array(int1d, this%bound_context%mshape, idt, & + this%mf6_input, this%nc_vars, this%input_name, & + this%iout, kper) + else if (layered) then + call get_layered_shape(this%bound_context%mshape, nlay, layer_shape) + call read_int1d_layered(parser, int1d, idt%mf6varname, nlay, layer_shape) + else + call read_int1d(parser, int1d, idt%mf6varname) + end if + call idm_log_var(int1d, idt%tagname, mempath, this%iout) + case ('DOUBLE1D') + ! set pointer to managed memory input variable + call mem_setptr(dbl1d, idt%mf6varname, mempath) + + ! read user input + if (netcdf) then + call netcdf_read_array(dbl1d, this%bound_context%mshape, idt, & + this%mf6_input, this%nc_vars, this%input_name, & + this%iout, kper) + else if (layered) then + call get_layered_shape(this%bound_context%mshape, nlay, layer_shape) + call read_dbl1d_layered(parser, dbl1d, idt%mf6varname, nlay, layer_shape) + else + call read_dbl1d(parser, dbl1d, idt%mf6varname) + end if + + ! log user input + call idm_log_var(dbl1d, idt%tagname, mempath, this%iout) + case ('DOUBLE2D') + ! set pointer to managed memory input variable + call mem_setptr(dbl2d, idt%mf6varname, mempath) + + ! allocate local array + allocate (dbl1d(this%bound_context%nodes)) + + ! read user input + if (netcdf) then + call netcdf_read_array(dbl1d, this%bound_context%mshape, idt, & + this%mf6_input, this%nc_vars, this%input_name, & + this%iout, kper, iaux) + else if (layered) then + call get_layered_shape(this%bound_context%mshape, nlay, layer_shape) + call read_dbl1d_layered(parser, dbl1d, idt%mf6varname, nlay, layer_shape) + else + call read_dbl1d(parser, dbl1d, idt%mf6varname) + end if + + ! copy into 2d array + do n = 1, this%bound_context%nodes + dbl2d(iaux, n) = dbl1d(n) + end do + + ! log user input + call idm_log_var(dbl1d, idt%tagname, mempath, this%iout) + + ! cleanup + deallocate (dbl1d) + case default + errmsg = 'IDM unimplemented. GridArrayLoad::param_load & + &datatype='//trim(idt%datatype) + call store_error(errmsg) + call store_error_filename(this%input_name) + end select + + ! if param is tracked set read state + iparam = ifind(this%param_names, idt%tagname) + if (iparam > 0) then + this%param_reads(iparam)%invar = 1 + end if + end subroutine param_load + +end module GridArrayLoadModule diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileGridInput.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 similarity index 85% rename from src/Utilities/Idm/mf6blockfile/Mf6FileGridInput.f90 rename to src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 index 5ceb05cf97b..864bc69fa41 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileGridInput.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 @@ -1,10 +1,11 @@ -!> @brief This module contains the Mf6FileGridInputModule +!> @brief This module contains the LayerArrayLoadModule !! !! This module contains the routines for reading period block -!! array based input. +!! array based input that is associated with a layer and an +!! layer index array, such as with the EVTA and RCHA packages. !! !< -module Mf6FileGridInputModule +module LayerArrayLoadModule use KindModule, only: I4B, DP, LGP use ConstantsModule, only: DZERO, IZERO, LINELENGTH, LENVARNAME, & @@ -23,11 +24,11 @@ module Mf6FileGridInputModule implicit none private - public :: BoundGridInputType + public :: LayerArrayLoadType - !> @brief Ascii grid based dynamic loader type + !> @brief Ascii array layer dynamic loader type !< - type, extends(AsciiDynamicPkgLoadBaseType) :: BoundGridInputType + type, extends(AsciiDynamicPkgLoadBaseType) :: LayerArrayLoadType integer(I4B) :: tas_active !< Are TAS6 inputs defined type(CharacterStringType), dimension(:), contiguous, & pointer :: aux_tasnames !< array of AUXVAR TAS names @@ -37,28 +38,28 @@ module Mf6FileGridInputModule type(TimeArraySeriesManagerType), pointer :: tasmanager !< TAS manager type(BoundInputContextType) :: bound_context contains - procedure :: ainit => bndgrid_init - procedure :: df => bndgrid_df - procedure :: ad => bndgrid_ad - procedure :: rp => bndgrid_rp - procedure :: destroy => bndgrid_destroy - procedure :: reset => bndgrid_reset + procedure :: ainit + procedure :: df + procedure :: ad + procedure :: rp + procedure :: destroy + procedure :: reset procedure :: init_charstr1d - procedure :: params_alloc => bndgrid_params_alloc - procedure :: param_load => bndgrid_param_load - procedure :: tas_arrays_alloc => bndgrid_tas_arrays_alloc - procedure :: tas_links_create => bndgrid_tas_links_create - end type BoundGridInputType + procedure :: params_alloc + procedure :: param_load + procedure :: tas_arrays_alloc + procedure :: tas_links_create + end type LayerArrayLoadType contains - subroutine bndgrid_init(this, mf6_input, component_name, & - component_input_name, input_name, & - iperblock, parser, iout) + subroutine ainit(this, mf6_input, component_name, & + component_input_name, input_name, & + iperblock, parser, iout) use MemoryManagerModule, only: get_isize use BlockParserModule, only: BlockParserType use LoadMf6FileModule, only: LoadMf6FileType - class(BoundGridInputType), intent(inout) :: this + class(LayerArrayLoadType), intent(inout) :: this type(ModflowInputType), intent(in) :: mf6_input character(len=*), intent(in) :: component_name character(len=*), intent(in) :: component_input_name @@ -103,26 +104,26 @@ subroutine bndgrid_init(this, mf6_input, component_name, & end if ! initialize input context memory - call this%bound_context%create(mf6_input, this%readasarrays) + call this%bound_context%create(mf6_input, this%readarray_layer) ! allocate dfn params call this%params_alloc() ! allocate memory for storing TAS strings call this%tas_arrays_alloc() - end subroutine bndgrid_init + end subroutine ainit - subroutine bndgrid_df(this) - class(BoundGridInputType), intent(inout) :: this !< Mf6FileGridInputType + subroutine df(this) + class(LayerArrayLoadType), intent(inout) :: this call this%tasmanager%tasmanager_df() - end subroutine bndgrid_df + end subroutine df - subroutine bndgrid_ad(this) - class(BoundGridInputType), intent(inout) :: this !< Mf6FileGridInputType + subroutine ad(this) + class(LayerArrayLoadType), intent(inout) :: this call this%tasmanager%ad() - end subroutine bndgrid_ad + end subroutine ad - subroutine bndgrid_rp(this, parser) + subroutine rp(this, parser) use MemoryManagerModule, only: mem_setptr use BlockParserModule, only: BlockParserType use InputDefinitionModule, only: InputParamDefinitionType @@ -130,7 +131,7 @@ subroutine bndgrid_rp(this, parser) use ArrayHandlersModule, only: ifind use SourceCommonModule, only: ifind_charstr use IdmLoggerModule, only: idm_log_header, idm_log_close, idm_log_var - class(BoundGridInputType), intent(inout) :: this !< Mf6FileGridInputType + class(LayerArrayLoadType), intent(inout) :: this type(BlockParserType), pointer, intent(inout) :: parser logical(LGP) :: endOfBlock, netcdf character(len=LINELENGTH) :: keyword, param_tag @@ -215,19 +216,19 @@ subroutine bndgrid_rp(this, parser) ! log lst file header call idm_log_close(this%mf6_input%component_name, & this%mf6_input%subcomponent_name, this%iout) - end subroutine bndgrid_rp + end subroutine rp - subroutine bndgrid_destroy(this) - class(BoundGridInputType), intent(inout) :: this !< Mf6FileGridInputType + subroutine destroy(this) + class(LayerArrayLoadType), intent(inout) :: this ! ! deallocate tasmanager call this%tasmanager%da() deallocate (this%tasmanager) nullify (this%tasmanager) - end subroutine bndgrid_destroy + end subroutine destroy - subroutine bndgrid_reset(this) - class(BoundGridInputType), intent(inout) :: this !< BoundGridInputType + subroutine reset(this) + class(LayerArrayLoadType), intent(inout) :: this integer(I4B) :: n, m if (this%tas_active /= 0) then @@ -249,11 +250,11 @@ subroutine bndgrid_reset(this) this%bound_context%auxvar(n, m) = DZERO end do end do - end subroutine bndgrid_reset + end subroutine reset subroutine init_charstr1d(this, varname, input_name) use MemoryManagerModule, only: mem_setptr - class(BoundGridInputType) :: this + class(LayerArrayLoadType) :: this character(len=*), intent(in) :: varname character(len=*), intent(in) :: input_name type(CharacterStringType), dimension(:), pointer, & @@ -265,8 +266,8 @@ subroutine init_charstr1d(this, varname, input_name) end do end subroutine init_charstr1d - subroutine bndgrid_params_alloc(this) - class(BoundGridInputType), intent(inout) :: this !< BoundGridInputType + subroutine params_alloc(this) + class(LayerArrayLoadType), intent(inout) :: this character(len=LENVARNAME) :: rs_varname integer(I4B), pointer :: intvar integer(I4B) :: iparam @@ -287,9 +288,9 @@ subroutine bndgrid_params_alloc(this) this%param_reads(iparam)%invar => intvar this%param_reads(iparam)%invar = 0 end do - end subroutine bndgrid_params_alloc + end subroutine params_alloc - subroutine bndgrid_param_load(this, parser, idt, mempath, netcdf, iaux) + subroutine param_load(this, parser, idt, mempath, netcdf, iaux) use TdisModule, only: kper use MemoryManagerModule, only: mem_setptr use ArrayHandlersModule, only: ifind @@ -300,7 +301,7 @@ subroutine bndgrid_param_load(this, parser, idt, mempath, netcdf, iaux) use Integer1dReaderModule, only: read_int1d use LoadNCInputModule, only: netcdf_read_array use IdmLoggerModule, only: idm_log_var - class(BoundGridInputType), intent(inout) :: this !< BoundGridInputType + class(LayerArrayLoadType), intent(inout) :: this type(BlockParserType), intent(in) :: parser type(InputParamDefinitionType), intent(in) :: idt character(len=*), intent(in) :: mempath @@ -348,7 +349,7 @@ subroutine bndgrid_param_load(this, parser, idt, mempath, netcdf, iaux) call idm_log_var(dbl1d, idt%tagname, mempath, this%iout) deallocate (dbl1d) case default - errmsg = 'IDM unimplemented. Mf6FileGridInput::param_load & + errmsg = 'IDM unimplemented. LayerArrayLoad::param_load & &datatype='//trim(idt%datatype) call store_error(errmsg) call store_error_filename(this%input_name) @@ -359,11 +360,11 @@ subroutine bndgrid_param_load(this, parser, idt, mempath, netcdf, iaux) if (iparam > 0) then this%param_reads(iparam)%invar = 1 end if - end subroutine bndgrid_param_load + end subroutine param_load - subroutine bndgrid_tas_arrays_alloc(this) + subroutine tas_arrays_alloc(this) use MemoryManagerModule, only: mem_allocate - class(BoundGridInputType), intent(inout) :: this !< BoundGridInputType + class(LayerArrayLoadType), intent(inout) :: this ! count params other than AUX if (this%tas_active /= 0) then @@ -380,13 +381,13 @@ subroutine bndgrid_tas_arrays_alloc(this) call mem_allocate(this%param_tasnames, LENTIMESERIESNAME, 0, & 'PARAMTASNAME', this%mf6_input%mempath) end if - end subroutine bndgrid_tas_arrays_alloc + end subroutine tas_arrays_alloc ! FLUX and SFAC are handled in model context - subroutine bndgrid_tas_links_create(this, inunit) + subroutine tas_links_create(this, inunit) use InputDefinitionModule, only: InputParamDefinitionType use DefinitionSelectModule, only: get_param_definition_type - class(BoundGridInputType), intent(inout) :: this !< BoundGridInputType + class(LayerArrayLoadType), intent(inout) :: this integer(I4B), intent(in) :: inunit type(InputParamDefinitionType), pointer :: idt ! non-contiguous because a slice of bound is passed @@ -440,6 +441,6 @@ subroutine bndgrid_tas_links_create(this, inunit) end if end if end do - end subroutine bndgrid_tas_links_create + end subroutine tas_links_create -end module Mf6FileGridInputModule +end module LayerArrayLoadModule diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileListInput.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 similarity index 80% rename from src/Utilities/Idm/mf6blockfile/Mf6FileListInput.f90 rename to src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 index e3906f1d3f5..5ccebd457ff 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileListInput.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 @@ -1,10 +1,10 @@ -!> @brief This module contains the Mf6FileListInputModule +!> @brief This module contains the ListLoadModule !! !! This module contains the routines for reading period block !! list based input. !! !< -module Mf6FileListInputModule +module ListLoadModule use KindModule, only: I4B, DP, LGP use ConstantsModule, only: LINELENGTH, LENBOUNDNAME @@ -20,7 +20,7 @@ module Mf6FileListInputModule implicit none private - public :: BoundListInputType + public :: ListLoadType !> @brief Boundary package list loader. !! @@ -29,35 +29,35 @@ module Mf6FileListInputModule !! read and prepare (RP) routines. !! !< - type, extends(AsciiDynamicPkgLoadBaseType) :: BoundListInputType + type, extends(AsciiDynamicPkgLoadBaseType) :: ListLoadType type(TimeSeriesManagerType), pointer :: tsmanager => null() type(StructArrayType), pointer :: structarray => null() type(BoundInputContextType) :: bound_context integer(I4B) :: ts_active integer(I4B) :: iboundname contains - procedure :: ainit => bndlist_init - procedure :: df => bndlist_df - procedure :: ad => bndlist_ad - procedure :: reset => bndlist_reset - procedure :: rp => bndlist_rp - procedure :: destroy => bndlist_destroy - procedure :: ts_link_bnd => bndlist_ts_link_bnd - procedure :: ts_link_aux => bndlist_ts_link_aux - procedure :: ts_link => bndlist_ts_link - procedure :: ts_update => bndlist_ts_update - procedure :: create_structarray => bndlist_create_structarray - end type BoundListInputType + procedure :: ainit + procedure :: df + procedure :: ad + procedure :: reset + procedure :: rp + procedure :: destroy + procedure :: ts_link_bnd + procedure :: ts_link_aux + procedure :: ts_link + procedure :: ts_update + procedure :: create_structarray + end type ListLoadType contains - subroutine bndlist_init(this, mf6_input, component_name, component_input_name, & - input_name, iperblock, parser, iout) + subroutine ainit(this, mf6_input, component_name, component_input_name, & + input_name, iperblock, parser, iout) use InputOutputModule, only: getunit use MemoryManagerModule, only: get_isize use BlockParserModule, only: BlockParserType use LoadMf6FileModule, only: LoadMf6FileType - class(BoundListInputType), intent(inout) :: this + class(ListLoadType), intent(inout) :: this type(ModflowInputType), intent(in) :: mf6_input character(len=*), intent(in) :: component_name character(len=*), intent(in) :: component_input_name @@ -98,7 +98,7 @@ subroutine bndlist_init(this, mf6_input, component_name, component_input_name, & end if ! initialize package input context - call this%bound_context%create(mf6_input, this%readasarrays) + call this%bound_context%create(mf6_input, .false.) ! store in scope SA cols for list input call this%bound_context%bound_params(this%param_names, this%nparam, & @@ -108,32 +108,32 @@ subroutine bndlist_init(this, mf6_input, component_name, component_input_name, & ! finalize input context setup call this%bound_context%allocate_arrays() - end subroutine bndlist_init + end subroutine ainit - subroutine bndlist_df(this) - class(BoundListInputType), intent(inout) :: this !< ListInputType + subroutine df(this) + class(ListLoadType), intent(inout) :: this ! define tsmanager call this%tsmanager%tsmanager_df() - end subroutine bndlist_df + end subroutine df - subroutine bndlist_ad(this) - class(BoundListInputType), intent(inout) :: this !< ListInputType + subroutine ad(this) + class(ListLoadType), intent(inout) :: this ! advance timeseries call this%tsmanager%ad() - end subroutine bndlist_ad + end subroutine ad - subroutine bndlist_reset(this) - class(BoundListInputType), intent(inout) :: this !< ListInputType + subroutine reset(this) + class(ListLoadType), intent(inout) :: this ! reset tsmanager call this%tsmanager%reset(this%mf6_input%subcomponent_name) - end subroutine bndlist_reset + end subroutine reset - subroutine bndlist_rp(this, parser) + subroutine rp(this, parser) use BlockParserModule, only: BlockParserType use LoadMf6FileModule, only: read_control_record use StructVectorModule, only: StructVectorType use IdmLoggerModule, only: idm_log_header, idm_log_close - class(BoundListInputType), intent(inout) :: this + class(ListLoadType), intent(inout) :: this type(BlockParserType), pointer, intent(inout) :: parser integer(I4B) :: ibinary integer(I4B) :: oc_inunit @@ -165,10 +165,10 @@ subroutine bndlist_rp(this, parser) ! close logging statement call idm_log_close(this%mf6_input%component_name, & this%mf6_input%subcomponent_name, this%iout) - end subroutine bndlist_rp + end subroutine rp - subroutine bndlist_destroy(this) - class(BoundListInputType), intent(inout) :: this !< BoundListInputType + subroutine destroy(this) + class(ListLoadType), intent(inout) :: this ! ! deallocate tsmanager call this%tsmanager%da() @@ -178,13 +178,13 @@ subroutine bndlist_destroy(this) ! deallocate StructArray call destructStructArray(this%structarray) call this%bound_context%destroy() - end subroutine bndlist_destroy + end subroutine destroy - subroutine bndlist_ts_link_bnd(this, structvector, ts_strloc) + subroutine ts_link_bnd(this, structvector, ts_strloc) use TimeSeriesLinkModule, only: TimeSeriesLinkType use TimeSeriesManagerModule, only: read_value_or_time_series use StructVectorModule, only: StructVectorType, TSStringLocType - class(BoundListInputType), intent(inout) :: this + class(ListLoadType), intent(inout) :: this type(StructVectorType), pointer, intent(in) :: structvector type(TSStringLocType), pointer, intent(in) :: ts_strloc real(DP), pointer :: bndElem @@ -213,13 +213,13 @@ subroutine bndlist_ts_link_bnd(this, structvector, ts_strloc) tsLinkBnd%BndName = boundname end if end if - end subroutine bndlist_ts_link_bnd + end subroutine ts_link_bnd - subroutine bndlist_ts_link_aux(this, structvector, ts_strloc) + subroutine ts_link_aux(this, structvector, ts_strloc) use TimeSeriesLinkModule, only: TimeSeriesLinkType use TimeSeriesManagerModule, only: read_value_or_time_series use StructVectorModule, only: StructVectorType, TSStringLocType - class(BoundListInputType), intent(inout) :: this + class(ListLoadType), intent(inout) :: this type(StructVectorType), pointer, intent(in) :: structvector type(TSStringLocType), pointer, intent(in) :: ts_strloc real(DP), pointer :: bndElem @@ -248,13 +248,13 @@ subroutine bndlist_ts_link_aux(this, structvector, ts_strloc) tsLinkAux%BndName = boundname end if end if - end subroutine bndlist_ts_link_aux + end subroutine ts_link_aux - subroutine bndlist_ts_update(this, structarray) + subroutine ts_update(this, structarray) use SimModule, only: count_errors, store_error_filename use StructVectorModule, only: TSStringLocType use StructVectorModule, only: StructVectorType - class(BoundListInputType), intent(inout) :: this + class(ListLoadType), intent(inout) :: this type(StructArrayType), pointer, intent(inout) :: structarray integer(I4B) :: n, m type(TSStringLocType), pointer :: ts_strloc @@ -275,11 +275,11 @@ subroutine bndlist_ts_update(this, structarray) if (count_errors() > 0) then call store_error_filename(this%input_name) end if - end subroutine bndlist_ts_update + end subroutine ts_update - subroutine bndlist_ts_link(this, structvector, ts_strloc) + subroutine ts_link(this, structvector, ts_strloc) use StructVectorModule, only: StructVectorType, TSStringLocType - class(BoundListInputType), intent(inout) :: this + class(ListLoadType), intent(inout) :: this type(StructVectorType), pointer, intent(in) :: structvector type(TSStringLocType), pointer, intent(in) :: ts_strloc select case (structvector%memtype) @@ -289,12 +289,12 @@ subroutine bndlist_ts_link(this, structvector, ts_strloc) call this%ts_link_aux(structvector, ts_strloc) case default end select - end subroutine bndlist_ts_link + end subroutine ts_link - subroutine bndlist_create_structarray(this) + subroutine create_structarray(this) use InputDefinitionModule, only: InputParamDefinitionType use DefinitionSelectModule, only: get_param_definition_type - class(BoundListInputType), intent(inout) :: this + class(ListLoadType), intent(inout) :: this type(InputParamDefinitionType), pointer :: idt integer(I4B) :: icol @@ -315,6 +315,6 @@ subroutine bndlist_create_structarray(this) ! store boundname index when found if (idt%mf6varname == 'BOUNDNAME') this%iboundname = icol end do - end subroutine bndlist_create_structarray + end subroutine create_structarray -end module Mf6FileListInputModule +end module ListLoadModule diff --git a/src/meson.build b/src/meson.build index a2a43008cbd..4d0fc5c488f 100644 --- a/src/meson.build +++ b/src/meson.build @@ -65,6 +65,7 @@ modflow_sources = files( 'Idm' / 'gwf-evtidm.f90', 'Idm' / 'gwf-evtaidm.f90', 'Idm' / 'gwf-ghbidm.f90', + 'Idm' / 'gwf-ghbaidm.f90', 'Idm' / 'gwf-icidm.f90', 'Idm' / 'gwf-namidm.f90', 'Idm' / 'gwf-npfidm.f90', @@ -181,6 +182,7 @@ modflow_sources = files( 'Model' / 'GroundWaterFlow' / 'gwf-drn.f90', 'Model' / 'GroundWaterFlow' / 'gwf-evt.f90', 'Model' / 'GroundWaterFlow' / 'gwf-ghb.f90', + 'Model' / 'GroundWaterFlow' / 'gwf-ghba.f90', 'Model' / 'GroundWaterFlow' / 'gwf-hfb.f90', 'Model' / 'GroundWaterFlow' / 'gwf-ic.f90', 'Model' / 'GroundWaterFlow' / 'gwf-lak.f90', @@ -341,8 +343,9 @@ modflow_sources = files( 'Utilities' / 'Idm' / 'mf6blockfile' / 'AsciiInputLoadType.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'IdmMf6File.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'LoadMf6File.f90', - 'Utilities' / 'Idm' / 'mf6blockfile' / 'Mf6FileGridInput.f90', - 'Utilities' / 'Idm' / 'mf6blockfile' / 'Mf6FileListInput.f90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'Mf6FileGridArray.f90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'Mf6FileLayerArray.f90', + 'Utilities' / 'Idm' / 'mf6blockfile' / 'Mf6FileList.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'Mf6FileStoInput.f90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'LoadNCInput.F90', 'Utilities' / 'Idm' / 'mf6blockfile' / 'StructArray.f90', diff --git a/utils/idmloader/dfns.txt b/utils/idmloader/dfns.txt index 13737805a86..3de63c81e58 100644 --- a/utils/idmloader/dfns.txt +++ b/utils/idmloader/dfns.txt @@ -9,6 +9,7 @@ gwf-drn.dfn gwf-evt.dfn gwf-evta.dfn gwf-ghb.dfn +gwf-ghba.dfn gwf-ic.dfn gwf-npf.dfn gwf-rch.dfn diff --git a/utils/idmloader/scripts/dfn2f90.py b/utils/idmloader/scripts/dfn2f90.py index acf7bec1749..e28c12f7ed5 100644 --- a/utils/idmloader/scripts/dfn2f90.py +++ b/utils/idmloader/scripts/dfn2f90.py @@ -366,13 +366,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 + if mf6vn == "AUXVAR": + if shape == "NCOL*NROW; NCPL": shape = "NAUX NCPL" - else: - shape = "NCPL" + elif shape == "NODES": + shape = "NAUX NODES" + elif shape == "NCOL*NROW; NCPL": + shape = "NCPL" shapelist = shape.strip().split() ndim = len(shapelist) From 5849628922c0ae6e45bd75c462a3997e832103fd Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 17 Mar 2025 08:13:24 -0400 Subject: [PATCH 02/22] add ghba dfn --- doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn | 191 +++++++++++++++++++++++++++++ 1 file changed, 191 insertions(+) create mode 100644 doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn diff --git a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn b/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn new file mode 100644 index 00000000000..3c9ebe4644a --- /dev/null +++ b/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn @@ -0,0 +1,191 @@ +# --------------------- gwf ghba options --------------------- +# flopy multi-package +# package-type stress-package + +block options +name auxiliary +type string +shape (naux) +reader urword +optional true +longname keyword to specify aux variables +description REPLACE auxnames {'{#1}': 'Groundwater Flow'} + +block options +name auxmultname +type string +shape +reader urword +optional true +longname name of auxiliary variable for multiplier +description REPLACE auxmultname {'{#1}': 'general-head boundary conductance'} + +block options +name print_input +type keyword +reader urword +optional true +longname print input to listing file +description REPLACE print_input {'{#1}': 'general-head boundary'} +mf6internal iprpak + +block options +name print_flows +type keyword +reader urword +optional true +longname print calculated flows to listing file +description REPLACE print_flows {'{#1}': 'general-head boundary'} +mf6internal iprflow + +block options +name save_flows +type keyword +reader urword +optional true +longname save CHD flows to budget file +description REPLACE save_flows {'{#1}': 'general-head boundary'} +mf6internal ipakcb + +block options +name tas_filerecord +type record tas6 filein tas6_filename +shape +reader urword +tagged true +optional true +longname +description + +block options +name tas6 +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname head keyword +description keyword to specify that record corresponds to a time-array-series file. + +block options +name filein +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname file keyword +description keyword to specify that an input filename is expected next. + +block options +name tas6_filename +type string +preserve_case true +in_record true +reader urword +optional false +tagged false +longname file name of time series information +description defines a time-array-series file defining a time-array series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-array series capability. + +block options +name obs_filerecord +type record obs6 filein obs6_filename +shape +reader urword +tagged true +optional true +longname +description + +block options +name obs6 +type keyword +shape +in_record true +reader urword +tagged true +optional false +longname obs keyword +description keyword to specify that record corresponds to an observations file. + +block options +name obs6_filename +type string +preserve_case true +in_record true +tagged false +reader urword +optional false +longname obs6 input filename +description REPLACE obs6_filename {'{#1}': 'General-Head Boundary'} + +block options +name mover +type keyword +tagged true +reader urword +optional true +longname +description REPLACE mover {'{#1}': 'General-Head Boundary'} + +block options +name export_array_netcdf +type keyword +reader urword +optional true +mf6internal export_nc +longname export array variables to netcdf output files. +description keyword that specifies input griddata arrays should be written to the model output netcdf file. +extended true + +# --------------------- gwf ghba period --------------------- + +block period +name iper +type integer +block_variable True +in_record true +tagged false +shape +valid +reader urword +optional false +longname stress period number +description REPLACE iper {} + +block period +name bhead +type double precision +shape (nodes) +reader readarray +layered true +netcdf true +longname boundary head +description is the boundary head. The recharge array may be defined by a time-array series (see the ``Using Time-Array Series in a Package'' section). +default_value 3.e30 + +block period +name cond +type double precision +shape (nodes) +reader readarray +layered true +netcdf true +longname boundary conductance +description is the hydraulic conductance of the interface between the aquifer cell and the boundary. The recharge array may be defined by a time-array series (see the ``Using Time-Array Series in a Package'' section). +default_value 3.e30 + +block period +name aux +type double precision +shape (nodes) +reader readarray +layered true +netcdf true +optional true +longname recharge auxiliary variable iaux +description is an array of values for auxiliary variable aux(iaux), where iaux is a value from 1 to naux, and aux(iaux) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the recharge array will be multiplied by this array. +mf6internal auxvar From 3f254a45397621ed37b735c6aa4f0265a3f62653 Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 17 Mar 2025 08:42:46 -0400 Subject: [PATCH 03/22] cleanup unused variables --- src/Model/GroundWaterFlow/gwf-buy.f90 | 2 +- src/Model/GroundWaterFlow/gwf-ghba.f90 | 35 +++++++++---------- .../Idm/mf6blockfile/Mf6FileGridArray.f90 | 4 +-- 3 files changed, 18 insertions(+), 23 deletions(-) diff --git a/src/Model/GroundWaterFlow/gwf-buy.f90 b/src/Model/GroundWaterFlow/gwf-buy.f90 index b9881183321..521474fe2d9 100644 --- a/src/Model/GroundWaterFlow/gwf-buy.f90 +++ b/src/Model/GroundWaterFlow/gwf-buy.f90 @@ -520,7 +520,7 @@ subroutine buy_cf_ghba(packobj, hnew, dense, elev, denseref, locelev, & integer(I4B), intent(in) :: iform ! -- local integer(I4B) :: n - integer(I4B) :: node, nodeuser + integer(I4B) :: node real(DP) :: denseghb real(DP) :: elevghb real(DP) :: hghb diff --git a/src/Model/GroundWaterFlow/gwf-ghba.f90 b/src/Model/GroundWaterFlow/gwf-ghba.f90 index d875d027b42..560a552b946 100644 --- a/src/Model/GroundWaterFlow/gwf-ghba.f90 +++ b/src/Model/GroundWaterFlow/gwf-ghba.f90 @@ -163,7 +163,6 @@ subroutine ghba_allocate_arrays(this, nodelist, auxvar) class(GhbaType) :: this integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar - integer(I4B) :: n ! ! -- call base type allocate arrays call this%BndType%allocate_arrays(nodelist, auxvar) @@ -195,7 +194,6 @@ subroutine ghba_rp(this) real(DP), dimension(:, :), pointer, contiguous :: auxvar integer(I4B) :: i, j, noder, nodeuser character(len=LINELENGTH) :: nodestr - logical(LGP) :: found ! if (this%iper /= kper) return ! @@ -255,8 +253,7 @@ subroutine ghba_ck(this) ! -- local character(len=LINELENGTH) :: errmsg integer(I4B) :: i - integer(I4B) :: node, noder, nodeuser - character(len=LINELENGTH) :: nodestr + integer(I4B) :: noder, nodeuser real(DP) :: bt ! -- formats character(len=*), parameter :: fmtghberr = & @@ -280,11 +277,11 @@ subroutine ghba_ck(this) ! ! -- check stress period data do i = 1, this%nbound - node = this%nodelist(i) - nodeuser = this%dis%get_nodeuser(node) - bt = this%dis%bot(node) + noder = this%nodelist(i) + nodeuser = this%dis%get_nodeuser(noder) + bt = this%dis%bot(noder) ! -- accumulate errors - if (this%bhead(nodeuser) < bt .and. this%icelltype(node) /= 0) then + if (this%bhead(nodeuser) < bt .and. this%icelltype(noder) /= 0) then write (errmsg, fmt=fmtghberr) nodeuser, this%bhead(nodeuser), bt call store_error(errmsg) end if @@ -315,17 +312,17 @@ subroutine ghba_cf(this) ! -- dummy class(GhbaType) :: this ! -- local - integer(I4B) :: i, node, noder, nodeuser + integer(I4B) :: i, noder, nodeuser ! do i = 1, this%nbound - node = this%nodelist(i) - if (this%ibound(node) .le. 0) then + noder = this%nodelist(i) + if (this%ibound(noder) .le. 0) then this%hcof(i) = DZERO this%rhs(i) = DZERO cycle end if ! TODO or use bound_value? - nodeuser = this%dis%get_nodeuser(node) + nodeuser = this%dis%get_nodeuser(noder) this%hcof(i) = -this%cond_mult(i) this%rhs(i) = -this%cond_mult(i) * this%bhead(nodeuser) end do @@ -341,7 +338,7 @@ subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) integer(I4B), dimension(:), intent(in) :: idxglo class(MatrixBaseType), pointer :: matrix_sln ! -- local - integer(I4B) :: i, n, noder, nodeuser, ipos + integer(I4B) :: i, noder, nodeuser, ipos real(DP) :: cond, bhead, qghb ! ! -- pakmvrobj fc @@ -350,19 +347,19 @@ subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) end if do i = 1, this%nbound - n = this%nodelist(i) - nodeuser = this%dis%get_nodeuser(n) - rhs(n) = rhs(n) + this%rhs(i) - ipos = ia(n) + noder = this%nodelist(i) + nodeuser = this%dis%get_nodeuser(noder) + rhs(noder) = rhs(noder) + this%rhs(i) + ipos = ia(noder) call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) ! ! -- If mover is active and this boundary is discharging, ! store available water (as positive value). ! TODO or use bound_value? bhead = this%bhead(nodeuser) - if (this%imover == 1 .and. this%xnew(n) > bhead) then + if (this%imover == 1 .and. this%xnew(noder) > bhead) then cond = this%cond_mult(i) - qghb = cond * (this%xnew(n) - bhead) + qghb = cond * (this%xnew(noder) - bhead) call this%pakmvrobj%accumulate_qformvr(i, qghb) end if end do diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 index da4f01467c8..b9c54ef8ca2 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 @@ -57,7 +57,6 @@ subroutine ainit(this, mf6_input, component_name, & type(BlockParserType), pointer, intent(inout) :: parser integer(I4B), intent(in) :: iout type(LoadMf6FileType) :: loader - integer(I4B) :: n ! initialize base type call this%DynamicPkgLoadType%init(mf6_input, component_name, & @@ -97,8 +96,7 @@ subroutine rp(this, parser) logical(LGP) :: endOfBlock, netcdf, layered character(len=LINELENGTH) :: keyword, param_tag type(InputParamDefinitionType), pointer :: idt - integer(I4B) :: iaux, iparam - integer(I4B), dimension(:), pointer, contiguous :: int1d + integer(I4B) :: iaux ! reset for this period call this%reset() From a53720bb442d375b44b2930f76579c53baee7390 Mon Sep 17 00:00:00 2001 From: mjreno Date: Thu, 20 Mar 2025 08:38:12 -0400 Subject: [PATCH 04/22] nodelist contains nodesuser nodes --- src/Model/GroundWaterFlow/gwf-buy.f90 | 1 + src/Model/GroundWaterFlow/gwf-ghba.f90 | 99 +++++++------------ src/Model/GroundWaterFlow/gwf-vsc.f90 | 8 +- .../Idm/mf6blockfile/Mf6FileGridArray.f90 | 2 + 4 files changed, 41 insertions(+), 69 deletions(-) diff --git a/src/Model/GroundWaterFlow/gwf-buy.f90 b/src/Model/GroundWaterFlow/gwf-buy.f90 index 521474fe2d9..33a17648544 100644 --- a/src/Model/GroundWaterFlow/gwf-buy.f90 +++ b/src/Model/GroundWaterFlow/gwf-buy.f90 @@ -532,6 +532,7 @@ subroutine buy_cf_ghba(packobj, hnew, dense, elev, denseref, locelev, & type is (GhbaType) do n = 1, packobj%nbound node = packobj%nodelist(n) + if (node == 0) cycle if (packobj%ibound(node) <= 0) cycle ! ! -- density diff --git a/src/Model/GroundWaterFlow/gwf-ghba.f90 b/src/Model/GroundWaterFlow/gwf-ghba.f90 index 560a552b946..b67481fd1ee 100644 --- a/src/Model/GroundWaterFlow/gwf-ghba.f90 +++ b/src/Model/GroundWaterFlow/gwf-ghba.f90 @@ -19,8 +19,8 @@ module ghbamodule character(len=LENPACKAGENAME) :: text = ' GHBA' ! type, extends(BndExtType) :: GhbaType - real(DP), dimension(:), pointer, contiguous :: bhead => null() !< GHB boundary head - real(DP), dimension(:), pointer, contiguous :: cond => null() !< GHB hydraulic conductance + real(DP), dimension(:), pointer, contiguous :: bhead => null() !< GHBA boundary head + real(DP), dimension(:), pointer, contiguous :: cond => null() !< GHBA hydraulic conductance contains procedure :: allocate_arrays => ghba_allocate_arrays procedure :: source_options => ghba_options @@ -147,7 +147,8 @@ subroutine ghba_dimensions(this) class(GhbaType), intent(inout) :: this ! -- local ! - this%maxbound = this%dis%nodes + this%maxbound = this%dis%nodesuser + this%nbound = this%dis%nodesuser ! ! -- Call define_listlabel to construct the list label that is written ! when PRINT_INPUT option is used. @@ -165,7 +166,7 @@ subroutine ghba_allocate_arrays(this, nodelist, auxvar) real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar ! ! -- call base type allocate arrays - call this%BndType%allocate_arrays(nodelist, auxvar) + call this%BndExtType%allocate_arrays(nodelist, auxvar) ! ! -- set ghb input context pointers call mem_setptr(this%bhead, 'BHEAD', this%input_mempath) @@ -176,10 +177,6 @@ subroutine ghba_allocate_arrays(this, nodelist, auxvar) 'BHEAD', this%input_mempath) call mem_checkin(this%cond, 'COND', this%memoryPath, & 'COND', this%input_mempath) - ! - ! -- checkin auxvar input context pointer - call mem_checkin(this%auxvar, 'AUXVAR_IDM', this%memoryPath, & - 'AUXVAR', this%input_mempath) end subroutine ghba_allocate_arrays !> @brief Read and prepare @@ -191,31 +188,21 @@ subroutine ghba_rp(this) use MemoryManagerModule, only: mem_setptr ! -- dummy class(GhbaType), intent(inout) :: this - real(DP), dimension(:, :), pointer, contiguous :: auxvar - integer(I4B) :: i, j, noder, nodeuser + integer(I4B) :: i, noder character(len=LINELENGTH) :: nodestr ! if (this%iper /= kper) return ! - ! -- set auxvar input context pointer - call mem_setptr(auxvar, 'AUXVAR', this%input_mempath) - ! ! -- Update the nodelist - this%nbound = 0 - do i = 1, this%dis%nodesuser + do i = 1, this%nbound if (this%bhead(i) == DNODATA) then - ! no-op + this%nodelist(i) = 0 else noder = this%dis%get_nodenumber(i, 1) if (noder > 0) then - this%nbound = this%nbound + 1 - this%nodelist(this%nbound) = noder - do j = 1, this%naux - this%auxvar(j, this%nbound) = auxvar(j, i) - end do + this%nodelist(i) = noder else - nodeuser = this%dis%get_nodeuser(noder) - call this%dis%nodeu_to_string(nodeuser, nodestr) + call this%dis%nodeu_to_string(i, nodestr) write (errmsg, *) & ' Cell is outside active grid domain: '// & trim(adjustl(nodestr)) @@ -253,36 +240,27 @@ subroutine ghba_ck(this) ! -- local character(len=LINELENGTH) :: errmsg integer(I4B) :: i - integer(I4B) :: noder, nodeuser + integer(I4B) :: noder real(DP) :: bt ! -- formats character(len=*), parameter :: fmtghberr = & - "('GHB BOUNDARY (',i0,') HEAD (',f10.3,') IS LESS THAN CELL & + "('GHBA BOUNDARY (',i0,') HEAD (',f10.3,') IS LESS THAN CELL & &BOTTOM (',f10.3,')')" character(len=*), parameter :: fmtcondmulterr = & - "('GHB BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS & + "('GHBA BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS & &LESS THAN ZERO')" character(len=*), parameter :: fmtconderr = & - "('GHB BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN & + "('GHBA BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN & &ZERO')" ! - ! -- Check cond data - do i = 1, this%dis%nodes - if (this%nodelist(i) == 0) then - ! verify cond consistent - else - ! verify cond consistent - end if - end do - ! ! -- check stress period data do i = 1, this%nbound noder = this%nodelist(i) - nodeuser = this%dis%get_nodeuser(noder) + if (noder == 0) cycle bt = this%dis%bot(noder) ! -- accumulate errors - if (this%bhead(nodeuser) < bt .and. this%icelltype(noder) /= 0) then - write (errmsg, fmt=fmtghberr) nodeuser, this%bhead(nodeuser), bt + if (this%bhead(i) < bt .and. this%icelltype(noder) /= 0) then + write (errmsg, fmt=fmtghberr) i, this%bhead(i), bt call store_error(errmsg) end if if (this%iauxmultcol > 0) then @@ -292,8 +270,9 @@ subroutine ghba_ck(this) call store_error(errmsg) end if end if - if (this%cond(nodeuser) < DZERO) then - write (errmsg, fmt=fmtconderr) nodeuser, this%cond(nodeuser) + ! TODO update to include error for DNODATA + if (this%cond(i) < DZERO) then + write (errmsg, fmt=fmtconderr) i, this%cond(i) call store_error(errmsg) end if end do @@ -312,19 +291,18 @@ subroutine ghba_cf(this) ! -- dummy class(GhbaType) :: this ! -- local - integer(I4B) :: i, noder, nodeuser + integer(I4B) :: i, noder ! do i = 1, this%nbound noder = this%nodelist(i) + if (noder == 0) cycle if (this%ibound(noder) .le. 0) then this%hcof(i) = DZERO this%rhs(i) = DZERO cycle end if - ! TODO or use bound_value? - nodeuser = this%dis%get_nodeuser(noder) this%hcof(i) = -this%cond_mult(i) - this%rhs(i) = -this%cond_mult(i) * this%bhead(nodeuser) + this%rhs(i) = -this%cond_mult(i) * this%bhead(i) end do end subroutine ghba_cf @@ -338,7 +316,7 @@ subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) integer(I4B), dimension(:), intent(in) :: idxglo class(MatrixBaseType), pointer :: matrix_sln ! -- local - integer(I4B) :: i, noder, nodeuser, ipos + integer(I4B) :: i, noder, ipos real(DP) :: cond, bhead, qghb ! ! -- pakmvrobj fc @@ -348,15 +326,14 @@ subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) do i = 1, this%nbound noder = this%nodelist(i) - nodeuser = this%dis%get_nodeuser(noder) + if (noder == 0) cycle rhs(noder) = rhs(noder) + this%rhs(i) ipos = ia(noder) call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) ! ! -- If mover is active and this boundary is discharging, ! store available water (as positive value). - ! TODO or use bound_value? - bhead = this%bhead(nodeuser) + bhead = this%bhead(i) if (this%imover == 1 .and. this%xnew(noder) > bhead) then cond = this%cond_mult(i) qghb = cond * (this%xnew(noder) - bhead) @@ -393,7 +370,7 @@ end subroutine define_listlabel ! -- Procedures related to observations - !> @brief Return true because GHB package supports observations + !> @brief Return true because GHBA package supports observations !! !! Overrides BndType%bnd_obs_supported() !< @@ -405,7 +382,7 @@ logical function ghba_obs_supported(this) ghba_obs_supported = .true. end function ghba_obs_supported - !> @brief Store observation type supported by GHB package + !> @brief Store observation type supported by GHBA package !! !! Overrides BndType%bnd_df_obs !< @@ -425,7 +402,7 @@ subroutine ghba_df_obs(this) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor end subroutine ghba_df_obs - !> @brief Store user-specified conductance for GHB boundary type + !> @brief Store user-specified conductance for GHBA boundary type !< subroutine ghba_store_user_cond(this) ! -- modules @@ -440,7 +417,7 @@ subroutine ghba_store_user_cond(this) end do end subroutine ghba_store_user_cond - !> @brief Apply multiplier to GHB conductance if option AUXMULTCOL is used + !> @brief Apply multiplier to GHBA conductance if option AUXMULTCOL is used !< function cond_mult(this, row) result(cond) ! -- modules @@ -450,15 +427,11 @@ function cond_mult(this, row) result(cond) integer(I4B), intent(in) :: row ! -- result real(DP) :: cond - ! -- local - integer(I4B) :: noder, nodeuser ! - noder = this%nodelist(row) - nodeuser = this%dis%get_nodeuser(noder) if (this%iauxmultcol > 0) then - cond = this%cond(nodeuser) * this%auxvar(this%iauxmultcol, row) + cond = this%cond(row) * this%auxvar(this%iauxmultcol, row) else - cond = this%cond(nodeuser) + cond = this%cond(row) end if end function cond_mult @@ -473,18 +446,14 @@ function ghba_bound_value(this, col, row) result(bndval) integer(I4B), intent(in) :: row ! -- result real(DP) :: bndval - ! -- local - integer(I4B) :: noder, nodeuser ! select case (col) case (1) - noder = this%nodelist(row) - nodeuser = this%dis%get_nodeuser(noder) - bndval = this%bhead(nodeuser) + bndval = this%bhead(row) case (2) bndval = this%cond_mult(row) case default - errmsg = 'Programming error. GHB bound value requested column '& + errmsg = 'Programming error. GHBA bound value requested column '& &'outside range of ncolbnd (2).' call store_error(errmsg) call store_error_filename(this%input_fname) diff --git a/src/Model/GroundWaterFlow/gwf-vsc.f90 b/src/Model/GroundWaterFlow/gwf-vsc.f90 index 666fa55a599..1d8d1ce7fd8 100644 --- a/src/Model/GroundWaterFlow/gwf-vsc.f90 +++ b/src/Model/GroundWaterFlow/gwf-vsc.f90 @@ -491,7 +491,7 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & real(DP), dimension(:), intent(inout) :: ctemp ! -- local integer(I4B) :: n - integer(I4B) :: node, nodeuser + integer(I4B) :: node real(DP) :: viscbnd ! ! -- Process density terms for each GHB @@ -499,6 +499,7 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & node = packobj%nodelist(n) ! ! -- Check if boundary cell is active, cycle if not + if (node == 0) cycle if (packobj%ibound(node) <= 0) cycle ! ! -- calculate the viscosity associated with the boundary @@ -523,9 +524,8 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & case ('GHBA') select type (packobj) type is (GhbaType) - nodeuser = packobj%dis%get_nodeuser(node) - packobj%cond(nodeuser) = update_bnd_cond(viscbnd, viscref, & - packobj%condinput(n)) + packobj%cond(n) = update_bnd_cond(viscbnd, viscref, & + packobj%condinput(n)) end select case ('RIV') select type (packobj) diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 index b9c54ef8ca2..32ba11ba6f1 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 @@ -152,6 +152,7 @@ subroutine destroy(this) end subroutine destroy subroutine reset(this) + use ConstantsModule, only: DNODATA class(GridArrayLoadType), intent(inout) :: this integer(I4B) :: n, m @@ -163,6 +164,7 @@ subroutine reset(this) ! explicitly reset auxvar array each period do m = 1, this%bound_context%nodes do n = 1, this%bound_context%naux + !this%bound_context%auxvar(n, m) = DNODATA this%bound_context%auxvar(n, m) = DZERO end do end do From ef6ce906a7402afe2b4cba72985641da753091f3 Mon Sep 17 00:00:00 2001 From: mjreno Date: Thu, 20 Mar 2025 09:10:04 -0400 Subject: [PATCH 05/22] add structured netcdf grid write support --- autotest/test_netcdf_gwf_vsc03_sfr.py | 2 +- src/Utilities/Export/DisNCStructured.f90 | 64 +++++++++++++++++------- src/Utilities/Export/NCExportCreate.f90 | 18 +++++-- 3 files changed, 60 insertions(+), 24 deletions(-) diff --git a/autotest/test_netcdf_gwf_vsc03_sfr.py b/autotest/test_netcdf_gwf_vsc03_sfr.py index 0b2a4342f31..d316eca9a16 100644 --- a/autotest/test_netcdf_gwf_vsc03_sfr.py +++ b/autotest/test_netcdf_gwf_vsc03_sfr.py @@ -230,7 +230,7 @@ def check_output(idx, test, export, gridded_input): auxarr = xds["rcha-1_auxvar_l1_p1a1"].data.flatten() elif export == "structured": rarr = xds["rcha-1_recharge_p1"].data[0].flatten() - auxarr = xds["rcha-1_auxvar_p1a1"].data[0].flatten() + auxarr = xds["rcha-1_temperature_p1"].data[0].flatten() assert np.allclose( np.array(irch[0]).flatten() + 1, xds["rcha-1_irch_p1"].data, diff --git a/src/Utilities/Export/DisNCStructured.f90 b/src/Utilities/Export/DisNCStructured.f90 index 403a243ad25..3a5bf8f7808 100644 --- a/src/Utilities/Export/DisNCStructured.f90 +++ b/src/Utilities/Export/DisNCStructured.f90 @@ -305,7 +305,7 @@ subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) iaux = 0 ! set variable name and input attribute string - nc_varname = export_varname(pkgname, idt) + nc_varname = export_varname(pkgname, idt%mf6varname) input_attr = this%input_attribute(pkgname, idt) select case (idt%datatype) @@ -434,8 +434,8 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) 'PERIOD', export_pkg%param_names(iparam), & this%nc_fname) ! set variable name and input attrs - nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, idt, & - iper=kper) + nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, & + idt%mf6varname, iper=kper) input_attr = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & idt) ! export arrays @@ -480,13 +480,19 @@ subroutine package_step(this, export_pkg) use TdisModule, only: kper use NCModelExportModule, only: ExportPackageType use DefinitionSelectModule, only: get_param_definition_type + use ConstantsModule, only: DNODATA, LENAUXNAME class(DisNCStructuredType), intent(inout) :: this class(ExportPackageType), pointer, intent(in) :: export_pkg integer(I4B), dimension(:), pointer, contiguous :: int1d real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d type(InputParamDefinitionType), pointer :: idt character(len=LINELENGTH) :: nc_varname, input_attr - integer(I4B) :: iparam + character(len=LENAUXNAME) :: aux + type(CharacterStringType), dimension(:), pointer, & + contiguous :: auxname_cst + integer(I4B) :: iparam, n do iparam = 1, export_pkg%nparam ! set input definition @@ -497,8 +503,8 @@ subroutine package_step(this, export_pkg) this%nc_fname) ! set variable name and input attribute string - nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, idt, & - iper=kper) + nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, & + idt%mf6varname, iper=kper) input_attr = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & idt) @@ -524,6 +530,26 @@ subroutine package_step(this, export_pkg) this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, kper, this%nc_fname) + case ('DOUBLE2D') + call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) + call mem_setptr(auxname_cst, 'AUXILIARY', export_pkg%mf6_input%mempath) + do n = 1, size(dbl2d, dim=1) ! naux + ! reset varname to auxname + aux = auxname_cst(n) + nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, & + aux, iper=kper) + + ! export the 1d array as a structured 3d array + dbl3d(1:export_pkg%mshape(3), 1:export_pkg%mshape(2), & + 1:export_pkg%mshape(1)) => dbl2d(n, :) + call nc_export_array(this%ncid, this%dim_ids, this%var_ids, & + this%dis, dbl3d, nc_varname, & + export_pkg%mf6_input%subcomponent_name, & + aux, 'NCOL NROW NLAY', idt%longname, input_attr, & + this%gridmap_name, this%latlon, this%deflate, & + this%shuffle, this%chunk_z, this%chunk_y, & + this%chunk_x, kper, n, this%nc_fname) + end do case default errmsg = 'EXPORT unsupported datatype='//trim(idt%datatype) call store_error(errmsg, .true.) @@ -538,6 +564,7 @@ end subroutine package_step !< subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & dbl1d, nc_varname, input_attr, iaux) + use ConstantsModule, only: DNODATA, DZERO, LENAUXNAME use TdisModule, only: kper use NCModelExportModule, only: ExportPackageType class(DisNCStructuredType), intent(inout) :: this @@ -552,12 +579,17 @@ subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d integer(I4B) :: n, i, j, k, nvals, idxaux real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr + character(len=LENAUXNAME) :: aux + type(CharacterStringType), dimension(:), pointer, & + contiguous :: auxname_cst ! initialize idxaux = 0 if (present(iaux)) then + call mem_setptr(auxname_cst, 'AUXILIARY', export_pkg%mf6_input%mempath) + aux = auxname_cst(iaux) nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, & - idt, iper=kper, iaux=iaux) + aux, iper=kper) idxaux = iaux end if @@ -1483,27 +1515,21 @@ end subroutine nc_export_dbl3d !> @brief build netcdf variable name !< - function export_varname(pkgname, idt, iper, iaux) result(varname) + function export_varname(pkgname, varname, iper) result(fullname) use InputOutputModule, only: lowcase character(len=*), intent(in) :: pkgname - type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=*), intent(in) :: varname integer(I4B), optional, intent(in) :: iper - integer(I4B), optional, intent(in) :: iaux - character(len=LINELENGTH) :: varname + character(len=LINELENGTH) :: fullname character(len=LINELENGTH) :: pname, vname pname = pkgname - vname = idt%mf6varname + vname = varname call lowcase(pname) call lowcase(vname) if (present(iper)) then - if (present(iaux)) then - write (varname, '(a,i0,a,i0)') trim(pname)//'_'//trim(vname)// & - '_p', iper, 'a', iaux - else - write (varname, '(a,i0)') trim(pname)//'_'//trim(vname)//'_p', iper - end if + write (fullname, '(a,i0)') trim(pname)//'_'//trim(vname)//'_p', iper else - varname = trim(pname)//'_'//trim(vname) + fullname = trim(pname)//'_'//trim(vname) end if end function export_varname diff --git a/src/Utilities/Export/NCExportCreate.f90 b/src/Utilities/Export/NCExportCreate.f90 index a525be78dca..56a67021ac4 100644 --- a/src/Utilities/Export/NCExportCreate.f90 +++ b/src/Utilities/Export/NCExportCreate.f90 @@ -144,7 +144,8 @@ subroutine create_export_pkglist(pkglist, loaders, iout) use InputLoadTypeModule, only: ModelDynamicPkgsType use InputLoadTypeModule, only: DynamicPkgLoadBaseType use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType - use Mf6FileGridInputModule, only: BoundGridInputType + use LayerArrayLoadModule, only: LayerArrayLoadType + use GridArrayLoadModule, only: GridArrayLoadType use IdmMf6FileModule, only: Mf6FileDynamicPkgLoadType type(ListType), intent(inout) :: pkglist type(ModelDynamicPkgsType), pointer, intent(in) :: loaders @@ -154,7 +155,7 @@ subroutine create_export_pkglist(pkglist, loaders, iout) type(ExportPackageType), pointer :: export_pkg integer(I4B), pointer :: export_arrays class(*), pointer :: obj - logical(LGP) :: found + logical(LGP) :: found, readasarrays integer(I4B) :: n ! create list of in scope loaders @@ -170,12 +171,21 @@ subroutine create_export_pkglist(pkglist, loaders, iout) call mem_set_value(export_arrays, 'EXPORT_NC', & dynamic_pkg%mf6_input%mempath, found) - if (export_arrays > 0 .and. dynamic_pkg%readasarrays) then + readasarrays = (dynamic_pkg%readarray_layer .or. dynamic_pkg%readarray_grid) + if (export_arrays > 0 .and. readasarrays) then select type (dynamic_pkg) type is (Mf6FileDynamicPkgLoadType) rp_loader => dynamic_pkg%rp_loader select type (rp_loader) - type is (BoundGridInputType) + type is (LayerArrayLoadType) + ! create the export object + allocate (export_pkg) + call export_pkg%init(rp_loader%mf6_input, & + rp_loader%bound_context%mshape, & + rp_loader%param_names, rp_loader%nparam) + obj => export_pkg + call pkglist%add(obj) + type is (GridArrayLoadType) ! create the export object allocate (export_pkg) call export_pkg%init(rp_loader%mf6_input, & From b00f04e4c8e8a1d08998dc1b07c4f60fb3fcdd47 Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 24 Mar 2025 15:02:12 -0400 Subject: [PATCH 06/22] add netcdf read and write support --- autotest/test_netcdf_gwf_vsc03_sfr.py | 2 +- src/Utilities/Export/DisNCMesh.f90 | 371 ++++++++++++--------- src/Utilities/Export/DisNCStructured.f90 | 346 ++++++++----------- src/Utilities/Export/DisvNCMesh.f90 | 317 ++++++++++-------- src/Utilities/Export/MeshNCModel.f90 | 32 -- src/Utilities/Export/NCModel.f90 | 58 +++- src/Utilities/Idm/netcdf/NCArrayReader.f90 | 65 ++-- src/Utilities/Idm/netcdf/NCFileVars.f90 | 2 +- 8 files changed, 626 insertions(+), 567 deletions(-) diff --git a/autotest/test_netcdf_gwf_vsc03_sfr.py b/autotest/test_netcdf_gwf_vsc03_sfr.py index d316eca9a16..6ab72e3b73e 100644 --- a/autotest/test_netcdf_gwf_vsc03_sfr.py +++ b/autotest/test_netcdf_gwf_vsc03_sfr.py @@ -227,7 +227,7 @@ def check_output(idx, test, export, gridded_input): aux = getattr(rch, "aux").array if export == "ugrid": rarr = xds["rcha-1_recharge_l1_p1"].data.flatten() - auxarr = xds["rcha-1_auxvar_l1_p1a1"].data.flatten() + auxarr = xds["rcha-1_temperature_l1_p1"].data.flatten() elif export == "structured": rarr = xds["rcha-1_recharge_p1"].data[0].flatten() auxarr = xds["rcha-1_temperature_p1"].data[0].flatten() diff --git a/src/Utilities/Export/DisNCMesh.f90 b/src/Utilities/Export/DisNCMesh.f90 index 3396a37c61d..8b37d421fb1 100644 --- a/src/Utilities/Export/DisNCMesh.f90 +++ b/src/Utilities/Export/DisNCMesh.f90 @@ -17,8 +17,8 @@ module MeshDisModelModule use CharacterStringModule, only: CharacterStringType use MeshModelModule, only: Mesh2dModelType, MeshNCDimIdType, MeshNCVarIdType, & ncvar_chunk, ncvar_deflate, ncvar_gridmap, & - ncvar_mf6attr, export_varname - use NCModelExportModule, only: export_longname + ncvar_mf6attr + use NCModelExportModule, only: export_longname, export_varname use DisModule, only: DisType use NetCDFCommonModule, only: nf_verify use netcdf @@ -193,7 +193,7 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) real(DP), dimension(:, :), pointer, contiguous :: dbl2d integer(I4B), dimension(:), pointer, contiguous :: ialayer real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr - character(len=LINELENGTH) :: nc_varname, input_attr + character(len=LINELENGTH) :: nc_tag integer(I4B) :: n, iparam, nvals logical(LGP) :: ilayer_read @@ -221,35 +221,32 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) export_pkg%mf6_input%component_type, & export_pkg%mf6_input%subcomponent_type, & 'PERIOD', export_pkg%param_names(iparam), '') - ! set variable name and input string - nc_varname = trim(export_pkg%mf6_input%subcomponent_name)//'_'// & - trim(idt%mf6varname) - input_attr = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & - idt) + ! set variable input tag + nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & + idt) ! export arrays select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call nc_export_int1d(this%ncid, this%dim_ids, this%x_dim, this%y_dim, & - this%var_ids, this%dis, int1d, nc_varname, & + call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, & + export_pkg%mf6_input%mempath, nc_tag, & export_pkg%mf6_input%subcomponent_name, & - idt%tagname, this%gridmap_name, idt%shape, & - idt%longname, input_attr, this%deflate, & - this%shuffle, this%chunk_face, kper, this%nc_fname) + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) call this%export_layer_3d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_varname, input_attr) + dbl1d, nc_tag) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) nvals = this%dis%ncol * this%dis%nrow - do n = 1, size(dbl2d, dim=1) !naux dbl1d_ptr(1:nvals) => dbl2d(n, :) if (all(dbl1d_ptr == DZERO)) then else call this%export_layer_3d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d_ptr, nc_varname, input_attr, n) + dbl1d_ptr, nc_tag, n) end if end do case default @@ -265,13 +262,72 @@ end subroutine package_step_ilayer !> @brief netcdf export package dynamic input !< subroutine package_step(this, export_pkg) + use ConstantsModule, only: DNODATA, DZERO + use TdisModule, only: kper + use DefinitionSelectModule, only: get_param_definition_type use NCModelExportModule, only: ExportPackageType class(Mesh2dDisExportType), intent(inout) :: this class(ExportPackageType), pointer, intent(in) :: export_pkg - errmsg = 'NetCDF period export not supported for model='// & - trim(this%modelname)//', package='// & - trim(export_pkg%mf6_input%subcomponent_name) - call store_error(errmsg, .true.) + type(InputParamDefinitionType), pointer :: idt + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + character(len=LINELENGTH) :: nc_tag + integer(I4B) :: iaux, iparam, nvals + + ! initialize + iaux = 0 + + ! export defined period input + do iparam = 1, export_pkg%nparam + ! check if variable was read this period + if (export_pkg%param_reads(iparam)%invar < 1) cycle + + ! set input definition + idt => & + get_param_definition_type(export_pkg%mf6_input%param_dfns, & + export_pkg%mf6_input%component_type, & + export_pkg%mf6_input%subcomponent_type, & + 'PERIOD', export_pkg%param_names(iparam), '') + + ! set variable input tag + nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & + idt) + + ! export arrays + select case (idt%datatype) + case ('INTEGER1D') + call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) + call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, & + export_pkg%mf6_input%mempath, nc_tag, & + export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, this%nc_fname) + case ('DOUBLE1D') + call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, & + export_pkg%mf6_input%mempath, nc_tag, & + export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + case ('DOUBLE2D') + call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) + nvals = this%dis%ncol * this%dis%nrow + do iaux = 1, size(dbl2d, dim=1) !naux + dbl1d(1:nvals) => dbl2d(iaux, :) + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, & + export_pkg%mf6_input%mempath, nc_tag, & + export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + end do + case default + ! no-op, no other datatypes exported + end select + end do ! synchronize file call nf_verify(nf90_sync(this%ncid), this%nc_fname) @@ -280,7 +336,7 @@ end subroutine package_step !> @brief export layer variable as full grid !< subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_varname, input_attr, iaux) + dbl1d, nc_tag, iaux) use ConstantsModule, only: DNODATA, DZERO use NCModelExportModule, only: ExportPackageType class(Mesh2dDisExportType), intent(inout) :: this @@ -289,8 +345,7 @@ subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & logical(LGP), intent(in) :: ilayer_read integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ialayer real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d - character(len=*), intent(in) :: nc_varname - character(len=*), intent(in) :: input_attr + character(len=*), intent(in) :: nc_tag integer(I4B), optional, intent(in) :: iaux real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d integer(I4B) :: n, i, j, k, nvals, idxaux @@ -326,10 +381,10 @@ subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & dbl3d(:, :, 1) = dbl2d_ptr(:, :) end if - call nc_export_dbl3d(this%ncid, this%dim_ids, this%var_ids, this%dis, dbl3d, & - nc_varname, export_pkg%mf6_input%subcomponent_name, & - idt%tagname, this%gridmap_name, idt%shape, & - idt%longname, input_attr, this%deflate, this%shuffle, & + call nc_export_dbl3d(dbl3d, this%ncid, this%dim_ids, this%var_ids, this%dis, & + idt, export_pkg%mf6_input%mempath, nc_tag, & + export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, export_pkg%iper, idxaux, this%nc_fname) deallocate (dbl3d) @@ -349,59 +404,52 @@ subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) real(DP), dimension(:), pointer, contiguous :: dbl1d real(DP), dimension(:, :), pointer, contiguous :: dbl2d real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d - character(len=LINELENGTH) :: nc_varname, input_attr + character(len=LINELENGTH) :: nc_tag integer(I4B) :: iper, iaux iper = 0 iaux = 0 - ! set package base name - nc_varname = trim(pkgname)//'_'//trim(idt%mf6varname) - ! put input attributes - input_attr = this%input_attribute(pkgname, idt) + ! set package input tag + nc_tag = this%input_attribute(pkgname, idt) select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, idt%mf6varname, mempath) - call nc_export_int1d(this%ncid, this%dim_ids, this%x_dim, this%y_dim, & - this%var_ids, this%dis, int1d, nc_varname, pkgname, & - idt%tagname, this%gridmap_name, idt%shape, & - idt%longname, input_attr, this%deflate, this%shuffle, & - this%chunk_face, iper, this%nc_fname) + call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, mempath, & + nc_tag, pkgname, this%gridmap_name, this%deflate, & + this%shuffle, this%chunk_face, iper, this%nc_fname) case ('INTEGER2D') call mem_setptr(int2d, idt%mf6varname, mempath) - call nc_export_int2d(this%ncid, this%dim_ids, this%var_ids, this%dis, & - int2d, nc_varname, pkgname, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, & - input_attr, this%deflate, this%shuffle, & + call nc_export_int2d(int2d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & + this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, this%nc_fname) case ('INTEGER3D') call mem_setptr(int3d, idt%mf6varname, mempath) - call nc_export_int3d(this%ncid, this%dim_ids, this%var_ids, this%dis, & - int3d, nc_varname, pkgname, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, & - input_attr, this%deflate, this%shuffle, & + call nc_export_int3d(int3d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & + this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, mempath) - call nc_export_dbl1d(this%ncid, this%dim_ids, this%x_dim, this%y_dim, & - this%var_ids, this%dis, dbl1d, nc_varname, pkgname, & - idt%tagname, this%gridmap_name, idt%shape, & - idt%longname, input_attr, this%deflate, this%shuffle, & - this%chunk_face, this%nc_fname) + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, mempath, & + nc_tag, pkgname, this%gridmap_name, this%deflate, & + this%shuffle, this%chunk_face, iper, iaux, & + this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, mempath) - call nc_export_dbl2d(this%ncid, this%dim_ids, this%var_ids, this%dis, & - dbl2d, nc_varname, pkgname, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, & - input_attr, this%deflate, this%shuffle, & + call nc_export_dbl2d(dbl2d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & + this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, this%nc_fname) case ('DOUBLE3D') call mem_setptr(dbl3d, idt%mf6varname, mempath) - call nc_export_dbl3d(this%ncid, this%dim_ids, this%var_ids, this%dis, & - dbl3d, nc_varname, pkgname, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, & - input_attr, this%deflate, this%shuffle, & + call nc_export_dbl3d(dbl3d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & + this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, iper, iaux, this%nc_fname) case default ! no-op, no other datatypes exported @@ -595,24 +643,21 @@ end subroutine add_mesh_data !> @brief netcdf export 1D integer !< - subroutine nc_export_int1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & - nc_varname, pkgname, tagname, gridmap_name, & - shapestr, longname, nc_tag, deflate, shuffle, & - chunk_face, iper, nc_fname) + subroutine nc_export_int1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & + idt, mempath, nc_tag, pkgname, gridmap_name, & + deflate, shuffle, chunk_face, iper, nc_fname) + integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids integer(I4B), intent(in) :: x_dim integer(I4B), intent(in) :: y_dim type(MeshNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face @@ -624,13 +669,13 @@ subroutine nc_export_int1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & integer(I4B), dimension(:), pointer, contiguous :: int1d integer(I4B) :: axis_dim, nvals, k integer(I4B), dimension(:), allocatable :: var_id - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname - if (shapestr == 'NROW' .or. & - shapestr == 'NCOL' .or. & - shapestr == 'NCPL') then + if (idt%shape == 'NROW' .or. & + idt%shape == 'NCOL' .or. & + idt%shape == 'NCPL') then - select case (shapestr) + select case (idt%shape) case ('NROW') axis_dim = y_dim case ('NCOL') @@ -640,14 +685,15 @@ subroutine nc_export_int1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & end select ! set names - varname_l = export_varname(nc_varname, layer=0, iper=iper) - longname_l = export_longname(longname, pkgname, tagname, layer=0, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, iper=iper) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + iper=iper) allocate (var_id(1)) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/axis_dim/), var_id(1)), & nc_fname) @@ -658,7 +704,7 @@ subroutine nc_export_int1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add mf6 attr call ncvar_mf6attr(ncid, var_id(1), 0, iper, 0, nc_tag, nc_fname) @@ -675,11 +721,12 @@ subroutine nc_export_int1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & call nf_verify(nf90_redef(ncid), nc_fname) do k = 1, dis%nlay ! set names - varname_l = export_varname(nc_varname, layer=k, iper=iper) - longname_l = export_longname(longname, pkgname, tagname, layer=k, & - iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, & + layer=k, iper=iper) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + layer=k, iper=iper) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%nmesh_face/), var_id(k)), & nc_fname) @@ -692,7 +739,7 @@ subroutine nc_export_int1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) @@ -721,21 +768,19 @@ end subroutine nc_export_int1d !> @brief netcdf export 2D integer !< - subroutine nc_export_int2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, gridmap_name, shapestr, longname, & - nc_tag, deflate, shuffle, chunk_face, nc_fname) + subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, deflate, shuffle, & + chunk_face, nc_fname) + integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids type(MeshNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face @@ -743,15 +788,15 @@ subroutine nc_export_int2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & integer(I4B) :: var_id integer(I4B), dimension(:), pointer, contiguous :: int1d integer(I4B), dimension(1) :: layer_shape - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname ! set names - varname_l = export_varname(nc_varname) - longname_l = export_longname(longname, pkgname, tagname, 0) + varname = export_varname(pkgname, idt%tagname, mempath) + longname = export_longname(idt%longname, pkgname, idt%tagname) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%nmesh_face/), var_id), & nc_fname) @@ -764,7 +809,7 @@ subroutine nc_export_int2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, nc_fname) @@ -779,28 +824,26 @@ end subroutine nc_export_int2d !> @brief netcdf export 3D integer !< - subroutine nc_export_int3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, gridmap_name, shapestr, longname, & - nc_tag, deflate, shuffle, chunk_face, nc_fname) + subroutine nc_export_int3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, deflate, shuffle, & + chunk_face, nc_fname) + integer(I4B), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids type(MeshNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - integer(I4B), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face character(len=*), intent(in) :: nc_fname integer(I4B), dimension(:), allocatable :: var_id integer(I4B), dimension(:), pointer, contiguous :: int1d - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname integer(I4B), dimension(1) :: layer_shape integer(I4B) :: k @@ -810,10 +853,10 @@ subroutine nc_export_int3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_redef(ncid), nc_fname) do k = 1, dis%nlay ! set names - varname_l = export_varname(nc_varname, layer=k) - longname_l = export_longname(longname, pkgname, tagname, k) + varname = export_varname(pkgname, idt%tagname, mempath, layer=k) + longname = export_longname(idt%longname, pkgname, idt%tagname, layer=k) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%nmesh_face/), var_id(k)), & nc_fname) @@ -826,7 +869,7 @@ subroutine nc_export_int3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) @@ -847,27 +890,26 @@ end subroutine nc_export_int3d !> @brief netcdf export 1D double !< - subroutine nc_export_dbl1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & - nc_varname, pkgname, tagname, gridmap_name, & - shapestr, longname, nc_tag, deflate, shuffle, & - chunk_face, nc_fname) + subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & + idt, mempath, nc_tag, pkgname, gridmap_name, & + deflate, shuffle, chunk_face, iper, iaux, nc_fname) + real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids integer(I4B), intent(in) :: x_dim integer(I4B), intent(in) :: y_dim type(MeshNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face + integer(I4B), intent(in) :: iper + integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname integer(I4B), dimension(3) :: dis_shape integer(I4B), dimension(1) :: layer_shape @@ -875,13 +917,13 @@ subroutine nc_export_dbl1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & real(DP), dimension(:), pointer, contiguous :: dbl1d integer(I4B) :: axis_dim, nvals, k integer(I4B), dimension(:), allocatable :: var_id - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname - if (shapestr == 'NROW' .or. & - shapestr == 'NCOL') then ! .or. & - !shapestr == 'NCPL') then + if (idt%shape == 'NROW' .or. & + idt%shape == 'NCOL') then ! .or. & + !idt%shape == 'NCPL') then - select case (shapestr) + select case (idt%shape) case ('NROW') axis_dim = y_dim case ('NCOL') @@ -891,14 +933,16 @@ subroutine nc_export_dbl1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & end select ! set names - varname_l = export_varname(nc_varname) - longname_l = export_longname(longname, pkgname, tagname, 0) + varname = export_varname(pkgname, idt%tagname, mempath, iper=iper, & + iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + iper=iper) allocate (var_id(1)) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/axis_dim/), var_id(1)), & nc_fname) @@ -909,10 +953,10 @@ subroutine nc_export_dbl1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add mf6 attr - call ncvar_mf6attr(ncid, var_id(1), 0, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id(1), 0, iper, iaux, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) @@ -926,10 +970,12 @@ subroutine nc_export_dbl1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & call nf_verify(nf90_redef(ncid), nc_fname) do k = 1, dis%nlay ! set names - varname_l = export_varname(nc_varname, layer=k) - longname_l = export_longname(longname, pkgname, tagname, k) + varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & + iper=iper, iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + layer=k, iper=iper) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%nmesh_face/), var_id(k)), & nc_fname) @@ -942,11 +988,11 @@ subroutine nc_export_dbl1d(ncid, dim_ids, x_dim, y_dim, var_ids, dis, p_mem, & call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, iper, iaux, nc_tag, nc_fname) end do ! reshape input @@ -971,37 +1017,35 @@ end subroutine nc_export_dbl1d !> @brief netcdf export 2D double !< - subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, gridmap_name, shapestr, longname, & - nc_tag, deflate, shuffle, chunk_face, nc_fname) + subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, deflate, shuffle, & + chunk_face, nc_fname) + real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids type(MeshNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face character(len=*), intent(in) :: nc_fname integer(I4B) :: var_id - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname real(DP), dimension(:), pointer, contiguous :: dbl1d integer(I4B), dimension(1) :: layer_shape ! set names - varname_l = export_varname(nc_varname) - longname_l = export_longname(longname, pkgname, tagname, 0) + varname = export_varname(pkgname, idt%tagname, mempath) + longname = export_longname(idt%longname, pkgname, idt%tagname) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%nmesh_face/), var_id), & nc_fname) @@ -1014,7 +1058,7 @@ subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, nc_fname) @@ -1029,23 +1073,20 @@ end subroutine nc_export_dbl2d !> @brief netcdf export 3D double !< - subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, gridmap_name, shapestr, longname, & - nc_tag, deflate, shuffle, chunk_face, iper, iaux, & - nc_fname) + subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, deflate, shuffle, & + chunk_face, iper, iaux, nc_fname) use ConstantsModule, only: DNODATA + real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids type(MeshNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face @@ -1054,7 +1095,7 @@ subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & character(len=*), intent(in) :: nc_fname integer(I4B), dimension(:), allocatable :: var_id real(DP), dimension(:), pointer, contiguous :: dbl1d - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname integer(I4B), dimension(1) :: layer_shape integer(I4B) :: k real(DP) :: fill_value @@ -1071,10 +1112,12 @@ subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_redef(ncid), nc_fname) do k = 1, dis%nlay ! set names - varname_l = export_varname(nc_varname, layer=k, iper=iper, iaux=iaux) - longname_l = export_longname(longname, pkgname, tagname, layer=k, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & + iper=iper, iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + layer=k, iper=iper) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%nmesh_face/), var_id(k)), & nc_fname) @@ -1087,7 +1130,7 @@ subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & (/fill_value/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) diff --git a/src/Utilities/Export/DisNCStructured.f90 b/src/Utilities/Export/DisNCStructured.f90 index 3a5bf8f7808..9e45c2e6972 100644 --- a/src/Utilities/Export/DisNCStructured.f90 +++ b/src/Utilities/Export/DisNCStructured.f90 @@ -15,7 +15,8 @@ module DisNCStructuredModule use MemoryManagerModule, only: mem_setptr use InputDefinitionModule, only: InputParamDefinitionType use CharacterStringModule, only: CharacterStringType - use NCModelExportModule, only: NCBaseModelExportType, export_longname + use NCModelExportModule, only: NCBaseModelExportType, export_varname, & + export_longname use DisModule, only: DisType use NetCDFCommonModule, only: nf_verify use netcdf @@ -297,7 +298,7 @@ subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) real(DP), dimension(:), pointer, contiguous :: dbl1d real(DP), dimension(:, :), pointer, contiguous :: dbl2d real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d - character(len=LINELENGTH) :: nc_varname, input_attr + character(len=LINELENGTH) :: nc_tag integer(I4B) :: iper, iaux ! initialize @@ -305,55 +306,48 @@ subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) iaux = 0 ! set variable name and input attribute string - nc_varname = export_varname(pkgname, idt%mf6varname) - input_attr = this%input_attribute(pkgname, idt) + nc_tag = this%input_attribute(pkgname, idt) select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, idt%mf6varname, mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - int1d, nc_varname, pkgname, idt%tagname, & - idt%shape, idt%longname, input_attr, & + call nc_export_array(int1d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, iper, this%nc_fname) case ('INTEGER2D') call mem_setptr(int2d, idt%mf6varname, mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - int2d, nc_varname, pkgname, idt%tagname, & - idt%shape, idt%longname, input_attr, & + call nc_export_array(int2d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, this%nc_fname) case ('INTEGER3D') call mem_setptr(int3d, idt%mf6varname, mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - int3d, nc_varname, pkgname, idt%tagname, & - idt%shape, idt%longname, input_attr, & + call nc_export_array(int3d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - dbl1d, nc_varname, pkgname, idt%tagname, & - idt%shape, idt%longname, input_attr, & + call nc_export_array(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & - this%chunk_x, iper, this%nc_fname) + this%chunk_x, iper, iaux, this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - dbl2d, nc_varname, pkgname, idt%tagname, & - idt%shape, idt%longname, input_attr, & + call nc_export_array(dbl2d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, this%nc_fname) case ('DOUBLE3D') call mem_setptr(dbl3d, idt%mf6varname, mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - dbl3d, nc_varname, pkgname, idt%tagname, & - idt%shape, idt%longname, input_attr, & + call nc_export_array(dbl3d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, iper, iaux, this%nc_fname) @@ -392,6 +386,7 @@ end subroutine export_input_arrays !< subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) use TdisModule, only: kper + use ConstantsModule, only: DNODATA, DZERO use NCModelExportModule, only: ExportPackageType use DefinitionSelectModule, only: get_param_definition_type class(DisNCStructuredType), intent(inout) :: this @@ -404,7 +399,7 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) real(DP), dimension(:, :), pointer, contiguous :: dbl2d integer(I4B), dimension(:), pointer, contiguous :: ialayer real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr - character(len=LINELENGTH) :: nc_varname, input_attr + character(len=LINELENGTH) :: nc_tag integer(I4B) :: n, iparam, nvals logical(LGP) :: ilayer_read @@ -434,25 +429,22 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) 'PERIOD', export_pkg%param_names(iparam), & this%nc_fname) ! set variable name and input attrs - nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, & - idt%mf6varname, iper=kper) - input_attr = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & - idt) + nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & + idt) ! export arrays select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - int1d, nc_varname, & - export_pkg%mf6_input%subcomponent_name, & - idt%tagname, idt%shape, idt%longname, input_attr, & + call nc_export_array(int1d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, export_pkg%iper, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) call this%export_layer_3d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_varname, input_attr) + dbl1d, nc_tag) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) nvals = this%dis%ncol * this%dis%nrow @@ -461,7 +453,7 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) if (all(dbl1d_ptr == DZERO)) then else call this%export_layer_3d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d_ptr, nc_varname, input_attr, n) + dbl1d_ptr, nc_tag, n) end if end do case default @@ -480,19 +472,18 @@ subroutine package_step(this, export_pkg) use TdisModule, only: kper use NCModelExportModule, only: ExportPackageType use DefinitionSelectModule, only: get_param_definition_type - use ConstantsModule, only: DNODATA, LENAUXNAME + use ConstantsModule, only: DNODATA class(DisNCStructuredType), intent(inout) :: this class(ExportPackageType), pointer, intent(in) :: export_pkg integer(I4B), dimension(:), pointer, contiguous :: int1d real(DP), dimension(:), pointer, contiguous :: dbl1d real(DP), dimension(:, :), pointer, contiguous :: dbl2d - real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d type(InputParamDefinitionType), pointer :: idt - character(len=LINELENGTH) :: nc_varname, input_attr - character(len=LENAUXNAME) :: aux - type(CharacterStringType), dimension(:), pointer, & - contiguous :: auxname_cst - integer(I4B) :: iparam, n + character(len=LINELENGTH) :: nc_tag + integer(I4B) :: iparam, iaux + + ! initialize + iaux = 0 do iparam = 1, export_pkg%nparam ! set input definition @@ -503,52 +494,39 @@ subroutine package_step(this, export_pkg) this%nc_fname) ! set variable name and input attribute string - nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, & - idt%mf6varname, iper=kper) - input_attr = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & - idt) + nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & + idt) ! export arrays select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, export_pkg%param_names(iparam), & export_pkg%mf6_input%mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - int1d, nc_varname, & - export_pkg%mf6_input%subcomponent_name, & - idt%tagname, idt%shape, idt%longname, input_attr, & + call nc_export_array(int1d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, kper, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, export_pkg%param_names(iparam), & export_pkg%mf6_input%mempath) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, & - dbl1d, nc_varname, & - export_pkg%mf6_input%subcomponent_name, & - idt%tagname, idt%shape, idt%longname, input_attr, & + call nc_export_array(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & - this%chunk_x, kper, this%nc_fname) + this%chunk_x, kper, iaux, this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) - call mem_setptr(auxname_cst, 'AUXILIARY', export_pkg%mf6_input%mempath) - do n = 1, size(dbl2d, dim=1) ! naux - ! reset varname to auxname - aux = auxname_cst(n) - nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, & - aux, iper=kper) - - ! export the 1d array as a structured 3d array - dbl3d(1:export_pkg%mshape(3), 1:export_pkg%mshape(2), & - 1:export_pkg%mshape(1)) => dbl2d(n, :) - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, & - this%dis, dbl3d, nc_varname, & - export_pkg%mf6_input%subcomponent_name, & - aux, 'NCOL NROW NLAY', idt%longname, input_attr, & + do iaux = 1, size(dbl2d, dim=1) ! naux + dbl1d => dbl2d(iaux, :) + call nc_export_array(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & - this%chunk_x, kper, n, this%nc_fname) + this%chunk_x, kper, iaux, this%nc_fname) end do case default errmsg = 'EXPORT unsupported datatype='//trim(idt%datatype) @@ -563,9 +541,8 @@ end subroutine package_step !> @brief export layer variable as full grid !< subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_varname, input_attr, iaux) - use ConstantsModule, only: DNODATA, DZERO, LENAUXNAME - use TdisModule, only: kper + dbl1d, nc_tag, iaux) + use ConstantsModule, only: DNODATA, DZERO use NCModelExportModule, only: ExportPackageType class(DisNCStructuredType), intent(inout) :: this class(ExportPackageType), pointer, intent(in) :: export_pkg @@ -573,23 +550,15 @@ subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & logical(LGP), intent(in) :: ilayer_read integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ialayer real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d - character(len=*), intent(inout) :: nc_varname - character(len=*), intent(in) :: input_attr + character(len=*), intent(in) :: nc_tag integer(I4B), optional, intent(in) :: iaux real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d integer(I4B) :: n, i, j, k, nvals, idxaux real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr - character(len=LENAUXNAME) :: aux - type(CharacterStringType), dimension(:), pointer, & - contiguous :: auxname_cst ! initialize idxaux = 0 if (present(iaux)) then - call mem_setptr(auxname_cst, 'AUXILIARY', export_pkg%mf6_input%mempath) - aux = auxname_cst(iaux) - nc_varname = export_varname(export_pkg%mf6_input%subcomponent_name, & - aux, iper=kper) idxaux = iaux end if @@ -617,12 +586,12 @@ subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & dbl3d(:, :, 1) = dbl2d_ptr(:, :) end if - call nc_export_array(this%ncid, this%dim_ids, this%var_ids, this%dis, dbl3d, & - nc_varname, export_pkg%mf6_input%subcomponent_name, & - idt%tagname, idt%shape, idt%longname, input_attr, & + call nc_export_array(dbl3d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & this%gridmap_name, this%latlon, this%deflate, & - this%shuffle, this%chunk_z, this%chunk_y, this%chunk_x, & - export_pkg%iper, idxaux, this%nc_fname) + this%shuffle, this%chunk_z, this%chunk_y, & + this%chunk_x, export_pkg%iper, idxaux, this%nc_fname) deallocate (dbl3d) end subroutine export_layer_3d @@ -1080,21 +1049,18 @@ end subroutine ncvar_mf6attr !> @brief netcdf export 1D integer !< - subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, shapestr, longname, nc_tag, & - gridmap_name, latlon, deflate, shuffle, chunk_z, & - chunk_y, chunk_x, iper, nc_fname) + subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, latlon, deflate, & + shuffle, chunk_z, chunk_y, chunk_x, iper, nc_fname) + integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids type(StructuredNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname - character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname + type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=*), intent(in) :: mempath character(len=*), intent(in) :: nc_tag + character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: gridmap_name logical(LGP), intent(in) :: latlon integer(I4B), intent(in) :: deflate @@ -1105,13 +1071,15 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & integer(I4B), intent(in) :: iper character(len=*), intent(in) :: nc_fname integer(I4B) :: var_id, axis_sz - character(len=LINELENGTH) :: longname_l + character(len=LINELENGTH) :: varname, longname - if (shapestr == 'NROW' .or. & - shapestr == 'NCOL' .or. & - shapestr == 'NCPL') then + varname = export_varname(pkgname, idt%tagname, mempath, iper=iper) - select case (shapestr) + if (idt%shape == 'NROW' .or. & + idt%shape == 'NCOL' .or. & + idt%shape == 'NCPL') then + + select case (idt%shape) case ('NROW') axis_sz = dim_ids%y case ('NCOL') @@ -1120,11 +1088,11 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & axis_sz = dim_ids%ncpl end select - longname_l = export_longname(longname, pkgname, tagname, layer=0, iper=iper) + longname = export_longname(idt%longname, pkgname, idt%tagname, iper=iper) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, nc_varname, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/axis_sz/), var_id), & nc_fname) @@ -1135,7 +1103,7 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add mf6 attr call ncvar_mf6attr(ncid, var_id, iper, 0, nc_tag, nc_fname) @@ -1148,7 +1116,7 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & else ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, nc_varname, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%x, dim_ids%y, dim_ids%z/), var_id), & nc_fname) @@ -1161,7 +1129,7 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname), nc_fname) + idt%longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) @@ -1177,21 +1145,18 @@ end subroutine nc_export_int1d !> @brief netcdf export 2D integer !< - subroutine nc_export_int2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, shapestr, longname, nc_tag, & - gridmap_name, latlon, deflate, shuffle, chunk_z, & - chunk_y, chunk_x, nc_fname) + subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, latlon, deflate, & + shuffle, chunk_z, chunk_y, chunk_x, nc_fname) + integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids type(StructuredNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname - character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname + type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=*), intent(in) :: mempath character(len=*), intent(in) :: nc_tag + character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: gridmap_name logical(LGP), intent(in) :: latlon integer(I4B), intent(in) :: deflate @@ -1200,11 +1165,14 @@ subroutine nc_export_int2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & integer(I4B), intent(in) :: chunk_y integer(I4B), intent(in) :: chunk_x character(len=*), intent(in) :: nc_fname + character(len=LINELENGTH) :: varname integer(I4B) :: var_id + varname = export_varname(pkgname, idt%tagname, mempath) + ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, nc_varname, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%x, dim_ids%y/), var_id), & nc_fname) @@ -1217,7 +1185,7 @@ subroutine nc_export_int2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname), nc_fname) + idt%longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) @@ -1232,21 +1200,18 @@ end subroutine nc_export_int2d !> @brief netcdf export 3D integer !< - subroutine nc_export_int3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, shapestr, longname, nc_tag, & - gridmap_name, latlon, deflate, shuffle, chunk_z, & - chunk_y, chunk_x, nc_fname) + subroutine nc_export_int3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, latlon, deflate, & + shuffle, chunk_z, chunk_y, chunk_x, nc_fname) + integer(I4B), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids type(StructuredNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - integer(I4B), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname - character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname + type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=*), intent(in) :: mempath character(len=*), intent(in) :: nc_tag + character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: gridmap_name logical(LGP), intent(in) :: latlon integer(I4B), intent(in) :: deflate @@ -1255,11 +1220,14 @@ subroutine nc_export_int3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & integer(I4B), intent(in) :: chunk_y integer(I4B), intent(in) :: chunk_x character(len=*), intent(in) :: nc_fname + character(len=LINELENGTH) :: varname integer(I4B) :: var_id + varname = export_varname(pkgname, idt%tagname, mempath) + ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, nc_varname, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%x, dim_ids%y, dim_ids%z/), var_id), & nc_fname) @@ -1272,7 +1240,7 @@ subroutine nc_export_int3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname), nc_fname) + idt%longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) @@ -1287,22 +1255,20 @@ end subroutine nc_export_int3d !> @brief netcdf export 1D double !< - subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, shapestr, longname, nc_tag, & - gridmap_name, latlon, deflate, shuffle, chunk_z, & - chunk_y, chunk_x, iper, nc_fname) + subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, latlon, deflate, & + shuffle, chunk_z, chunk_y, chunk_x, iper, iaux, & + nc_fname) use ConstantsModule, only: DNODATA + real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids type(StructuredNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname - character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname + type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=*), intent(in) :: mempath character(len=*), intent(in) :: nc_tag + character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: gridmap_name logical(LGP), intent(in) :: latlon integer(I4B), intent(in) :: deflate @@ -1311,16 +1277,17 @@ subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & integer(I4B), intent(in) :: chunk_y integer(I4B), intent(in) :: chunk_x integer(I4B), intent(in) :: iper + integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname integer(I4B) :: var_id, axis_sz real(DP) :: fill_value - character(len=LINELENGTH) :: longname_l + character(len=LINELENGTH) :: varname, longname - if (shapestr == 'NROW' .or. & - shapestr == 'NCOL' .or. & - shapestr == 'NCPL') then + if (idt%shape == 'NROW' .or. & + idt%shape == 'NCOL' .or. & + idt%shape == 'NCPL') then - select case (shapestr) + select case (idt%shape) case ('NROW') axis_sz = dim_ids%y case ('NCOL') @@ -1329,9 +1296,11 @@ subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & axis_sz = dim_ids%ncpl end select + varname = export_varname(pkgname, idt%tagname, mempath, iper=iper) + ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, nc_varname, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/axis_sz/), var_id), & nc_fname) @@ -1342,10 +1311,10 @@ subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname), nc_fname) + idt%longname), nc_fname) ! add mf6 attr - call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id, iper, iaux, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) @@ -1359,11 +1328,13 @@ subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & fill_value = NF90_FILL_DOUBLE end if - longname_l = export_longname(longname, pkgname, tagname, layer=0, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, iper=iper, & + iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, iper=iper) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, nc_varname, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%x, dim_ids%y, dim_ids%z/), var_id), & nc_fname) @@ -1376,11 +1347,11 @@ subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/fill_value/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) - call ncvar_mf6attr(ncid, var_id, iper, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id, iper, iaux, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) @@ -1392,21 +1363,18 @@ end subroutine nc_export_dbl1d !> @brief netcdf export 2D double !< - subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, shapestr, longname, nc_tag, & - gridmap_name, latlon, deflate, shuffle, chunk_z, & - chunk_y, chunk_x, nc_fname) + subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, latlon, deflate, & + shuffle, chunk_z, chunk_y, chunk_x, nc_fname) + real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids type(StructuredNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname - character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname + type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=*), intent(in) :: mempath character(len=*), intent(in) :: nc_tag + character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: gridmap_name logical(LGP), intent(in) :: latlon integer(I4B), intent(in) :: deflate @@ -1415,11 +1383,14 @@ subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & integer(I4B), intent(in) :: chunk_y integer(I4B), intent(in) :: chunk_x character(len=*), intent(in) :: nc_fname + character(len=LINELENGTH) :: varname integer(I4B) :: var_id + varname = export_varname(pkgname, idt%tagname, mempath) + ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, nc_varname, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%x, dim_ids%y/), var_id), & nc_fname) @@ -1432,7 +1403,7 @@ subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname), nc_fname) + idt%longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) @@ -1447,22 +1418,20 @@ end subroutine nc_export_dbl2d !> @brief netcdf export 3D double !< - subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, shapestr, longname, nc_tag, & - gridmap_name, latlon, deflate, shuffle, chunk_z, & - chunk_y, chunk_x, iper, iaux, nc_fname) + subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & + nc_tag, pkgname, gridmap_name, latlon, deflate, & + shuffle, chunk_z, chunk_y, chunk_x, iper, iaux, & + nc_fname) use ConstantsModule, only: DNODATA + real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids type(StructuredNCVarIdType), intent(inout) :: var_ids type(DisType), pointer, intent(in) :: dis - real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname - character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname + type(InputParamDefinitionType), pointer, intent(in) :: idt + character(len=*), intent(in) :: mempath character(len=*), intent(in) :: nc_tag + character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: gridmap_name logical(LGP), intent(in) :: latlon integer(I4B), intent(in) :: deflate @@ -1475,7 +1444,7 @@ subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & character(len=*), intent(in) :: nc_fname integer(I4B) :: var_id real(DP) :: fill_value - character(len=LINELENGTH) :: longname_l + character(len=LINELENGTH) :: varname, longname if (iper > 0) then fill_value = DNODATA @@ -1483,11 +1452,12 @@ subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & fill_value = NF90_FILL_DOUBLE end if - longname_l = export_longname(longname, pkgname, tagname, layer=0, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, iper=iper, iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, iper=iper) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, nc_varname, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%x, dim_ids%y, dim_ids%z/), var_id), & nc_fname) @@ -1500,7 +1470,7 @@ subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & (/fill_value/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) @@ -1513,24 +1483,4 @@ subroutine nc_export_dbl3d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & nc_fname) end subroutine nc_export_dbl3d - !> @brief build netcdf variable name - !< - function export_varname(pkgname, varname, iper) result(fullname) - use InputOutputModule, only: lowcase - character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: varname - integer(I4B), optional, intent(in) :: iper - character(len=LINELENGTH) :: fullname - character(len=LINELENGTH) :: pname, vname - pname = pkgname - vname = varname - call lowcase(pname) - call lowcase(vname) - if (present(iper)) then - write (fullname, '(a,i0)') trim(pname)//'_'//trim(vname)//'_p', iper - else - fullname = trim(pname)//'_'//trim(vname) - end if - end function export_varname - end module DisNCStructuredModule diff --git a/src/Utilities/Export/DisvNCMesh.f90 b/src/Utilities/Export/DisvNCMesh.f90 index 43e44e89b43..cd14f6e6a50 100644 --- a/src/Utilities/Export/DisvNCMesh.f90 +++ b/src/Utilities/Export/DisvNCMesh.f90 @@ -17,8 +17,8 @@ module MeshDisvModelModule use CharacterStringModule, only: CharacterStringType use MeshModelModule, only: Mesh2dModelType, MeshNCDimIdType, MeshNCVarIdType, & ncvar_chunk, ncvar_deflate, ncvar_gridmap, & - ncvar_mf6attr, export_varname - use NCModelExportModule, only: export_longname + ncvar_mf6attr + use NCModelExportModule, only: export_longname, export_varname use DisvModule, only: DisvType use NetCDFCommonModule, only: nf_verify use netcdf @@ -192,8 +192,8 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) real(DP), dimension(:, :), pointer, contiguous :: dbl2d integer(I4B), dimension(:), pointer, contiguous :: ialayer real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr - character(len=LINELENGTH) :: nc_varname, input_attr - integer(I4B) :: n, iparam, nvals + character(len=LINELENGTH) :: nc_tag + integer(I4B) :: iaux, iparam, nvals logical(LGP) :: ilayer_read ! initialize @@ -222,34 +222,31 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) 'PERIOD', export_pkg%param_names(iparam), '') ! set variable name and input string - nc_varname = trim(export_pkg%mf6_input%subcomponent_name)//'_'// & - trim(idt%mf6varname) - input_attr = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & - idt) + nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & + idt) ! export arrays select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call nc_export_int1d(this%ncid, this%dim_ids, this%var_ids, this%disv, & - int1d, nc_varname, & - export_pkg%mf6_input%subcomponent_name, & - idt%tagname, this%gridmap_name, idt%shape, & - idt%longname, input_attr, this%deflate, & - this%shuffle, this%chunk_face, kper, this%nc_fname) + call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) call this%export_layer_2d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_varname, input_attr) + dbl1d, nc_tag) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) nvals = this%disv%ncpl - do n = 1, size(dbl2d, dim=1) !naux - dbl1d_ptr(1:nvals) => dbl2d(n, :) + do iaux = 1, size(dbl2d, dim=1) !naux + dbl1d_ptr(1:nvals) => dbl2d(iaux, :) if (all(dbl1d_ptr == DZERO)) then else call this%export_layer_2d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d_ptr, nc_varname, input_attr, n) + dbl1d_ptr, nc_tag, iaux) end if end do case default @@ -265,13 +262,70 @@ end subroutine package_step_ilayer !> @brief netcdf export package dynamic input !< subroutine package_step(this, export_pkg) + use ConstantsModule, only: DNODATA, DZERO + use TdisModule, only: kper + use DefinitionSelectModule, only: get_param_definition_type use NCModelExportModule, only: ExportPackageType class(Mesh2dDisvExportType), intent(inout) :: this class(ExportPackageType), pointer, intent(in) :: export_pkg - errmsg = 'NetCDF period export not supported for model='// & - trim(this%modelname)//', package='// & - trim(export_pkg%mf6_input%subcomponent_name) - call store_error(errmsg, .true.) + type(InputParamDefinitionType), pointer :: idt + integer(I4B), dimension(:), pointer, contiguous :: int1d + real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:, :), pointer, contiguous :: dbl2d + character(len=LINELENGTH) :: nc_tag + integer(I4B) :: iaux, iparam, nvals + + ! initialize + iaux = 0 + + ! export defined period input + do iparam = 1, export_pkg%nparam + ! check if variable was read this period + if (export_pkg%param_reads(iparam)%invar < 1) cycle + + ! set input definition + idt => & + get_param_definition_type(export_pkg%mf6_input%param_dfns, & + export_pkg%mf6_input%component_type, & + export_pkg%mf6_input%subcomponent_type, & + 'PERIOD', export_pkg%param_names(iparam), '') + + ! set variable input tag + nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & + idt) + + ! export array + select case (idt%datatype) + case ('INTEGER1D') + call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) + call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, this%nc_fname) + case ('DOUBLE1D') + call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + case ('DOUBLE2D') + call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) + nvals = this%disv%ncpl + do iaux = 1, size(dbl2d, dim=1) !naux + dbl1d(1:nvals) => dbl2d(iaux, :) + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + end do + case default + ! no-op, no other datatypes exported + end select + end do + ! synchronize file call nf_verify(nf90_sync(this%ncid), this%nc_fname) end subroutine package_step @@ -279,7 +333,7 @@ end subroutine package_step !> @brief export layer variable as full grid !< subroutine export_layer_2d(this, export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_varname, input_attr, iaux) + dbl1d, nc_tag, iaux) use ConstantsModule, only: DNODATA, DZERO use NCModelExportModule, only: ExportPackageType class(Mesh2dDisvExportType), intent(inout) :: this @@ -288,8 +342,7 @@ subroutine export_layer_2d(this, export_pkg, idt, ilayer_read, ialayer, & logical(LGP), intent(in) :: ilayer_read integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ialayer real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d - character(len=*), intent(in) :: nc_varname - character(len=*), intent(in) :: input_attr + character(len=*), intent(in) :: nc_tag integer(I4B), optional, intent(in) :: iaux real(DP), dimension(:, :), pointer, contiguous :: dbl2d integer(I4B) :: n, j, k, idxaux @@ -319,12 +372,11 @@ subroutine export_layer_2d(this, export_pkg, idt, ilayer_read, ialayer, & dbl2d(:, 1) = dbl1d(:) end if - call nc_export_dbl2d(this%ncid, this%dim_ids, this%var_ids, this%disv, & - dbl2d, nc_varname, & - export_pkg%mf6_input%subcomponent_name, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, input_attr, & - this%deflate, this%shuffle, this%chunk_face, & - export_pkg%iper, idxaux, this%nc_fname) + call nc_export_dbl2d(dbl2d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, export_pkg%iper, idxaux, this%nc_fname) deallocate (dbl2d) end subroutine export_layer_2d @@ -341,45 +393,39 @@ subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) integer(I4B), dimension(:, :), pointer, contiguous :: int2d real(DP), dimension(:), pointer, contiguous :: dbl1d real(DP), dimension(:, :), pointer, contiguous :: dbl2d - character(len=LINELENGTH) :: nc_varname, input_attr + character(len=LINELENGTH) :: nc_tag integer(I4B) :: iper, iaux iper = 0 iaux = 0 - ! set package base name - nc_varname = trim(pkgname)//'_'//trim(idt%mf6varname) - ! put input attributes - input_attr = this%input_attribute(pkgname, idt) + ! set variable input tag + nc_tag = this%input_attribute(pkgname, idt) select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, idt%mf6varname, mempath) - call nc_export_int1d(this%ncid, this%dim_ids, this%var_ids, this%disv, & - int1d, nc_varname, pkgname, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, & - input_attr, this%deflate, this%shuffle, & + call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, mempath, nc_tag, pkgname, & + this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, iper, this%nc_fname) case ('INTEGER2D') call mem_setptr(int2d, idt%mf6varname, mempath) - call nc_export_int2d(this%ncid, this%dim_ids, this%var_ids, this%disv, & - int2d, nc_varname, pkgname, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, & - input_attr, this%deflate, this%shuffle, & + call nc_export_int2d(int2d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, mempath, nc_tag, pkgname, & + this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, mempath) - call nc_export_dbl1d(this%ncid, this%dim_ids, this%var_ids, this%disv, & - dbl1d, nc_varname, pkgname, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, & - input_attr, this%deflate, this%shuffle, & - this%chunk_face, this%nc_fname) + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, mempath, nc_tag, pkgname, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, iper, iaux, this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, mempath) - call nc_export_dbl2d(this%ncid, this%dim_ids, this%var_ids, this%disv, & - dbl2d, nc_varname, pkgname, idt%tagname, & - this%gridmap_name, idt%shape, idt%longname, & - input_attr, this%deflate, this%shuffle, & + call nc_export_dbl2d(dbl2d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, mempath, nc_tag, pkgname, & + this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, iper, iaux, this%nc_fname) case default ! no-op, no other datatypes exported @@ -570,21 +616,19 @@ end subroutine add_mesh_data !> @brief netcdf export 1D integer array !< - subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, gridmap_name, shapestr, longname, & - nc_tag, deflate, shuffle, chunk_face, iper, nc_fname) + subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & + nc_tag, pkgname, gridmap_name, deflate, shuffle, & + chunk_face, iper, nc_fname) + integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids type(MeshNCVarIdType), intent(inout) :: var_ids - type(DisvType), pointer, intent(in) :: dis - integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(DisvType), pointer, intent(in) :: disv + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face @@ -594,19 +638,20 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & integer(I4B), dimension(:, :), pointer, contiguous :: int2d integer(I4B) :: axis_sz, nvals, k integer(I4B), dimension(:), allocatable :: var_id - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname - if (shapestr == 'NCPL') then + if (idt%shape == 'NCPL') then ! set names - varname_l = export_varname(nc_varname) - longname_l = export_longname(longname, pkgname, tagname, layer=0, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, iper=iper) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + iper=iper) allocate (var_id(1)) axis_sz = dim_ids%nmesh_face ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/axis_sz/), var_id(1)), & nc_fname) @@ -619,7 +664,7 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(1), gridmap_name, nc_fname) @@ -631,17 +676,18 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & nc_fname) else - allocate (var_id(dis%nlay)) + allocate (var_id(disv%nlay)) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - do k = 1, dis%nlay + do k = 1, disv%nlay ! set names - varname_l = export_varname(nc_varname, layer=k, iper=iper) - longname_l = export_longname(longname, pkgname, tagname, layer=k, & - iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, & + layer=k, iper=iper) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + layer=k, iper=iper) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%nmesh_face/), var_id(k)), & nc_fname) @@ -654,7 +700,7 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) @@ -662,14 +708,14 @@ subroutine nc_export_int1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & end do ! reshape input - dis_shape(1) = dis%ncpl - dis_shape(2) = dis%nlay + dis_shape(1) = disv%ncpl + dis_shape(2) = disv%nlay nvals = product(dis_shape) int2d(1:dis_shape(1), 1:dis_shape(2)) => p_mem(1:nvals) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) - do k = 1, dis%nlay + do k = 1, disv%nlay call nf_verify(nf90_put_var(ncid, var_id(k), int2d(:, k)), nc_fname) end do @@ -680,27 +726,25 @@ end subroutine nc_export_int1d !> @brief netcdf export 2D integer array !< - subroutine nc_export_int2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, & - pkgname, tagname, gridmap_name, shapestr, longname, & - nc_tag, deflate, shuffle, chunk_face, nc_fname) + subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & + nc_tag, pkgname, gridmap_name, deflate, shuffle, & + chunk_face, nc_fname) + integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids type(MeshNCVarIdType), intent(inout) :: var_ids type(DisvType), pointer, intent(in) :: disv - integer(I4B), dimension(:, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face character(len=*), intent(in) :: nc_fname integer(I4B), dimension(:), allocatable :: var_id - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname integer(I4B) :: k allocate (var_id(disv%nlay)) @@ -709,10 +753,10 @@ subroutine nc_export_int2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, & call nf_verify(nf90_redef(ncid), nc_fname) do k = 1, disv%nlay ! set names - varname_l = export_varname(nc_varname, layer=k) - longname_l = export_longname(longname, pkgname, tagname, k) + varname = export_varname(pkgname, idt%tagname, mempath, layer=k) + longname = export_longname(idt%longname, pkgname, idt%tagname, layer=k) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_INT, & + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%nmesh_face/), var_id(k)), & nc_fname) @@ -725,7 +769,7 @@ subroutine nc_export_int2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & (/NF90_FILL_INT/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) @@ -743,42 +787,44 @@ end subroutine nc_export_int2d !> @brief netcdf export 1D double array !< - subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & - pkgname, tagname, gridmap_name, shapestr, longname, & - nc_tag, deflate, shuffle, chunk_face, nc_fname) + subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & + nc_tag, pkgname, gridmap_name, deflate, shuffle, & + chunk_face, iper, iaux, nc_fname) + real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids type(MeshNCVarIdType), intent(inout) :: var_ids - type(DisvType), pointer, intent(in) :: dis - real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(DisvType), pointer, intent(in) :: disv + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face + integer(I4B), intent(in) :: iper + integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname integer(I4B), dimension(2) :: dis_shape real(DP), dimension(:, :), pointer, contiguous :: dbl2d integer(I4B) :: axis_sz, nvals, k integer(I4B), dimension(:), allocatable :: var_id - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname - if (shapestr == 'NCPL') then + if (idt%shape == 'NCPL') then ! set names - varname_l = export_varname(nc_varname) - longname_l = export_longname(longname, pkgname, tagname, 0) + varname = export_varname(pkgname, idt%tagname, mempath, iper=iper, & + iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + iper=iper) allocate (var_id(1)) axis_sz = dim_ids%nmesh_face ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/axis_sz/), var_id(1)), & nc_fname) @@ -791,11 +837,11 @@ subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(1), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(1), 0, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id(1), 0, iper, iaux, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) @@ -803,16 +849,18 @@ subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & nc_fname) else - allocate (var_id(dis%nlay)) + allocate (var_id(disv%nlay)) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) - do k = 1, dis%nlay + do k = 1, disv%nlay ! set names - varname_l = export_varname(nc_varname, layer=k) - longname_l = export_longname(longname, pkgname, tagname, k) + varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & + iper=iper, iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + layer=k, iper=iper) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%nmesh_face/), var_id(k)), & nc_fname) @@ -825,22 +873,22 @@ subroutine nc_export_dbl1d(ncid, dim_ids, var_ids, dis, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, iper, iaux, nc_tag, nc_fname) end do ! reshape input - dis_shape(1) = dis%ncpl - dis_shape(2) = dis%nlay + dis_shape(1) = disv%ncpl + dis_shape(2) = disv%nlay nvals = product(dis_shape) dbl2d(1:dis_shape(1), 1:dis_shape(2)) => p_mem(1:nvals) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) - do k = 1, dis%nlay + do k = 1, disv%nlay call nf_verify(nf90_put_var(ncid, var_id(k), dbl2d(:, k)), nc_fname) end do @@ -851,23 +899,20 @@ end subroutine nc_export_dbl1d !> @brief netcdf export 2D double array !< - subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, & - pkgname, tagname, gridmap_name, shapestr, longname, & - nc_tag, deflate, shuffle, chunk_face, iper, iaux, & - nc_fname) + subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & + nc_tag, pkgname, gridmap_name, deflate, shuffle, & + chunk_face, iper, iaux, nc_fname) use ConstantsModule, only: DNODATA + real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids type(MeshNCVarIdType), intent(inout) :: var_ids type(DisvType), pointer, intent(in) :: disv - real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem - character(len=*), intent(in) :: nc_varname + type(InputParamDefinitionType), pointer :: idt + character(len=*), intent(in) :: mempath + character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: pkgname - character(len=*), intent(in) :: tagname character(len=*), intent(in) :: gridmap_name - character(len=*), intent(in) :: shapestr - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: nc_tag integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face @@ -875,7 +920,7 @@ subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, & integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname integer(I4B), dimension(:), allocatable :: var_id - character(len=LINELENGTH) :: longname_l, varname_l + character(len=LINELENGTH) :: longname, varname integer(I4B) :: k real(DP) :: fill_value @@ -891,10 +936,12 @@ subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, & call nf_verify(nf90_redef(ncid), nc_fname) do k = 1, disv%nlay ! set names - varname_l = export_varname(nc_varname, layer=k, iper=iper, iaux=iaux) - longname_l = export_longname(longname, pkgname, tagname, layer=k, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & + iper=iper, iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, layer=k, & + iper=iper) - call nf_verify(nf90_def_var(ncid, varname_l, NF90_DOUBLE, & + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%nmesh_face/), var_id(k)), & nc_fname) @@ -907,7 +954,7 @@ subroutine nc_export_dbl2d(ncid, dim_ids, var_ids, disv, p_mem, nc_varname, & call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & (/fill_value/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & - longname_l), nc_fname) + longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) diff --git a/src/Utilities/Export/MeshNCModel.f90 b/src/Utilities/Export/MeshNCModel.f90 index 3a7fb58e3e6..6d56dc2247c 100644 --- a/src/Utilities/Export/MeshNCModel.f90 +++ b/src/Utilities/Export/MeshNCModel.f90 @@ -26,7 +26,6 @@ module MeshModelModule public :: ncvar_deflate public :: ncvar_gridmap public :: ncvar_mf6attr - public :: export_varname !> @brief type for storing model export dimension ids !< @@ -572,35 +571,4 @@ subroutine ncvar_mf6attr(ncid, varid, layer, iper, iaux, nc_tag, nc_fname) end if end subroutine ncvar_mf6attr - !> @brief build netcdf variable name - !< - function export_varname(varname, layer, iper, iaux) result(vname) - use InputOutputModule, only: lowcase - character(len=*), intent(in) :: varname - integer(I4B), optional, intent(in) :: layer - integer(I4B), optional, intent(in) :: iper - integer(I4B), optional, intent(in) :: iaux - character(len=LINELENGTH) :: vname - vname = '' - if (varname /= '') then - vname = varname - call lowcase(vname) - if (present(layer)) then - if (layer > 0) then - write (vname, '(a,i0)') trim(vname)//'_l', layer - end if - end if - if (present(iper)) then - if (iper > 0) then - write (vname, '(a,i0)') trim(vname)//'_p', iper - end if - end if - if (present(iaux)) then - if (iaux > 0) then - write (vname, '(a,i0)') trim(vname)//'a', iaux - end if - end if - end if - end function export_varname - end module MeshModelModule diff --git a/src/Utilities/Export/NCModel.f90 b/src/Utilities/Export/NCModel.f90 index e2d3558a4a5..7ce4ff427b8 100644 --- a/src/Utilities/Export/NCModel.f90 +++ b/src/Utilities/Export/NCModel.f90 @@ -24,7 +24,7 @@ module NCModelExportModule public :: NCExportAnnotation public :: ExportPackageType public :: NETCDF_UNDEF, NETCDF_STRUCTURED, NETCDF_MESH2D - public :: export_longname + public :: export_longname, export_varname !> @brief netcdf export types enumerator !< @@ -412,6 +412,54 @@ function input_attribute(this, pkgname, idt) result(attr) end if end function input_attribute + !> @brief build netcdf variable name + !< + function export_varname(pkgname, tagname, mempath, layer, iper, iaux) & + result(varname) + use MemoryManagerModule, only: mem_setptr + use CharacterStringModule, only: CharacterStringType + use InputOutputModule, only: lowcase + character(len=*), intent(in) :: pkgname + character(len=*), intent(in) :: tagname + character(len=*), intent(in) :: mempath + integer(I4B), optional, intent(in) :: layer + integer(I4B), optional, intent(in) :: iper + integer(I4B), optional, intent(in) :: iaux + character(len=LINELENGTH) :: varname + type(CharacterStringType), dimension(:), pointer, & + contiguous :: auxnames + character(len=LINELENGTH) :: pname, vname + vname = tagname + pname = pkgname + + if (present(iaux)) then + if (iaux > 0) then + if (tagname == 'AUX') then + ! reset vname to auxiliary variable name + call mem_setptr(auxnames, 'AUXILIARY', mempath) + vname = auxnames(iaux) + end if + end if + end if + + call lowcase(vname) + call lowcase(pname) + varname = trim(pname)//'_'//trim(vname) + + if (present(layer)) then + if (layer > 0) then + !write (varname, '(a,i0)') trim(varname)//'_L', layer + write (varname, '(a,i0)') trim(varname)//'_l', layer + end if + end if + if (present(iper)) then + if (iper > 0) then + !write (varname, '(a,i0)') trim(varname)//'_SP', iper + write (varname, '(a,i0)') trim(varname)//'_p', iper + end if + end if + end function export_varname + !> @brief build netcdf variable longname !< function export_longname(longname, pkgname, tagname, layer, iper) result(lname) @@ -419,7 +467,7 @@ function export_longname(longname, pkgname, tagname, layer, iper) result(lname) character(len=*), intent(in) :: longname character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: tagname - integer(I4B), intent(in) :: layer + integer(I4B), optional, intent(in) :: layer integer(I4B), optional, intent(in) :: iper character(len=LINELENGTH) :: lname character(len=LINELENGTH) :: pname, vname @@ -432,8 +480,10 @@ function export_longname(longname, pkgname, tagname, layer, iper) result(lname) else lname = longname end if - if (layer > 0) then - write (lname, '(a,i0)') trim(lname)//' layer=', layer + if (present(layer)) then + if (layer > 0) then + write (lname, '(a,i0)') trim(lname)//' layer=', layer + end if end if if (present(iper)) then if (iper > 0) then diff --git a/src/Utilities/Idm/netcdf/NCArrayReader.f90 b/src/Utilities/Idm/netcdf/NCArrayReader.f90 index 11119dc32fc..aaf518a7c7b 100644 --- a/src/Utilities/Idm/netcdf/NCArrayReader.f90 +++ b/src/Utilities/Idm/netcdf/NCArrayReader.f90 @@ -462,11 +462,11 @@ subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & character(len=*), intent(in) :: input_fname integer(I4B), optional, intent(in) :: iaux real(DP), dimension(:, :, :), contiguous, pointer :: dbl3d - integer(I4B) :: nvals, varid + integer(I4B) :: varid integer(I4B) :: n, i, j, k ! initialize - nvals = 0 + n = 0 ! set varid if (present(iaux)) then @@ -475,20 +475,22 @@ subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & varid = nc_vars%varid(idt%mf6varname, period=iper) end if - if (idt%shape == 'NODES') then - ! TODO future support - write (errmsg, '(a)') & - 'IDM NetCDF load_double1d_spd NODES var shape not supported => '// & - trim(idt%tagname) - call store_error(errmsg) - call store_error_filename(input_fname) - else if (idt%shape == 'NCPL' .or. idt%shape == 'NAUX NCPL') then + if (size(mshape) == 3) then + allocate (dbl3d(mshape(3), mshape(2), mshape(1))) + call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl3d), & + nc_vars%nc_fname) - if (size(mshape) == 3) then - allocate (dbl3d(mshape(3), mshape(2), mshape(1))) - call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl3d), & - nc_vars%nc_fname) - n = 0 + if (idt%shape == 'NODES' .or. idt%shape == 'NAUX NODES') then + do k = 1, size(dbl3d, dim=3) + do i = 1, size(dbl3d, dim=2) + do j = 1, size(dbl3d, dim=1) + n = n + 1 + dbl1d(n) = dbl3d(j, i, k) + end do + end do + end do + + else if (idt%shape == 'NCPL' .or. idt%shape == 'NAUX NCPL') then do k = 1, size(dbl3d, dim=3) do i = 1, size(dbl3d, dim=2) do j = 1, size(dbl3d, dim=1) @@ -503,15 +505,10 @@ subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & end do end do end do - - else if (size(mshape) == 2) then - ! TODO - write (errmsg, '(a)') & - 'IDM NetCDF load_double1d_spd DISV model not supported => '// & - trim(idt%tagname) - call store_error(errmsg) - call store_error_filename(input_fname) end if + + ! clean up + deallocate (dbl3d) end if end subroutine load_double1d_spd @@ -561,8 +558,7 @@ subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & integer(I4B), optional, intent(in) :: iaux integer(I4B), dimension(:), allocatable :: layer_shape integer(I4B) :: nlay, varid - integer(I4B) :: k, n, ncpl - integer(I4B) :: index_start, index_stop + integer(I4B) :: k, n, ncpl, idx real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr call get_layered_shape(mshape, nlay, layer_shape) @@ -570,8 +566,6 @@ subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & allocate (dbl1d_ptr(ncpl)) do k = 1, nlay - index_start = 1 - index_stop = index_start + ncpl - 1 if (present(iaux)) then varid = nc_vars%varid(idt%mf6varname, layer=k, period=iper, iaux=iaux) else @@ -579,11 +573,18 @@ subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & end if call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), & nc_vars%nc_fname) - do n = 1, ncpl - if (dbl1d_ptr(n) /= DNODATA) then - dbl1d(n) = dbl1d_ptr(n) - end if - end do + if (idt%shape == 'NODES' .or. idt%shape == 'NAUX NODES') then + do n = 1, ncpl + idx = (k - 1) * ncpl + n + dbl1d(idx) = dbl1d_ptr(n) + end do + else if (idt%shape == 'NCPL' .or. idt%shape == 'NAUX NCPL') then + do n = 1, ncpl + if (dbl1d_ptr(n) /= DNODATA) then + dbl1d(n) = dbl1d_ptr(n) + end if + end do + end if end do ! cleanup diff --git a/src/Utilities/Idm/netcdf/NCFileVars.f90 b/src/Utilities/Idm/netcdf/NCFileVars.f90 index a7cee0273d1..9e38dc78bc3 100644 --- a/src/Utilities/Idm/netcdf/NCFileVars.f90 +++ b/src/Utilities/Idm/netcdf/NCFileVars.f90 @@ -116,7 +116,7 @@ function ncvars_varid(this, tagname, layer, period, iaux) result(varid) write (errmsg, '(a)') & 'NetCDF variable not found, tagname="'//trim(tagname)//'"' if (present(layer)) then - write (errmsg, '(a,i0)') trim(errmsg)//', ilayer=', layer + write (errmsg, '(a,i0)') trim(errmsg)//', layer=', layer end if if (present(period)) then write (errmsg, '(a,i0)') trim(errmsg)//', period=', period From 5808d226629228bf2a350bea76a88fb2f966696b Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 24 Mar 2025 15:04:38 -0400 Subject: [PATCH 07/22] rebuild makefiles --- make/makefile | 74 ++++++++++++++++++++++++++++----------------------- 1 file changed, 40 insertions(+), 34 deletions(-) diff --git a/make/makefile b/make/makefile index 97726af3b66..18418af14de 100644 --- a/make/makefile +++ b/make/makefile @@ -17,36 +17,37 @@ SOURCEDIR10=../src/Model/Geometry SOURCEDIR11=../src/Model/GroundWaterEnergy SOURCEDIR12=../src/Model/GroundWaterFlow SOURCEDIR13=../src/Model/GroundWaterFlow/submodules -SOURCEDIR14=../src/Model/GroundWaterTransport -SOURCEDIR15=../src/Model/ModelUtilities -SOURCEDIR16=../src/Model/OverlandFlow -SOURCEDIR17=../src/Model/ParticleTracking -SOURCEDIR18=../src/Model/SurfaceWaterFlow -SOURCEDIR19=../src/Model/TransportModel -SOURCEDIR20=../src/Solution -SOURCEDIR21=../src/Solution/LinearMethods -SOURCEDIR22=../src/Solution/PETSc -SOURCEDIR23=../src/Solution/ParticleTracker -SOURCEDIR24=../src/Timing -SOURCEDIR25=../src/Utilities -SOURCEDIR26=../src/Utilities/ArrayRead -SOURCEDIR27=../src/Utilities/Export -SOURCEDIR28=../src/Utilities/Idm -SOURCEDIR29=../src/Utilities/Idm/mf6blockfile -SOURCEDIR30=../src/Utilities/Idm/netcdf -SOURCEDIR31=../src/Utilities/Libraries -SOURCEDIR32=../src/Utilities/Libraries/blas -SOURCEDIR33=../src/Utilities/Libraries/daglib -SOURCEDIR34=../src/Utilities/Libraries/rcm -SOURCEDIR35=../src/Utilities/Libraries/sparsekit -SOURCEDIR36=../src/Utilities/Libraries/sparskit2 -SOURCEDIR37=../src/Utilities/Matrix -SOURCEDIR38=../src/Utilities/Memory -SOURCEDIR39=../src/Utilities/Observation -SOURCEDIR40=../src/Utilities/OutputControl -SOURCEDIR41=../src/Utilities/Performance -SOURCEDIR42=../src/Utilities/TimeSeries -SOURCEDIR43=../src/Utilities/Vector +SOURCEDIR14=../src/Model/GroundWaterFlow/tmp +SOURCEDIR15=../src/Model/GroundWaterTransport +SOURCEDIR16=../src/Model/ModelUtilities +SOURCEDIR17=../src/Model/OverlandFlow +SOURCEDIR18=../src/Model/ParticleTracking +SOURCEDIR19=../src/Model/SurfaceWaterFlow +SOURCEDIR20=../src/Model/TransportModel +SOURCEDIR21=../src/Solution +SOURCEDIR22=../src/Solution/LinearMethods +SOURCEDIR23=../src/Solution/PETSc +SOURCEDIR24=../src/Solution/ParticleTracker +SOURCEDIR25=../src/Timing +SOURCEDIR26=../src/Utilities +SOURCEDIR27=../src/Utilities/ArrayRead +SOURCEDIR28=../src/Utilities/Export +SOURCEDIR29=../src/Utilities/Idm +SOURCEDIR30=../src/Utilities/Idm/mf6blockfile +SOURCEDIR31=../src/Utilities/Idm/netcdf +SOURCEDIR32=../src/Utilities/Libraries +SOURCEDIR33=../src/Utilities/Libraries/blas +SOURCEDIR34=../src/Utilities/Libraries/daglib +SOURCEDIR35=../src/Utilities/Libraries/rcm +SOURCEDIR36=../src/Utilities/Libraries/sparsekit +SOURCEDIR37=../src/Utilities/Libraries/sparskit2 +SOURCEDIR38=../src/Utilities/Matrix +SOURCEDIR39=../src/Utilities/Memory +SOURCEDIR40=../src/Utilities/Observation +SOURCEDIR41=../src/Utilities/OutputControl +SOURCEDIR42=../src/Utilities/Performance +SOURCEDIR43=../src/Utilities/TimeSeries +SOURCEDIR44=../src/Utilities/Vector VPATH = \ ${SOURCEDIR1} \ @@ -91,7 +92,8 @@ ${SOURCEDIR39} \ ${SOURCEDIR40} \ ${SOURCEDIR41} \ ${SOURCEDIR42} \ -${SOURCEDIR43} +${SOURCEDIR43} \ +${SOURCEDIR44} .SUFFIXES: .f90 .F90 .o @@ -173,6 +175,7 @@ $(OBJDIR)/gwf-npfidm.o \ $(OBJDIR)/gwf-namidm.o \ $(OBJDIR)/gwf-icidm.o \ $(OBJDIR)/gwf-ghbidm.o \ +$(OBJDIR)/gwf-ghbaidm.o \ $(OBJDIR)/gwf-evtidm.o \ $(OBJDIR)/gwf-evtaidm.o \ $(OBJDIR)/gwf-drnidm.o \ @@ -287,7 +290,6 @@ $(OBJDIR)/SfrCrossSectionUtils.o \ $(OBJDIR)/TernarySolveTrack.o \ $(OBJDIR)/SubcellTri.o \ $(OBJDIR)/Method.o \ -$(OBJDIR)/MethodCell.o \ $(OBJDIR)/SubcellRect.o \ $(OBJDIR)/VirtualBase.o \ $(OBJDIR)/STLVecInt.o \ @@ -314,10 +316,12 @@ $(OBJDIR)/mf6lists.o \ $(OBJDIR)/gwf-lak.o \ $(OBJDIR)/GwfVscInputData.o \ $(OBJDIR)/gwf-ghb.o \ +$(OBJDIR)/gwf-ghba.o \ $(OBJDIR)/gwf-drn.o \ $(OBJDIR)/IndexMap.o \ $(OBJDIR)/ArrayReaderBase.o \ $(OBJDIR)/MethodSubcellPool.o \ +$(OBJDIR)/MethodCell.o \ $(OBJDIR)/CellPoly.o \ $(OBJDIR)/CellRectQuad.o \ $(OBJDIR)/CellRect.o \ @@ -471,8 +475,9 @@ $(OBJDIR)/NumericalSolution.o \ $(OBJDIR)/MappedMemory.o \ $(OBJDIR)/NCModel.o \ $(OBJDIR)/Mf6FileStoInput.o \ -$(OBJDIR)/Mf6FileListInput.o \ -$(OBJDIR)/Mf6FileGridInput.o \ +$(OBJDIR)/Mf6FileList.o \ +$(OBJDIR)/Mf6FileLayerArray.o \ +$(OBJDIR)/Mf6FileGridArray.o \ $(OBJDIR)/prt.o \ $(OBJDIR)/olf.o \ $(OBJDIR)/chf.o \ @@ -521,6 +526,7 @@ $(OBJDIR)/GwfSfrCommon.o \ $(OBJDIR)/gwf-sfr-transient.o \ $(OBJDIR)/gwf-sfr-steady.o \ $(OBJDIR)/gwf-sfr-constant.o \ +$(OBJDIR)/gwf-ghba.o \ $(OBJDIR)/RectangularGeometry.o \ $(OBJDIR)/CircularGeometry.o \ $(OBJDIR)/ExplicitModel.o \ From 1e57872e62f5e42e172af0f1f3c8d36ef2df5232 Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 24 Mar 2025 17:07:21 -0400 Subject: [PATCH 08/22] rebuild makefiles --- make/makefile | 65 ++++++++++++++++++++++++--------------------------- 1 file changed, 31 insertions(+), 34 deletions(-) diff --git a/make/makefile b/make/makefile index 18418af14de..7595e04f752 100644 --- a/make/makefile +++ b/make/makefile @@ -17,37 +17,36 @@ SOURCEDIR10=../src/Model/Geometry SOURCEDIR11=../src/Model/GroundWaterEnergy SOURCEDIR12=../src/Model/GroundWaterFlow SOURCEDIR13=../src/Model/GroundWaterFlow/submodules -SOURCEDIR14=../src/Model/GroundWaterFlow/tmp -SOURCEDIR15=../src/Model/GroundWaterTransport -SOURCEDIR16=../src/Model/ModelUtilities -SOURCEDIR17=../src/Model/OverlandFlow -SOURCEDIR18=../src/Model/ParticleTracking -SOURCEDIR19=../src/Model/SurfaceWaterFlow -SOURCEDIR20=../src/Model/TransportModel -SOURCEDIR21=../src/Solution -SOURCEDIR22=../src/Solution/LinearMethods -SOURCEDIR23=../src/Solution/PETSc -SOURCEDIR24=../src/Solution/ParticleTracker -SOURCEDIR25=../src/Timing -SOURCEDIR26=../src/Utilities -SOURCEDIR27=../src/Utilities/ArrayRead -SOURCEDIR28=../src/Utilities/Export -SOURCEDIR29=../src/Utilities/Idm -SOURCEDIR30=../src/Utilities/Idm/mf6blockfile -SOURCEDIR31=../src/Utilities/Idm/netcdf -SOURCEDIR32=../src/Utilities/Libraries -SOURCEDIR33=../src/Utilities/Libraries/blas -SOURCEDIR34=../src/Utilities/Libraries/daglib -SOURCEDIR35=../src/Utilities/Libraries/rcm -SOURCEDIR36=../src/Utilities/Libraries/sparsekit -SOURCEDIR37=../src/Utilities/Libraries/sparskit2 -SOURCEDIR38=../src/Utilities/Matrix -SOURCEDIR39=../src/Utilities/Memory -SOURCEDIR40=../src/Utilities/Observation -SOURCEDIR41=../src/Utilities/OutputControl -SOURCEDIR42=../src/Utilities/Performance -SOURCEDIR43=../src/Utilities/TimeSeries -SOURCEDIR44=../src/Utilities/Vector +SOURCEDIR14=../src/Model/GroundWaterTransport +SOURCEDIR15=../src/Model/ModelUtilities +SOURCEDIR16=../src/Model/OverlandFlow +SOURCEDIR17=../src/Model/ParticleTracking +SOURCEDIR18=../src/Model/SurfaceWaterFlow +SOURCEDIR19=../src/Model/TransportModel +SOURCEDIR20=../src/Solution +SOURCEDIR21=../src/Solution/LinearMethods +SOURCEDIR22=../src/Solution/PETSc +SOURCEDIR23=../src/Solution/ParticleTracker +SOURCEDIR24=../src/Timing +SOURCEDIR25=../src/Utilities +SOURCEDIR26=../src/Utilities/ArrayRead +SOURCEDIR27=../src/Utilities/Export +SOURCEDIR28=../src/Utilities/Idm +SOURCEDIR29=../src/Utilities/Idm/mf6blockfile +SOURCEDIR30=../src/Utilities/Idm/netcdf +SOURCEDIR31=../src/Utilities/Libraries +SOURCEDIR32=../src/Utilities/Libraries/blas +SOURCEDIR33=../src/Utilities/Libraries/daglib +SOURCEDIR34=../src/Utilities/Libraries/rcm +SOURCEDIR35=../src/Utilities/Libraries/sparsekit +SOURCEDIR36=../src/Utilities/Libraries/sparskit2 +SOURCEDIR37=../src/Utilities/Matrix +SOURCEDIR38=../src/Utilities/Memory +SOURCEDIR39=../src/Utilities/Observation +SOURCEDIR40=../src/Utilities/OutputControl +SOURCEDIR41=../src/Utilities/Performance +SOURCEDIR42=../src/Utilities/TimeSeries +SOURCEDIR43=../src/Utilities/Vector VPATH = \ ${SOURCEDIR1} \ @@ -92,8 +91,7 @@ ${SOURCEDIR39} \ ${SOURCEDIR40} \ ${SOURCEDIR41} \ ${SOURCEDIR42} \ -${SOURCEDIR43} \ -${SOURCEDIR44} +${SOURCEDIR43} .SUFFIXES: .f90 .F90 .o @@ -526,7 +524,6 @@ $(OBJDIR)/GwfSfrCommon.o \ $(OBJDIR)/gwf-sfr-transient.o \ $(OBJDIR)/gwf-sfr-steady.o \ $(OBJDIR)/gwf-sfr-constant.o \ -$(OBJDIR)/gwf-ghba.o \ $(OBJDIR)/RectangularGeometry.o \ $(OBJDIR)/CircularGeometry.o \ $(OBJDIR)/ExplicitModel.o \ From c90a298fdffaea01619bf86184802cc39b93fdbd Mon Sep 17 00:00:00 2001 From: mjreno Date: Fri, 4 Apr 2025 09:30:40 -0400 Subject: [PATCH 09/22] store dynamic netcdf input as timeseries --- autotest/test_netcdf_gwf_rch01.py | 11 +- autotest/test_netcdf_gwf_rch03.py | 11 +- autotest/test_netcdf_gwf_vsc03_sfr.py | 10 +- doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn | 50 +- src/Idm/gwf-ghbaidm.f90 | 82 +-- src/Utilities/Export/DisNCMesh.f90 | 648 ++++++++--------- src/Utilities/Export/DisNCStructured.f90 | 727 +++++++++++--------- src/Utilities/Export/DisvNCMesh.f90 | 557 +++++++-------- src/Utilities/Export/MeshNCModel.f90 | 175 ++++- src/Utilities/Export/NCExportCreate.f90 | 2 + src/Utilities/Export/NCModel.f90 | 85 +-- src/Utilities/Idm/netcdf/NCArrayReader.f90 | 220 ++++-- src/Utilities/Idm/netcdf/NCContextBuild.f90 | 18 +- src/Utilities/Idm/netcdf/NetCDFCommon.f90 | 14 + 14 files changed, 1332 insertions(+), 1278 deletions(-) diff --git a/autotest/test_netcdf_gwf_rch01.py b/autotest/test_netcdf_gwf_rch01.py index 1a5c8fcfb22..8bf060387f5 100644 --- a/autotest/test_netcdf_gwf_rch01.py +++ b/autotest/test_netcdf_gwf_rch01.py @@ -198,20 +198,17 @@ def check_output(idx, test, export, gridded_input): irch = getattr(rch, "irch").array recharge = getattr(rch, "recharge").array if export == "ugrid": - rl1 = xds["rcha_0_recharge_l1_p1"].data.flatten() - rl2 = xds["rcha_0_recharge_l2_p1"].data.flatten() + r = xds["rcha_0_recharge"].data.flatten() elif export == "structured": - rl1 = xds["rcha_0_recharge_p1"].data[0].flatten() - rl2 = xds["rcha_0_recharge_p1"].data[1].flatten() + r = xds["rcha_0_recharge"].data[0].flatten() if idx == 1: assert np.allclose( np.array(irch).flatten() + 1, - xds["rcha_0_irch_p1"].data, + xds["rcha_0_irch"].data, ), "NetCDF-irch comparison failure" - rarr = np.where(~np.isnan(rl1), rl1, rl2) assert np.allclose( np.array(recharge).flatten(), - rarr, + r, ), "NetCDF-recharge comparison failure" vlist = [ diff --git a/autotest/test_netcdf_gwf_rch03.py b/autotest/test_netcdf_gwf_rch03.py index 341d7eaee63..199be957729 100644 --- a/autotest/test_netcdf_gwf_rch03.py +++ b/autotest/test_netcdf_gwf_rch03.py @@ -200,19 +200,16 @@ def check_output(idx, test, export, gridded_input): irch = getattr(rch, "irch").array recharge = getattr(rch, "recharge").array if export == "ugrid": - rl1 = xds["rcha_0_recharge_l1_p1"].data.flatten() - rl2 = xds["rcha_0_recharge_l2_p1"].data.flatten() + r = xds["rcha_0_recharge"].data.flatten() elif export == "structured": - rl1 = xds["rcha_0_recharge_p1"].data[0].flatten() - rl2 = xds["rcha_0_recharge_p1"].data[1].flatten() + r = xds["rcha_0_recharge"].data[0].flatten() assert np.allclose( np.array(irch).flatten() + 1, - xds["rcha_0_irch_p1"].data, + xds["rcha_0_irch"].data.flatten(), ), "NetCDF-irch comparison failure" - rarr = np.where(~np.isnan(rl1), rl1, rl2) assert np.allclose( np.array(recharge).flatten(), - rarr, + r, ), "NetCDF-recharge comparison failure" vlist = [ diff --git a/autotest/test_netcdf_gwf_vsc03_sfr.py b/autotest/test_netcdf_gwf_vsc03_sfr.py index 6ab72e3b73e..52336f8a848 100644 --- a/autotest/test_netcdf_gwf_vsc03_sfr.py +++ b/autotest/test_netcdf_gwf_vsc03_sfr.py @@ -225,15 +225,11 @@ def check_output(idx, test, export, gridded_input): irch = getattr(rch, "irch").array recharge = getattr(rch, "recharge").array aux = getattr(rch, "aux").array - if export == "ugrid": - rarr = xds["rcha-1_recharge_l1_p1"].data.flatten() - auxarr = xds["rcha-1_temperature_l1_p1"].data.flatten() - elif export == "structured": - rarr = xds["rcha-1_recharge_p1"].data[0].flatten() - auxarr = xds["rcha-1_temperature_p1"].data[0].flatten() + rarr = xds["rcha-1_recharge"].data[0].flatten() + auxarr = xds["rcha-1_temperature"][0].data.flatten() assert np.allclose( np.array(irch[0]).flatten() + 1, - xds["rcha-1_irch_p1"].data, + xds["rcha-1_irch"][0].data.flatten(), ), "NetCDF-irch comparison failure" assert np.allclose( np.array(recharge[0]).flatten(), diff --git a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn b/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn index 3c9ebe4644a..3da446e1aa7 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn @@ -48,8 +48,8 @@ description REPLACE save_flows {'{#1}': 'general-head boundary'} mf6internal ipakcb block options -name tas_filerecord -type record tas6 filein tas6_filename +name obs_filerecord +type record obs6 filein obs6_filename shape reader urword tagged true @@ -58,15 +58,15 @@ longname description block options -name tas6 +name obs6 type keyword shape in_record true reader urword tagged true optional false -longname head keyword -description keyword to specify that record corresponds to a time-array-series file. +longname obs keyword +description keyword to specify that record corresponds to an observations file. block options name filein @@ -79,38 +79,6 @@ optional false longname file keyword description keyword to specify that an input filename is expected next. -block options -name tas6_filename -type string -preserve_case true -in_record true -reader urword -optional false -tagged false -longname file name of time series information -description defines a time-array-series file defining a time-array series that can be used to assign time-varying values. See the ``Time-Variable Input'' section for instructions on using the time-array series capability. - -block options -name obs_filerecord -type record obs6 filein obs6_filename -shape -reader urword -tagged true -optional true -longname -description - -block options -name obs6 -type keyword -shape -in_record true -reader urword -tagged true -optional false -longname obs keyword -description keyword to specify that record corresponds to an observations file. - block options name obs6_filename type string @@ -164,7 +132,7 @@ reader readarray layered true netcdf true longname boundary head -description is the boundary head. The recharge array may be defined by a time-array series (see the ``Using Time-Array Series in a Package'' section). +description is the boundary head. default_value 3.e30 block period @@ -175,7 +143,7 @@ reader readarray layered true netcdf true longname boundary conductance -description is the hydraulic conductance of the interface between the aquifer cell and the boundary. The recharge array may be defined by a time-array series (see the ``Using Time-Array Series in a Package'' section). +description is the hydraulic conductance of the interface between the aquifer cell and the boundary. default_value 3.e30 block period @@ -186,6 +154,6 @@ reader readarray layered true netcdf true optional true -longname recharge auxiliary variable iaux -description is an array of values for auxiliary variable aux(iaux), where iaux is a value from 1 to naux, and aux(iaux) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the recharge array will be multiplied by this array. +longname general-head boundary auxiliary variable iaux +description is an array of values for auxiliary variable aux(iaux), where iaux is a value from 1 to naux, and aux(iaux) must be listed as part of the auxiliary variables. A separate array can be specified for each auxiliary variable. If an array is not specified for an auxiliary variable, then a value of zero is assigned. If the value specified here for the auxiliary variable is the same as auxmultname, then the boundary head array will be multiplied by this array. mf6internal auxvar diff --git a/src/Idm/gwf-ghbaidm.f90 b/src/Idm/gwf-ghbaidm.f90 index 4c1b4eba317..423f450092e 100644 --- a/src/Idm/gwf-ghbaidm.f90 +++ b/src/Idm/gwf-ghbaidm.f90 @@ -17,12 +17,9 @@ module GwfGhbaInputModule logical :: iprpak = .false. logical :: iprflow = .false. logical :: ipakcb = .false. - logical :: tas_filerecord = .false. - logical :: tas6 = .false. - logical :: filein = .false. - logical :: tas6_filename = .false. logical :: obs_filerecord = .false. logical :: obs6 = .false. + logical :: filein = .false. logical :: obs6_filename = .false. logical :: mover = .false. logical :: export_nc = .false. @@ -130,14 +127,14 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_tas_filerecord = InputParamDefinitionType & + gwfghba_obs_filerecord = InputParamDefinitionType & ( & 'GWF', & ! component 'GHBA', & ! subcomponent 'OPTIONS', & ! block - 'TAS_FILERECORD', & ! tag name - 'TAS_FILERECORD', & ! fortran variable - 'RECORD TAS6 FILEIN TAS6_FILENAME', & ! type + 'OBS_FILERECORD', & ! tag name + 'OBS_FILERECORD', & ! fortran variable + 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type '', & ! shape '', & ! longname .false., & ! required @@ -148,16 +145,16 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_tas6 = InputParamDefinitionType & + gwfghba_obs6 = InputParamDefinitionType & ( & 'GWF', & ! component 'GHBA', & ! subcomponent 'OPTIONS', & ! block - 'TAS6', & ! tag name - 'TAS6', & ! fortran variable + 'OBS6', & ! tag name + 'OBS6', & ! fortran variable 'KEYWORD', & ! type '', & ! shape - 'head keyword', & ! longname + 'obs keyword', & ! longname .true., & ! required .true., & ! multi-record .false., & ! preserve case @@ -183,60 +180,6 @@ module GwfGhbaInputModule .false. & ! timeseries ) - type(InputParamDefinitionType), parameter :: & - gwfghba_tas6_filename = InputParamDefinitionType & - ( & - 'GWF', & ! component - 'GHBA', & ! subcomponent - 'OPTIONS', & ! block - 'TAS6_FILENAME', & ! tag name - 'TAS6_FILENAME', & ! fortran variable - 'STRING', & ! type - '', & ! shape - 'file name of time series information', & ! longname - .true., & ! required - .true., & ! multi-record - .true., & ! preserve case - .false., & ! layered - .false. & ! timeseries - ) - - type(InputParamDefinitionType), parameter :: & - gwfghba_obs_filerecord = InputParamDefinitionType & - ( & - 'GWF', & ! component - 'GHBA', & ! subcomponent - 'OPTIONS', & ! block - 'OBS_FILERECORD', & ! tag name - 'OBS_FILERECORD', & ! fortran variable - 'RECORD OBS6 FILEIN OBS6_FILENAME', & ! type - '', & ! shape - '', & ! longname - .false., & ! required - .false., & ! multi-record - .false., & ! preserve case - .false., & ! layered - .false. & ! timeseries - ) - - type(InputParamDefinitionType), parameter :: & - gwfghba_obs6 = InputParamDefinitionType & - ( & - 'GWF', & ! component - 'GHBA', & ! subcomponent - 'OPTIONS', & ! block - 'OBS6', & ! tag name - 'OBS6', & ! fortran variable - 'KEYWORD', & ! type - '', & ! shape - 'obs keyword', & ! longname - .true., & ! required - .true., & ! multi-record - .false., & ! preserve case - .false., & ! layered - .false. & ! timeseries - ) - type(InputParamDefinitionType), parameter :: & gwfghba_obs6_filename = InputParamDefinitionType & ( & @@ -337,7 +280,7 @@ module GwfGhbaInputModule 'AUXVAR', & ! fortran variable 'DOUBLE2D', & ! type 'NAUX NODES', & ! shape - 'recharge auxiliary variable iaux', & ! longname + 'general-head boundary auxiliary variable iaux', & ! longname .false., & ! required .false., & ! multi-record .false., & ! preserve case @@ -353,12 +296,9 @@ module GwfGhbaInputModule gwfghba_iprpak, & gwfghba_iprflow, & gwfghba_ipakcb, & - gwfghba_tas_filerecord, & - gwfghba_tas6, & - gwfghba_filein, & - gwfghba_tas6_filename, & gwfghba_obs_filerecord, & gwfghba_obs6, & + gwfghba_filein, & gwfghba_obs6_filename, & gwfghba_mover, & gwfghba_export_nc, & diff --git a/src/Utilities/Export/DisNCMesh.f90 b/src/Utilities/Export/DisNCMesh.f90 index 8b37d421fb1..615ed4ec3d9 100644 --- a/src/Utilities/Export/DisNCMesh.f90 +++ b/src/Utilities/Export/DisNCMesh.f90 @@ -38,9 +38,7 @@ module MeshDisModelModule procedure :: df procedure :: step procedure :: export_input_array - procedure :: package_step_ilayer procedure :: package_step - procedure :: export_layer_3d procedure :: define_dim procedure :: add_mesh_data end type Mesh2dDisExportType @@ -66,6 +64,7 @@ subroutine dis_export_init(this, modelname, modeltype, modelfname, nc_fname, & ! allocate var_id arrays allocate (this%var_ids%dependent(this%nlay)) + allocate (this%var_ids%export(this%nlay)) ! initialize base class call this%mesh_init(modelname, modeltype, modelfname, nc_fname, disenum, & @@ -98,6 +97,8 @@ subroutine df(this) ! define the dependent variable call this%define_dependent() end if + ! define period input arrays + call this%df_export() ! exit define mode call nf_verify(nf90_enddef(this%ncid), this%nc_fname) ! create mesh @@ -115,9 +116,10 @@ end subroutine df subroutine step(this) use ConstantsModule, only: DHNOFLO use TdisModule, only: totim + use NetCDFCommonModule, only: gstp class(Mesh2dDisExportType), intent(inout) :: this real(DP), dimension(:), pointer, contiguous :: dbl1d - integer(I4B) :: n, k, nvals + integer(I4B) :: n, k, nvals, istp integer(I4B), dimension(2) :: dis_shape real(DP), dimension(:, :), pointer, contiguous :: dbl2d @@ -125,8 +127,8 @@ subroutine step(this) nullify (dbl1d) nullify (dbl2d) - ! increment step - this%stepcnt = this%stepcnt + 1 + ! set global step index + istp = gstp() dis_shape(1) = this%dis%ncol * this%dis%nrow dis_shape(2) = this%dis%nlay @@ -158,14 +160,14 @@ subroutine step(this) ! extend array with step data call nf_verify(nf90_put_var(this%ncid, & this%var_ids%dependent(k), dbl2d(:, k), & - start=(/1, this%stepcnt/), & + start=(/1, istp/), & count=(/(this%dis%ncol * this%dis%nrow), 1/)), & this%nc_fname) end do ! write to time coordinate variable call nf_verify(nf90_put_var(this%ncid, this%var_ids%time, & - totim, start=(/this%stepcnt/)), & + totim, start=(/istp/)), & this%nc_fname) ! update file call nf_verify(nf90_sync(this%ncid), this%nc_fname) @@ -176,89 +178,6 @@ subroutine step(this) nullify (dbl2d) end subroutine step - !> @brief netcdf export package dynamic input with ilayer index variable - !< - subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) - use ConstantsModule, only: DNODATA, DZERO - use TdisModule, only: kper - use DefinitionSelectModule, only: get_param_definition_type - use NCModelExportModule, only: ExportPackageType - class(Mesh2dDisExportType), intent(inout) :: this - class(ExportPackageType), pointer, intent(in) :: export_pkg - character(len=*), intent(in) :: ilayer_varname - integer(I4B), intent(in) :: ilayer - type(InputParamDefinitionType), pointer :: idt - integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d - real(DP), dimension(:, :), pointer, contiguous :: dbl2d - integer(I4B), dimension(:), pointer, contiguous :: ialayer - real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr - character(len=LINELENGTH) :: nc_tag - integer(I4B) :: n, iparam, nvals - logical(LGP) :: ilayer_read - - ! initialize - nullify (ialayer) - ilayer_read = .false. - - ! set pointer to ilayer variable - call mem_setptr(ialayer, export_pkg%param_names(ilayer), & - export_pkg%mf6_input%mempath) - - ! check if layer index variable was read - if (export_pkg%param_reads(ilayer)%invar == 1) then - ilayer_read = .true. - end if - - ! export defined period input - do iparam = 1, export_pkg%nparam - ! check if variable was read this period - if (export_pkg%param_reads(iparam)%invar < 1) cycle - - ! set input definition - idt => & - get_param_definition_type(export_pkg%mf6_input%param_dfns, & - export_pkg%mf6_input%component_type, & - export_pkg%mf6_input%subcomponent_type, & - 'PERIOD', export_pkg%param_names(iparam), '') - ! set variable input tag - nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & - idt) - ! export arrays - select case (idt%datatype) - case ('INTEGER1D') - call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%x_dim, & - this%y_dim, this%var_ids, this%dis, idt, & - export_pkg%mf6_input%mempath, nc_tag, & - export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, kper, this%nc_fname) - case ('DOUBLE1D') - call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call this%export_layer_3d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_tag) - case ('DOUBLE2D') - call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) - nvals = this%dis%ncol * this%dis%nrow - do n = 1, size(dbl2d, dim=1) !naux - dbl1d_ptr(1:nvals) => dbl2d(n, :) - if (all(dbl1d_ptr == DZERO)) then - else - call this%export_layer_3d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d_ptr, nc_tag, n) - end if - end do - case default - errmsg = 'EXPORT ilayaer unsupported datatype='//trim(idt%datatype) - call store_error(errmsg, .true.) - end select - end do - - ! synchronize file - call nf_verify(nf90_sync(this%ncid), this%nc_fname) - end subroutine package_step_ilayer - !> @brief netcdf export package dynamic input !< subroutine package_step(this, export_pkg) @@ -274,6 +193,7 @@ subroutine package_step(this, export_pkg) real(DP), dimension(:, :), pointer, contiguous :: dbl2d character(len=LINELENGTH) :: nc_tag integer(I4B) :: iaux, iparam, nvals + integer(I4B) :: k, n ! initialize iaux = 0 @@ -298,6 +218,7 @@ subroutine package_step(this, export_pkg) select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) + this%var_ids%export(1) = export_pkg%varids_param(iparam, 1) call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%x_dim, & this%y_dim, this%var_ids, this%dis, idt, & export_pkg%mf6_input%mempath, nc_tag, & @@ -306,6 +227,15 @@ subroutine package_step(this, export_pkg) this%chunk_face, kper, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) + select case (idt%shape) + case ('NCPL') + this%var_ids%export(1) = export_pkg%varids_param(iparam, 1) + case ('NODES') + do k = 1, this%dis%nlay + this%var_ids%export(k) = export_pkg%varids_param(iparam, k) + end do + case default + end select call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, & this%y_dim, this%var_ids, this%dis, idt, & export_pkg%mf6_input%mempath, nc_tag, & @@ -314,9 +244,27 @@ subroutine package_step(this, export_pkg) this%chunk_face, kper, iaux, this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) - nvals = this%dis%ncol * this%dis%nrow + select case (idt%shape) + case ('NAUX NCPL') + nvals = this%dis%nrow * this%dis%ncol + case ('NAUX NODES') + nvals = this%dis%nodesuser + case default + end select + allocate (dbl1d(nvals)) do iaux = 1, size(dbl2d, dim=1) !naux - dbl1d(1:nvals) => dbl2d(iaux, :) + select case (idt%shape) + case ('NAUX NCPL') + this%var_ids%export(1) = export_pkg%varids_aux(iaux, 1) + case ('NAUX NODES') + do k = 1, this%dis%nlay + this%var_ids%export(k) = export_pkg%varids_aux(iaux, k) + end do + case default + end select + do n = 1, nvals + dbl1d(n) = dbl2d(iaux, n) + end do call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, & this%y_dim, this%var_ids, this%dis, idt, & export_pkg%mf6_input%mempath, nc_tag, & @@ -324,6 +272,7 @@ subroutine package_step(this, export_pkg) this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, kper, iaux, this%nc_fname) end do + deallocate (dbl1d) case default ! no-op, no other datatypes exported end select @@ -333,63 +282,6 @@ subroutine package_step(this, export_pkg) call nf_verify(nf90_sync(this%ncid), this%nc_fname) end subroutine package_step - !> @brief export layer variable as full grid - !< - subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_tag, iaux) - use ConstantsModule, only: DNODATA, DZERO - use NCModelExportModule, only: ExportPackageType - class(Mesh2dDisExportType), intent(inout) :: this - class(ExportPackageType), pointer, intent(in) :: export_pkg - type(InputParamDefinitionType), pointer, intent(in) :: idt - logical(LGP), intent(in) :: ilayer_read - integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ialayer - real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d - character(len=*), intent(in) :: nc_tag - integer(I4B), optional, intent(in) :: iaux - real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d - integer(I4B) :: n, i, j, k, nvals, idxaux - real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr - - ! initialize - idxaux = 0 - if (present(iaux)) then - idxaux = iaux - end if - - allocate (dbl3d(export_pkg%mshape(3), export_pkg%mshape(2), & - export_pkg%mshape(1))) - - if (ilayer_read) then - do k = 1, size(dbl3d, dim=3) - n = 0 - do i = 1, size(dbl3d, dim=2) - do j = 1, size(dbl3d, dim=1) - n = n + 1 - if (ialayer(n) == k) then - dbl3d(j, i, k) = dbl1d(n) - else - dbl3d(j, i, k) = DNODATA - end if - end do - end do - end do - else - dbl3d = DNODATA - nvals = export_pkg%mshape(3) * export_pkg%mshape(2) - dbl2d_ptr(1:export_pkg%mshape(3), 1:export_pkg%mshape(2)) => dbl1d(1:nvals) - dbl3d(:, :, 1) = dbl2d_ptr(:, :) - end if - - call nc_export_dbl3d(dbl3d, this%ncid, this%dim_ids, this%var_ids, this%dis, & - idt, export_pkg%mf6_input%mempath, nc_tag, & - export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, export_pkg%iper, idxaux, this%nc_fname) - - deallocate (dbl3d) - end subroutine export_layer_3d - !> @brief netcdf export an input array !< subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) @@ -450,7 +342,7 @@ subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) call nc_export_dbl3d(dbl3d, this%ncid, this%dim_ids, this%var_ids, & this%dis, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, iper, iaux, this%nc_fname) + this%chunk_face, this%nc_fname) case default ! no-op, no other datatypes exported end select @@ -459,28 +351,24 @@ end subroutine export_input_array !> @brief netcdf export define dimensions !< subroutine define_dim(this) - use ConstantsModule, only: MVALIDATE - use SimVariablesModule, only: isim_mode class(Mesh2dDisExportType), intent(inout) :: this ! time - if (isim_mode /= MVALIDATE) then - call nf_verify(nf90_def_dim(this%ncid, 'time', this%totnstp, & - this%dim_ids%time), this%nc_fname) - call nf_verify(nf90_def_var(this%ncid, 'time', NF90_DOUBLE, & - this%dim_ids%time, this%var_ids%time), & - this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'calendar', & - 'standard'), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'units', & - this%datetime), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'axis', 'T'), & - this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'standard_name', & - 'time'), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'long_name', & - 'time'), this%nc_fname) - end if + call nf_verify(nf90_def_dim(this%ncid, 'time', this%totnstp, & + this%dim_ids%time), this%nc_fname) + call nf_verify(nf90_def_var(this%ncid, 'time', NF90_DOUBLE, & + this%dim_ids%time, this%var_ids%time), & + this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'calendar', & + 'standard'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'units', & + this%datetime), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'axis', 'T'), & + this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'standard_name', & + 'time'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'long_name', & + 'time'), this%nc_fname) ! mesh call nf_verify(nf90_def_dim(this%ncid, 'nmesh_node', & @@ -646,6 +534,7 @@ end subroutine add_mesh_data subroutine nc_export_int1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & idt, mempath, nc_tag, pkgname, gridmap_name, & deflate, shuffle, chunk_face, iper, nc_fname) + use NetCDFCommonModule, only: gstp integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids @@ -663,106 +552,125 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & integer(I4B), intent(in) :: chunk_face integer(I4B), intent(in) :: iper character(len=*), intent(in) :: nc_fname - integer(I4B), dimension(3) :: dis_shape - integer(I4B), dimension(1) :: layer_shape integer(I4B), dimension(:, :, :), pointer, contiguous :: int3d integer(I4B), dimension(:), pointer, contiguous :: int1d - integer(I4B) :: axis_dim, nvals, k + integer(I4B) :: axis_dim, nvals, k, istp integer(I4B), dimension(:), allocatable :: var_id character(len=LINELENGTH) :: longname, varname if (idt%shape == 'NROW' .or. & idt%shape == 'NCOL' .or. & - idt%shape == 'NCPL') then - - select case (idt%shape) - case ('NROW') - axis_dim = y_dim - case ('NCOL') - axis_dim = x_dim - case ('NCPL') - axis_dim = dim_ids%nmesh_face - end select - - ! set names - varname = export_varname(pkgname, idt%tagname, mempath, iper=iper) - longname = export_longname(idt%longname, pkgname, idt%tagname, & - iper=iper) - - allocate (var_id(1)) - - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & - (/axis_dim/), var_id(1)), & - nc_fname) - - ! NROW/NCOL shapes use default chunking - call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname) + idt%shape == 'NCPL' .or. & + idt%shape == 'NAUX NCPL') then - ! put attr - call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & - (/NF90_FILL_INT/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & - longname), nc_fname) - - ! add mf6 attr - call ncvar_mf6attr(ncid, var_id(1), 0, iper, 0, nc_tag, nc_fname) - - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & - nc_fname) + if (iper == 0) then - else - allocate (var_id(dis%nlay)) + select case (idt%shape) + case ('NROW') + axis_dim = y_dim + case ('NCOL') + axis_dim = x_dim + case ('NCPL', 'NAUX NCPL') + axis_dim = dim_ids%nmesh_face + end select - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - do k = 1, dis%nlay ! set names - varname = export_varname(pkgname, idt%tagname, mempath, & - layer=k, iper=iper) - longname = export_longname(idt%longname, pkgname, idt%tagname, & - layer=k, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath) + longname = export_longname(idt%longname, pkgname, idt%tagname, mempath) + allocate (var_id(1)) + + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & - (/dim_ids%nmesh_face/), var_id(k)), & + (/axis_dim/), var_id(1)), & nc_fname) - ! apply chunking parameters - call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname) - ! defalte and shuffle - call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname) + ! NROW/NCOL shapes use default chunking + call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname) ! put attr - call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & + call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & (/NF90_FILL_INT/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & + call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & longname), nc_fname) - ! add grid mapping and mf6 attr - call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, iper, 0, nc_tag, nc_fname) - end do + ! add mf6 attr + call ncvar_mf6attr(ncid, var_id(1), 0, 0, nc_tag, nc_fname) + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & + nc_fname) + else + istp = gstp() + nvals = dis%nrow * dis%ncol + call nf_verify(nf90_put_var(ncid, & + var_ids%export(1), p_mem, & + start=(/1, istp/), & + count=(/nvals, 1/)), nc_fname) + end if + + else ! reshape input - dis_shape(1) = dis%ncol - dis_shape(2) = dis%nrow - dis_shape(3) = dis%nlay - nvals = product(dis_shape) - int3d(1:dis_shape(1), 1:dis_shape(2), 1:dis_shape(3)) => p_mem(1:nvals) - - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - layer_shape(1) = dis%nrow * dis%ncol - do k = 1, dis%nlay - int1d(1:layer_shape(1)) => int3d(:, :, k) - call nf_verify(nf90_put_var(ncid, var_id(k), int1d), nc_fname) - end do + int3d(1:dis%ncol, 1:dis%nrow, 1:dis%nlay) => p_mem(1:dis%nodesuser) + + ! set nvals as ncpl + nvals = dis%nrow * dis%ncol + + if (iper == 0) then + ! not a timeseries, create variables and write griddata + allocate (var_id(dis%nlay)) + + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) + do k = 1, dis%nlay + ! set names + varname = export_varname(pkgname, idt%tagname, mempath, & + layer=k) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + mempath, layer=k) + + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & + (/dim_ids%nmesh_face/), var_id(k)), & + nc_fname) + + ! apply chunking parameters + call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname) + ! deflate and shuffle + call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname) + + ! put attr + call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & + (/NF90_FILL_INT/)), nc_fname) + call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & + longname), nc_fname) + + ! add grid mapping and mf6 attr + call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname) + end do - ! cleanup - deallocate (var_id) + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + do k = 1, dis%nlay + int1d(1:nvals) => int3d(:, :, k) + call nf_verify(nf90_put_var(ncid, var_id(k), int1d), nc_fname) + end do + + ! cleanup + deallocate (var_id) + else + ! timeseries, add period data + istp = gstp() + do k = 1, dis%nlay + int1d(1:nvals) => int3d(:, :, k) + call nf_verify(nf90_put_var(ncid, & + var_ids%export(k), int1d, & + start=(/1, istp/), & + count=(/nvals, 1/)), nc_fname) + end do + end if end if end subroutine nc_export_int1d @@ -785,14 +693,13 @@ subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face character(len=*), intent(in) :: nc_fname - integer(I4B) :: var_id + integer(I4B) :: var_id, nvals integer(I4B), dimension(:), pointer, contiguous :: int1d - integer(I4B), dimension(1) :: layer_shape character(len=LINELENGTH) :: longname, varname ! set names varname = export_varname(pkgname, idt%tagname, mempath) - longname = export_longname(idt%longname, pkgname, idt%tagname) + longname = export_longname(idt%longname, pkgname, idt%tagname, mempath) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) @@ -813,12 +720,12 @@ subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id, 0, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) - layer_shape(1) = dis%nrow * dis%ncol - int1d(1:layer_shape(1)) => p_mem + nvals = dis%nrow * dis%ncol + int1d(1:nvals) => p_mem call nf_verify(nf90_put_var(ncid, var_id, int1d), nc_fname) end subroutine nc_export_int2d @@ -844,8 +751,7 @@ subroutine nc_export_int3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & integer(I4B), dimension(:), allocatable :: var_id integer(I4B), dimension(:), pointer, contiguous :: int1d character(len=LINELENGTH) :: longname, varname - integer(I4B), dimension(1) :: layer_shape - integer(I4B) :: k + integer(I4B) :: k, nvals allocate (var_id(dis%nlay)) @@ -854,7 +760,8 @@ subroutine nc_export_int3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & do k = 1, dis%nlay ! set names varname = export_varname(pkgname, idt%tagname, mempath, layer=k) - longname = export_longname(idt%longname, pkgname, idt%tagname, layer=k) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + mempath, layer=k) call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%nmesh_face/), var_id(k)), & @@ -873,14 +780,14 @@ subroutine nc_export_int3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname) end do ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) - layer_shape(1) = dis%nrow * dis%ncol + nvals = dis%nrow * dis%ncol do k = 1, dis%nlay - int1d(1:layer_shape(1)) => p_mem(:, :, k) + int1d(1:nvals) => p_mem(:, :, k) call nf_verify(nf90_put_var(ncid, var_id(k), int1d), nc_fname) end do @@ -893,12 +800,14 @@ end subroutine nc_export_int3d subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & idt, mempath, nc_tag, pkgname, gridmap_name, & deflate, shuffle, chunk_face, iper, iaux, nc_fname) + use ConstantsModule, only: DNODATA + use NetCDFCommonModule, only: gstp real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids integer(I4B), intent(in) :: x_dim integer(I4B), intent(in) :: y_dim - type(MeshNCVarIdType), intent(inout) :: var_ids + type(MeshNCVarIdType), intent(in) :: var_ids type(DisType), pointer, intent(in) :: dis type(InputParamDefinitionType), pointer :: idt character(len=*), intent(in) :: mempath @@ -911,107 +820,131 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & integer(I4B), intent(in) :: iper integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname - integer(I4B), dimension(3) :: dis_shape - integer(I4B), dimension(1) :: layer_shape real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d real(DP), dimension(:), pointer, contiguous :: dbl1d - integer(I4B) :: axis_dim, nvals, k - integer(I4B), dimension(:), allocatable :: var_id + integer(I4B) :: axis_dim, nvals, k, istp + integer(NF90_INT), dimension(:), allocatable :: var_id character(len=LINELENGTH) :: longname, varname if (idt%shape == 'NROW' .or. & - idt%shape == 'NCOL') then ! .or. & - !idt%shape == 'NCPL') then - - select case (idt%shape) - case ('NROW') - axis_dim = y_dim - case ('NCOL') - axis_dim = x_dim - !case ('NCPL') - ! axis_dim = dim_ids%nmesh_face - end select - - ! set names - varname = export_varname(pkgname, idt%tagname, mempath, iper=iper, & - iaux=iaux) - longname = export_longname(idt%longname, pkgname, idt%tagname, & - iper=iper) - - allocate (var_id(1)) - - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & - (/axis_dim/), var_id(1)), & - nc_fname) - - ! NROW/NCOL shapes use default chunking - call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname) - - ! put attr - call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & - (/NF90_FILL_DOUBLE/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & - longname), nc_fname) - - ! add mf6 attr - call ncvar_mf6attr(ncid, var_id(1), 0, iper, iaux, nc_tag, nc_fname) + idt%shape == 'NCOL' .or. & + idt%shape == 'NCPL' .or. & + idt%shape == 'NAUX NCPL') then - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & - nc_fname) + if (iper == 0) then - else - allocate (var_id(dis%nlay)) + select case (idt%shape) + case ('NROW') + axis_dim = y_dim + case ('NCOL') + axis_dim = x_dim + case ('NCPL', 'NAUX NCPL') + axis_dim = dim_ids%nmesh_face + end select - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - do k = 1, dis%nlay ! set names - varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & - iper=iper, iaux=iaux) + varname = export_varname(pkgname, idt%tagname, mempath, iaux=iaux) longname = export_longname(idt%longname, pkgname, idt%tagname, & - layer=k, iper=iper) + mempath, iaux=iaux) + + allocate (var_id(1)) + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & - (/dim_ids%nmesh_face/), var_id(k)), & + (/axis_dim/), var_id(1)), & nc_fname) - ! apply chunking parameters - call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname) - ! defalte and shuffle - call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname) + ! NROW/NCOL shapes use default chunking + call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname) ! put attr - call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & + call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & + call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & longname), nc_fname) - ! add grid mapping and mf6 attr - call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, iper, iaux, nc_tag, nc_fname) - end do + ! add mf6 attr + call ncvar_mf6attr(ncid, var_id(1), 0, iaux, nc_tag, nc_fname) + + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & + nc_fname) + else + istp = gstp() + nvals = dis%nrow * dis%ncol + call nf_verify(nf90_put_var(ncid, & + var_ids%export(1), p_mem, & + start=(/1, istp/), & + count=(/nvals, 1/)), nc_fname) + end if + else ! reshape input - dis_shape(1) = dis%ncol - dis_shape(2) = dis%nrow - dis_shape(3) = dis%nlay - nvals = product(dis_shape) - dbl3d(1:dis_shape(1), 1:dis_shape(2), 1:dis_shape(3)) => p_mem(1:nvals) - - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - layer_shape(1) = dis%nrow * dis%ncol - do k = 1, dis%nlay - dbl1d(1:layer_shape(1)) => dbl3d(:, :, k) - call nf_verify(nf90_put_var(ncid, var_id(k), dbl1d), nc_fname) - end do + dbl3d(1:dis%ncol, 1:dis%nrow, 1:dis%nlay) => p_mem(1:dis%nodesuser) + + ! set nvals as ncpl + nvals = dis%nrow * dis%ncol + + if (iper == 0) then + ! not a timeseries, create variables and write griddata + + ! allocate local variable id storage + allocate (var_id(dis%nlay)) + + ! reenter define mode and create layer variables + call nf_verify(nf90_redef(ncid), nc_fname) + do k = 1, dis%nlay + ! set names + varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & + iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + mempath, layer=k, iaux=iaux) + + ! create layer variable + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & + (/dim_ids%nmesh_face/), var_id(k)), & + nc_fname) + + ! apply chunking parameters + call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname) + ! deflate and shuffle + call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname) + + ! put attr + call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & + (/NF90_FILL_DOUBLE/)), nc_fname) + call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & + longname), nc_fname) + + ! add grid mapping and mf6 attr + call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, iaux, nc_tag, nc_fname) + end do - ! cleanup - deallocate (var_id) + ! exit define mode + call nf_verify(nf90_enddef(ncid), nc_fname) + + ! write layer data + do k = 1, dis%nlay + dbl1d(1:nvals) => dbl3d(:, :, k) + call nf_verify(nf90_put_var(ncid, var_id(k), dbl1d), nc_fname) + end do + + ! cleanup + deallocate (var_id) + else + ! timeseries, add period data + istp = gstp() + do k = 1, dis%nlay + dbl1d(1:nvals) => dbl3d(:, :, k) + call nf_verify(nf90_put_var(ncid, & + var_ids%export(k), dbl1d, & + start=(/1, istp/), & + count=(/nvals, 1/)), nc_fname) + end do + end if end if end subroutine nc_export_dbl1d @@ -1034,14 +967,13 @@ subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face character(len=*), intent(in) :: nc_fname - integer(I4B) :: var_id + integer(I4B) :: var_id, nvals character(len=LINELENGTH) :: longname, varname real(DP), dimension(:), pointer, contiguous :: dbl1d - integer(I4B), dimension(1) :: layer_shape ! set names varname = export_varname(pkgname, idt%tagname, mempath) - longname = export_longname(idt%longname, pkgname, idt%tagname) + longname = export_longname(idt%longname, pkgname, idt%tagname, mempath) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) @@ -1062,12 +994,12 @@ subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id, 0, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) - layer_shape(1) = dis%nrow * dis%ncol - dbl1d(1:layer_shape(1)) => p_mem + nvals = dis%nrow * dis%ncol + dbl1d(1:nvals) => p_mem call nf_verify(nf90_put_var(ncid, var_id, dbl1d), nc_fname) end subroutine nc_export_dbl2d @@ -1075,7 +1007,7 @@ end subroutine nc_export_dbl2d !< subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_tag, pkgname, gridmap_name, deflate, shuffle, & - chunk_face, iper, iaux, nc_fname) + chunk_face, nc_fname) use ConstantsModule, only: DNODATA real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid @@ -1090,21 +1022,14 @@ subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face - integer(I4B), intent(in) :: iper - integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname integer(I4B), dimension(:), allocatable :: var_id real(DP), dimension(:), pointer, contiguous :: dbl1d character(len=LINELENGTH) :: longname, varname - integer(I4B), dimension(1) :: layer_shape - integer(I4B) :: k - real(DP) :: fill_value + integer(I4B) :: k, nvals - if (iper > 0) then - fill_value = DNODATA - else - fill_value = NF90_FILL_DOUBLE - end if + ! set nvals as ncpl + nvals = dis%nrow * dis%ncol allocate (var_id(dis%nlay)) @@ -1112,10 +1037,9 @@ subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & call nf_verify(nf90_redef(ncid), nc_fname) do k = 1, dis%nlay ! set names - varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & - iper=iper, iaux=iaux) + varname = export_varname(pkgname, idt%tagname, mempath, layer=k) longname = export_longname(idt%longname, pkgname, idt%tagname, & - layer=k, iper=iper) + mempath, layer=k) call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%nmesh_face/), var_id(k)), & @@ -1128,21 +1052,19 @@ subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & ! put attr call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & - (/fill_value/)), nc_fname) + (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, iper, iaux, nc_tag, nc_fname) - !end if + call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname) end do ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) - layer_shape(1) = dis%nrow * dis%ncol do k = 1, dis%nlay - dbl1d(1:layer_shape(1)) => p_mem(:, :, k) + dbl1d(1:nvals) => p_mem(:, :, k) call nf_verify(nf90_put_var(ncid, var_id(k), dbl1d), nc_fname) end do diff --git a/src/Utilities/Export/DisNCStructured.f90 b/src/Utilities/Export/DisNCStructured.f90 index 9e45c2e6972..b3daa90a8f5 100644 --- a/src/Utilities/Export/DisNCStructured.f90 +++ b/src/Utilities/Export/DisNCStructured.f90 @@ -46,6 +46,7 @@ module DisNCStructuredModule integer(I4B) :: z_bnds !< z boundaries 2D array integer(I4B) :: latitude !< latitude 2D array integer(I4B) :: longitude !< longitude 2D array + integer(I4B) :: export !< in scope export contains end type StructuredNCVarIdType @@ -65,12 +66,13 @@ module DisNCStructuredModule procedure :: init => dis_export_init procedure :: destroy => dis_export_destroy procedure :: df + procedure :: df_export procedure :: step procedure :: export_input_array + procedure :: export_df + procedure :: create_timeseries procedure :: export_input_arrays - procedure :: package_step_ilayer procedure :: package_step - procedure :: export_layer_3d procedure :: add_pkg_data procedure :: add_global_att procedure :: define_dim @@ -221,6 +223,8 @@ subroutine df(this) ! define the dependent variable call this%define_dependent() end if + ! define period input arrays + call this%df_export() ! exit define mode call nf_verify(nf90_enddef(this%ncid), this%nc_fname) ! add data locations @@ -235,16 +239,31 @@ subroutine df(this) call nf_verify(nf90_sync(this%ncid), this%nc_fname) end subroutine df + !> @brief define timeseries input variables + !< + subroutine df_export(this) + use NCModelExportModule, only: ExportPackageType + class(DisNCStructuredType), intent(inout) :: this + class(ExportPackageType), pointer :: export_pkg + integer(I4B) :: idx + do idx = 1, this%pkglist%Count() + export_pkg => this%get(idx) + call this%export_df(export_pkg) + end do + end subroutine df_export + !> @brief netcdf export step !< subroutine step(this) use ConstantsModule, only: DHNOFLO use TdisModule, only: totim + use NetCDFCommonModule, only: gstp class(DisNCStructuredType), intent(inout) :: this real(DP), dimension(:), pointer, contiguous :: dbl1d - integer(I4B) :: n + integer(I4B) :: n, istp - this%stepcnt = this%stepcnt + 1 + ! set global step index + istp = gstp() if (size(this%dis%nodeuser) < & size(this%dis%nodereduced)) then @@ -258,7 +277,7 @@ subroutine step(this) ! write step data to dependent variable call nf_verify(nf90_put_var(this%ncid, & this%var_ids%dependent, dbl1d, & - start=(/1, 1, 1, this%stepcnt/), & + start=(/1, 1, 1, istp/), & count=(/this%dis%ncol, & this%dis%nrow, & this%dis%nlay, 1/)), & @@ -268,7 +287,7 @@ subroutine step(this) ! write step data to dependent variable call nf_verify(nf90_put_var(this%ncid, & this%var_ids%dependent, this%x, & - start=(/1, 1, 1, this%stepcnt/), & + start=(/1, 1, 1, istp/), & count=(/this%dis%ncol, & this%dis%nrow, & this%dis%nlay, 1/)), & @@ -277,7 +296,7 @@ subroutine step(this) ! write to time coordinate variable call nf_verify(nf90_put_var(this%ncid, this%var_ids%time, & - totim, start=(/this%stepcnt/)), & + totim, start=(/istp/)), & this%nc_fname) ! synchronize file @@ -350,12 +369,145 @@ subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) this%dis, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%latlon, this%deflate, & this%shuffle, this%chunk_z, this%chunk_y, & - this%chunk_x, iper, iaux, this%nc_fname) + this%chunk_x, this%nc_fname) case default ! no-op, no other datatypes exported end select end subroutine export_input_array + !> @brief define export package + !< + subroutine export_df(this, export_pkg) + use NCModelExportModule, only: ExportPackageType + use DefinitionSelectModule, only: get_param_definition_type + class(DisNCStructuredType), intent(inout) :: this + class(ExportPackageType), pointer, intent(in) :: export_pkg + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iparam, iaux + + ! export defined period input + do iparam = 1, export_pkg%nparam + ! initialize + iaux = 0 + ! set input definition + idt => & + get_param_definition_type(export_pkg%mf6_input%param_dfns, & + export_pkg%mf6_input%component_type, & + export_pkg%mf6_input%subcomponent_type, & + 'PERIOD', export_pkg%param_names(iparam), '') + select case (idt%shape) + case ('NCPL', 'NODES') + call this%create_timeseries(idt, iparam, iaux, export_pkg) + case ('NAUX NCPL', 'NAUX NODES') + do iaux = 1, export_pkg%naux + call this%create_timeseries(idt, iparam, iaux, export_pkg) + end do + case default + end select + end do + end subroutine export_df + + !> @brief create timeseries export variable + !< + subroutine create_timeseries(this, idt, iparam, iaux, export_pkg) + use ConstantsModule, only: DNODATA + use NCModelExportModule, only: ExportPackageType + class(DisNCStructuredType), intent(inout) :: this + type(InputParamDefinitionType), pointer, intent(in) :: idt + integer(I4B), intent(in) :: iparam + integer(I4B), intent(in) :: iaux + class(ExportPackageType), pointer, intent(in) :: export_pkg + character(len=LINELENGTH) :: varname, longname, nc_tag + integer(I4B) :: varid + + ! set variable input tag + nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & + idt) + + ! set names + varname = export_varname(export_pkg%mf6_input%subcomponent_name, & + idt%tagname, export_pkg%mf6_input%mempath, & + iaux=iaux) + longname = export_longname(idt%longname, & + export_pkg%mf6_input%subcomponent_name, & + idt%tagname, export_pkg%mf6_input%mempath, & + iaux=iaux) + + ! create the netcdf timeseries variable + select case (idt%datatype) + case ('DOUBLE1D', 'DOUBLE2D') + if (idt%shape == 'NCPL' .or. & + idt%shape == 'NAUX NCPL') then + call nf_verify(nf90_def_var(this%ncid, varname, NF90_DOUBLE, & + (/this%dim_ids%x, & + this%dim_ids%y, & + this%dim_ids%time/), varid), & + this%nc_fname) + else + call nf_verify(nf90_def_var(this%ncid, varname, NF90_DOUBLE, & + (/this%dim_ids%x, & + this%dim_ids%y, & + this%dim_ids%z, & + this%dim_ids%time/), varid), & + this%nc_fname) + end if + call nf_verify(nf90_put_att(this%ncid, varid, & + '_FillValue', (/DNODATA/)), & + this%nc_fname) + case ('INTEGER1D') + if (idt%shape == 'NCPL' .or. & + idt%shape == 'NAUX NCPL') then + call nf_verify(nf90_def_var(this%ncid, varname, NF90_INT, & + (/this%dim_ids%x, & + this%dim_ids%y, & + this%dim_ids%time/), varid), & + this%nc_fname) + else + call nf_verify(nf90_def_var(this%ncid, varname, NF90_INT, & + (/this%dim_ids%x, & + this%dim_ids%y, & + this%dim_ids%z, & + this%dim_ids%time/), varid), & + this%nc_fname) + end if + call nf_verify(nf90_put_att(this%ncid, varid, & + '_FillValue', (/NF90_FILL_INT/)), & + this%nc_fname) + end select + + ! apply chunking parameters + if (this%chunking_active) then + call nf_verify(nf90_def_var_chunking(this%ncid, & + varid, & + NF90_CHUNKED, & + (/this%chunk_x, this%chunk_y, & + this%chunk_z, this%chunk_time/)), & + this%nc_fname) + end if + + ! deflate and shuffle + call ncvar_deflate(this%ncid, varid, this%deflate, & + this%shuffle, this%nc_fname) + + ! variable attributes + call nf_verify(nf90_put_att(this%ncid, varid, & + 'units', 'm'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, varid, & + 'long_name', longname), this%nc_fname) + + ! add grid mapping and mf6 attr + call ncvar_gridmap(this%ncid, varid, this%gridmap_name, this%latlon, & + this%nc_fname) + call ncvar_mf6attr(this%ncid, varid, iaux, nc_tag, this%nc_fname) + + ! store variable id + if (idt%tagname == 'AUX') then + export_pkg%varids_aux(iaux, 1) = varid + else + export_pkg%varids_param(iparam, 1) = varid + end if + end subroutine create_timeseries + !> @brief write package gridded input data !< subroutine export_input_arrays(this, pkgtype, pkgname, mempath, param_dfns) @@ -382,39 +534,24 @@ subroutine export_input_arrays(this, pkgtype, pkgname, mempath, param_dfns) end do end subroutine export_input_arrays - !> @brief netcdf export package dynamic input with ilayer index variable + !> @brief netcdf export package dynamic input !< - subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) - use TdisModule, only: kper + subroutine package_step(this, export_pkg) use ConstantsModule, only: DNODATA, DZERO - use NCModelExportModule, only: ExportPackageType + use TdisModule, only: kper use DefinitionSelectModule, only: get_param_definition_type + use NCModelExportModule, only: ExportPackageType class(DisNCStructuredType), intent(inout) :: this class(ExportPackageType), pointer, intent(in) :: export_pkg - character(len=*), intent(in) :: ilayer_varname - integer(I4B), intent(in) :: ilayer type(InputParamDefinitionType), pointer :: idt integer(I4B), dimension(:), pointer, contiguous :: int1d real(DP), dimension(:), pointer, contiguous :: dbl1d real(DP), dimension(:, :), pointer, contiguous :: dbl2d - integer(I4B), dimension(:), pointer, contiguous :: ialayer - real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr character(len=LINELENGTH) :: nc_tag - integer(I4B) :: n, iparam, nvals - logical(LGP) :: ilayer_read + integer(I4B) :: iaux, iparam, nvals, n ! initialize - nullify (ialayer) - ilayer_read = .false. - - ! set pointer to ilayer variable - call mem_setptr(ialayer, export_pkg%param_names(ilayer), & - export_pkg%mf6_input%mempath) - - ! check if layer index variable was read - if (export_pkg%param_reads(ilayer)%invar == 1) then - ilayer_read = .true. - end if + iaux = 0 ! export defined period input do iparam = 1, export_pkg%nparam @@ -426,82 +563,17 @@ subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) get_param_definition_type(export_pkg%mf6_input%param_dfns, & export_pkg%mf6_input%component_type, & export_pkg%mf6_input%subcomponent_type, & - 'PERIOD', export_pkg%param_names(iparam), & - this%nc_fname) - ! set variable name and input attrs - nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & - idt) - ! export arrays - select case (idt%datatype) - case ('INTEGER1D') - call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call nc_export_array(int1d, this%ncid, this%dim_ids, this%var_ids, & - this%dis, idt, export_pkg%mf6_input%mempath, & - nc_tag, export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%latlon, this%deflate, & - this%shuffle, this%chunk_z, this%chunk_y, & - this%chunk_x, export_pkg%iper, this%nc_fname) - case ('DOUBLE1D') - call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call this%export_layer_3d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_tag) - case ('DOUBLE2D') - call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) - nvals = this%dis%ncol * this%dis%nrow - do n = 1, size(dbl2d, dim=1) ! naux - dbl1d_ptr(1:nvals) => dbl2d(n, :) - if (all(dbl1d_ptr == DZERO)) then - else - call this%export_layer_3d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d_ptr, nc_tag, n) - end if - end do - case default - errmsg = 'EXPORT ilayer unsupported datatype='//trim(idt%datatype) - call store_error(errmsg, .true.) - end select - end do + 'PERIOD', export_pkg%param_names(iparam), '') - ! synchronize file - call nf_verify(nf90_sync(this%ncid), this%nc_fname) - end subroutine package_step_ilayer - - !> @brief netcdf export package dynamic input - !< - subroutine package_step(this, export_pkg) - use TdisModule, only: kper - use NCModelExportModule, only: ExportPackageType - use DefinitionSelectModule, only: get_param_definition_type - use ConstantsModule, only: DNODATA - class(DisNCStructuredType), intent(inout) :: this - class(ExportPackageType), pointer, intent(in) :: export_pkg - integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d - real(DP), dimension(:, :), pointer, contiguous :: dbl2d - type(InputParamDefinitionType), pointer :: idt - character(len=LINELENGTH) :: nc_tag - integer(I4B) :: iparam, iaux - - ! initialize - iaux = 0 - - do iparam = 1, export_pkg%nparam - ! set input definition - idt => get_param_definition_type(export_pkg%mf6_input%param_dfns, & - export_pkg%mf6_input%component_type, & - export_pkg%mf6_input%subcomponent_type, & - 'PERIOD', export_pkg%param_names(iparam), & - this%nc_fname) - - ! set variable name and input attribute string + ! set variable input tag nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & idt) ! export arrays select case (idt%datatype) case ('INTEGER1D') - call mem_setptr(int1d, export_pkg%param_names(iparam), & - export_pkg%mf6_input%mempath) + call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) + this%var_ids%export = export_pkg%varids_param(iparam, 1) call nc_export_array(int1d, this%ncid, this%dim_ids, this%var_ids, & this%dis, idt, export_pkg%mf6_input%mempath, & nc_tag, export_pkg%mf6_input%subcomponent_name, & @@ -509,8 +581,8 @@ subroutine package_step(this, export_pkg) this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, kper, this%nc_fname) case ('DOUBLE1D') - call mem_setptr(dbl1d, export_pkg%param_names(iparam), & - export_pkg%mf6_input%mempath) + call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) + this%var_ids%export = export_pkg%varids_param(iparam, 1) call nc_export_array(dbl1d, this%ncid, this%dim_ids, this%var_ids, & this%dis, idt, export_pkg%mf6_input%mempath, & nc_tag, export_pkg%mf6_input%subcomponent_name, & @@ -519,8 +591,19 @@ subroutine package_step(this, export_pkg) this%chunk_x, kper, iaux, this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) - do iaux = 1, size(dbl2d, dim=1) ! naux - dbl1d => dbl2d(iaux, :) + select case (idt%shape) + case ('NAUX NCPL') + nvals = this%dis%nrow * this%dis%ncol + case ('NAUX NODES') + nvals = this%dis%nodesuser + case default + end select + allocate (dbl1d(nvals)) + do iaux = 1, size(dbl2d, dim=1) !naux + this%var_ids%export = export_pkg%varids_aux(iaux, 1) + do n = 1, nvals + dbl1d(n) = dbl2d(iaux, n) + end do call nc_export_array(dbl1d, this%ncid, this%dim_ids, this%var_ids, & this%dis, idt, export_pkg%mf6_input%mempath, & nc_tag, export_pkg%mf6_input%subcomponent_name, & @@ -528,9 +611,9 @@ subroutine package_step(this, export_pkg) this%shuffle, this%chunk_z, this%chunk_y, & this%chunk_x, kper, iaux, this%nc_fname) end do + deallocate (dbl1d) case default - errmsg = 'EXPORT unsupported datatype='//trim(idt%datatype) - call store_error(errmsg, .true.) + ! no-op, no other datatypes exported end select end do @@ -538,64 +621,6 @@ subroutine package_step(this, export_pkg) call nf_verify(nf90_sync(this%ncid), this%nc_fname) end subroutine package_step - !> @brief export layer variable as full grid - !< - subroutine export_layer_3d(this, export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_tag, iaux) - use ConstantsModule, only: DNODATA, DZERO - use NCModelExportModule, only: ExportPackageType - class(DisNCStructuredType), intent(inout) :: this - class(ExportPackageType), pointer, intent(in) :: export_pkg - type(InputParamDefinitionType), pointer, intent(in) :: idt - logical(LGP), intent(in) :: ilayer_read - integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ialayer - real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d - character(len=*), intent(in) :: nc_tag - integer(I4B), optional, intent(in) :: iaux - real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d - integer(I4B) :: n, i, j, k, nvals, idxaux - real(DP), dimension(:, :), contiguous, pointer :: dbl2d_ptr - - ! initialize - idxaux = 0 - if (present(iaux)) then - idxaux = iaux - end if - - allocate (dbl3d(export_pkg%mshape(3), export_pkg%mshape(2), & - export_pkg%mshape(1))) - - if (ilayer_read) then - do k = 1, size(dbl3d, dim=3) - n = 0 - do i = 1, size(dbl3d, dim=2) - do j = 1, size(dbl3d, dim=1) - n = n + 1 - if (ialayer(n) == k) then - dbl3d(j, i, k) = dbl1d(n) - else - dbl3d(j, i, k) = DNODATA - end if - end do - end do - end do - else - dbl3d = DNODATA - nvals = export_pkg%mshape(3) * export_pkg%mshape(2) - dbl2d_ptr(1:export_pkg%mshape(3), 1:export_pkg%mshape(2)) => dbl1d(1:nvals) - dbl3d(:, :, 1) = dbl2d_ptr(:, :) - end if - - call nc_export_array(dbl3d, this%ncid, this%dim_ids, this%var_ids, & - this%dis, idt, export_pkg%mf6_input%mempath, & - nc_tag, export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%latlon, this%deflate, & - this%shuffle, this%chunk_z, this%chunk_y, & - this%chunk_x, export_pkg%iper, idxaux, this%nc_fname) - - deallocate (dbl3d) - end subroutine export_layer_3d - !> @brief determine packages to write gridded input !< subroutine add_pkg_data(this) @@ -680,8 +705,6 @@ end subroutine add_global_att !> @brief netcdf export define dimensions !< subroutine define_dim(this) - use ConstantsModule, only: MVALIDATE - use SimVariablesModule, only: isim_mode class(DisNCStructuredType), intent(inout) :: this ! bound dim @@ -689,24 +712,22 @@ subroutine define_dim(this) this%nc_fname) ! Time - if (isim_mode /= MVALIDATE) then - call nf_verify(nf90_def_dim(this%ncid, 'time', this%totnstp, & - this%dim_ids%time), this%nc_fname) - call nf_verify(nf90_def_var(this%ncid, 'time', NF90_DOUBLE, & - this%dim_ids%time, this%var_ids%time), & - this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'calendar', & - 'standard'), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'units', & - this%datetime), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'axis', 'T'), & - this%nc_fname) - !call nf_verify(nf90_put_att(ncid, var_ids%time, 'bounds', 'time_bnds'), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'standard_name', & - 'time'), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'long_name', & - 'time'), this%nc_fname) - end if + call nf_verify(nf90_def_dim(this%ncid, 'time', this%totnstp, & + this%dim_ids%time), this%nc_fname) + call nf_verify(nf90_def_var(this%ncid, 'time', NF90_DOUBLE, & + this%dim_ids%time, this%var_ids%time), & + this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'calendar', & + 'standard'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'units', & + this%datetime), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'axis', 'T'), & + this%nc_fname) + !call nf_verify(nf90_put_att(ncid, var_ids%time, 'bounds', 'time_bnds'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'standard_name', & + 'time'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'long_name', & + 'time'), this%nc_fname) ! Z dimension call nf_verify(nf90_def_dim(this%ncid, 'z', this%dis%nlay, this%dim_ids%z), & @@ -1026,22 +1047,17 @@ end subroutine ncvar_gridmap !> @brief put variable internal modflow6 attributes !< - subroutine ncvar_mf6attr(ncid, varid, iper, iaux, nc_tag, nc_fname) + subroutine ncvar_mf6attr(ncid, varid, iaux, nc_tag, nc_fname) integer(I4B), intent(in) :: ncid integer(I4B), intent(in) :: varid - integer(I4B), intent(in) :: iper integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: nc_fname if (nc_tag /= '') then - call nf_verify(nf90_put_att(ncid, varid, 'modflow6_input', & + call nf_verify(nf90_put_att(ncid, varid, 'modflow_input', & nc_tag), nc_fname) - if (iper > 0) then - call nf_verify(nf90_put_att(ncid, varid, 'modflow6_iper', & - iper), nc_fname) - end if if (iaux > 0) then - call nf_verify(nf90_put_att(ncid, varid, 'modflow6_iaux', & + call nf_verify(nf90_put_att(ncid, varid, 'modflow_iaux', & iaux), nc_fname) end if end if @@ -1052,6 +1068,7 @@ end subroutine ncvar_mf6attr subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_tag, pkgname, gridmap_name, latlon, deflate, & shuffle, chunk_z, chunk_y, chunk_x, iper, nc_fname) + use NetCDFCommonModule, only: gstp integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids @@ -1070,76 +1087,97 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & integer(I4B), intent(in) :: chunk_x integer(I4B), intent(in) :: iper character(len=*), intent(in) :: nc_fname - integer(I4B) :: var_id, axis_sz + integer(I4B) :: var_id, axis_sz, istp character(len=LINELENGTH) :: varname, longname - varname = export_varname(pkgname, idt%tagname, mempath, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath) if (idt%shape == 'NROW' .or. & idt%shape == 'NCOL' .or. & - idt%shape == 'NCPL') then - - select case (idt%shape) - case ('NROW') - axis_sz = dim_ids%y - case ('NCOL') - axis_sz = dim_ids%x - case ('NCPL') - axis_sz = dim_ids%ncpl - end select - - longname = export_longname(idt%longname, pkgname, idt%tagname, iper=iper) - - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & - (/axis_sz/), var_id), & - nc_fname) - - ! NROW/NCOL shapes use default chunking - call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname) - - ! put attr - call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & - (/NF90_FILL_INT/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname), nc_fname) - - ! add mf6 attr - call ncvar_mf6attr(ncid, var_id, iper, 0, nc_tag, nc_fname) - - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - call nf_verify(nf90_put_var(ncid, var_id, p_mem), & - nc_fname) + idt%shape == 'NCPL' .or. & + idt%shape == 'NAUX NCPL') then + + if (iper == 0) then + select case (idt%shape) + case ('NROW') + axis_sz = dim_ids%y + case ('NCOL') + axis_sz = dim_ids%x + case ('NCPL', 'NAUX NCPL') + axis_sz = dim_ids%ncpl + end select + + longname = export_longname(idt%longname, pkgname, idt%tagname, mempath) + + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & + (/axis_sz/), var_id), & + nc_fname) + + ! NROW/NCOL shapes use default chunking + call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname) + + ! put attr + call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & + (/NF90_FILL_INT/)), nc_fname) + call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & + longname), nc_fname) + + ! add mf6 attr + call ncvar_mf6attr(ncid, var_id, 0, nc_tag, nc_fname) + + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + call nf_verify(nf90_put_var(ncid, var_id, p_mem), & + nc_fname) + else + ! timeseries + istp = gstp() + call nf_verify(nf90_put_var(ncid, & + var_ids%export, p_mem, & + start=(/1, istp/), & + count=(/dis%ncol, dis%nrow, 1/)), nc_fname) + end if else - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & - (/dim_ids%x, dim_ids%y, dim_ids%z/), var_id), & - nc_fname) - ! apply chunking parameters - call ncvar_chunk3d(ncid, var_id, chunk_x, chunk_y, chunk_z, nc_fname) - ! deflate and shuffle - call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname) - - ! put attr - call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & - (/NF90_FILL_INT/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - idt%longname), nc_fname) - - ! add grid mapping and mf6 attr - call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) - call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname) - - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - call nf_verify(nf90_put_var(ncid, var_id, p_mem, start=(/1, 1, 1/), & - count=(/dis%ncol, dis%nrow, dis%nlay/)), & - nc_fname) + if (iper == 0) then + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & + (/dim_ids%x, dim_ids%y, dim_ids%z/), & + var_id), nc_fname) + + ! apply chunking parameters + call ncvar_chunk3d(ncid, var_id, chunk_x, chunk_y, chunk_z, nc_fname) + ! deflate and shuffle + call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname) + + ! put attr + call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & + (/NF90_FILL_INT/)), nc_fname) + call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & + idt%longname), nc_fname) + + ! add grid mapping and mf6 attr + call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) + call ncvar_mf6attr(ncid, var_id, 0, nc_tag, nc_fname) + + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + call nf_verify(nf90_put_var(ncid, var_id, p_mem, start=(/1, 1, 1/), & + count=(/dis%ncol, dis%nrow, dis%nlay/)), & + nc_fname) + else + ! timeseries + istp = gstp() + call nf_verify(nf90_put_var(ncid, & + var_ids%export, p_mem, & + start=(/1, 1, 1, istp/), & + count=(/dis%ncol, dis%nrow, dis%nlay, 1/)), & + nc_fname) + end if end if end subroutine nc_export_int1d @@ -1189,7 +1227,7 @@ subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) - call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id, 0, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) @@ -1244,7 +1282,7 @@ subroutine nc_export_int3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) - call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id, 0, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) @@ -1260,6 +1298,7 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & shuffle, chunk_z, chunk_y, chunk_x, iper, iaux, & nc_fname) use ConstantsModule, only: DNODATA + use NetCDFCommonModule, only: gstp real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids @@ -1279,85 +1318,101 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & integer(I4B), intent(in) :: iper integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname - integer(I4B) :: var_id, axis_sz - real(DP) :: fill_value + integer(I4B) :: var_id, axis_sz, istp character(len=LINELENGTH) :: varname, longname if (idt%shape == 'NROW' .or. & idt%shape == 'NCOL' .or. & - idt%shape == 'NCPL') then - - select case (idt%shape) - case ('NROW') - axis_sz = dim_ids%y - case ('NCOL') - axis_sz = dim_ids%x - case ('NCPL') - axis_sz = dim_ids%ncpl - end select - - varname = export_varname(pkgname, idt%tagname, mempath, iper=iper) - - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & - (/axis_sz/), var_id), & - nc_fname) - - ! NROW/NCOL shapes use default chunking - call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname) - - ! put attr - call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & - (/NF90_FILL_DOUBLE/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - idt%longname), nc_fname) - - ! add mf6 attr - call ncvar_mf6attr(ncid, var_id, iper, iaux, nc_tag, nc_fname) - - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - call nf_verify(nf90_put_var(ncid, var_id, p_mem), & - nc_fname) - - else - if (iper > 0) then - fill_value = DNODATA + idt%shape == 'NCPL' .or. & + idt%shape == 'NAUX NCPL') then + + if (iper == 0) then + select case (idt%shape) + case ('NROW') + axis_sz = dim_ids%y + case ('NCOL') + axis_sz = dim_ids%x + case ('NCPL', 'NAUX NCPL') + axis_sz = dim_ids%ncpl + end select + + varname = export_varname(pkgname, idt%tagname, mempath) + longname = export_longname(idt%longname, pkgname, idt%tagname, mempath, & + iaux=iaux) + + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & + (/axis_sz/), var_id), & + nc_fname) + + ! NROW/NCOL shapes use default chunking + call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname) + + ! put attr + call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & + (/NF90_FILL_DOUBLE/)), nc_fname) + call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & + longname), nc_fname) + + ! add mf6 attr + call ncvar_mf6attr(ncid, var_id, iaux, nc_tag, nc_fname) + + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + call nf_verify(nf90_put_var(ncid, var_id, p_mem), & + nc_fname) else - fill_value = NF90_FILL_DOUBLE + ! timeseries + istp = gstp() + call nf_verify(nf90_put_var(ncid, & + var_ids%export, p_mem, & + start=(/1, istp/), & + count=(/dis%ncol, dis%nrow, 1/)), nc_fname) end if - varname = export_varname(pkgname, idt%tagname, mempath, iper=iper, & - iaux=iaux) - longname = export_longname(idt%longname, pkgname, idt%tagname, iper=iper) - - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & - (/dim_ids%x, dim_ids%y, dim_ids%z/), var_id), & - nc_fname) + else - ! apply chunking parameters - call ncvar_chunk3d(ncid, var_id, chunk_x, chunk_y, chunk_z, nc_fname) - ! deflate and shuffle - call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname) - - ! put attr - call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & - (/fill_value/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & - longname), nc_fname) - - ! add grid mapping and mf6 attr - call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) - call ncvar_mf6attr(ncid, var_id, iper, iaux, nc_tag, nc_fname) - - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - call nf_verify(nf90_put_var(ncid, var_id, p_mem, start=(/1, 1, 1/), & - count=(/dis%ncol, dis%nrow, dis%nlay/)), & - nc_fname) + if (iper == 0) then + varname = export_varname(pkgname, idt%tagname, mempath, iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, mempath, & + iaux=iaux) + + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & + (/dim_ids%x, dim_ids%y, dim_ids%z/), & + var_id), nc_fname) + + ! apply chunking parameters + call ncvar_chunk3d(ncid, var_id, chunk_x, chunk_y, chunk_z, nc_fname) + ! deflate and shuffle + call ncvar_deflate(ncid, var_id, deflate, shuffle, nc_fname) + + ! put attr + call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & + (/NF90_FILL_DOUBLE/)), nc_fname) + call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & + longname), nc_fname) + + ! add grid mapping and mf6 attr + call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) + call ncvar_mf6attr(ncid, var_id, iaux, nc_tag, nc_fname) + + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + call nf_verify(nf90_put_var(ncid, var_id, p_mem, start=(/1, 1, 1/), & + count=(/dis%ncol, dis%nrow, dis%nlay/)), & + nc_fname) + else + ! timeseries + istp = gstp() + call nf_verify(nf90_put_var(ncid, & + var_ids%export, p_mem, & + start=(/1, 1, 1, istp/), & + count=(/dis%ncol, dis%nrow, dis%nlay, 1/)), & + nc_fname) + end if end if end subroutine nc_export_dbl1d @@ -1407,7 +1462,7 @@ subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) - call ncvar_mf6attr(ncid, var_id, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id, 0, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) @@ -1420,8 +1475,7 @@ end subroutine nc_export_dbl2d !< subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_tag, pkgname, gridmap_name, latlon, deflate, & - shuffle, chunk_z, chunk_y, chunk_x, iper, iaux, & - nc_fname) + shuffle, chunk_z, chunk_y, chunk_x, nc_fname) use ConstantsModule, only: DNODATA real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid @@ -1439,21 +1493,12 @@ subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & integer(I4B), intent(in) :: chunk_z integer(I4B), intent(in) :: chunk_y integer(I4B), intent(in) :: chunk_x - integer(I4B), intent(in) :: iper - integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname integer(I4B) :: var_id - real(DP) :: fill_value character(len=LINELENGTH) :: varname, longname - if (iper > 0) then - fill_value = DNODATA - else - fill_value = NF90_FILL_DOUBLE - end if - - varname = export_varname(pkgname, idt%tagname, mempath, iper=iper, iaux=iaux) - longname = export_longname(idt%longname, pkgname, idt%tagname, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath) + longname = export_longname(idt%longname, pkgname, idt%tagname, mempath) ! reenter define mode and create variable call nf_verify(nf90_redef(ncid), nc_fname) @@ -1468,13 +1513,13 @@ subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & ! put attr call nf_verify(nf90_put_att(ncid, var_id, '_FillValue', & - (/fill_value/)), nc_fname) + (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id, 'long_name', & longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id, gridmap_name, latlon, nc_fname) - call ncvar_mf6attr(ncid, var_id, iper, iaux, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id, 0, nc_tag, nc_fname) ! exit define mode and write data call nf_verify(nf90_enddef(ncid), nc_fname) diff --git a/src/Utilities/Export/DisvNCMesh.f90 b/src/Utilities/Export/DisvNCMesh.f90 index cd14f6e6a50..443a6ae4d70 100644 --- a/src/Utilities/Export/DisvNCMesh.f90 +++ b/src/Utilities/Export/DisvNCMesh.f90 @@ -36,9 +36,7 @@ module MeshDisvModelModule procedure :: df procedure :: step procedure :: export_input_array - procedure :: package_step_ilayer procedure :: package_step - procedure :: export_layer_2d procedure :: define_dim procedure :: add_mesh_data end type Mesh2dDisvExportType @@ -64,6 +62,7 @@ subroutine disv_export_init(this, modelname, modeltype, modelfname, nc_fname, & ! allocate var_id arrays allocate (this%var_ids%dependent(this%nlay)) + allocate (this%var_ids%export(this%nlay)) ! initialize base class call this%mesh_init(modelname, modeltype, modelfname, nc_fname, disenum, & @@ -96,6 +95,8 @@ subroutine df(this) ! define the dependent variable call this%define_dependent() end if + ! define period input arrays + call this%df_export() ! exit define mode call nf_verify(nf90_enddef(this%ncid), this%nc_fname) ! create mesh @@ -113,9 +114,10 @@ end subroutine df subroutine step(this) use ConstantsModule, only: DHNOFLO use TdisModule, only: totim + use NetCDFCommonModule, only: gstp class(Mesh2dDisvExportType), intent(inout) :: this real(DP), dimension(:), pointer, contiguous :: dbl1d - integer(I4B) :: n, k, nvals + integer(I4B) :: n, k, nvals, istp integer(I4B), dimension(2) :: dis_shape real(DP), dimension(:, :), pointer, contiguous :: dbl2d @@ -123,8 +125,8 @@ subroutine step(this) nullify (dbl1d) nullify (dbl2d) - ! increment step - this%stepcnt = this%stepcnt + 1 + ! set global step index + istp = gstp() dis_shape(1) = this%disv%ncpl dis_shape(2) = this%disv%nlay @@ -156,14 +158,14 @@ subroutine step(this) ! extend array with step data call nf_verify(nf90_put_var(this%ncid, & this%var_ids%dependent(k), dbl2d(:, k), & - start=(/1, this%stepcnt/), & + start=(/1, istp/), & count=(/this%disv%ncpl, 1/)), & this%nc_fname) end do ! write to time coordinate variable call nf_verify(nf90_put_var(this%ncid, this%var_ids%time, & - totim, start=(/this%stepcnt/)), & + totim, start=(/istp/)), & this%nc_fname) ! update file @@ -175,90 +177,6 @@ subroutine step(this) nullify (dbl2d) end subroutine step - !> @brief netcdf export package dynamic input with ilayer index variable - !< - subroutine package_step_ilayer(this, export_pkg, ilayer_varname, ilayer) - use ConstantsModule, only: DNODATA, DZERO - use TdisModule, only: kper - use DefinitionSelectModule, only: get_param_definition_type - use NCModelExportModule, only: ExportPackageType - class(Mesh2dDisvExportType), intent(inout) :: this - class(ExportPackageType), pointer, intent(in) :: export_pkg - character(len=*), intent(in) :: ilayer_varname - integer(I4B), intent(in) :: ilayer - type(InputParamDefinitionType), pointer :: idt - integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d - real(DP), dimension(:, :), pointer, contiguous :: dbl2d - integer(I4B), dimension(:), pointer, contiguous :: ialayer - real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr - character(len=LINELENGTH) :: nc_tag - integer(I4B) :: iaux, iparam, nvals - logical(LGP) :: ilayer_read - - ! initialize - nullify (ialayer) - ilayer_read = .false. - - ! set pointer to ilayer variable - call mem_setptr(ialayer, export_pkg%param_names(ilayer), & - export_pkg%mf6_input%mempath) - - ! check if layer index variable was read - if (export_pkg%param_reads(ilayer)%invar == 1) then - ilayer_read = .true. - end if - - ! export defined period input - do iparam = 1, export_pkg%nparam - ! check if variable was read this period - if (export_pkg%param_reads(iparam)%invar < 1) cycle - - ! set input definition - idt => & - get_param_definition_type(export_pkg%mf6_input%param_dfns, & - export_pkg%mf6_input%component_type, & - export_pkg%mf6_input%subcomponent_type, & - 'PERIOD', export_pkg%param_names(iparam), '') - - ! set variable name and input string - nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & - idt) - - ! export arrays - select case (idt%datatype) - case ('INTEGER1D') - call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%var_ids, & - this%disv, idt, export_pkg%mf6_input%mempath, & - nc_tag, export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, kper, this%nc_fname) - case ('DOUBLE1D') - call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) - call this%export_layer_2d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_tag) - case ('DOUBLE2D') - call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) - nvals = this%disv%ncpl - do iaux = 1, size(dbl2d, dim=1) !naux - dbl1d_ptr(1:nvals) => dbl2d(iaux, :) - if (all(dbl1d_ptr == DZERO)) then - else - call this%export_layer_2d(export_pkg, idt, ilayer_read, ialayer, & - dbl1d_ptr, nc_tag, iaux) - end if - end do - case default - errmsg = 'EXPORT ilayer unsupported datatype='//trim(idt%datatype) - call store_error(errmsg, .true.) - end select - end do - - ! synchronize file - call nf_verify(nf90_sync(this%ncid), this%nc_fname) - end subroutine package_step_ilayer - !> @brief netcdf export package dynamic input !< subroutine package_step(this, export_pkg) @@ -274,6 +192,7 @@ subroutine package_step(this, export_pkg) real(DP), dimension(:, :), pointer, contiguous :: dbl2d character(len=LINELENGTH) :: nc_tag integer(I4B) :: iaux, iparam, nvals + integer(I4B) :: k, n ! initialize iaux = 0 @@ -294,10 +213,11 @@ subroutine package_step(this, export_pkg) nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & idt) - ! export array + ! export arrays select case (idt%datatype) case ('INTEGER1D') call mem_setptr(int1d, idt%mf6varname, export_pkg%mf6_input%mempath) + this%var_ids%export(1) = export_pkg%varids_param(iparam, 1) call nc_export_int1d(int1d, this%ncid, this%dim_ids, this%var_ids, & this%disv, idt, export_pkg%mf6_input%mempath, & nc_tag, export_pkg%mf6_input%subcomponent_name, & @@ -305,6 +225,15 @@ subroutine package_step(this, export_pkg) this%chunk_face, kper, this%nc_fname) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) + select case (idt%shape) + case ('NCPL') + this%var_ids%export(1) = export_pkg%varids_param(iparam, 1) + case ('NODES') + do k = 1, this%disv%nlay + this%var_ids%export(k) = export_pkg%varids_param(iparam, k) + end do + case default + end select call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & this%disv, idt, export_pkg%mf6_input%mempath, & nc_tag, export_pkg%mf6_input%subcomponent_name, & @@ -312,15 +241,34 @@ subroutine package_step(this, export_pkg) this%chunk_face, kper, iaux, this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) - nvals = this%disv%ncpl + select case (idt%shape) + case ('NAUX NCPL') + nvals = this%disv%ncpl + case ('NAUX NODES') + nvals = this%disv%nodesuser + case default + end select + allocate (dbl1d(nvals)) do iaux = 1, size(dbl2d, dim=1) !naux - dbl1d(1:nvals) => dbl2d(iaux, :) + select case (idt%shape) + case ('NAUX NCPL') + this%var_ids%export(1) = export_pkg%varids_aux(iaux, 1) + case ('NAUX NODES') + do k = 1, this%disv%nlay + this%var_ids%export(k) = export_pkg%varids_aux(iaux, k) + end do + case default + end select + do n = 1, nvals + dbl1d(n) = dbl2d(iaux, n) + end do call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & this%disv, idt, export_pkg%mf6_input%mempath, & nc_tag, export_pkg%mf6_input%subcomponent_name, & this%gridmap_name, this%deflate, this%shuffle, & this%chunk_face, kper, iaux, this%nc_fname) end do + deallocate (dbl1d) case default ! no-op, no other datatypes exported end select @@ -330,57 +278,6 @@ subroutine package_step(this, export_pkg) call nf_verify(nf90_sync(this%ncid), this%nc_fname) end subroutine package_step - !> @brief export layer variable as full grid - !< - subroutine export_layer_2d(this, export_pkg, idt, ilayer_read, ialayer, & - dbl1d, nc_tag, iaux) - use ConstantsModule, only: DNODATA, DZERO - use NCModelExportModule, only: ExportPackageType - class(Mesh2dDisvExportType), intent(inout) :: this - class(ExportPackageType), pointer, intent(in) :: export_pkg - type(InputParamDefinitionType), pointer, intent(in) :: idt - logical(LGP), intent(in) :: ilayer_read - integer(I4B), dimension(:), pointer, contiguous, intent(in) :: ialayer - real(DP), dimension(:), pointer, contiguous, intent(in) :: dbl1d - character(len=*), intent(in) :: nc_tag - integer(I4B), optional, intent(in) :: iaux - real(DP), dimension(:, :), pointer, contiguous :: dbl2d - integer(I4B) :: n, j, k, idxaux - - ! initialize - idxaux = 0 - if (present(iaux)) then - idxaux = iaux - end if - - allocate (dbl2d(export_pkg%mshape(2), export_pkg%mshape(1))) - - if (ilayer_read) then - do k = 1, size(dbl2d, dim=2) - n = 0 - do j = 1, size(dbl2d, dim=1) - n = n + 1 - if (ialayer(n) == k) then - dbl2d(j, k) = dbl1d(n) - else - dbl2d(j, k) = DNODATA - end if - end do - end do - else - dbl2d = DNODATA - dbl2d(:, 1) = dbl1d(:) - end if - - call nc_export_dbl2d(dbl2d, this%ncid, this%dim_ids, this%var_ids, & - this%disv, idt, export_pkg%mf6_input%mempath, & - nc_tag, export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, export_pkg%iper, idxaux, this%nc_fname) - - deallocate (dbl2d) - end subroutine export_layer_2d - !> @brief netcdf export an input array !< subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) @@ -426,7 +323,7 @@ subroutine export_input_array(this, pkgtype, pkgname, mempath, idt) call nc_export_dbl2d(dbl2d, this%ncid, this%dim_ids, this%var_ids, & this%disv, idt, mempath, nc_tag, pkgname, & this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, iper, iaux, this%nc_fname) + this%chunk_face, this%nc_fname) case default ! no-op, no other datatypes exported end select @@ -435,8 +332,6 @@ end subroutine export_input_array !> @brief netcdf export define dimensions !< subroutine define_dim(this) - use ConstantsModule, only: MVALIDATE - use SimVariablesModule, only: isim_mode class(Mesh2dDisvExportType), intent(inout) :: this integer(I4B), dimension(:), contiguous, pointer :: ncvert @@ -444,23 +339,21 @@ subroutine define_dim(this) call mem_setptr(ncvert, 'NCVERT', this%dis_mempath) ! time - if (isim_mode /= MVALIDATE) then - call nf_verify(nf90_def_dim(this%ncid, 'time', this%totnstp, & - this%dim_ids%time), this%nc_fname) - call nf_verify(nf90_def_var(this%ncid, 'time', NF90_DOUBLE, & - this%dim_ids%time, this%var_ids%time), & - this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'calendar', & - 'standard'), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'units', & - this%datetime), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'axis', 'T'), & - this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'standard_name', & - 'time'), this%nc_fname) - call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'long_name', & - 'time'), this%nc_fname) - end if + call nf_verify(nf90_def_dim(this%ncid, 'time', this%totnstp, & + this%dim_ids%time), this%nc_fname) + call nf_verify(nf90_def_var(this%ncid, 'time', NF90_DOUBLE, & + this%dim_ids%time, this%var_ids%time), & + this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'calendar', & + 'standard'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'units', & + this%datetime), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'axis', 'T'), & + this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'standard_name', & + 'time'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, this%var_ids%time, 'long_name', & + 'time'), this%nc_fname) ! mesh call nf_verify(nf90_def_dim(this%ncid, 'nmesh_node', this%disv%nvert, & @@ -619,6 +512,7 @@ end subroutine add_mesh_data subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & nc_tag, pkgname, gridmap_name, deflate, shuffle, & chunk_face, iper, nc_fname) + use NetCDFCommonModule, only: gstp integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids @@ -634,93 +528,111 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & integer(I4B), intent(in) :: chunk_face integer(I4B), intent(in) :: iper character(len=*), intent(in) :: nc_fname - integer(I4B), dimension(2) :: dis_shape + integer(I4B), dimension(:), pointer, contiguous :: int1d integer(I4B), dimension(:, :), pointer, contiguous :: int2d - integer(I4B) :: axis_sz, nvals, k + integer(I4B) :: axis_sz, k, istp integer(I4B), dimension(:), allocatable :: var_id character(len=LINELENGTH) :: longname, varname - if (idt%shape == 'NCPL') then - ! set names - varname = export_varname(pkgname, idt%tagname, mempath, iper=iper) - longname = export_longname(idt%longname, pkgname, idt%tagname, & - iper=iper) - - allocate (var_id(1)) - axis_sz = dim_ids%nmesh_face - - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & - (/axis_sz/), var_id(1)), & - nc_fname) - - ! apply chunking parameters - call ncvar_chunk(ncid, var_id(1), chunk_face, nc_fname) - ! deflate and shuffle - call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname) - - ! put attr - call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & - (/NF90_FILL_INT/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & - longname), nc_fname) - - ! add grid mapping and mf6 attr - call ncvar_gridmap(ncid, var_id(1), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(1), 0, iper, 0, nc_tag, nc_fname) + if (idt%shape == 'NCPL' .or. & + idt%shape == 'NAUX NCPL') then - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & - nc_fname) - - else - allocate (var_id(disv%nlay)) - - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - do k = 1, disv%nlay + if (iper == 0) then ! set names - varname = export_varname(pkgname, idt%tagname, mempath, & - layer=k, iper=iper) - longname = export_longname(idt%longname, pkgname, idt%tagname, & - layer=k, iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath) + longname = export_longname(idt%longname, pkgname, idt%tagname, mempath) + + allocate (var_id(1)) + axis_sz = dim_ids%nmesh_face + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & - (/dim_ids%nmesh_face/), var_id(k)), & + (/axis_sz/), var_id(1)), & nc_fname) ! apply chunking parameters - call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname) - ! defalte and shuffle - call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname) + call ncvar_chunk(ncid, var_id(1), chunk_face, nc_fname) + ! deflate and shuffle + call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname) ! put attr - call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & + call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & (/NF90_FILL_INT/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & + call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & longname), nc_fname) ! add grid mapping and mf6 attr - call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, iper, 0, nc_tag, nc_fname) - end do + call ncvar_gridmap(ncid, var_id(1), gridmap_name, nc_fname) + call ncvar_mf6attr(ncid, var_id(1), 0, 0, nc_tag, nc_fname) + + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & + nc_fname) + else + ! timeseries + istp = gstp() + call nf_verify(nf90_put_var(ncid, & + var_ids%export(1), p_mem, & + start=(/1, istp/), & + count=(/disv%ncpl, 1/)), nc_fname) + end if - ! reshape input - dis_shape(1) = disv%ncpl - dis_shape(2) = disv%nlay - nvals = product(dis_shape) - int2d(1:dis_shape(1), 1:dis_shape(2)) => p_mem(1:nvals) + else - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - do k = 1, disv%nlay - call nf_verify(nf90_put_var(ncid, var_id(k), int2d(:, k)), nc_fname) - end do + int2d(1:disv%ncpl, 1:disv%nlay) => p_mem(1:disv%nodesuser) + + if (iper == 0) then + allocate (var_id(disv%nlay)) + + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) + do k = 1, disv%nlay + ! set names + varname = export_varname(pkgname, idt%tagname, mempath, layer=k) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + mempath, layer=k) + + call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & + (/dim_ids%nmesh_face/), var_id(k)), & + nc_fname) + + ! apply chunking parameters + call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname) + ! deflate and shuffle + call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname) + + ! put attr + call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & + (/NF90_FILL_INT/)), nc_fname) + call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & + longname), nc_fname) + + ! add grid mapping and mf6 attr + call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname) + end do + + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + do k = 1, disv%nlay + call nf_verify(nf90_put_var(ncid, var_id(k), int2d(:, k)), nc_fname) + end do - ! cleanup - deallocate (var_id) + ! cleanup + deallocate (var_id) + else + ! timeseries, add period data + istp = gstp() + do k = 1, disv%nlay + int1d(1:disv%ncpl) => int2d(:, k) + call nf_verify(nf90_put_var(ncid, & + var_ids%export(k), int1d, & + start=(/1, istp/), & + count=(/disv%ncpl, 1/)), nc_fname) + end do + end if end if end subroutine nc_export_int1d @@ -754,7 +666,8 @@ subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & do k = 1, disv%nlay ! set names varname = export_varname(pkgname, idt%tagname, mempath, layer=k) - longname = export_longname(idt%longname, pkgname, idt%tagname, layer=k) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + mempath, layer=k) call nf_verify(nf90_def_var(ncid, varname, NF90_INT, & (/dim_ids%nmesh_face/), var_id(k)), & @@ -773,7 +686,7 @@ subroutine nc_export_int2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, 0, 0, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname) end do ! exit define mode and write data @@ -790,6 +703,8 @@ end subroutine nc_export_int2d subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & nc_tag, pkgname, gridmap_name, deflate, shuffle, & chunk_face, iper, iaux, nc_fname) + use ConstantsModule, only: DNODATA + use NetCDFCommonModule, only: gstp real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids @@ -806,94 +721,114 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & integer(I4B), intent(in) :: iper integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname - integer(I4B), dimension(2) :: dis_shape + real(DP), dimension(:), pointer, contiguous :: dbl1d real(DP), dimension(:, :), pointer, contiguous :: dbl2d - integer(I4B) :: axis_sz, nvals, k + integer(I4B) :: axis_sz, k, istp integer(I4B), dimension(:), allocatable :: var_id character(len=LINELENGTH) :: longname, varname - if (idt%shape == 'NCPL') then - ! set names - varname = export_varname(pkgname, idt%tagname, mempath, iper=iper, & - iaux=iaux) - longname = export_longname(idt%longname, pkgname, idt%tagname, & - iper=iper) - - allocate (var_id(1)) - axis_sz = dim_ids%nmesh_face + if (idt%shape == 'NCPL' .or. & + idt%shape == 'NAUX NCPL') then - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & - (/axis_sz/), var_id(1)), & - nc_fname) - - ! apply chunking parameters - call ncvar_chunk(ncid, var_id(1), chunk_face, nc_fname) - ! deflate and shuffle - call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname) - - ! put attr - call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & - (/NF90_FILL_DOUBLE/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & - longname), nc_fname) - - ! add grid mapping and mf6 attr - call ncvar_gridmap(ncid, var_id(1), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(1), 0, iper, iaux, nc_tag, nc_fname) - - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & - nc_fname) - - else - allocate (var_id(disv%nlay)) - - ! reenter define mode and create variable - call nf_verify(nf90_redef(ncid), nc_fname) - do k = 1, disv%nlay + if (iper == 0) then ! set names - varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & - iper=iper, iaux=iaux) + varname = export_varname(pkgname, idt%tagname, mempath, & + iaux=iaux) longname = export_longname(idt%longname, pkgname, idt%tagname, & - layer=k, iper=iper) + mempath, iaux=iaux) + allocate (var_id(1)) + axis_sz = dim_ids%nmesh_face + + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & - (/dim_ids%nmesh_face/), var_id(k)), & + (/axis_sz/), var_id(1)), & nc_fname) ! apply chunking parameters - call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname) + call ncvar_chunk(ncid, var_id(1), chunk_face, nc_fname) ! deflate and shuffle - call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname) + call ncvar_deflate(ncid, var_id(1), deflate, shuffle, nc_fname) ! put attr - call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & + call nf_verify(nf90_put_att(ncid, var_id(1), '_FillValue', & (/NF90_FILL_DOUBLE/)), nc_fname) - call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & + call nf_verify(nf90_put_att(ncid, var_id(1), 'long_name', & longname), nc_fname) ! add grid mapping and mf6 attr - call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, iper, iaux, nc_tag, nc_fname) - end do + call ncvar_gridmap(ncid, var_id(1), gridmap_name, nc_fname) + call ncvar_mf6attr(ncid, var_id(1), 0, iaux, nc_tag, nc_fname) - ! reshape input - dis_shape(1) = disv%ncpl - dis_shape(2) = disv%nlay - nvals = product(dis_shape) - dbl2d(1:dis_shape(1), 1:dis_shape(2)) => p_mem(1:nvals) + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & + nc_fname) + else + ! timeseries + istp = gstp() + call nf_verify(nf90_put_var(ncid, & + var_ids%export(1), p_mem, & + start=(/1, istp/), & + count=(/disv%ncpl, 1/)), nc_fname) + end if - ! exit define mode and write data - call nf_verify(nf90_enddef(ncid), nc_fname) - do k = 1, disv%nlay - call nf_verify(nf90_put_var(ncid, var_id(k), dbl2d(:, k)), nc_fname) - end do + else - ! cleanup - deallocate (var_id) + dbl2d(1:disv%ncpl, 1:disv%nlay) => p_mem(1:disv%nodesuser) + + if (iper == 0) then + allocate (var_id(disv%nlay)) + + ! reenter define mode and create variable + call nf_verify(nf90_redef(ncid), nc_fname) + do k = 1, disv%nlay + ! set names + varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & + iaux=iaux) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + mempath, layer=k, iaux=iaux) + + call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & + (/dim_ids%nmesh_face/), var_id(k)), & + nc_fname) + + ! apply chunking parameters + call ncvar_chunk(ncid, var_id(k), chunk_face, nc_fname) + ! deflate and shuffle + call ncvar_deflate(ncid, var_id(k), deflate, shuffle, nc_fname) + + ! put attr + call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & + (/NF90_FILL_DOUBLE/)), nc_fname) + call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & + longname), nc_fname) + + ! add grid mapping and mf6 attr + call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, iaux, nc_tag, nc_fname) + end do + + ! exit define mode and write data + call nf_verify(nf90_enddef(ncid), nc_fname) + do k = 1, disv%nlay + call nf_verify(nf90_put_var(ncid, var_id(k), dbl2d(:, k)), nc_fname) + end do + + ! cleanup + deallocate (var_id) + else + ! timeseries, add period data + istp = gstp() + do k = 1, disv%nlay + dbl1d(1:disv%ncpl) => dbl2d(:, k) + call nf_verify(nf90_put_var(ncid, & + var_ids%export(k), dbl1d, & + start=(/1, istp/), & + count=(/disv%ncpl, 1/)), nc_fname) + end do + end if end if end subroutine nc_export_dbl1d @@ -901,7 +836,7 @@ end subroutine nc_export_dbl1d !< subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & nc_tag, pkgname, gridmap_name, deflate, shuffle, & - chunk_face, iper, iaux, nc_fname) + chunk_face, nc_fname) use ConstantsModule, only: DNODATA real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid @@ -916,19 +851,10 @@ subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & integer(I4B), intent(in) :: deflate integer(I4B), intent(in) :: shuffle integer(I4B), intent(in) :: chunk_face - integer(I4B), intent(in) :: iper - integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_fname integer(I4B), dimension(:), allocatable :: var_id character(len=LINELENGTH) :: longname, varname integer(I4B) :: k - real(DP) :: fill_value - - if (iper > 0) then - fill_value = DNODATA - else - fill_value = NF90_FILL_DOUBLE - end if allocate (var_id(disv%nlay)) @@ -936,10 +862,9 @@ subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & call nf_verify(nf90_redef(ncid), nc_fname) do k = 1, disv%nlay ! set names - varname = export_varname(pkgname, idt%tagname, mempath, layer=k, & - iper=iper, iaux=iaux) - longname = export_longname(idt%longname, pkgname, idt%tagname, layer=k, & - iper=iper) + varname = export_varname(pkgname, idt%tagname, mempath, layer=k) + longname = export_longname(idt%longname, pkgname, idt%tagname, & + mempath, layer=k) call nf_verify(nf90_def_var(ncid, varname, NF90_DOUBLE, & (/dim_ids%nmesh_face/), var_id(k)), & @@ -952,13 +877,13 @@ subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & ! put attr call nf_verify(nf90_put_att(ncid, var_id(k), '_FillValue', & - (/fill_value/)), nc_fname) + (/NF90_FILL_DOUBLE/)), nc_fname) call nf_verify(nf90_put_att(ncid, var_id(k), 'long_name', & longname), nc_fname) ! add grid mapping and mf6 attr call ncvar_gridmap(ncid, var_id(k), gridmap_name, nc_fname) - call ncvar_mf6attr(ncid, var_id(k), k, iper, iaux, nc_tag, nc_fname) + call ncvar_mf6attr(ncid, var_id(k), k, 0, nc_tag, nc_fname) end do ! exit define mode and write data diff --git a/src/Utilities/Export/MeshNCModel.f90 b/src/Utilities/Export/MeshNCModel.f90 index 6d56dc2247c..58dfaa8f173 100644 --- a/src/Utilities/Export/MeshNCModel.f90 +++ b/src/Utilities/Export/MeshNCModel.f90 @@ -14,7 +14,8 @@ module MeshModelModule use MemoryManagerModule, only: mem_setptr use InputDefinitionModule, only: InputParamDefinitionType use CharacterStringModule, only: CharacterStringType - use NCModelExportModule, only: NCBaseModelExportType + use NCModelExportModule, only: export_longname, export_varname, & + NCBaseModelExportType use NetCDFCommonModule, only: nf_verify use netcdf @@ -50,6 +51,9 @@ module MeshModelModule integer(I4B) :: mesh_face_ybnds !< mesh faces 2D y bounds array integer(I4B) :: mesh_face_nodes !< mesh faces 2D nodes array integer(I4B) :: time !< time coordinate variable + !integer(I4B) :: export !< in scope export + !integer(I4B), dimension(:), allocatable :: export_layer !< in scope layer export + integer(I4B), dimension(:), allocatable :: export !< in scope layer export integer(I4B), dimension(:), allocatable :: dependent !< layered dependent variables array contains end type MeshNCVarIdType @@ -64,6 +68,9 @@ module MeshModelModule contains procedure :: mesh_init procedure :: mesh_destroy + procedure :: df_export + procedure :: export_df + procedure :: create_timeseries procedure :: add_global_att procedure(nc_array_export_if), deferred :: export_input_array procedure :: export_input_arrays @@ -76,7 +83,7 @@ module MeshModelModule !< abstract interface subroutine nc_array_export_if(this, pkgtype, pkgname, mempath, idt) - import MeshModelType, InputParamDefinitionType, LGP + import MeshModelType, InputParamDefinitionType class(MeshModelType), intent(inout) :: this character(len=*), intent(in) :: pkgtype character(len=*), intent(in) :: pkgname @@ -154,6 +161,157 @@ subroutine mesh_destroy(this) nullify (this%chunk_face) end subroutine mesh_destroy + !> @brief define timeseries input variables + !< + subroutine df_export(this) + use NCModelExportModule, only: ExportPackageType + class(MeshModelType), intent(inout) :: this + class(ExportPackageType), pointer :: export_pkg + integer(I4B) :: idx + do idx = 1, this%pkglist%Count() + export_pkg => this%get(idx) + call this%export_df(export_pkg) + end do + end subroutine df_export + + !> @brief define export package + !< + subroutine export_df(this, export_pkg) + use NCModelExportModule, only: ExportPackageType + use DefinitionSelectModule, only: get_param_definition_type + class(MeshModelType), intent(inout) :: this + class(ExportPackageType), pointer, intent(in) :: export_pkg + type(InputParamDefinitionType), pointer :: idt + integer(I4B) :: iparam, iaux, layer + + ! export defined period input + do iparam = 1, export_pkg%nparam + ! initialize + iaux = 0 + layer = 0 + ! set input definition + idt => & + get_param_definition_type(export_pkg%mf6_input%param_dfns, & + export_pkg%mf6_input%component_type, & + export_pkg%mf6_input%subcomponent_type, & + 'PERIOD', export_pkg%param_names(iparam), '') + + select case (idt%shape) + case ('NCPL') + call this%create_timeseries(idt, iparam, iaux, layer, export_pkg) + case ('NODES') + do layer = 1, this%nlay + call this%create_timeseries(idt, iparam, iaux, layer, export_pkg) + end do + case ('NAUX NCPL') + do iaux = 1, export_pkg%naux + call this%create_timeseries(idt, iparam, iaux, layer, export_pkg) + end do + case ('NAUX NODES') + do iaux = 1, export_pkg%naux + do layer = 1, this%nlay + call this%create_timeseries(idt, iparam, iaux, layer, export_pkg) + end do + end do + case default + end select + end do + end subroutine export_df + + !> @brief create timeseries export variable + !< + subroutine create_timeseries(this, idt, iparam, iaux, layer, export_pkg) + use ConstantsModule, only: DNODATA + use NCModelExportModule, only: ExportPackageType + class(MeshModelType), intent(inout) :: this + type(InputParamDefinitionType), pointer, intent(in) :: idt + integer(I4B), intent(in) :: iparam + integer(I4B), intent(in) :: iaux + integer(I4B), intent(in) :: layer + class(ExportPackageType), pointer, intent(in) :: export_pkg + character(len=LINELENGTH) :: varname, longname, nc_tag + integer(I4B) :: varid + + ! set variable input tag + nc_tag = this%input_attribute(export_pkg%mf6_input%subcomponent_name, & + idt) + + ! set names + varname = export_varname(export_pkg%mf6_input%subcomponent_name, & + idt%tagname, export_pkg%mf6_input%mempath, & + layer=layer, iaux=iaux) + longname = export_longname(idt%longname, & + export_pkg%mf6_input%subcomponent_name, & + idt%tagname, export_pkg%mf6_input%mempath, & + layer=layer, iaux=iaux) + + ! create the netcdf dependent layer variable + select case (idt%datatype) + case ('DOUBLE1D', 'DOUBLE2D') + call nf_verify(nf90_def_var(this%ncid, varname, NF90_DOUBLE, & + (/this%dim_ids%nmesh_face, & + this%dim_ids%time/), & + varid), & + this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, varid, & + '_FillValue', (/DNODATA/)), & + this%nc_fname) + case ('INTEGER1D') + call nf_verify(nf90_def_var(this%ncid, varname, NF90_INT, & + (/this%dim_ids%nmesh_face, & + this%dim_ids%time/), & + varid), & + this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, varid, & + '_FillValue', (/NF90_FILL_INT/)), & + this%nc_fname) + end select + + ! apply chunking parameters + if (this%chunking_active) then + call nf_verify(nf90_def_var_chunking(this%ncid, & + varid, & + NF90_CHUNKED, & + (/this%chunk_face, & + this%chunk_time/)), & + this%nc_fname) + end if + + ! deflate and shuffle + call ncvar_deflate(this%ncid, varid, this%deflate, & + this%shuffle, this%nc_fname) + + ! assign variable attributes + call nf_verify(nf90_put_att(this%ncid, varid, & + 'units', 'm'), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, varid, & + 'long_name', longname), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, varid, & + 'mesh', this%mesh_name), this%nc_fname) + call nf_verify(nf90_put_att(this%ncid, varid, & + 'location', 'face'), this%nc_fname) + + ! add grid mapping and mf6 attr + call ncvar_gridmap(this%ncid, varid, & + this%gridmap_name, this%nc_fname) + call ncvar_mf6attr(this%ncid, varid, layer, iaux, nc_tag, this%nc_fname) + + ! store variable id + if (idt%tagname == 'AUX') then + if (layer > 0) then + export_pkg%varids_aux(iaux, layer) = varid + else + export_pkg%varids_aux(iaux, 1) = varid + end if + else + if (layer > 0) then + export_pkg%varids_param(iparam, layer) = varid + else + export_pkg%varids_param(iparam, 1) = varid + end if + end if + end subroutine create_timeseries + !> @brief create file (group) attributes !< subroutine add_global_att(this) @@ -545,27 +703,22 @@ end subroutine ncvar_gridmap !> @brief put variable internal attributes !< - subroutine ncvar_mf6attr(ncid, varid, layer, iper, iaux, nc_tag, nc_fname) + subroutine ncvar_mf6attr(ncid, varid, layer, iaux, nc_tag, nc_fname) integer(I4B), intent(in) :: ncid integer(I4B), intent(in) :: varid integer(I4B), intent(in) :: layer - integer(I4B), intent(in) :: iper integer(I4B), intent(in) :: iaux character(len=*), intent(in) :: nc_tag character(len=*), intent(in) :: nc_fname if (nc_tag /= '') then - call nf_verify(nf90_put_att(ncid, varid, 'modflow6_input', & + call nf_verify(nf90_put_att(ncid, varid, 'modflow_input', & nc_tag), nc_fname) if (layer > 0) then - call nf_verify(nf90_put_att(ncid, varid, 'modflow6_layer', & + call nf_verify(nf90_put_att(ncid, varid, 'layer', & layer), nc_fname) end if - if (iper > 0) then - call nf_verify(nf90_put_att(ncid, varid, 'modflow6_iper', & - iper), nc_fname) - end if if (iaux > 0) then - call nf_verify(nf90_put_att(ncid, varid, 'modflow6_iaux', & + call nf_verify(nf90_put_att(ncid, varid, 'modflow_iaux', & iaux), nc_fname) end if end if diff --git a/src/Utilities/Export/NCExportCreate.f90 b/src/Utilities/Export/NCExportCreate.f90 index 56a67021ac4..de15680d6e5 100644 --- a/src/Utilities/Export/NCExportCreate.f90 +++ b/src/Utilities/Export/NCExportCreate.f90 @@ -182,6 +182,7 @@ subroutine create_export_pkglist(pkglist, loaders, iout) allocate (export_pkg) call export_pkg%init(rp_loader%mf6_input, & rp_loader%bound_context%mshape, & + rp_loader%bound_context%naux, & rp_loader%param_names, rp_loader%nparam) obj => export_pkg call pkglist%add(obj) @@ -190,6 +191,7 @@ subroutine create_export_pkglist(pkglist, loaders, iout) allocate (export_pkg) call export_pkg%init(rp_loader%mf6_input, & rp_loader%bound_context%mshape, & + rp_loader%bound_context%naux, & rp_loader%param_names, rp_loader%nparam) obj => export_pkg call pkglist%add(obj) diff --git a/src/Utilities/Export/NCModel.f90 b/src/Utilities/Export/NCModel.f90 index 7ce4ff427b8..0055ec25744 100644 --- a/src/Utilities/Export/NCModel.f90 +++ b/src/Utilities/Export/NCModel.f90 @@ -38,10 +38,13 @@ module NCModelExportModule type(ModflowInputType) :: mf6_input !< description of modflow6 input character(len=LINELENGTH), dimension(:), allocatable :: param_names !< dynamic param tagnames type(ReadStateVarType), dimension(:), allocatable :: param_reads !< param read states + integer(I4B), dimension(:, :), allocatable :: varids_param + integer(I4B), dimension(:, :), allocatable :: varids_aux integer(I4B), dimension(:), pointer, contiguous :: mshape => null() !< model shape integer(I4B), pointer :: iper !< most recent package rp load integer(I4B) :: iper_export !< most recent period of netcdf package export integer(I4B) :: nparam !< number of in scope params + integer(I4B) :: naux !< number of auxiliary variables contains procedure :: init => epkg_init procedure :: destroy => epkg_destroy @@ -82,7 +85,6 @@ module NCModelExportModule real(DP), dimension(:), pointer, contiguous :: x !< dependent variable pointer integer(I4B) :: disenum !< type of discretization integer(I4B) :: ncid !< netcdf file descriptor - integer(I4B) :: stepcnt !< simulation step count integer(I4B) :: totnstp !< simulation total number of steps integer(I4B), pointer :: deflate !< variable deflate level integer(I4B), pointer :: shuffle !< variable shuffle filter @@ -103,9 +105,9 @@ module NCModelExportModule contains procedure :: export_input procedure(model_define), deferred :: df + procedure(package_export), deferred :: export_df procedure(model_step), deferred :: step procedure(package_export), deferred :: package_step - procedure(package_export_ilayer), deferred :: package_step_ilayer end type NCBaseModelExportType !> @brief abstract interfaces for model netcdf export type @@ -138,7 +140,7 @@ subroutine package_export_ilayer(this, export_pkg, ilayer_varname, & !> @brief initialize dynamic package export object !< - subroutine epkg_init(this, mf6_input, mshape, param_names, & + subroutine epkg_init(this, mf6_input, mshape, naux, param_names, & nparam) use SimVariablesModule, only: idm_context use MemoryManagerModule, only: mem_setptr @@ -147,6 +149,7 @@ subroutine epkg_init(this, mf6_input, mshape, param_names, & class(ExportPackageType), intent(inout) :: this type(ModflowInputType), intent(in) :: mf6_input integer(I4B), dimension(:), pointer, contiguous, intent(in) :: mshape !< model shape + integer(I4B), intent(in) :: naux character(len=LINELENGTH), dimension(:), allocatable, & intent(in) :: param_names integer(I4B), intent(in) :: nparam @@ -158,6 +161,7 @@ subroutine epkg_init(this, mf6_input, mshape, param_names, & this%mf6_input = mf6_input this%mshape => mshape this%nparam = nparam + this%naux = naux this%iper_export = 0 input_mempath = create_mem_path(component=mf6_input%component_name, & @@ -167,6 +171,8 @@ subroutine epkg_init(this, mf6_input, mshape, param_names, & ! allocate param arrays allocate (this%param_names(nparam)) allocate (this%param_reads(nparam)) + allocate (this%varids_param(nparam, mshape(1))) + allocate (this%varids_aux(naux, mshape(1))) ! set param arrays do n = 1, nparam @@ -263,7 +269,7 @@ end subroutine set !< subroutine export_init(this, modelname, modeltype, modelfname, nc_fname, & disenum, nctype, iout) - use TdisModule, only: datetime0, nstp + use TdisModule, only: datetime0, nstp, inats use MemoryManagerModule, only: mem_setptr use MemoryHelperModule, only: create_mem_path use MemoryManagerExtModule, only: mem_set_value @@ -300,7 +306,6 @@ subroutine export_init(this, modelname, modeltype, modelfname, nc_fname, & this%lenunits = '' this%disenum = disenum this%ncid = 0 - this%stepcnt = 0 this%totnstp = 0 this%deflate = -1 this%shuffle = 0 @@ -373,6 +378,14 @@ subroutine export_init(this, modelname, modeltype, modelfname, nc_fname, & this%datetime = 'days since 1970-01-01T00:00:00' end if + ! TODO: verify this will be set at this point + if (inats > 0) then + errmsg = 'Adaptive time stepping not currently supported & + &with NetCDF exports.' + call store_error(errmsg) + call store_error_filename(modelfname) + end if + ! set total nstp this%totnstp = sum(nstp) end subroutine export_init @@ -414,7 +427,7 @@ end function input_attribute !> @brief build netcdf variable name !< - function export_varname(pkgname, tagname, mempath, layer, iper, iaux) & + function export_varname(pkgname, tagname, mempath, layer, iaux) & result(varname) use MemoryManagerModule, only: mem_setptr use CharacterStringModule, only: CharacterStringType @@ -423,7 +436,6 @@ function export_varname(pkgname, tagname, mempath, layer, iper, iaux) & character(len=*), intent(in) :: tagname character(len=*), intent(in) :: mempath integer(I4B), optional, intent(in) :: layer - integer(I4B), optional, intent(in) :: iper integer(I4B), optional, intent(in) :: iaux character(len=LINELENGTH) :: varname type(CharacterStringType), dimension(:), pointer, & @@ -452,25 +464,25 @@ function export_varname(pkgname, tagname, mempath, layer, iper, iaux) & write (varname, '(a,i0)') trim(varname)//'_l', layer end if end if - if (present(iper)) then - if (iper > 0) then - !write (varname, '(a,i0)') trim(varname)//'_SP', iper - write (varname, '(a,i0)') trim(varname)//'_p', iper - end if - end if end function export_varname !> @brief build netcdf variable longname !< - function export_longname(longname, pkgname, tagname, layer, iper) result(lname) + function export_longname(longname, pkgname, tagname, mempath, layer, iaux) & + result(lname) + use MemoryManagerModule, only: mem_setptr + use CharacterStringModule, only: CharacterStringType use InputOutputModule, only: lowcase character(len=*), intent(in) :: longname character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: tagname + character(len=*), intent(in) :: mempath integer(I4B), optional, intent(in) :: layer - integer(I4B), optional, intent(in) :: iper + integer(I4B), optional, intent(in) :: iaux character(len=LINELENGTH) :: lname - character(len=LINELENGTH) :: pname, vname + type(CharacterStringType), dimension(:), pointer, & + contiguous :: auxnames + character(len=LINELENGTH) :: pname, vname, auxname pname = pkgname vname = tagname call lowcase(pname) @@ -480,28 +492,33 @@ function export_longname(longname, pkgname, tagname, layer, iper) result(lname) else lname = longname end if + + if (present(iaux)) then + if (iaux > 0) then + if (tagname == 'AUX') then + ! reset vname to auxiliary variable name + call mem_setptr(auxnames, 'AUXILIARY', mempath) + auxname = auxnames(iaux) + call lowcase(auxname) + lname = trim(lname)//' '//trim(auxname) + end if + end if + end if + if (present(layer)) then if (layer > 0) then write (lname, '(a,i0)') trim(lname)//' layer=', layer end if end if - if (present(iper)) then - if (iper > 0) then - write (lname, '(a,i0)') trim(lname)//' period=', iper - end if - end if end function export_longname !> @brief netcdf dynamic package period export !< subroutine export_input(this) use TdisModule, only: kper - use ArrayHandlersModule, only: ifind class(NCBaseModelExportType), intent(inout) :: this - integer(I4B) :: idx, ilayer + integer(I4B) :: idx class(ExportPackageType), pointer :: export_pkg - character(len=LENVARNAME) :: ilayer_varname - do idx = 1, this%pkglist%Count() export_pkg => this%get(idx) ! last loaded data is not current period @@ -510,22 +527,8 @@ subroutine export_input(this) if (export_pkg%iper_export >= export_pkg%iper) cycle ! set exported iper export_pkg%iper_export = export_pkg%iper - - ! initialize ilayer - ilayer = 0 - - ! set expected ilayer index variable name - ilayer_varname = 'I'//trim(export_pkg%mf6_input%subcomponent_type(1:3)) - - ! is ilayer variable in param name list - ilayer = ifind(export_pkg%param_names, ilayer_varname) - - ! layer index variable is required to be first defined in period block - if (ilayer == 1) then - call this%package_step_ilayer(export_pkg, ilayer_varname, ilayer) - else - call this%package_step(export_pkg) - end if + ! update export package + call this%package_step(export_pkg) end do end subroutine export_input diff --git a/src/Utilities/Idm/netcdf/NCArrayReader.f90 b/src/Utilities/Idm/netcdf/NCArrayReader.f90 index aaf518a7c7b..23fc2d12d0f 100644 --- a/src/Utilities/Idm/netcdf/NCArrayReader.f90 +++ b/src/Utilities/Idm/netcdf/NCArrayReader.f90 @@ -56,23 +56,34 @@ subroutine nc_array_load_int1d(int1d, mshape, idt, mf6_input, nc_vars, & type(NCPackageVarsType), pointer, intent(in) :: nc_vars character(len=*), intent(in) :: input_fname integer(I4B), intent(in) :: iout - integer(I4B), optional, intent(in) :: kper - integer(I4B) :: varid + integer(I4B), optional, intent(in) :: kper !< flag if set > 0 indicates ts + integer(I4B) :: varid, iper logical(LGP) :: layered + iper = 0 layered = (idt%layered .and. is_layered(nc_vars%grid)) + if (present(kper)) then + iper = kper + end if + if (layered) then - call load_integer1d_layered(int1d, mf6_input, mshape, idt, nc_vars, & - input_fname) + if (iper > 0) then + call load_integer1d_layered_spd(int1d, mf6_input, mshape, idt, nc_vars, & + iper, input_fname) + else + call load_integer1d_layered(int1d, mf6_input, mshape, idt, nc_vars, & + input_fname) + end if else - if (present(kper)) then - varid = nc_vars%varid(idt%mf6varname, period=kper) + if (iper > 0) then + call load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, & + iper, input_fname) else varid = nc_vars%varid(idt%mf6varname) + call load_integer1d_type(int1d, mf6_input, mshape, idt, nc_vars, & + varid, input_fname) end if - call load_integer1d_type(int1d, mf6_input, mshape, idt, nc_vars, & - varid, input_fname) end if end subroutine nc_array_load_int1d @@ -139,29 +150,30 @@ subroutine nc_array_load_dbl1d(dbl1d, mshape, idt, mf6_input, nc_vars, & type(NCPackageVarsType), pointer, intent(in) :: nc_vars character(len=*), intent(in) :: input_fname integer(I4B), intent(in) :: iout - integer(I4B), optional, intent(in) :: kper + integer(I4B), optional, intent(in) :: kper !< flag if set > 0 indicates ts integer(I4B), optional, intent(in) :: iaux - integer(I4B) :: varid + integer(I4B) :: varid, iper logical(LGP) :: layered + iper = 0 + layered = (idt%layered .and. is_layered(nc_vars%grid)) + if (present(kper)) then - layered = (kper > 0 .and. is_layered(nc_vars%grid)) - else - layered = (idt%layered .and. is_layered(nc_vars%grid)) + iper = kper end if if (layered) then - if (present(kper)) then + if (iper > 0) then call load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & - kper, input_fname, iaux) + iper, input_fname, iaux) else call load_double1d_layered(dbl1d, mf6_input, mshape, idt, nc_vars, & input_fname) end if else - if (present(kper)) then + if (iper > 0) then call load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & - kper, input_fname, iaux) + iper, input_fname, iaux) else varid = nc_vars%varid(idt%mf6varname) call load_double1d_type(dbl1d, mf6_input, mshape, idt, nc_vars, & @@ -265,6 +277,53 @@ subroutine load_integer1d_type(int1d, mf6_input, mshape, idt, nc_vars, & end if end subroutine load_integer1d_type + !> @brief load type 1d double + !< + subroutine load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, & + iper, input_fname) + use ConstantsModule, only: DNODATA + use NetCDFCommonModule, only: gstp + integer(I4B), dimension(:), contiguous, pointer, intent(in) :: int1d + type(ModflowInputType), intent(in) :: mf6_input + integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape + type(InputParamDefinitionType), intent(in) :: idt + type(NCPackageVarsType), pointer, intent(in) :: nc_vars + integer(I4B), intent(in) :: iper + character(len=*), intent(in) :: input_fname + integer(I4B), dimension(:), allocatable :: layer_shape + integer(I4B) :: varid, nlay, ncpl, istp + + istp = gstp() + + ! set varid + varid = nc_vars%varid(idt%mf6varname) + + call get_layered_shape(mshape, nlay, layer_shape) + ncpl = product(layer_shape) + + if (size(mshape) == 3) then + select case (idt%shape) + case ('NCPL', 'NAUX NCPL') + if (nc_vars%grid == 'STRUCTURED') then + call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, & + start=(/1, 1, istp/), & + count=(/mshape(3), mshape(2), 1/)), & + nc_vars%nc_fname) + else if (nc_vars%grid == 'LAYERED MESH') then + call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, & + start=(/1, istp/), count=(/ncpl, 1/)), & + nc_vars%nc_fname) + end if + case ('NODES', 'NAUX NODES') + ! TODO implement or set error? + if (nc_vars%grid == 'STRUCTURED') then + else if (nc_vars%grid == 'LAYERED MESH') then + end if + case default + end select + end if + end subroutine load_integer1d_spd + !> @brief load type 1d integer layered !< subroutine load_integer1d_layered(int1d, mf6_input, mshape, idt, nc_vars, & @@ -297,6 +356,43 @@ subroutine load_integer1d_layered(int1d, mf6_input, mshape, idt, nc_vars, & end do end subroutine load_integer1d_layered + !> @brief load type 1d integer layered + !< + subroutine load_integer1d_layered_spd(int1d, mf6_input, mshape, idt, nc_vars, & + iper, input_fname) + use ConstantsModule, only: DNODATA + use NetCDFCommonModule, only: gstp + integer(I4B), dimension(:), contiguous, pointer, intent(in) :: int1d + type(ModflowInputType), intent(in) :: mf6_input + integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape + type(InputParamDefinitionType), intent(in) :: idt + type(NCPackageVarsType), pointer, intent(in) :: nc_vars + integer(I4B), intent(in) :: iper + character(len=*), intent(in) :: input_fname + integer(I4B), dimension(:), allocatable :: layer_shape + integer(I4B) :: nlay, varid + integer(I4B) :: ncpl, nvals, istp + + istp = gstp() + + call get_layered_shape(mshape, nlay, layer_shape) + nvals = product(mshape) + ncpl = product(layer_shape) + + varid = nc_vars%varid(idt%mf6varname) + select case (idt%shape) + case ('NCPL', 'NAUX NCPL') + call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, & + start=(/1, istp/), count=(/ncpl, 1/)), & + nc_vars%nc_fname) + case ('NODES', 'NAUX NODES') + call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, & + start=(/1, istp/), count=(/nvals, 1/)), & + nc_vars%nc_fname) + case default + end select + end subroutine load_integer1d_layered_spd + !> @brief load type 2d integer !< subroutine load_integer2d_type(int2d, mf6_input, mshape, idt, nc_vars, varid, & @@ -453,6 +549,7 @@ end subroutine load_double1d_type subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & iper, input_fname, iaux) use ConstantsModule, only: DNODATA + use NetCDFCommonModule, only: gstp real(DP), dimension(:), contiguous, pointer, intent(in) :: dbl1d type(ModflowInputType), intent(in) :: mf6_input integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape @@ -461,54 +558,53 @@ subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & integer(I4B), intent(in) :: iper character(len=*), intent(in) :: input_fname integer(I4B), optional, intent(in) :: iaux + integer(I4B), dimension(:), allocatable :: layer_shape real(DP), dimension(:, :, :), contiguous, pointer :: dbl3d - integer(I4B) :: varid - integer(I4B) :: n, i, j, k + integer(I4B) :: varid, nlay, ncpl, nvals + integer(I4B) :: n, istp ! initialize n = 0 + istp = gstp() ! set varid if (present(iaux)) then - varid = nc_vars%varid(idt%mf6varname, period=iper, iaux=iaux) + varid = nc_vars%varid(idt%mf6varname, iaux=iaux) else - varid = nc_vars%varid(idt%mf6varname, period=iper) + varid = nc_vars%varid(idt%mf6varname) end if - if (size(mshape) == 3) then - allocate (dbl3d(mshape(3), mshape(2), mshape(1))) - call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl3d), & - nc_vars%nc_fname) - - if (idt%shape == 'NODES' .or. idt%shape == 'NAUX NODES') then - do k = 1, size(dbl3d, dim=3) - do i = 1, size(dbl3d, dim=2) - do j = 1, size(dbl3d, dim=1) - n = n + 1 - dbl1d(n) = dbl3d(j, i, k) - end do - end do - end do - - else if (idt%shape == 'NCPL' .or. idt%shape == 'NAUX NCPL') then - do k = 1, size(dbl3d, dim=3) - do i = 1, size(dbl3d, dim=2) - do j = 1, size(dbl3d, dim=1) - if (n < size(dbl1d)) then - n = n + 1 - else - n = 1 - end if - if (dbl3d(j, i, k) /= DNODATA) then - dbl1d(n) = dbl3d(j, i, k) - end if - end do - end do - end do - end if + call get_layered_shape(mshape, nlay, layer_shape) + ncpl = product(layer_shape) + nvals = product(mshape) - ! clean up - deallocate (dbl3d) + if (size(mshape) == 3) then + select case (idt%shape) + case ('NCPL', 'NAUX NCPL') + if (nc_vars%grid == 'STRUCTURED') then + call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d, & + start=(/1, 1, istp/), & + count=(/mshape(3), mshape(2), 1/)), & + nc_vars%nc_fname) + else if (nc_vars%grid == 'LAYERED MESH') then + call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d, & + start=(/1, istp/), count=(/ncpl, 1/)), & + nc_vars%nc_fname) + end if + case ('NODES', 'NAUX NODES') + if (nc_vars%grid == 'STRUCTURED') then + dbl3d(1:mshape(3), 1:mshape(2), 1:mshape(1)) => dbl1d(1:nvals) + call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl3d, & + start=(/1, 1, 1, istp/), & + count=(/mshape(3), mshape(2), mshape(1), & + 1/)), nc_vars%nc_fname) + else if (nc_vars%grid == 'LAYERED MESH') then + call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d, & + start=(/1, istp/), count=(/nvals, 1/)), & + nc_vars%nc_fname) + end if + case default + end select end if end subroutine load_double1d_spd @@ -548,6 +644,7 @@ end subroutine load_double1d_layered subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & iper, input_fname, iaux) use ConstantsModule, only: DNODATA + use NetCDFCommonModule, only: gstp real(DP), dimension(:), contiguous, pointer, intent(in) :: dbl1d type(ModflowInputType), intent(in) :: mf6_input integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape @@ -558,20 +655,23 @@ subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & integer(I4B), optional, intent(in) :: iaux integer(I4B), dimension(:), allocatable :: layer_shape integer(I4B) :: nlay, varid - integer(I4B) :: k, n, ncpl, idx + integer(I4B) :: k, n, ncpl, idx, istp real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr + istp = gstp() + call get_layered_shape(mshape, nlay, layer_shape) ncpl = product(layer_shape) allocate (dbl1d_ptr(ncpl)) do k = 1, nlay if (present(iaux)) then - varid = nc_vars%varid(idt%mf6varname, layer=k, period=iper, iaux=iaux) + varid = nc_vars%varid(idt%mf6varname, layer=k, iaux=iaux) else - varid = nc_vars%varid(idt%mf6varname, layer=k, period=iper) + varid = nc_vars%varid(idt%mf6varname, layer=k) end if - call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), & + call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr, & + start=(/1, istp/), count=(/ncpl, 1/)), & nc_vars%nc_fname) if (idt%shape == 'NODES' .or. idt%shape == 'NAUX NODES') then do n = 1, ncpl @@ -580,9 +680,7 @@ subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & end do else if (idt%shape == 'NCPL' .or. idt%shape == 'NAUX NCPL') then do n = 1, ncpl - if (dbl1d_ptr(n) /= DNODATA) then - dbl1d(n) = dbl1d_ptr(n) - end if + dbl1d(n) = dbl1d_ptr(n) end do end if end do diff --git a/src/Utilities/Idm/netcdf/NCContextBuild.f90 b/src/Utilities/Idm/netcdf/NCContextBuild.f90 index 72127e2d3c3..1b4fc8c5c68 100644 --- a/src/Utilities/Idm/netcdf/NCContextBuild.f90 +++ b/src/Utilities/Idm/netcdf/NCContextBuild.f90 @@ -63,7 +63,7 @@ subroutine add_package_var(modeltype, modelname, nc_vars, input_name, varid, & character(len=NETCDF_ATTR_STRLEN) :: input_str character(len=LENCOMPONENTNAME) :: c_name, sc_name character(len=LINELENGTH) :: mempath, varname - integer(I4B) :: layer, period, iaux, mf6_layer, mf6_period, mf6_iaux + integer(I4B) :: layer, period, iaux, mf6_layer, mf6_iaux logical(LGP) :: success ! initialize @@ -75,7 +75,7 @@ subroutine add_package_var(modeltype, modelname, nc_vars, input_name, varid, & sc_name = '' ! process mf6_input attribute - if (nf90_get_att(nc_vars%ncid, varid, 'modflow6_input', & + if (nf90_get_att(nc_vars%ncid, varid, 'modflow_input', & input_str) == NF90_NOERR) then ! mf6_input should provide a memory address call split_mem_address(input_str, mempath, varname, success) @@ -89,26 +89,20 @@ subroutine add_package_var(modeltype, modelname, nc_vars, input_name, varid, & call upcase(sc_name) ! check for optional layer attribute if (nf90_get_att(nc_vars%ncid, varid, & - 'modflow6_layer', mf6_layer) == NF90_NOERR) then + 'layer', mf6_layer) == NF90_NOERR) then layer = mf6_layer end if - ! check for optional period attribute + ! check for optional iaux attribute if (nf90_get_att(nc_vars%ncid, varid, & - 'modflow6_iper', mf6_period) == NF90_NOERR) then - period = mf6_period - end if - - ! check for optional period attribute - if (nf90_get_att(nc_vars%ncid, varid, & - 'modflow6_iaux', mf6_iaux) == NF90_NOERR) then + 'modflow_iaux', mf6_iaux) == NF90_NOERR) then iaux = mf6_iaux end if ! add the variable to netcdf description call nc_vars%add(sc_name, varname, layer, period, iaux, varid) else - errmsg = 'NetCDF variable invalid modflow6_input attribute: "'// & + errmsg = 'NetCDF variable invalid modflow_input attribute: "'// & trim(input_str)//'".' call store_error(errmsg) call store_error_filename(nc_vars%nc_fname) diff --git a/src/Utilities/Idm/netcdf/NetCDFCommon.f90 b/src/Utilities/Idm/netcdf/NetCDFCommon.f90 index 42bf9953d3a..5f9d060d5a7 100644 --- a/src/Utilities/Idm/netcdf/NetCDFCommon.f90 +++ b/src/Utilities/Idm/netcdf/NetCDFCommon.f90 @@ -17,6 +17,7 @@ module NetCDFCommonModule public :: NETCDF_MAX_DIM public :: NETCDF_ATTR_STRLEN public :: nf_verify + public :: gstp integer(I4B), parameter :: NETCDF_MAX_DIM = 6 integer(I4B), parameter :: NETCDF_ATTR_STRLEN = 80 @@ -107,4 +108,17 @@ subroutine nf_verify(res, nc_fname) end if end subroutine nf_verify + !> @brief global step count + !< + function gstp() + use TdisModule, only: kstp, kper, nstp + integer(I4B) :: n, gstp + gstp = kstp + if (kper > 1) then + do n = 1, kper - 1 + gstp = gstp + nstp(n) + end do + end if + end function gstp + end module NetCDFCommonModule From 876689c2334b0d0c24d652d7ab1023417066cd18 Mon Sep 17 00:00:00 2001 From: mjreno Date: Tue, 15 Apr 2025 11:07:13 -0400 Subject: [PATCH 10/22] add tests --- autotest/test_gwf_disv_uzf.py | 56 +++-- autotest/test_gwf_sfr_inactive02.py | 53 ++++- autotest/test_gwf_uzf01.py | 83 +++++-- autotest/test_gwf_vsc01.py | 82 +++++-- autotest/test_gwt_henry_nr.py | 107 +++++++-- autotest/test_netcdf_gwf_disv.py | 21 +- autotest/test_netcdf_gwf_disv_uzf.py | 188 +++++++++++++++ autotest/test_netcdf_gwf_uzf01.py | 207 +++++++++++++++++ autotest/test_netcdf_gwf_vsc01.py | 206 +++++++++++++++++ autotest/test_netcdf_gwt_henry_nr.py | 216 ++++++++++++++++++ src/Model/GroundWaterFlow/gwf-ghba.f90 | 45 ++-- src/Utilities/Export/NCModel.f90 | 2 +- .../Idm/mf6blockfile/Mf6FileGridArray.f90 | 1 - src/Utilities/Idm/netcdf/NCArrayReader.f90 | 9 +- src/Utilities/Idm/netcdf/NCContextBuild.f90 | 5 +- src/Utilities/Idm/netcdf/NCFileVars.f90 | 17 +- 16 files changed, 1152 insertions(+), 146 deletions(-) create mode 100644 autotest/test_netcdf_gwf_disv_uzf.py create mode 100644 autotest/test_netcdf_gwf_uzf01.py create mode 100644 autotest/test_netcdf_gwf_vsc01.py create mode 100644 autotest/test_netcdf_gwt_henry_nr.py diff --git a/autotest/test_gwf_disv_uzf.py b/autotest/test_gwf_disv_uzf.py index 28e22c641be..d1857e18ae4 100644 --- a/autotest/test_gwf_disv_uzf.py +++ b/autotest/test_gwf_disv_uzf.py @@ -14,7 +14,7 @@ import numpy as np import pytest from flopy.utils.gridutil import get_disv_kwargs -from framework import TestFramework +from framework import DNODATA, TestFramework cases = ["disv_with_uzf"] nlay = 5 @@ -109,20 +109,21 @@ uzf_spd.update({t: spd}) -# Work up the GHB boundary +# Work up the GHB / GHBA boundary ghb_ids = [(ncol - 1) + i * ncol for i in range(nrow)] ghb_spd = [] +abhead = np.full((nlay, ncpl), DNODATA, dtype=np.float64) +acond = np.full((nlay, ncpl), DNODATA, dtype=np.float64) cond = 1e4 for k in np.arange(3, 5, 1): for i in ghb_ids: ghb_spd.append([(k, i), 14.0, cond]) + abhead[k, i] = 14.0 + acond[k, i] = cond -def build_models(idx, test): - name = cases[idx] - +def get_model(ws, name, array_input=False): # build MODFLOW 6 files - ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -171,7 +172,10 @@ def build_models(idx, test): sto = flopy.mf6.ModflowGwfsto(gwf, iconvert=1, ss=1e-5, sy=0.2, transient=True) # general-head boundary - ghb = flopy.mf6.ModflowGwfghb(gwf, print_flows=True, stress_period_data=ghb_spd) + if array_input: + ghb = flopy.mf6.ModflowGwfghba(gwf, print_flows=True, bhead=abhead, cond=acond) + else: + ghb = flopy.mf6.ModflowGwfghb(gwf, print_flows=True, stress_period_data=ghb_spd) # unsaturated-zone flow etobs = [] @@ -220,18 +224,18 @@ def build_models(idx, test): obs_dict = {f"{name}.obs.csv": obs_lst} obs = flopy.mf6.ModflowUtlobs(gwf, pname="head_obs", digits=20, continuous=obs_dict) - return sim, None + return sim -def check_output(idx, test): +def check_output(ws, name): # Next, get the binary printed heads - fpth = os.path.join(test.workspace, test.name + ".hds") + fpth = os.path.join(ws, name + ".hds") hobj = flopy.utils.HeadFile(fpth, precision="double") hds = hobj.get_alldata() hds = hds.reshape((np.sum(nstp), 5, 10, 10)) # Get the MF6 cell-by-cell fluxes - bpth = os.path.join(test.workspace, test.name + ".cbc") + bpth = os.path.join(ws, name + ".cbc") bobj = flopy.utils.CellBudgetFile(bpth, precision="double") bobj.get_unique_record_names() # ' STO-SS' @@ -249,7 +253,7 @@ def check_output(idx, test): gwet = gwetv.reshape((np.sum(nstp), 5, 10, 10)) # Also retrieve the binary UZET output - uzpth = os.path.join(test.workspace, test.name + ".uzf.bud") + uzpth = os.path.join(ws, name + ".uzf.bud") uzobj = flopy.utils.CellBudgetFile(uzpth, precision="double") uzobj.get_unique_record_names() # b' FLOW-JA-FACE', @@ -353,6 +357,31 @@ def check_output(idx, test): print("Finished running checks") +def build_models(idx, test): + # build MODFLOW 6 files + ws = test.workspace + name = cases[idx] + sim = get_model(ws, name) + + # build comparison array_input model + ws = os.path.join(test.workspace, "mf6") + mc = get_model(ws, name, array_input=True) + + return sim, mc + + +def check_outputs(idx, test): + name = cases[idx] + + # check output MODFLOW 6 files + ws = test.workspace + check_output(ws, name) + + # check output comparison array_input model + ws = os.path.join(test.workspace, "mf6") + check_output(ws, name) + + @pytest.mark.slow @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): @@ -361,6 +390,7 @@ def test_mf6model(idx, name, function_tmpdir, targets): workspace=function_tmpdir, targets=targets, build=lambda t: build_models(idx, t), - check=lambda t: check_output(idx, t), + check=lambda t: check_outputs(idx, t), + compare="mf6", ) test.run() diff --git a/autotest/test_gwf_sfr_inactive02.py b/autotest/test_gwf_sfr_inactive02.py index 4b80ff47c87..9ad8258c689 100644 --- a/autotest/test_gwf_sfr_inactive02.py +++ b/autotest/test_gwf_sfr_inactive02.py @@ -1,20 +1,19 @@ # Test evap in SFR reaches (no interaction with gwf) +import os import flopy import numpy as np import pytest -from framework import TestFramework +from framework import DNODATA, TestFramework HDRY, HNOFLO = -1e30, 1e30 cases = ["sfr-inactive02"] -def build_models(idx, test): +def get_model(ws, name, array_input=False): # Base simulation and model name and workspace - ws = test.workspace - name = cases[idx] length_units = "m" time_units = "sec" @@ -66,7 +65,15 @@ def build_models(idx, test): icelltype=1, # >0 means saturated thickness varies with computed head ) flopy.mf6.ModflowGwfic(gwf, strt=1.0) - flopy.mf6.ModflowGwfghb(gwf, stress_period_data=[((0, 0, 0), 1.0, 1e6)]) + if array_input: + # if False: + bhead = np.full(nlay * nrow * ncol, DNODATA, dtype=np.float64) + cond = np.full(nlay * nrow * ncol, DNODATA, dtype=np.float64) + bhead[0] = 1.0 + cond[0] = 1e6 + flopy.mf6.ModflowGwfghba(gwf, bhead=bhead, cond=cond) + else: + flopy.mf6.ModflowGwfghb(gwf, stress_period_data=[((0, 0, 0), 1.0, 1e6)]) # sfr data nreaches = 4 @@ -116,7 +123,7 @@ def build_models(idx, test): print_stage=True, print_flows=True, print_input=True, - stage_filerecord=f"{name}.sfr.hds", + stage_filerecord=f"{name}.sfr.stg", budget_filerecord=f"{name}.sfr.cbc", length_conversion=1.0, time_conversion=1.0, @@ -150,11 +157,11 @@ def build_models(idx, test): saverecord=[("head", "all"), ("budget", "all")], ) - return sim, None + return sim -def check_output(idx, test): - sim = flopy.mf6.MFSimulation.load(sim_ws=test.workspace) +def check_output(ws, name): + sim = flopy.mf6.MFSimulation.load(sim_ws=ws) gwf = sim.get_model() sfr = gwf.get_package("SFR-1") stage = sfr.output.stage().get_alldata().squeeze() @@ -214,6 +221,31 @@ def check_output(idx, test): ) +def build_models(idx, test): + # build MODFLOW 6 files + ws = test.workspace + name = cases[idx] + sim = get_model(ws, name) + + # build comparison array_input model + ws = os.path.join(test.workspace, "mf6") + mc = get_model(ws, name, array_input=True) + + return sim, mc + + +def check_outputs(idx, test): + name = cases[idx] + + # check output MODFLOW 6 files + ws = test.workspace + check_output(ws, name) + + # check output comparison array_input model + ws = os.path.join(test.workspace, "mf6") + check_output(ws, name) + + @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): test = TestFramework( @@ -221,6 +253,7 @@ def test_mf6model(idx, name, function_tmpdir, targets): workspace=function_tmpdir, targets=targets, build=lambda t: build_models(idx, t), - check=lambda t: check_output(idx, t), + check=lambda t: check_outputs(idx, t), + compare="mf6", ) test.run() diff --git a/autotest/test_gwf_uzf01.py b/autotest/test_gwf_uzf01.py index 35ccb1adf2f..f70d29f8a59 100644 --- a/autotest/test_gwf_uzf01.py +++ b/autotest/test_gwf_uzf01.py @@ -8,7 +8,7 @@ import flopy import numpy as np import pytest -from framework import TestFramework +from framework import DNODATA, TestFramework cases = ["gwf_uzf01a"] nlay, nrow, ncol = 100, 1, 1 @@ -16,9 +16,7 @@ crs = "EPSG:26916" -def build_models(idx, test): - name = cases[idx] - +def get_model(ws, name, array_input=False): perlen = [500.0] nper = len(perlen) nstp = [10] @@ -39,7 +37,6 @@ def build_models(idx, test): tdis_rc.append((perlen[i], nstp[i], tsmult[i])) # build MODFLOW 6 files - ws = test.workspace sim = flopy.mf6.MFSimulation( sim_name=name, version="mf6", exe_name="mf6", sim_ws=ws ) @@ -104,16 +101,39 @@ def build_models(idx, test): transient={0: True}, ) - # ghb - ghbspdict = { - 0: [[(nlay - 1, 0, 0), 1.5, 1.0]], - } - ghb = flopy.mf6.ModflowGwfghb( - gwf, + # ghb / ghba + if array_input: + ghb_obs = {f"{name}.ghb.obs.csv": [("100_1_1", "GHBA", (99, 0, 0))]} + bhead = np.full(nlay * nrow * ncol, DNODATA, dtype=np.float64) + cond = np.full(nlay * nrow * ncol, DNODATA, dtype=np.float64) + bhead[nlay - 1] = 1.5 + cond[nlay - 1] = 1.0 + ghb = flopy.mf6.ModflowGwfghba( + gwf, + print_input=True, + print_flows=True, + bhead=bhead, + cond=cond, + save_flows=False, + ) + else: + ghb_obs = {f"{name}.ghb.obs.csv": [("100_1_1", "GHB", (99, 0, 0))]} + ghbspdict = { + 0: [[(nlay - 1, 0, 0), 1.5, 1.0]], + } + ghb = flopy.mf6.ModflowGwfghb( + gwf, + print_input=True, + print_flows=True, + stress_period_data=ghbspdict, + save_flows=False, + ) + + ghb.obs.initialize( + filename=f"{name}.ghb.obs", + digits=20, print_input=True, - print_flows=True, - stress_period_data=ghbspdict, - save_flows=False, + continuous=ghb_obs, ) # note: for specifying lake number, use fortran indexing! @@ -174,13 +194,10 @@ def build_models(idx, test): obs_dict = {f"{name}.obs.csv": obs_lst} obs = flopy.mf6.ModflowUtlobs(gwf, pname="head_obs", digits=20, continuous=obs_dict) - return sim, None + return sim -def check_output(idx, test): - name = test.name - ws = test.workspace - +def check_output(ws, name): # check binary grid file fname = os.path.join(ws, name + ".dis.grb") grbobj = flopy.mf6.utils.MfGrdFile(fname) @@ -228,13 +245,39 @@ def check_output(idx, test): ) +def build_models(idx, test): + # build MODFLOW 6 files + ws = test.workspace + name = cases[idx] + sim = get_model(ws, name) + + # build comparison array_input model + ws = os.path.join(test.workspace, "mf6") + mc = get_model(ws, name, array_input=True) + + return sim, mc + + +def check_outputs(idx, test): + name = cases[idx] + + # check output MODFLOW 6 files + ws = test.workspace + check_output(ws, name) + + # check output comparison array_input model + ws = os.path.join(test.workspace, "mf6") + check_output(ws, name) + + @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): test = TestFramework( name=name, workspace=function_tmpdir, build=lambda t: build_models(idx, t), - check=lambda t: check_output(idx, t), + check=lambda t: check_outputs(idx, t), targets=targets, + compare="mf6", ) test.run() diff --git a/autotest/test_gwf_vsc01.py b/autotest/test_gwf_vsc01.py index 6ed2adf66ab..0050250ea4e 100644 --- a/autotest/test_gwf_vsc01.py +++ b/autotest/test_gwf_vsc01.py @@ -12,7 +12,7 @@ import flopy import numpy as np import pytest -from framework import TestFramework +from framework import DNODATA, TestFramework cases = ["no-vsc01-bnd", "vsc01-bnd", "no-vsc01-k"] hyd_cond = [1205.49396942506, 864.0] # Hydraulic conductivity (m/d) @@ -55,9 +55,8 @@ hclose, rclose, relax = 1e-10, 1e-6, 0.97 -def build_models(idx, test): +def get_model(idx, ws, array_input=False): # Base simulation and model name and workspace - ws = test.workspace name = cases[idx] print(f"Building model...{name}") @@ -118,7 +117,7 @@ def build_models(idx, test): # Instantiating VSC if viscosity_on[idx]: # Instantiate viscosity (VSC) package - vsc_filerecord = f"{gwfname}.vsc.bin" + vsc_filerecord = f"{gwfname}.vsc.vscb" vsc_pd = [(0, 0.0, 20.0, gwtname, "temperature")] flopy.mf6.ModflowGwfvsc( gwf, @@ -136,15 +135,32 @@ def build_models(idx, test): # Instantiating GHB ghbcond = hydraulic_conductivity[idx] * delv * delc / (0.5 * delr) - ghbspd = [ - [(0, i, ncol - 1), top, ghbcond, initial_temperature] for i in range(nrow) - ] - flopy.mf6.ModflowGwfghb( - gwf, - stress_period_data=ghbspd, - pname="GHB-1", - auxiliary="temperature", - ) + if array_input: + bhead = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64)} + cond = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64)} + temp = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64)} + for i in range(nrow): + bhead[0][0, i, ncol - 1] = top + cond[0][0, i, ncol - 1] = ghbcond + temp[0][0, i, ncol - 1] = initial_temperature + flopy.mf6.ModflowGwfghba( + gwf, + pname="GHB-1", + auxiliary="temperature", + bhead=bhead, + cond=cond, + aux=temp, + ) + else: + ghbspd = [ + [(0, i, ncol - 1), top, ghbcond, initial_temperature] for i in range(nrow) + ] + flopy.mf6.ModflowGwfghb( + gwf, + stress_period_data=ghbspd, + pname="GHB-1", + auxiliary="temperature", + ) # Instantiating CHD chdspd = [[(0, i, 0), 2.0, initial_temperature] for i in range(nrow)] @@ -240,19 +256,22 @@ def build_models(idx, test): sim, exgtype="GWF6-GWT6", exgmnamea=gwfname, exgmnameb=gwtname ) - return sim, None + return sim -def check_output(idx, test): +def check_output(idx, ws, array_input=False): # read flow results from model name = cases[idx] gwfname = "gwf-" + name fname = gwfname + ".bud" - fname = os.path.join(test.workspace, fname) + fname = os.path.join(ws, fname) assert os.path.isfile(fname) budobj = flopy.utils.CellBudgetFile(fname, precision="double") - outbud = budobj.get_data(text=" GHB") + if array_input: + outbud = budobj.get_data(text=" GHBA") + else: + outbud = budobj.get_data(text=" GHB") # Establish known answer: stored_ans = -151.63446156218242 @@ -298,8 +317,8 @@ def check_output(idx, test): ) # Ensure that binary output file is readable (has the correct header) - vsc_filerecord = f"{gwfname}.vsc.bin" - fname = os.path.join(test.workspace, vsc_filerecord) + vsc_filerecord = f"{gwfname}.vsc.vscb" + fname = os.path.join(ws, vsc_filerecord) if os.path.isfile(fname): vscobj = flopy.utils.HeadFile(fname, precision="double", text="VISCOSITY") try: @@ -310,13 +329,36 @@ def check_output(idx, test): print("Binary viscosity output file was not read successfully") +def build_models(idx, test): + # build MODFLOW 6 files + ws = test.workspace + sim = get_model(idx, ws) + + # build comparison array_input model + ws = os.path.join(test.workspace, "mf6") + mc = get_model(idx, ws, array_input=True) + + return sim, mc + + +def check_outputs(idx, test): + # check output MODFLOW 6 files + ws = test.workspace + check_output(idx, ws) + + # check output comparison array_input model + ws = os.path.join(test.workspace, "mf6") + check_output(idx, ws, array_input=True) + + @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): test = TestFramework( name=name, workspace=function_tmpdir, build=lambda t: build_models(idx, t), - check=lambda t: check_output(idx, t), + check=lambda t: check_outputs(idx, t), targets=targets, + compare="mf6", ) test.run() diff --git a/autotest/test_gwt_henry_nr.py b/autotest/test_gwt_henry_nr.py index 1d507a5e2d0..caf73ba5ec9 100644 --- a/autotest/test_gwt_henry_nr.py +++ b/autotest/test_gwt_henry_nr.py @@ -12,7 +12,7 @@ import flopy import numpy as np import pytest -from framework import TestFramework +from framework import DNODATA, TestFramework cases = ["henrynr01"] @@ -67,10 +67,7 @@ def sinfunc(a, b, c, d, x): return a * np.sin(b * (x - c)) + d -def build_models(idx, test): - ws = test.workspace - name = cases[idx] - +def get_model(ws, name, array_input=False): nrow = 1 delr = lx / ncol delc = 1.0 @@ -167,23 +164,46 @@ def build_models(idx, test): sealevelts = [sealevel] + list( sinfunc(amplitude, frequency * 2 * np.pi, 0, sealevel, times) ) - ghbspd = {} drnspd = {} + if array_input: + bheadspd = {} + condspd = {} + auxspd = {} + else: + ghbspd = {} for kper in range(nper): if kper == 0: sl = sealevel else: sl = sealevelts[kper] - ghblist = [] drnlist = [] + if array_input: + abhead = np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64) + acond = np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64) + aconc = np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64) + adens = np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64) + else: + ghblist = [] + nbound = 0 for k, i, j in zip(kidx, iidx, jidx): zcell = zcellcenters[k, i, j] cond = 864.0 * (delz * delc) / (0.5 * delr) if zcell > sl: drnlist.append([(k, i, j), zcell, 864.0, 0.0]) else: - ghblist.append([(k, i, j), sl, 864.0, 35.0, 1024.5]) - if len(ghblist) > 0: + if array_input: + abhead[k, i, j] = sl + acond[k, i, j] = 864.0 + aconc[k, i, j] = 35.0 + adens[k, i, j] = 1024.5 + else: + ghblist.append([(k, i, j), sl, 864.0, 35.0, 1024.5]) + nbound += 1 + if array_input and zcell <= sl: + bheadspd[kper] = abhead + condspd[kper] = acond + auxspd[kper] = [aconc, adens] + elif len(ghblist) > 0: ghbspd[kper] = ghblist if len(drnlist) > 0: drnspd[kper] = drnlist @@ -199,16 +219,29 @@ def build_models(idx, test): auxiliary="CONCENTRATION", ) - # ghb - ghb1 = flopy.mf6.ModflowGwfghb( - gwf, - stress_period_data=ghbspd, - print_input=True, - print_flows=True, - save_flows=False, - pname="GHB-1", - auxiliary=["CONCENTRATION", "DENSITY"], - ) + # ghb / ghba + if array_input: + ghb1 = flopy.mf6.ModflowGwfghba( + gwf, + print_input=True, + print_flows=True, + save_flows=False, + pname="GHB-1", + auxiliary=["CONCENTRATION", "DENSITY"], + bhead=bheadspd, + cond=condspd, + aux=auxspd, + ) + else: + ghb1 = flopy.mf6.ModflowGwfghb( + gwf, + stress_period_data=ghbspd, + print_input=True, + print_flows=True, + save_flows=False, + pname="GHB-1", + auxiliary=["CONCENTRATION", "DENSITY"], + ) wellist1 = [] qwell = 5.7024 * wellfact @@ -338,7 +371,7 @@ def build_models(idx, test): filename=f"{name}.gwfgwt", ) - return sim, None + return sim def get_patch_collection(modelgrid, head, conc, cmap="jet", zorder=None): @@ -453,10 +486,7 @@ def plot_output(idx, test): plt.savefig(fname, bbox_inches="tight") -def check_output(idx, test): - name = test.name - ws = test.workspace - sim = test.sims[0] +def check_output(ws, name, sim): gwfname = "gwf_" + name gwtname = "gwt_" + name gwf = sim.get_model(gwfname) @@ -503,6 +533,32 @@ def check_output(idx, test): assert np.allclose(hsim, hans, atol=1.0e-3), errmsg +def build_models(idx, test): + # build MODFLOW 6 files + ws = test.workspace + name = cases[idx] + sim = get_model(ws, name) + + # build comparison array_input model + ws = os.path.join(test.workspace, "mf6") + mc = get_model(ws, name, array_input=True) + + return sim, mc + + +def check_outputs(idx, test): + name = cases[idx] + sim = test.sims[0] + + # check output MODFLOW 6 files + ws = test.workspace + check_output(ws, name, sim) + + # check output comparison array_input model + ws = os.path.join(test.workspace, "mf6") + check_output(ws, name, sim) + + @pytest.mark.slow @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets, plot): @@ -511,7 +567,8 @@ def test_mf6model(idx, name, function_tmpdir, targets, plot): workspace=function_tmpdir, targets=targets, build=lambda t: build_models(idx, t), - check=lambda t: check_output(idx, t), + check=lambda t: check_outputs(idx, t), plot=lambda t: plot_output(idx, t) if plot else None, + compare="mf6", ) test.run() diff --git a/autotest/test_netcdf_gwf_disv.py b/autotest/test_netcdf_gwf_disv.py index d0fbb20eca4..9b1795c2f47 100644 --- a/autotest/test_netcdf_gwf_disv.py +++ b/autotest/test_netcdf_gwf_disv.py @@ -38,7 +38,7 @@ ) -def build_models(idx, test, export, gridded_input): +def build_models(idx, test, gridded_input): from test_gwf_disv import build_models as build sim, dummy = build(idx, test) @@ -51,8 +51,7 @@ def build_models(idx, test, export, gridded_input): name = cases[idx] - if export == "ugrid": - gwf.name_file.nc_mesh2d_filerecord = f"{name}.nc" + gwf.name_file.nc_mesh2d_filerecord = f"{name}.nc" # netcdf config ncf = flopy.mf6.ModflowUtlncf( @@ -77,7 +76,7 @@ def build_models(idx, test, export, gridded_input): return sim, dummy -def check_output(idx, test, export, gridded_input): +def check_output(idx, test, gridded_input): from test_gwf_disv import check_output as check name = test.name @@ -101,16 +100,15 @@ def check_output(idx, test, export, gridded_input): if gridded_input == "netcdf": # re-run the simulation with model netcdf input input_fname = f"{name}.nc" - nc_fname = f"{name}.{export}.nc" + nc_fname = f"{name}.ugrid.nc" os.rename(test.workspace / input_fname, test.workspace / nc_fname) - if export == "ugrid": - fileout_tag = "NETCDF_MESH2D" + fileout_tag = "NETCDF_MESH2D" with open(test.workspace / f"{name}.nam", "w") as f: f.write("BEGIN options\n") f.write(f" {fileout_tag} FILEOUT {name}.nc\n") - f.write(f" NETCDF FILEIN {name}.{export}.nc\n") + f.write(f" NETCDF FILEIN {name}.ugrid.nc\n") f.write("END options\n\n") f.write("BEGIN packages\n") f.write(f" DISV6 {name}.disv disv\n") @@ -244,15 +242,14 @@ def check_output(idx, test, export, gridded_input): @pytest.mark.netcdf @pytest.mark.parametrize("idx, name", enumerate(cases)) -@pytest.mark.parametrize("export", ["ugrid"]) @pytest.mark.parametrize("gridded_input", ["ascii", "netcdf"]) -def test_mf6model(idx, name, function_tmpdir, targets, export, gridded_input): +def test_mf6model(idx, name, function_tmpdir, targets, gridded_input): test = TestFramework( name=name, workspace=function_tmpdir, targets=targets, - build=lambda t: build_models(idx, t, export, gridded_input), - check=lambda t: check_output(idx, t, export, gridded_input), + build=lambda t: build_models(idx, t, gridded_input), + check=lambda t: check_output(idx, t, gridded_input), compare=None, ) test.run() diff --git a/autotest/test_netcdf_gwf_disv_uzf.py b/autotest/test_netcdf_gwf_disv_uzf.py new file mode 100644 index 00000000000..df6ac1a39fb --- /dev/null +++ b/autotest/test_netcdf_gwf_disv_uzf.py @@ -0,0 +1,188 @@ +""" +NetCDF test version of test_gwf_disv_uzf. The primary aim is to test +that GHBA package NetCDF array input (bhead and cond) gives the same +results as test_gwf_disv_uzf list based (GHB) and array based (GHBA) +ascii input runs. This test compares heads in the the NetCDF file to +those in the FloPy binary output head file. +""" + +# Imports + +import os +from pathlib import Path + +import numpy as np +import pytest + +try: + import flopy +except: + msg = "Error. FloPy package is not available.\n" + msg += "Try installing using the following command:\n" + msg += " pip install flopy" + raise Exception(msg) + +from framework import TestFramework +from test_gwf_disv_uzf import cases + +xa = pytest.importorskip("xarray") +xu = pytest.importorskip("xugrid") +nc = pytest.importorskip("netCDF4") + + +def build_models(idx, test): + from test_gwf_disv_uzf import build_models as build + + sim, mc = build(idx, test) + gwf = mc.gwf[0] + gwf.get_package("GHBA_0").export_array_netcdf = True + + name = cases[idx] + + gwf.name_file.nc_mesh2d_filerecord = f"{name}.nc" + + return sim, mc + + +def check_output(idx, test): + from test_gwf_disv_uzf import check_output as check + + name = test.name + ws = Path(test.workspace / "mf6") + + # check outputs of GHB / GHBA ascii input runs + check(test.workspace, name) + check(ws, name) + + # verify format of generated netcdf file + with nc.Dataset(ws / f"{name}.nc") as ds: + assert ds.data_model == "NETCDF4" + + # re-run the simulation with model netcdf input + input_fname = f"{name}.nc" + nc_fname = f"{name}.ugrid.nc" + os.rename(ws / input_fname, ws / nc_fname) + + fileout_tag = "NETCDF_MESH2D" + + with open(ws / f"{name}.nam", "w") as f: + f.write("BEGIN options\n") + f.write(" SAVE_FLOWS\n") + f.write(" NEWTON\n") + f.write(f" {fileout_tag} FILEOUT {name}.nc\n") + f.write(f" NETCDF FILEIN {name}.ugrid.nc\n") + f.write("END options\n\n") + f.write("BEGIN packages\n") + f.write(f" DISV6 {name}.disv disv\n") + f.write(f" IC6 {name}.ic ic\n") + f.write(f" NPF6 {name}.npf npf\n") + f.write(f" STO6 {name}.sto sto\n") + f.write(f" GHBA6 {name}.ghba ghba_0\n") + f.write(f" UZF6 {name}.uzf uzf_0\n") + f.write(f" OC6 {name}.oc oc\n") + f.write(f" OBS6 {name}.obs head_obs\n") + f.write("END packages\n") + + with open(ws / f"{name}.ghba", "w") as f: + f.write("BEGIN options\n") + f.write(" PRINT_INPUT\n") + f.write(" PRINT_FLOWS\n") + f.write("END options\n\n") + f.write("BEGIN period 1\n") + f.write(" bhead NETCDF\n") + f.write(" cond NETCDF\n") + f.write("END period 1\n") + + success, buff = flopy.run_model( + test.targets["mf6"], + ws / "mfsim.nam", + model_ws=ws, + report=True, + ) + + assert success + test.success = success + + # check netcdf input based run + check(ws, test.name) + + # compare head files for original + # list based and netcdf input runs + ext = ["hds"] + text = ["head"] + names = [test.name] + for i, e in enumerate(ext): + fpth1 = os.path.join( + test.workspace, + f"{names[i]}.{e}", + ) + fpth2 = os.path.join(ws, f"{names[i]}.{e}") + fout = os.path.join( + ws, + f"{names[i]}.{e}.cmp.out", + ) + success_tst = flopy.utils.compare.compare_heads( + None, + None, + text=f"{text[i]}", + outfile=fout, + files1=fpth1, + files2=fpth2, + difftol=True, + ) + msg = f"initial {text[i]} comparison success = {success_tst}" + if success_tst: + test.success = True + print(msg) + else: + test.success = False + assert success_tst, msg + + # now compare heads in head file and + # netcdf export for netcdf input run + try: + # load heads + fpth = os.path.join(ws, f"{name}.hds") + hobj = flopy.utils.HeadFile(fpth, precision="double") + heads = hobj.get_alldata() + except: + assert False, f'could not load headfile data from "{fpth}"' + + # open dataset + nc_fpth = os.path.join(ws, f"{name}.nc") + ds = xu.open_dataset(nc_fpth) + xds = ds.ugrid.to_dataset() + + # Compare NetCDF head arrays with binary headfile + gwf = test.sims[0].gwf[0] + dis = getattr(gwf, "dis") + tdis = getattr(test.sims[0], "tdis") + nper = getattr(tdis, "nper").data + nlay = getattr(dis, "nlay").data + pd = getattr(tdis, "perioddata").array + kstp = 0 + for i in range(nper): + for j in range(int(pd[i][1])): + rec = hobj.get_data(kstpkper=(j, i)) + for l in range(nlay): + assert np.allclose( + np.array(rec[l]).ravel(), + xds[f"head_l{l + 1}"][kstp, :].data, + ), f"NetCDF-head comparison failure in timestep {kstp + 1}" + kstp += 1 + + +@pytest.mark.netcdf +@pytest.mark.parametrize( + "idx, name", + list(enumerate(cases)), +) +def test_mf6model(idx, name, function_tmpdir, targets): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t), + check=lambda t: check_output(idx, t), + targets=targets, + ) + test.run() diff --git a/autotest/test_netcdf_gwf_uzf01.py b/autotest/test_netcdf_gwf_uzf01.py new file mode 100644 index 00000000000..c500dc6474d --- /dev/null +++ b/autotest/test_netcdf_gwf_uzf01.py @@ -0,0 +1,207 @@ +""" +NetCDF test version of test_gwf_uzf01. The primary aim is to test +that GHBA package NetCDF array input (bhead and cond) gives the same +results as test_gwf_uzf01 list based (GHB) and array based (GHBA) +ascii input runs. This test compares heads in the the NetCDF file +to those in the FloPy binary output head file. +""" + +# Imports + +import os +from pathlib import Path + +import numpy as np +import pytest + +try: + import flopy +except: + msg = "Error. FloPy package is not available.\n" + msg += "Try installing using the following command:\n" + msg += " pip install flopy" + raise Exception(msg) + +from framework import TestFramework +from test_gwf_uzf01 import cases + +xa = pytest.importorskip("xarray") +xu = pytest.importorskip("xugrid") +nc = pytest.importorskip("netCDF4") + + +def build_models(idx, test, export): + from test_gwf_uzf01 import build_models as build + + name = cases[idx] + + sim, mc = build(idx, test) + gwf = mc.gwf[0] + ghba = gwf.get_package("GHBA_0") + ghba.export_array_netcdf = True + + if export == "ugrid": + gwf.name_file.nc_mesh2d_filerecord = f"{name}.nc" + elif export == "structured": + gwf.name_file.nc_structured_filerecord = f"{name}.nc" + + return sim, mc + + +def check_output(idx, test, export): + from test_gwf_uzf01 import check_output as check + + name = test.name + ws = Path(test.workspace / "mf6") + + # check outputs of GHB / GHBA ascii input runs + check(test.workspace, name) + check(ws, name) + + # verify format of generated netcdf file + with nc.Dataset(ws / f"{name}.nc") as ds: + assert ds.data_model == "NETCDF4" + + # re-run the simulation with model netcdf input + input_fname = f"{name}.nc" + nc_fname = f"{name}.{export}.nc" + os.rename(ws / input_fname, ws / nc_fname) + + if export == "ugrid": + fileout_tag = "NETCDF_MESH2D" + elif export == "structured": + fileout_tag = "NETCDF_STRUCTURED" + + with open(ws / f"{name}.nam", "w") as f: + f.write("BEGIN options\n") + f.write(" SAVE_FLOWS\n") + f.write(" NEWTON UNDER_RELAXATION\n") + f.write(f" {fileout_tag} FILEOUT {name}.nc\n") + f.write(f" NETCDF FILEIN {name}.{export}.nc\n") + f.write("END options\n\n") + f.write("BEGIN packages\n") + f.write(f" DIS6 {name}.dis dis\n") + f.write(f" IC6 {name}.ic ic\n") + f.write(f" NPF6 {name}.npf npf\n") + f.write(f" STO6 {name}.sto sto\n") + f.write(f" GHBA6 {name}.ghba ghba_0\n") + f.write(f" UZF6 {name}.uzf uzf_0\n") + f.write(f" OC6 {name}.oc oc\n") + f.write(f" OBS6 {name}.obs head_obs\n") + f.write("END packages\n") + + with open(ws / f"{name}.ghba", "w") as f: + f.write("BEGIN options\n") + f.write(" PRINT_INPUT\n") + f.write(" PRINT_FLOWS\n") + f.write(" OBS6 FILEIN gwf_uzf01a.ghb.obs\n") + f.write("END options\n\n") + f.write("BEGIN period 1\n") + f.write(" bhead NETCDF\n") + f.write(" cond NETCDF\n") + f.write("END period 1\n") + + success, buff = flopy.run_model( + test.targets["mf6"], + ws / "mfsim.nam", + model_ws=ws, + report=True, + ) + + assert success + test.success = success + + # check netcdf input based run + check(ws, test.name) + + # compare head files for original + # list based and netcdf input runs + ext = ["hds"] + text = ["head"] + names = [test.name] + for i, e in enumerate(ext): + fpth1 = os.path.join( + test.workspace, + f"{names[i]}.{e}", + ) + fpth2 = os.path.join(ws, f"{names[i]}.{e}") + fout = os.path.join( + ws, + f"{names[i]}.{e}.cmp.out", + ) + success_tst = flopy.utils.compare.compare_heads( + None, + None, + text=f"{text[i]}", + outfile=fout, + files1=fpth1, + files2=fpth2, + difftol=True, + ) + msg = f"initial {text[i]} comparison success = {success_tst}" + if success_tst: + test.success = True + print(msg) + else: + test.success = False + assert success_tst, msg + + # now compare heads in head file and + # netcdf export for netcdf input run + try: + # load heads + fpth = os.path.join(ws, f"{name}.hds") + hobj = flopy.utils.HeadFile(fpth, precision="double") + heads = hobj.get_alldata() + except: + assert False, f'could not load headfile data from "{fpth}"' + + # open dataset + nc_fpth = os.path.join(ws, f"{name}.nc") + if export == "ugrid": + ds = xu.open_dataset(nc_fpth) + xds = ds.ugrid.to_dataset() + elif export == "structured": + xds = xa.open_dataset(nc_fpth) + + # Compare NetCDF head arrays with binary headfile + gwf = test.sims[0].gwf[0] + dis = getattr(gwf, "dis") + tdis = getattr(test.sims[0], "tdis") + nper = getattr(tdis, "nper").data + nlay = getattr(dis, "nlay").data + pd = getattr(tdis, "perioddata").array + kstp = 0 + for i in range(nper): + for j in range(int(pd[i][1])): + rec = hobj.get_data(kstpkper=(j, i)) + if export == "ugrid": + for l in range(nlay): + assert np.allclose( + np.array(rec[l]).ravel(), + xds[f"head_l{l + 1}"][kstp, :].data, + ), f"NetCDF-head comparison failure in timestep {kstp + 1}" + kstp += 1 + elif export == "structured": + assert np.allclose( + np.array(rec), + xds["head"][kstp, :].data, + ), f"NetCDF-head comparison failure in timestep {kstp + 1}" + kstp += 1 + + +@pytest.mark.netcdf +@pytest.mark.parametrize( + "idx, name", + list(enumerate(cases)), +) +@pytest.mark.parametrize("export", ["ugrid", "structured"]) +def test_mf6model(idx, name, function_tmpdir, targets, export): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t, export), + check=lambda t: check_output(idx, t, export), + targets=targets, + ) + test.run() diff --git a/autotest/test_netcdf_gwf_vsc01.py b/autotest/test_netcdf_gwf_vsc01.py new file mode 100644 index 00000000000..950ed6bfb59 --- /dev/null +++ b/autotest/test_netcdf_gwf_vsc01.py @@ -0,0 +1,206 @@ +""" +NetCDF test version of test_gwf_vsc01. The primary aim is to test +that GHBA package NetCDF array input (bhead, cond, and temperature +auxiliary arrays) gives the same results as test_gwf_vsc01 list based +(GHB) and array based (GHBA) ascii input runs. This test compares +heads in the the NetCDF file to those in the FloPy binary output +head file. +""" + +# Imports + +import os +from pathlib import Path + +import numpy as np +import pytest + +try: + import flopy +except: + msg = "Error. FloPy package is not available.\n" + msg += "Try installing using the following command:\n" + msg += " pip install flopy" + raise Exception(msg) + +from framework import TestFramework +from test_gwf_vsc01 import cases, viscosity_on + +xa = pytest.importorskip("xarray") +xu = pytest.importorskip("xugrid") +nc = pytest.importorskip("netCDF4") + + +def build_models(idx, test, export): + from test_gwf_vsc01 import build_models as build + + sim, mc = build(idx, test) + # mc.tdis.start_date_time = "2041-01-01T00:00:00-05:00" + gwf = mc.gwf[0] + gwf.get_package("GHB-1").export_array_netcdf = True + + name = "gwf-" + cases[idx] + + if export == "ugrid": + gwf.name_file.nc_mesh2d_filerecord = f"{name}.nc" + elif export == "structured": + gwf.name_file.nc_structured_filerecord = f"{name}.nc" + + return sim, mc + + +def check_output(idx, test, export): + from test_gwf_vsc01 import check_output as check + + name = "gwf-" + test.name + ws = Path(test.workspace / "mf6") + + # check outputs of GHB / GHBA ascii input runs + check(idx, test.workspace, array_input=False) + check(idx, ws, array_input=True) + + # verify format of generated netcdf file + with nc.Dataset(ws / f"{name}.nc") as ds: + assert ds.data_model == "NETCDF4" + + # re-run the simulation with model netcdf input + input_fname = f"{name}.nc" + nc_fname = f"{name}.{export}.nc" + os.rename(ws / input_fname, ws / nc_fname) + + if export == "ugrid": + fileout_tag = "NETCDF_MESH2D" + elif export == "structured": + fileout_tag = "NETCDF_STRUCTURED" + + with open(ws / f"{name}.nam", "w") as f: + f.write("BEGIN options\n") + f.write(" SAVE_FLOWS\n") + f.write(f" {fileout_tag} FILEOUT {name}.nc\n") + f.write(f" NETCDF FILEIN {name}.{export}.nc\n") + f.write("END options\n\n") + f.write("BEGIN packages\n") + f.write(f" DIS6 {name}.dis dis\n") + f.write(f" NPF6 {name}.npf npf\n") + f.write(f" IC6 {name}.ic ic\n") + if viscosity_on[idx]: + f.write(f" VSC6 {name}.vsc vsc\n") + f.write(f" GHBA6 {name}.ghba ghb-1\n") + f.write(f" CHD6 {name}.chd chd-1\n") + f.write(f" OC6 {name}.oc oc\n") + f.write("END packages\n") + + with open(ws / f"{name}.ghba", "w") as f: + f.write("BEGIN options\n") + f.write(" auxiliary TEMPERATURE\n") + f.write("END options\n\n") + f.write("BEGIN period 1\n") + f.write(" bhead NETCDF\n") + f.write(" cond NETCDF\n") + f.write(" TEMPERATURE NETCDF\n") + f.write("END period 1\n") + + success, buff = flopy.run_model( + test.targets["mf6"], + ws / "mfsim.nam", + model_ws=ws, + report=True, + ) + + assert success + test.success = success + + # check netcdf input based run + check(idx, ws, array_input=True) + + # compare head files for original + # list based and netcdf input runs + ext = ["hds", "ucn"] + text = ["head", "concentration"] + names = [name, "gwt-" + test.name] + for i, e in enumerate(ext): + fpth1 = os.path.join( + test.workspace, + f"{names[i]}.{e}", + ) + fpth2 = os.path.join(ws, f"{names[i]}.{e}") + fout = os.path.join( + ws, + f"{names[i]}.{e}.cmp.out", + ) + success_tst = flopy.utils.compare.compare_heads( + None, + None, + text=f"{text[i]}", + outfile=fout, + files1=fpth1, + files2=fpth2, + difftol=True, + ) + msg = f"initial {text[i]} comparison success = {success_tst}" + if success_tst: + test.success = True + print(msg) + else: + test.success = False + assert success_tst, msg + + # now compare heads in head file and + # netcdf export for netcdf input run + try: + # load heads + fpth = os.path.join(ws, f"{name}.hds") + hobj = flopy.utils.HeadFile(fpth, precision="double") + heads = hobj.get_alldata() + except: + assert False, f'could not load headfile data from "{fpth}"' + + # open dataset + nc_fpth = os.path.join(ws, f"{name}.nc") + if export == "ugrid": + ds = xu.open_dataset(nc_fpth) + xds = ds.ugrid.to_dataset() + elif export == "structured": + xds = xa.open_dataset(nc_fpth) + + # Compare NetCDF head arrays with binary headfile + gwf = test.sims[0].gwf[0] + dis = getattr(gwf, "dis") + tdis = getattr(test.sims[0], "tdis") + nper = getattr(tdis, "nper").data + nlay = getattr(dis, "nlay").data + pd = getattr(tdis, "perioddata").array + kstp = 0 + for i in range(nper): + for j in range(int(pd[i][1])): + rec = hobj.get_data(kstpkper=(j, i)) + if export == "ugrid": + for l in range(nlay): + assert np.allclose( + np.array(rec[l]).ravel(), + xds[f"head_l{l + 1}"][kstp, :].data, + ), f"NetCDF-head comparison failure in timestep {kstp + 1}" + kstp += 1 + elif export == "structured": + assert np.allclose( + np.array(rec), + xds["head"][kstp, :].data, + ), f"NetCDF-head comparison failure in timestep {kstp + 1}" + kstp += 1 + + +@pytest.mark.netcdf +@pytest.mark.parametrize( + "idx, name", + list(enumerate(cases)), +) +@pytest.mark.parametrize("export", ["ugrid", "structured"]) +def test_mf6model(idx, name, function_tmpdir, targets, export): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t, export), + check=lambda t: check_output(idx, t, export), + targets=targets, + ) + test.run() diff --git a/autotest/test_netcdf_gwt_henry_nr.py b/autotest/test_netcdf_gwt_henry_nr.py new file mode 100644 index 00000000000..c04d0018c59 --- /dev/null +++ b/autotest/test_netcdf_gwt_henry_nr.py @@ -0,0 +1,216 @@ +""" +NetCDF test version of test_gwt_henry_nr. The primary aim is to test +that GHBA package NetCDF array input (bhead, cond, concentration and +density auxiliary arrays) gives the same results as test_gwt_henry_nr +list based (GHB) and array based (GHBA) ascii input runs. This test +compares heads in the the NetCDF file to those in the FloPy binary +output head file. +""" + +# Imports + +import os +import shutil +from pathlib import Path + +import numpy as np +import pytest + +try: + import flopy +except: + msg = "Error. FloPy package is not available.\n" + msg += "Try installing using the following command:\n" + msg += " pip install flopy" + raise Exception(msg) + +from framework import TestFramework +from test_gwt_henry_nr import cases + +xa = pytest.importorskip("xarray") +xu = pytest.importorskip("xugrid") +nc = pytest.importorskip("netCDF4") + + +def build_models(idx, test, export): + from test_gwt_henry_nr import build_models as build + + sim, mc = build(idx, test) + # mc.tdis.start_date_time = "2041-01-01T00:00:00-05:00" + gwf = mc.gwf[0] + gwf.get_package("GHB-1").export_array_netcdf = True + + name = "gwf_" + cases[idx] + + if export == "ugrid": + gwf.name_file.nc_mesh2d_filerecord = f"{name}.nc" + elif export == "structured": + gwf.name_file.nc_structured_filerecord = f"{name}.nc" + + return sim, mc + + +def check_output(idx, test, export): + from test_gwt_henry_nr import check_output as check + + name = "gwf_" + test.name + ghba_ws = Path(test.workspace / "mf6") + ws = Path(test.workspace / "mf6" / "netcdf") + shutil.copytree(ghba_ws, ws) + + # check outputs of GHB / GHBA ascii input runs + check(test.workspace, test.name, test.sims[0]) + # check(ws, test.name, test.sims[0]) + check(ghba_ws, test.name, test.sims[0]) + + # verify format of generated netcdf file + with nc.Dataset(ws / f"{name}.nc") as ds: + assert ds.data_model == "NETCDF4" + + # re-run the simulation with model netcdf input + input_fname = f"{name}.nc" + nc_fname = f"{name}.{export}.nc" + os.rename(ws / input_fname, ws / nc_fname) + + if export == "ugrid": + fileout_tag = "NETCDF_MESH2D" + elif export == "structured": + fileout_tag = "NETCDF_STRUCTURED" + + with open(ws / f"{name}.nam", "w") as f: + f.write("BEGIN options\n") + f.write(" NEWTON\n") + f.write(f" {fileout_tag} FILEOUT {name}.nc\n") + f.write(f" NETCDF FILEIN {name}.{export}.nc\n") + f.write("END options\n\n") + f.write("BEGIN packages\n") + f.write(f" DIS6 {name}.dis dis\n") + f.write(f" IC6 {name}.ic ic\n") + f.write(f" NPF6 {name}.npf npf\n") + f.write(f" STO6 {name}.sto sto\n") + f.write(f" BUY6 {name}.buy buy\n") + f.write(f" DRN6 {name}.drn drn-1\n") + f.write(f" GHBA6 {name}.ghba ghb-1\n") + f.write(f" WEL6 {name}.wel wel-1\n") + f.write(f" OC6 {name}.oc oc\n") + f.write("END packages\n") + + with open(ws / f"{name}.ghba", "w") as f: + f.write("BEGIN options\n") + f.write(" auxiliary CONCENTRATION DENSITY\n") + f.write(" PRINT_INPUT\n") + f.write(" PRINT_FLOWS\n") + f.write("END options\n\n") + for i in range(1001): + f.write(f"BEGIN period {i + 1}\n") + f.write(" bhead NETCDF\n") + f.write(" cond NETCDF\n") + f.write(" concentration NETCDF\n") + f.write(" density NETCDF\n") + f.write(f"END period {i + 1}\n\n") + + success, buff = flopy.run_model( + test.targets["mf6"], + ws / "mfsim.nam", + model_ws=ws, + report=True, + ) + + assert success + test.success = success + + # check netcdf input based run + check(ws, test.name, test.sims[0]) + + # compare head files for original + # ascii and netcdf input runs + ext = ["hds", "ucn"] + text = ["head", "concentration"] + names = [name, "gwt_" + test.name] + for i, e in enumerate(ext): + fpth1 = os.path.join( + ghba_ws, + f"{names[i]}.{e}", + ) + fpth2 = os.path.join(ws, f"{names[i]}.{e}") + fout = os.path.join( + ws, + f"{names[i]}.{e}.cmp.out", + ) + success_tst = flopy.utils.compare.compare_heads( + None, + None, + text=f"{text[i]}", + outfile=fout, + files1=fpth1, + files2=fpth2, + difftol=True, + ) + msg = f"initial {text[i]} comparison success = {success_tst}" + if success_tst: + test.success = True + print(msg) + else: + test.success = False + assert success_tst, msg + + # now compare heads in head file and + # netcdf export for netcdf input run + try: + # load heads + fpth = os.path.join(ws, f"{name}.hds") + hobj = flopy.utils.HeadFile(fpth, precision="double") + heads = hobj.get_alldata() + except: + assert False, f'could not load headfile data from "{fpth}"' + + # open dataset + nc_fpth = os.path.join(ws, f"{name}.nc") + if export == "ugrid": + ds = xu.open_dataset(nc_fpth) + xds = ds.ugrid.to_dataset() + elif export == "structured": + xds = xa.open_dataset(nc_fpth) + + # Compare NetCDF head arrays with binary headfile + gwf = test.sims[0].gwf[0] + dis = getattr(gwf, "dis") + tdis = getattr(test.sims[0], "tdis") + nper = getattr(tdis, "nper").data + nlay = getattr(dis, "nlay").data + pd = getattr(tdis, "perioddata").array + kstp = 0 + for i in range(nper): + for j in range(int(pd[i][1])): + rec = hobj.get_data(kstpkper=(j, i)) + if export == "ugrid": + for l in range(nlay): + assert np.allclose( + np.array(rec[l]).ravel(), + xds[f"head_l{l + 1}"][kstp, :].fillna(1.00000000e30).data, + ), f"NetCDF-head comparison failure in timestep {kstp + 1}" + kstp += 1 + elif export == "structured": + assert np.allclose( + np.array(rec), + xds["head"][kstp, :].fillna(1.00000000e30).data, + ), f"NetCDF-head comparison failure in timestep {kstp + 1}" + kstp += 1 + + +@pytest.mark.slow +@pytest.mark.netcdf +@pytest.mark.parametrize( + "idx, name", + list(enumerate(cases)), +) +@pytest.mark.parametrize("export", ["ugrid", "structured"]) +def test_mf6model(idx, name, function_tmpdir, targets, export): + test = TestFramework( + name=name, + workspace=function_tmpdir, + build=lambda t: build_models(idx, t, export), + check=lambda t: check_output(idx, t, export), + targets=targets, + ) + test.run() diff --git a/src/Model/GroundWaterFlow/gwf-ghba.f90 b/src/Model/GroundWaterFlow/gwf-ghba.f90 index b67481fd1ee..5be806e2e50 100644 --- a/src/Model/GroundWaterFlow/gwf-ghba.f90 +++ b/src/Model/GroundWaterFlow/gwf-ghba.f90 @@ -42,7 +42,7 @@ module ghbamodule contains - !> @brief Create a New Ghb Package and point bndobj to the new package + !> @brief Create a New Ghba Package and point bndobj to the new package !< subroutine ghba_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & mempath) @@ -56,11 +56,11 @@ subroutine ghba_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & character(len=*), intent(in) :: pakname character(len=*), intent(in) :: mempath ! -- local - type(GhbaType), pointer :: ghbobj + type(GhbaType), pointer :: ghbaobj ! ! -- allocate the object and assign values to object variables - allocate (ghbobj) - packobj => ghbobj + allocate (ghbaobj) + packobj => ghbaobj ! ! -- create name and memory path call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) @@ -101,11 +101,11 @@ subroutine ghba_options(this) ! -- modules use MemoryManagerExtModule, only: mem_set_value use CharacterStringModule, only: CharacterStringType - use GwfGhbInputModule, only: GwfGhbParamFoundType + use GwfGhbaInputModule, only: GwfGhbaParamFoundType ! -- dummy class(GhbaType), intent(inout) :: this ! -- local - type(GwfGhbParamFoundType) :: found + type(GwfGhbaParamFoundType) :: found ! ! -- source base class options call this%BndExtType%source_options() @@ -113,7 +113,7 @@ subroutine ghba_options(this) ! -- source options from input context call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover) ! - ! -- log ghb specific options + ! -- log ghba specific options call this%log_ghba_options(found) end subroutine ghba_options @@ -121,10 +121,10 @@ end subroutine ghba_options !< subroutine log_ghba_options(this, found) ! -- modules - use GwfGhbInputModule, only: GwfGhbParamFoundType + use GwfGhbaInputModule, only: GwfGhbaParamFoundType ! -- dummy class(GhbaType), intent(inout) :: this !< BndExtType object - type(GwfGhbParamFoundType), intent(in) :: found + type(GwfGhbaParamFoundType), intent(in) :: found ! ! -- log found options write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & @@ -168,11 +168,11 @@ subroutine ghba_allocate_arrays(this, nodelist, auxvar) ! -- call base type allocate arrays call this%BndExtType%allocate_arrays(nodelist, auxvar) ! - ! -- set ghb input context pointers + ! -- set ghba input context pointers call mem_setptr(this%bhead, 'BHEAD', this%input_mempath) call mem_setptr(this%cond, 'COND', this%input_mempath) ! - ! --checkin ghb input context pointers + ! --checkin ghba input context pointers call mem_checkin(this%bhead, 'BHEAD', this%memoryPath, & 'BHEAD', this%input_mempath) call mem_checkin(this%cond, 'COND', this%memoryPath, & @@ -229,7 +229,7 @@ subroutine ghba_rp(this) end if end subroutine ghba_rp - !> @brief Check ghb boundary condition data + !> @brief Check ghba boundary condition data !< subroutine ghba_ck(this) ! -- modules @@ -248,10 +248,10 @@ subroutine ghba_ck(this) &BOTTOM (',f10.3,')')" character(len=*), parameter :: fmtcondmulterr = & "('GHBA BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS & - &LESS THAN ZERO')" + &NO DATA VALUE OR LESS THAN ZERO')" character(len=*), parameter :: fmtconderr = & - "('GHBA BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN & - &ZERO')" + "('GHBA BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS NO DATA VALUE & + &OR LESS THAN ZERO')" ! ! -- check stress period data do i = 1, this%nbound @@ -264,14 +264,15 @@ subroutine ghba_ck(this) call store_error(errmsg) end if if (this%iauxmultcol > 0) then - if (this%auxvar(this%iauxmultcol, i) < DZERO) then + if (this%auxvar(this%iauxmultcol, i) == DNODATA .or. & + this%auxvar(this%iauxmultcol, i) < DZERO) then write (errmsg, fmt=fmtcondmulterr) & i, this%auxvar(this%iauxmultcol, i) call store_error(errmsg) end if end if - ! TODO update to include error for DNODATA - if (this%cond(i) < DZERO) then + if (this%cond(i) == DNODATA .or. & + this%cond(i) < DZERO) then write (errmsg, fmt=fmtconderr) i, this%cond(i) call store_error(errmsg) end if @@ -317,7 +318,7 @@ subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) class(MatrixBaseType), pointer :: matrix_sln ! -- local integer(I4B) :: i, noder, ipos - real(DP) :: cond, bhead, qghb + real(DP) :: cond, bhead, qghba ! ! -- pakmvrobj fc if (this%imover == 1) then @@ -336,8 +337,8 @@ subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) bhead = this%bhead(i) if (this%imover == 1 .and. this%xnew(noder) > bhead) then cond = this%cond_mult(i) - qghb = cond * (this%xnew(noder) - bhead) - call this%pakmvrobj%accumulate_qformvr(i, qghb) + qghba = cond * (this%xnew(noder) - bhead) + call this%pakmvrobj%accumulate_qformvr(i, qghba) end if end do end subroutine ghba_fc @@ -393,7 +394,7 @@ subroutine ghba_df_obs(this) ! -- local integer(I4B) :: indx ! - call this%obs%StoreObsType('ghb', .true., indx) + call this%obs%StoreObsType('ghba', .true., indx) this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor ! ! -- Store obs type and assign procedure pointer diff --git a/src/Utilities/Export/NCModel.f90 b/src/Utilities/Export/NCModel.f90 index 0055ec25744..bf6aade2aaa 100644 --- a/src/Utilities/Export/NCModel.f90 +++ b/src/Utilities/Export/NCModel.f90 @@ -378,7 +378,7 @@ subroutine export_init(this, modelname, modeltype, modelfname, nc_fname, & this%datetime = 'days since 1970-01-01T00:00:00' end if - ! TODO: verify this will be set at this point + ! Set error and exit if ATS is on if (inats > 0) then errmsg = 'Adaptive time stepping not currently supported & &with NetCDF exports.' diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 index 32ba11ba6f1..d976c55453a 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 @@ -164,7 +164,6 @@ subroutine reset(this) ! explicitly reset auxvar array each period do m = 1, this%bound_context%nodes do n = 1, this%bound_context%naux - !this%bound_context%auxvar(n, m) = DNODATA this%bound_context%auxvar(n, m) = DZERO end do end do diff --git a/src/Utilities/Idm/netcdf/NCArrayReader.f90 b/src/Utilities/Idm/netcdf/NCArrayReader.f90 index 23fc2d12d0f..8af078d3f6e 100644 --- a/src/Utilities/Idm/netcdf/NCArrayReader.f90 +++ b/src/Utilities/Idm/netcdf/NCArrayReader.f90 @@ -315,10 +315,11 @@ subroutine load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, & nc_vars%nc_fname) end if case ('NODES', 'NAUX NODES') - ! TODO implement or set error? - if (nc_vars%grid == 'STRUCTURED') then - else if (nc_vars%grid == 'LAYERED MESH') then - end if + write (errmsg, '(a,a,a)') & + 'Timeseries netcdf input read not supported for DIS full grid int1d & + &type ('//trim(idt%tagname)//').' + call store_error(errmsg) + call store_error_filename(input_fname) case default end select end if diff --git a/src/Utilities/Idm/netcdf/NCContextBuild.f90 b/src/Utilities/Idm/netcdf/NCContextBuild.f90 index 1b4fc8c5c68..774612fa32e 100644 --- a/src/Utilities/Idm/netcdf/NCContextBuild.f90 +++ b/src/Utilities/Idm/netcdf/NCContextBuild.f90 @@ -63,12 +63,11 @@ subroutine add_package_var(modeltype, modelname, nc_vars, input_name, varid, & character(len=NETCDF_ATTR_STRLEN) :: input_str character(len=LENCOMPONENTNAME) :: c_name, sc_name character(len=LINELENGTH) :: mempath, varname - integer(I4B) :: layer, period, iaux, mf6_layer, mf6_iaux + integer(I4B) :: layer, iaux, mf6_layer, mf6_iaux logical(LGP) :: success ! initialize layer = -1 - period = -1 iaux = -1 varname = '' c_name = '' @@ -100,7 +99,7 @@ subroutine add_package_var(modeltype, modelname, nc_vars, input_name, varid, & end if ! add the variable to netcdf description - call nc_vars%add(sc_name, varname, layer, period, iaux, varid) + call nc_vars%add(sc_name, varname, layer, iaux, varid) else errmsg = 'NetCDF variable invalid modflow_input attribute: "'// & trim(input_str)//'".' diff --git a/src/Utilities/Idm/netcdf/NCFileVars.f90 b/src/Utilities/Idm/netcdf/NCFileVars.f90 index 9e38dc78bc3..cfb32af5ada 100644 --- a/src/Utilities/Idm/netcdf/NCFileVars.f90 +++ b/src/Utilities/Idm/netcdf/NCFileVars.f90 @@ -37,7 +37,6 @@ module NCFileVarsModule character(LINELENGTH) :: pkgname !< package name character(LINELENGTH) :: tagname !< tag name integer(I4B) :: layer !< variable layer - integer(I4B) :: period !< variable period integer(I4B) :: iaux !< variable aux index integer(I4B) :: varid !< NC file variable id contains @@ -70,11 +69,10 @@ end subroutine ncvars_init !> @brief return a netcdf variable id for a package tagname !< - function ncvars_varid(this, tagname, layer, period, iaux) result(varid) + function ncvars_varid(this, tagname, layer, iaux) result(varid) class(NCPackageVarsType) :: this character(len=*), intent(in) :: tagname integer(I4B), optional :: layer - integer(I4B), optional :: period integer(I4B), optional :: iaux integer(I4B) :: varid integer(I4B) :: n, l, p, a @@ -91,10 +89,6 @@ function ncvars_varid(this, tagname, layer, period, iaux) result(varid) l = layer end if - ! set search period if provided - if (present(period)) then - p = period - end if ! set search iaux if provided if (present(iaux)) then a = iaux @@ -104,7 +98,6 @@ function ncvars_varid(this, tagname, layer, period, iaux) result(varid) nc_var => ncvar_get(this%nc_vars, n) if (nc_var%tagname == tagname .and. & nc_var%layer == l .and. & - nc_var%period == p .and. & nc_var%iaux == a) then varid = nc_var%varid end if @@ -118,9 +111,6 @@ function ncvars_varid(this, tagname, layer, period, iaux) result(varid) if (present(layer)) then write (errmsg, '(a,i0)') trim(errmsg)//', layer=', layer end if - if (present(period)) then - write (errmsg, '(a,i0)') trim(errmsg)//', period=', period - end if if (present(iaux)) then write (errmsg, '(a,i0)') trim(errmsg)//', iaux=', iaux end if @@ -185,13 +175,12 @@ end subroutine fv_init !> @brief add netcdf modflow6 input variable to list !< - subroutine fv_add(this, pkgname, tagname, layer, period, iaux, varid) + subroutine fv_add(this, pkgname, tagname, layer, iaux, varid) use ArrayHandlersModule, only: expandarray class(NCFileVarsType) :: this character(len=*), intent(in) :: pkgname character(len=*), intent(in) :: tagname integer(I4B), intent(in) :: layer - integer(I4B), intent(in) :: period integer(I4B), intent(in) :: iaux integer(I4B), intent(in) :: varid class(NCFileMf6VarType), pointer :: invar @@ -201,7 +190,6 @@ subroutine fv_add(this, pkgname, tagname, layer, period, iaux, varid) invar%pkgname = pkgname invar%tagname = tagname invar%layer = layer - invar%period = period invar%iaux = iaux invar%varid = varid obj => invar @@ -241,7 +229,6 @@ subroutine create_varlists(this, modelname, pkgname, nc_vars) nc_var%pkgname = invar%pkgname nc_var%tagname = invar%tagname nc_var%layer = invar%layer - nc_var%period = invar%period nc_var%iaux = invar%iaux nc_var%varid = invar%varid obj => nc_var From 8c60f69258e4de8948b9b668cdb9f0e09c914aca Mon Sep 17 00:00:00 2001 From: mjreno Date: Tue, 15 Apr 2025 13:38:05 -0400 Subject: [PATCH 11/22] mark gridded array input packages as dev feature --- src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 index 9341329cf80..770cd7c3f76 100644 --- a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 @@ -271,6 +271,7 @@ subroutine dynamic_create_loader(this) use GridArrayLoadModule, only: GridArrayLoadType use ListLoadModule, only: ListLoadType use Mf6FileStoInputModule, only: StoInputType + use DevFeatureModule, only: dev_feature class(Mf6FileDynamicPkgLoadType), intent(inout) :: this class(ListLoadType), pointer :: list_loader class(GridArrayLoadType), pointer :: arrgrid_loader @@ -285,6 +286,10 @@ subroutine dynamic_create_loader(this) allocate (arrlayer_loader) this%rp_loader => arrlayer_loader else if (this%readarray_grid) then + call dev_feature(trim(this%mf6_input%subcomponent_type)// & + ' package input is still under development, install the & + &nightly build or compile from source with IDEVELOPMODE = 1.', & + this%iout) allocate (arrgrid_loader) this%rp_loader => arrgrid_loader else From 0c59247d430e96ad04cbfdbee88662cc0974a5b1 Mon Sep 17 00:00:00 2001 From: mjreno Date: Tue, 22 Apr 2025 13:06:53 -0400 Subject: [PATCH 12/22] netcdf timeseries export array uses dis length units --- src/Model/GroundWaterFlow/gwf-ghba.f90 | 3 +++ src/Utilities/Export/DisNCMesh.f90 | 21 +++++++--------- src/Utilities/Export/DisNCStructured.f90 | 24 ++++++++----------- src/Utilities/Export/DisvNCMesh.f90 | 21 +++++++--------- src/Utilities/Export/MeshNCModel.f90 | 4 +--- src/Utilities/Export/NCModel.f90 | 2 +- .../Idm/mf6blockfile/Mf6FileGridArray.f90 | 13 ---------- src/Utilities/Idm/netcdf/NCArrayReader.f90 | 16 ++++++------- src/Utilities/Idm/netcdf/NetCDFCommon.f90 | 14 +++++------ 9 files changed, 48 insertions(+), 70 deletions(-) diff --git a/src/Model/GroundWaterFlow/gwf-ghba.f90 b/src/Model/GroundWaterFlow/gwf-ghba.f90 index 5be806e2e50..0a0840365d5 100644 --- a/src/Model/GroundWaterFlow/gwf-ghba.f90 +++ b/src/Model/GroundWaterFlow/gwf-ghba.f90 @@ -147,7 +147,10 @@ subroutine ghba_dimensions(this) class(GhbaType), intent(inout) :: this ! -- local ! + ! -- set maxbound this%maxbound = this%dis%nodesuser + ! + ! -- set nbound, which applies for duration of simulation this%nbound = this%dis%nodesuser ! ! -- Call define_listlabel to construct the list label that is written diff --git a/src/Utilities/Export/DisNCMesh.f90 b/src/Utilities/Export/DisNCMesh.f90 index 615ed4ec3d9..65e616731a9 100644 --- a/src/Utilities/Export/DisNCMesh.f90 +++ b/src/Utilities/Export/DisNCMesh.f90 @@ -9,7 +9,7 @@ module MeshDisModelModule use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LINELENGTH, LENBIGLINE, LENCOMPONENTNAME, & - LENMEMPATH + LENMEMPATH, DNODATA, DZERO use SimVariablesModule, only: errmsg use SimModule, only: store_error, store_error_filename use MemoryManagerModule, only: mem_setptr @@ -116,7 +116,7 @@ end subroutine df subroutine step(this) use ConstantsModule, only: DHNOFLO use TdisModule, only: totim - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp class(Mesh2dDisExportType), intent(inout) :: this real(DP), dimension(:), pointer, contiguous :: dbl1d integer(I4B) :: n, k, nvals, istp @@ -128,7 +128,7 @@ subroutine step(this) nullify (dbl2d) ! set global step index - istp = gstp() + istp = ixstp() dis_shape(1) = this%dis%ncol * this%dis%nrow dis_shape(2) = this%dis%nlay @@ -181,7 +181,6 @@ end subroutine step !> @brief netcdf export package dynamic input !< subroutine package_step(this, export_pkg) - use ConstantsModule, only: DNODATA, DZERO use TdisModule, only: kper use DefinitionSelectModule, only: get_param_definition_type use NCModelExportModule, only: ExportPackageType @@ -534,7 +533,7 @@ end subroutine add_mesh_data subroutine nc_export_int1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & idt, mempath, nc_tag, pkgname, gridmap_name, & deflate, shuffle, chunk_face, iper, nc_fname) - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids @@ -603,7 +602,7 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & nc_fname) else - istp = gstp() + istp = ixstp() nvals = dis%nrow * dis%ncol call nf_verify(nf90_put_var(ncid, & var_ids%export(1), p_mem, & @@ -662,7 +661,7 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & deallocate (var_id) else ! timeseries, add period data - istp = gstp() + istp = ixstp() do k = 1, dis%nlay int1d(1:nvals) => int3d(:, :, k) call nf_verify(nf90_put_var(ncid, & @@ -800,8 +799,7 @@ end subroutine nc_export_int3d subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & idt, mempath, nc_tag, pkgname, gridmap_name, & deflate, shuffle, chunk_face, iper, iaux, nc_fname) - use ConstantsModule, only: DNODATA - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids @@ -872,7 +870,7 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & call nf_verify(nf90_put_var(ncid, var_id(1), p_mem), & nc_fname) else - istp = gstp() + istp = ixstp() nvals = dis%nrow * dis%ncol call nf_verify(nf90_put_var(ncid, & var_ids%export(1), p_mem, & @@ -936,7 +934,7 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, x_dim, y_dim, var_ids, dis, & deallocate (var_id) else ! timeseries, add period data - istp = gstp() + istp = ixstp() do k = 1, dis%nlay dbl1d(1:nvals) => dbl3d(:, :, k) call nf_verify(nf90_put_var(ncid, & @@ -1008,7 +1006,6 @@ end subroutine nc_export_dbl2d subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_tag, pkgname, gridmap_name, deflate, shuffle, & chunk_face, nc_fname) - use ConstantsModule, only: DNODATA real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids diff --git a/src/Utilities/Export/DisNCStructured.f90 b/src/Utilities/Export/DisNCStructured.f90 index b3daa90a8f5..310438a0464 100644 --- a/src/Utilities/Export/DisNCStructured.f90 +++ b/src/Utilities/Export/DisNCStructured.f90 @@ -9,7 +9,7 @@ module DisNCStructuredModule use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LINELENGTH, LENBIGLINE, LENCOMPONENTNAME, & - LENMEMPATH, LENVARNAME, DNODATA, DZERO + LENMEMPATH, DNODATA, DZERO use SimVariablesModule, only: errmsg, warnmsg use SimModule, only: store_error, store_warning, store_error_filename use MemoryManagerModule, only: mem_setptr @@ -257,13 +257,13 @@ end subroutine df_export subroutine step(this) use ConstantsModule, only: DHNOFLO use TdisModule, only: totim - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp class(DisNCStructuredType), intent(inout) :: this real(DP), dimension(:), pointer, contiguous :: dbl1d integer(I4B) :: n, istp ! set global step index - istp = gstp() + istp = ixstp() if (size(this%dis%nodeuser) < & size(this%dis%nodereduced)) then @@ -410,7 +410,6 @@ end subroutine export_df !> @brief create timeseries export variable !< subroutine create_timeseries(this, idt, iparam, iaux, export_pkg) - use ConstantsModule, only: DNODATA use NCModelExportModule, only: ExportPackageType class(DisNCStructuredType), intent(inout) :: this type(InputParamDefinitionType), pointer, intent(in) :: idt @@ -491,7 +490,7 @@ subroutine create_timeseries(this, idt, iparam, iaux, export_pkg) ! variable attributes call nf_verify(nf90_put_att(this%ncid, varid, & - 'units', 'm'), this%nc_fname) + 'units', this%lenunits), this%nc_fname) call nf_verify(nf90_put_att(this%ncid, varid, & 'long_name', longname), this%nc_fname) @@ -537,7 +536,6 @@ end subroutine export_input_arrays !> @brief netcdf export package dynamic input !< subroutine package_step(this, export_pkg) - use ConstantsModule, only: DNODATA, DZERO use TdisModule, only: kper use DefinitionSelectModule, only: get_param_definition_type use NCModelExportModule, only: ExportPackageType @@ -1068,7 +1066,7 @@ end subroutine ncvar_mf6attr subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_tag, pkgname, gridmap_name, latlon, deflate, & shuffle, chunk_z, chunk_y, chunk_x, iper, nc_fname) - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids @@ -1133,7 +1131,7 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_fname) else ! timeseries - istp = gstp() + istp = ixstp() call nf_verify(nf90_put_var(ncid, & var_ids%export, p_mem, & start=(/1, istp/), & @@ -1171,7 +1169,7 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_fname) else ! timeseries - istp = gstp() + istp = ixstp() call nf_verify(nf90_put_var(ncid, & var_ids%export, p_mem, & start=(/1, 1, 1, istp/), & @@ -1297,8 +1295,7 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_tag, pkgname, gridmap_name, latlon, deflate, & shuffle, chunk_z, chunk_y, chunk_x, iper, iaux, & nc_fname) - use ConstantsModule, only: DNODATA - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids @@ -1364,7 +1361,7 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_fname) else ! timeseries - istp = gstp() + istp = ixstp() call nf_verify(nf90_put_var(ncid, & var_ids%export, p_mem, & start=(/1, istp/), & @@ -1406,7 +1403,7 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_fname) else ! timeseries - istp = gstp() + istp = ixstp() call nf_verify(nf90_put_var(ncid, & var_ids%export, p_mem, & start=(/1, 1, 1, istp/), & @@ -1476,7 +1473,6 @@ end subroutine nc_export_dbl2d subroutine nc_export_dbl3d(p_mem, ncid, dim_ids, var_ids, dis, idt, mempath, & nc_tag, pkgname, gridmap_name, latlon, deflate, & shuffle, chunk_z, chunk_y, chunk_x, nc_fname) - use ConstantsModule, only: DNODATA real(DP), dimension(:, :, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(StructuredNCDimIdType), intent(inout) :: dim_ids diff --git a/src/Utilities/Export/DisvNCMesh.f90 b/src/Utilities/Export/DisvNCMesh.f90 index 443a6ae4d70..2ec71f8c0d7 100644 --- a/src/Utilities/Export/DisvNCMesh.f90 +++ b/src/Utilities/Export/DisvNCMesh.f90 @@ -9,7 +9,7 @@ module MeshDisvModelModule use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LINELENGTH, LENBIGLINE, LENCOMPONENTNAME, & - LENMEMPATH + LENMEMPATH, DNODATA, DZERO use SimVariablesModule, only: errmsg use SimModule, only: store_error, store_error_filename use MemoryManagerModule, only: mem_setptr @@ -114,7 +114,7 @@ end subroutine df subroutine step(this) use ConstantsModule, only: DHNOFLO use TdisModule, only: totim - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp class(Mesh2dDisvExportType), intent(inout) :: this real(DP), dimension(:), pointer, contiguous :: dbl1d integer(I4B) :: n, k, nvals, istp @@ -126,7 +126,7 @@ subroutine step(this) nullify (dbl2d) ! set global step index - istp = gstp() + istp = ixstp() dis_shape(1) = this%disv%ncpl dis_shape(2) = this%disv%nlay @@ -180,7 +180,6 @@ end subroutine step !> @brief netcdf export package dynamic input !< subroutine package_step(this, export_pkg) - use ConstantsModule, only: DNODATA, DZERO use TdisModule, only: kper use DefinitionSelectModule, only: get_param_definition_type use NCModelExportModule, only: ExportPackageType @@ -512,7 +511,7 @@ end subroutine add_mesh_data subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & nc_tag, pkgname, gridmap_name, deflate, shuffle, & chunk_face, iper, nc_fname) - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp integer(I4B), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids @@ -572,7 +571,7 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & nc_fname) else ! timeseries - istp = gstp() + istp = ixstp() call nf_verify(nf90_put_var(ncid, & var_ids%export(1), p_mem, & start=(/1, istp/), & @@ -624,7 +623,7 @@ subroutine nc_export_int1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & deallocate (var_id) else ! timeseries, add period data - istp = gstp() + istp = ixstp() do k = 1, disv%nlay int1d(1:disv%ncpl) => int2d(:, k) call nf_verify(nf90_put_var(ncid, & @@ -703,8 +702,7 @@ end subroutine nc_export_int2d subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & nc_tag, pkgname, gridmap_name, deflate, shuffle, & chunk_face, iper, iaux, nc_fname) - use ConstantsModule, only: DNODATA - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp real(DP), dimension(:), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids @@ -767,7 +765,7 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & nc_fname) else ! timeseries - istp = gstp() + istp = ixstp() call nf_verify(nf90_put_var(ncid, & var_ids%export(1), p_mem, & start=(/1, istp/), & @@ -820,7 +818,7 @@ subroutine nc_export_dbl1d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & deallocate (var_id) else ! timeseries, add period data - istp = gstp() + istp = ixstp() do k = 1, disv%nlay dbl1d(1:disv%ncpl) => dbl2d(:, k) call nf_verify(nf90_put_var(ncid, & @@ -837,7 +835,6 @@ end subroutine nc_export_dbl1d subroutine nc_export_dbl2d(p_mem, ncid, dim_ids, var_ids, disv, idt, mempath, & nc_tag, pkgname, gridmap_name, deflate, shuffle, & chunk_face, nc_fname) - use ConstantsModule, only: DNODATA real(DP), dimension(:, :), pointer, contiguous, intent(in) :: p_mem integer(I4B), intent(in) :: ncid type(MeshNCDimIdType), intent(inout) :: dim_ids diff --git a/src/Utilities/Export/MeshNCModel.f90 b/src/Utilities/Export/MeshNCModel.f90 index 58dfaa8f173..5f9b482dda2 100644 --- a/src/Utilities/Export/MeshNCModel.f90 +++ b/src/Utilities/Export/MeshNCModel.f90 @@ -51,8 +51,6 @@ module MeshModelModule integer(I4B) :: mesh_face_ybnds !< mesh faces 2D y bounds array integer(I4B) :: mesh_face_nodes !< mesh faces 2D nodes array integer(I4B) :: time !< time coordinate variable - !integer(I4B) :: export !< in scope export - !integer(I4B), dimension(:), allocatable :: export_layer !< in scope layer export integer(I4B), dimension(:), allocatable :: export !< in scope layer export integer(I4B), dimension(:), allocatable :: dependent !< layered dependent variables array contains @@ -283,7 +281,7 @@ subroutine create_timeseries(this, idt, iparam, iaux, layer, export_pkg) ! assign variable attributes call nf_verify(nf90_put_att(this%ncid, varid, & - 'units', 'm'), this%nc_fname) + 'units', this%lenunits), this%nc_fname) call nf_verify(nf90_put_att(this%ncid, varid, & 'long_name', longname), this%nc_fname) call nf_verify(nf90_put_att(this%ncid, varid, & diff --git a/src/Utilities/Export/NCModel.f90 b/src/Utilities/Export/NCModel.f90 index bf6aade2aaa..ba9e67206b2 100644 --- a/src/Utilities/Export/NCModel.f90 +++ b/src/Utilities/Export/NCModel.f90 @@ -408,7 +408,7 @@ function export_get(this, idx) result(res) end if end function export_get - !> @brief build modflow6_input attribute string + !> @brief build modflow_input attribute string !< function input_attribute(this, pkgname, idt) result(attr) use InputOutputModule, only: lowcase diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 index d976c55453a..712776c0f6f 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 @@ -235,10 +235,7 @@ subroutine param_load(this, parser, idt, mempath, layered, netcdf, iaux) end if call idm_log_var(int1d, idt%tagname, mempath, this%iout) case ('DOUBLE1D') - ! set pointer to managed memory input variable call mem_setptr(dbl1d, idt%mf6varname, mempath) - - ! read user input if (netcdf) then call netcdf_read_array(dbl1d, this%bound_context%mshape, idt, & this%mf6_input, this%nc_vars, this%input_name, & @@ -249,17 +246,11 @@ subroutine param_load(this, parser, idt, mempath, layered, netcdf, iaux) else call read_dbl1d(parser, dbl1d, idt%mf6varname) end if - - ! log user input call idm_log_var(dbl1d, idt%tagname, mempath, this%iout) case ('DOUBLE2D') - ! set pointer to managed memory input variable call mem_setptr(dbl2d, idt%mf6varname, mempath) - - ! allocate local array allocate (dbl1d(this%bound_context%nodes)) - ! read user input if (netcdf) then call netcdf_read_array(dbl1d, this%bound_context%mshape, idt, & this%mf6_input, this%nc_vars, this%input_name, & @@ -271,15 +262,11 @@ subroutine param_load(this, parser, idt, mempath, layered, netcdf, iaux) call read_dbl1d(parser, dbl1d, idt%mf6varname) end if - ! copy into 2d array do n = 1, this%bound_context%nodes dbl2d(iaux, n) = dbl1d(n) end do - ! log user input call idm_log_var(dbl1d, idt%tagname, mempath, this%iout) - - ! cleanup deallocate (dbl1d) case default errmsg = 'IDM unimplemented. GridArrayLoad::param_load & diff --git a/src/Utilities/Idm/netcdf/NCArrayReader.f90 b/src/Utilities/Idm/netcdf/NCArrayReader.f90 index 8af078d3f6e..7126f8ea1bc 100644 --- a/src/Utilities/Idm/netcdf/NCArrayReader.f90 +++ b/src/Utilities/Idm/netcdf/NCArrayReader.f90 @@ -282,7 +282,7 @@ end subroutine load_integer1d_type subroutine load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, & iper, input_fname) use ConstantsModule, only: DNODATA - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp integer(I4B), dimension(:), contiguous, pointer, intent(in) :: int1d type(ModflowInputType), intent(in) :: mf6_input integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape @@ -293,7 +293,7 @@ subroutine load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, & integer(I4B), dimension(:), allocatable :: layer_shape integer(I4B) :: varid, nlay, ncpl, istp - istp = gstp() + istp = ixstp() ! set varid varid = nc_vars%varid(idt%mf6varname) @@ -362,7 +362,7 @@ end subroutine load_integer1d_layered subroutine load_integer1d_layered_spd(int1d, mf6_input, mshape, idt, nc_vars, & iper, input_fname) use ConstantsModule, only: DNODATA - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp integer(I4B), dimension(:), contiguous, pointer, intent(in) :: int1d type(ModflowInputType), intent(in) :: mf6_input integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape @@ -374,7 +374,7 @@ subroutine load_integer1d_layered_spd(int1d, mf6_input, mshape, idt, nc_vars, & integer(I4B) :: nlay, varid integer(I4B) :: ncpl, nvals, istp - istp = gstp() + istp = ixstp() call get_layered_shape(mshape, nlay, layer_shape) nvals = product(mshape) @@ -550,7 +550,7 @@ end subroutine load_double1d_type subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & iper, input_fname, iaux) use ConstantsModule, only: DNODATA - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp real(DP), dimension(:), contiguous, pointer, intent(in) :: dbl1d type(ModflowInputType), intent(in) :: mf6_input integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape @@ -566,7 +566,7 @@ subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & ! initialize n = 0 - istp = gstp() + istp = ixstp() ! set varid if (present(iaux)) then @@ -645,7 +645,7 @@ end subroutine load_double1d_layered subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & iper, input_fname, iaux) use ConstantsModule, only: DNODATA - use NetCDFCommonModule, only: gstp + use NetCDFCommonModule, only: ixstp real(DP), dimension(:), contiguous, pointer, intent(in) :: dbl1d type(ModflowInputType), intent(in) :: mf6_input integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape @@ -659,7 +659,7 @@ subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & integer(I4B) :: k, n, ncpl, idx, istp real(DP), dimension(:), contiguous, pointer :: dbl1d_ptr - istp = gstp() + istp = ixstp() call get_layered_shape(mshape, nlay, layer_shape) ncpl = product(layer_shape) diff --git a/src/Utilities/Idm/netcdf/NetCDFCommon.f90 b/src/Utilities/Idm/netcdf/NetCDFCommon.f90 index 5f9d060d5a7..077011652f9 100644 --- a/src/Utilities/Idm/netcdf/NetCDFCommon.f90 +++ b/src/Utilities/Idm/netcdf/NetCDFCommon.f90 @@ -17,7 +17,7 @@ module NetCDFCommonModule public :: NETCDF_MAX_DIM public :: NETCDF_ATTR_STRLEN public :: nf_verify - public :: gstp + public :: ixstp integer(I4B), parameter :: NETCDF_MAX_DIM = 6 integer(I4B), parameter :: NETCDF_ATTR_STRLEN = 80 @@ -108,17 +108,17 @@ subroutine nf_verify(res, nc_fname) end if end subroutine nf_verify - !> @brief global step count + !> @brief step index for timeseries data !< - function gstp() + function ixstp() use TdisModule, only: kstp, kper, nstp - integer(I4B) :: n, gstp - gstp = kstp + integer(I4B) :: n, ixstp + ixstp = kstp if (kper > 1) then do n = 1, kper - 1 - gstp = gstp + nstp(n) + ixstp = ixstp + nstp(n) end do end if - end function gstp + end function ixstp end module NetCDFCommonModule From c763082ce83ee8aa747123a50cfd56a34a160332 Mon Sep 17 00:00:00 2001 From: mjreno Date: Thu, 24 Apr 2025 17:39:49 -0400 Subject: [PATCH 13/22] review updates --- autotest/test_gwf_disv_uzf.py | 4 ++-- autotest/test_gwf_sfr_inactive02.py | 4 ++-- autotest/test_gwf_uzf01.py | 4 ++-- autotest/test_gwf_vsc01.py | 6 +++--- autotest/test_gwt_henry_nr.py | 8 ++++---- doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn | 2 +- src/Idm/gwf-ghbaidm.f90 | 2 +- src/Model/GroundWaterFlow/gwf-ghba.f90 | 10 +--------- 8 files changed, 16 insertions(+), 24 deletions(-) diff --git a/autotest/test_gwf_disv_uzf.py b/autotest/test_gwf_disv_uzf.py index d1857e18ae4..805ae494ddb 100644 --- a/autotest/test_gwf_disv_uzf.py +++ b/autotest/test_gwf_disv_uzf.py @@ -112,8 +112,8 @@ # Work up the GHB / GHBA boundary ghb_ids = [(ncol - 1) + i * ncol for i in range(nrow)] ghb_spd = [] -abhead = np.full((nlay, ncpl), DNODATA, dtype=np.float64) -acond = np.full((nlay, ncpl), DNODATA, dtype=np.float64) +abhead = np.full((nlay, ncpl), DNODATA, dtype=float) +acond = np.full((nlay, ncpl), DNODATA, dtype=float) cond = 1e4 for k in np.arange(3, 5, 1): for i in ghb_ids: diff --git a/autotest/test_gwf_sfr_inactive02.py b/autotest/test_gwf_sfr_inactive02.py index 9ad8258c689..84dec1054ee 100644 --- a/autotest/test_gwf_sfr_inactive02.py +++ b/autotest/test_gwf_sfr_inactive02.py @@ -67,8 +67,8 @@ def get_model(ws, name, array_input=False): flopy.mf6.ModflowGwfic(gwf, strt=1.0) if array_input: # if False: - bhead = np.full(nlay * nrow * ncol, DNODATA, dtype=np.float64) - cond = np.full(nlay * nrow * ncol, DNODATA, dtype=np.float64) + bhead = np.full(nlay * nrow * ncol, DNODATA, dtype=float) + cond = np.full(nlay * nrow * ncol, DNODATA, dtype=float) bhead[0] = 1.0 cond[0] = 1e6 flopy.mf6.ModflowGwfghba(gwf, bhead=bhead, cond=cond) diff --git a/autotest/test_gwf_uzf01.py b/autotest/test_gwf_uzf01.py index f70d29f8a59..fcdbaeeac2f 100644 --- a/autotest/test_gwf_uzf01.py +++ b/autotest/test_gwf_uzf01.py @@ -104,8 +104,8 @@ def get_model(ws, name, array_input=False): # ghb / ghba if array_input: ghb_obs = {f"{name}.ghb.obs.csv": [("100_1_1", "GHBA", (99, 0, 0))]} - bhead = np.full(nlay * nrow * ncol, DNODATA, dtype=np.float64) - cond = np.full(nlay * nrow * ncol, DNODATA, dtype=np.float64) + bhead = np.full(nlay * nrow * ncol, DNODATA, dtype=float) + cond = np.full(nlay * nrow * ncol, DNODATA, dtype=float) bhead[nlay - 1] = 1.5 cond[nlay - 1] = 1.0 ghb = flopy.mf6.ModflowGwfghba( diff --git a/autotest/test_gwf_vsc01.py b/autotest/test_gwf_vsc01.py index 0050250ea4e..d15af1c058c 100644 --- a/autotest/test_gwf_vsc01.py +++ b/autotest/test_gwf_vsc01.py @@ -136,9 +136,9 @@ def get_model(idx, ws, array_input=False): # Instantiating GHB ghbcond = hydraulic_conductivity[idx] * delv * delc / (0.5 * delr) if array_input: - bhead = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64)} - cond = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64)} - temp = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64)} + bhead = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=float)} + cond = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=float)} + temp = {0: np.full((nlay, nrow, ncol), DNODATA, dtype=float)} for i in range(nrow): bhead[0][0, i, ncol - 1] = top cond[0][0, i, ncol - 1] = ghbcond diff --git a/autotest/test_gwt_henry_nr.py b/autotest/test_gwt_henry_nr.py index caf73ba5ec9..405be6ccc63 100644 --- a/autotest/test_gwt_henry_nr.py +++ b/autotest/test_gwt_henry_nr.py @@ -178,10 +178,10 @@ def get_model(ws, name, array_input=False): sl = sealevelts[kper] drnlist = [] if array_input: - abhead = np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64) - acond = np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64) - aconc = np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64) - adens = np.full((nlay, nrow, ncol), DNODATA, dtype=np.float64) + abhead = np.full((nlay, nrow, ncol), DNODATA, dtype=float) + acond = np.full((nlay, nrow, ncol), DNODATA, dtype=float) + aconc = np.full((nlay, nrow, ncol), DNODATA, dtype=float) + adens = np.full((nlay, nrow, ncol), DNODATA, dtype=float) else: ghblist = [] nbound = 0 diff --git a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn b/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn index 3da446e1aa7..c8ec87a3eeb 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn @@ -43,7 +43,7 @@ name save_flows type keyword reader urword optional true -longname save CHD flows to budget file +longname save GHBA flows to budget file description REPLACE save_flows {'{#1}': 'general-head boundary'} mf6internal ipakcb diff --git a/src/Idm/gwf-ghbaidm.f90 b/src/Idm/gwf-ghbaidm.f90 index 423f450092e..2d8c888a1b9 100644 --- a/src/Idm/gwf-ghbaidm.f90 +++ b/src/Idm/gwf-ghbaidm.f90 @@ -118,7 +118,7 @@ module GwfGhbaInputModule 'IPAKCB', & ! fortran variable 'KEYWORD', & ! type '', & ! shape - 'save CHD flows to budget file', & ! longname + 'save GHBA flows to budget file', & ! longname .false., & ! required .false., & ! multi-record .false., & ! preserve case diff --git a/src/Model/GroundWaterFlow/gwf-ghba.f90 b/src/Model/GroundWaterFlow/gwf-ghba.f90 index 0a0840365d5..3c690721827 100644 --- a/src/Model/GroundWaterFlow/gwf-ghba.f90 +++ b/src/Model/GroundWaterFlow/gwf-ghba.f90 @@ -162,7 +162,7 @@ end subroutine ghba_dimensions !< subroutine ghba_allocate_arrays(this, nodelist, auxvar) ! -- modules - use MemoryManagerModule, only: mem_allocate, mem_setptr, mem_checkin + use MemoryManagerModule, only: mem_setptr, mem_checkin ! -- dummy class(GhbaType) :: this integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist @@ -188,7 +188,6 @@ subroutine ghba_rp(this) ! -- modules use TdisModule, only: kper use ConstantsModule, only: LINELENGTH - use MemoryManagerModule, only: mem_setptr ! -- dummy class(GhbaType), intent(inout) :: this integer(I4B) :: i, noder @@ -236,12 +235,10 @@ end subroutine ghba_rp !< subroutine ghba_ck(this) ! -- modules - use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit ! -- dummy class(GhbaType), intent(inout) :: this ! -- local - character(len=LINELENGTH) :: errmsg integer(I4B) :: i integer(I4B) :: noder real(DP) :: bt @@ -367,9 +364,6 @@ subroutine define_listlabel(this) end if write (this%listlabel, '(a, a16)') trim(this%listlabel), 'STAGE' write (this%listlabel, '(a, a16)') trim(this%listlabel), 'CONDUCTANCE' - if (this%inamedbound == 1) then - write (this%listlabel, '(a, a16)') trim(this%listlabel), 'BOUNDARY NAME' - end if end subroutine define_listlabel ! -- Procedures related to observations @@ -425,7 +419,6 @@ end subroutine ghba_store_user_cond !< function cond_mult(this, row) result(cond) ! -- modules - use ConstantsModule, only: DZERO ! -- dummy variables class(GhbaType), intent(inout) :: this !< BndExtType object integer(I4B), intent(in) :: row @@ -443,7 +436,6 @@ end function cond_mult !< function ghba_bound_value(this, col, row) result(bndval) ! -- modules - use ConstantsModule, only: DZERO ! -- dummy class(GhbaType), intent(inout) :: this !< BndExtType object integer(I4B), intent(in) :: col From dbb7f1ddb0fa671bce19a4bb1e8222282f5e39ca Mon Sep 17 00:00:00 2001 From: mjreno Date: Sat, 26 Apr 2025 09:28:58 -0400 Subject: [PATCH 14/22] add developmode marker to ghba tests --- autotest/test_gwf_disv_uzf.py | 1 + autotest/test_gwf_sfr_inactive02.py | 1 + autotest/test_gwf_uzf01.py | 1 + autotest/test_gwf_vsc01.py | 1 + autotest/test_gwt_henry_nr.py | 1 + autotest/test_netcdf_gwf_disv_uzf.py | 1 + autotest/test_netcdf_gwf_uzf01.py | 1 + autotest/test_netcdf_gwf_vsc01.py | 1 + autotest/test_netcdf_gwt_henry_nr.py | 1 + 9 files changed, 9 insertions(+) diff --git a/autotest/test_gwf_disv_uzf.py b/autotest/test_gwf_disv_uzf.py index 805ae494ddb..2ed63abc5ee 100644 --- a/autotest/test_gwf_disv_uzf.py +++ b/autotest/test_gwf_disv_uzf.py @@ -383,6 +383,7 @@ def check_outputs(idx, test): @pytest.mark.slow +@pytest.mark.developmode @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): test = TestFramework( diff --git a/autotest/test_gwf_sfr_inactive02.py b/autotest/test_gwf_sfr_inactive02.py index 84dec1054ee..349ac397048 100644 --- a/autotest/test_gwf_sfr_inactive02.py +++ b/autotest/test_gwf_sfr_inactive02.py @@ -246,6 +246,7 @@ def check_outputs(idx, test): check_output(ws, name) +@pytest.mark.developmode @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): test = TestFramework( diff --git a/autotest/test_gwf_uzf01.py b/autotest/test_gwf_uzf01.py index fcdbaeeac2f..ad7c8c6949c 100644 --- a/autotest/test_gwf_uzf01.py +++ b/autotest/test_gwf_uzf01.py @@ -270,6 +270,7 @@ def check_outputs(idx, test): check_output(ws, name) +@pytest.mark.developmode @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): test = TestFramework( diff --git a/autotest/test_gwf_vsc01.py b/autotest/test_gwf_vsc01.py index d15af1c058c..03e8270de5a 100644 --- a/autotest/test_gwf_vsc01.py +++ b/autotest/test_gwf_vsc01.py @@ -351,6 +351,7 @@ def check_outputs(idx, test): check_output(idx, ws, array_input=True) +@pytest.mark.developmode @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets): test = TestFramework( diff --git a/autotest/test_gwt_henry_nr.py b/autotest/test_gwt_henry_nr.py index 405be6ccc63..fa5ebd60c7b 100644 --- a/autotest/test_gwt_henry_nr.py +++ b/autotest/test_gwt_henry_nr.py @@ -560,6 +560,7 @@ def check_outputs(idx, test): @pytest.mark.slow +@pytest.mark.developmode @pytest.mark.parametrize("idx, name", enumerate(cases)) def test_mf6model(idx, name, function_tmpdir, targets, plot): test = TestFramework( diff --git a/autotest/test_netcdf_gwf_disv_uzf.py b/autotest/test_netcdf_gwf_disv_uzf.py index df6ac1a39fb..d678c8524b6 100644 --- a/autotest/test_netcdf_gwf_disv_uzf.py +++ b/autotest/test_netcdf_gwf_disv_uzf.py @@ -173,6 +173,7 @@ def check_output(idx, test): @pytest.mark.netcdf +@pytest.mark.developmode @pytest.mark.parametrize( "idx, name", list(enumerate(cases)), diff --git a/autotest/test_netcdf_gwf_uzf01.py b/autotest/test_netcdf_gwf_uzf01.py index c500dc6474d..5a319b0326c 100644 --- a/autotest/test_netcdf_gwf_uzf01.py +++ b/autotest/test_netcdf_gwf_uzf01.py @@ -191,6 +191,7 @@ def check_output(idx, test, export): @pytest.mark.netcdf +@pytest.mark.developmode @pytest.mark.parametrize( "idx, name", list(enumerate(cases)), diff --git a/autotest/test_netcdf_gwf_vsc01.py b/autotest/test_netcdf_gwf_vsc01.py index 950ed6bfb59..51cc8a30eba 100644 --- a/autotest/test_netcdf_gwf_vsc01.py +++ b/autotest/test_netcdf_gwf_vsc01.py @@ -190,6 +190,7 @@ def check_output(idx, test, export): @pytest.mark.netcdf +@pytest.mark.developmode @pytest.mark.parametrize( "idx, name", list(enumerate(cases)), diff --git a/autotest/test_netcdf_gwt_henry_nr.py b/autotest/test_netcdf_gwt_henry_nr.py index c04d0018c59..0e4c75c735f 100644 --- a/autotest/test_netcdf_gwt_henry_nr.py +++ b/autotest/test_netcdf_gwt_henry_nr.py @@ -200,6 +200,7 @@ def check_output(idx, test, export): @pytest.mark.slow @pytest.mark.netcdf +@pytest.mark.developmode @pytest.mark.parametrize( "idx, name", list(enumerate(cases)), From 56242eb8587bc6c79f52fdb6b198a61ec4a8462a Mon Sep 17 00:00:00 2001 From: mjreno Date: Tue, 13 May 2025 13:44:46 -0400 Subject: [PATCH 15/22] apply maxbound to nodelist --- autotest/test_gwf_disv_uzf.py | 4 +- autotest/test_gwf_sfr_inactive02.py | 2 +- autotest/test_gwf_uzf01.py | 1 + autotest/test_gwf_vsc01.py | 1 + autotest/test_gwt_henry_nr.py | 1 + autotest/test_netcdf_gwf_disv_uzf.py | 3 + autotest/test_netcdf_gwf_uzf01.py | 3 + autotest/test_netcdf_gwf_vsc01.py | 3 + autotest/test_netcdf_gwt_henry_nr.py | 3 + doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn | 10 ++ src/Idm/gwf-ghbaidm.f90 | 26 +++++ src/Model/GroundWaterFlow/gwf-ghba.f90 | 96 +++++++++-------- .../ModelUtilities/BoundaryPackageExt.f90 | 7 +- src/Utilities/Export/DisNCMesh.f90 | 83 +++++++++----- src/Utilities/Export/DisNCStructured.f90 | 82 ++++++++++---- src/Utilities/Export/DisvNCMesh.f90 | 76 ++++++++----- src/Utilities/Idm/BoundInputContext.f90 | 21 +++- src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 | 2 +- .../Idm/mf6blockfile/LoadMf6File.f90 | 2 +- .../Idm/mf6blockfile/Mf6FileGridArray.f90 | 101 +++++++++++------- .../Idm/mf6blockfile/Mf6FileLayerArray.f90 | 6 +- .../Idm/mf6blockfile/Mf6FileList.f90 | 6 +- .../Idm/mf6blockfile/Mf6FileStoInput.f90 | 2 +- 23 files changed, 369 insertions(+), 172 deletions(-) diff --git a/autotest/test_gwf_disv_uzf.py b/autotest/test_gwf_disv_uzf.py index 2ed63abc5ee..2a8479317c5 100644 --- a/autotest/test_gwf_disv_uzf.py +++ b/autotest/test_gwf_disv_uzf.py @@ -173,7 +173,9 @@ def get_model(ws, name, array_input=False): # general-head boundary if array_input: - ghb = flopy.mf6.ModflowGwfghba(gwf, print_flows=True, bhead=abhead, cond=acond) + ghb = flopy.mf6.ModflowGwfghba( + gwf, print_flows=True, maxbound=20, bhead=abhead, cond=acond + ) else: ghb = flopy.mf6.ModflowGwfghb(gwf, print_flows=True, stress_period_data=ghb_spd) diff --git a/autotest/test_gwf_sfr_inactive02.py b/autotest/test_gwf_sfr_inactive02.py index 349ac397048..43f8de2a505 100644 --- a/autotest/test_gwf_sfr_inactive02.py +++ b/autotest/test_gwf_sfr_inactive02.py @@ -71,7 +71,7 @@ def get_model(ws, name, array_input=False): cond = np.full(nlay * nrow * ncol, DNODATA, dtype=float) bhead[0] = 1.0 cond[0] = 1e6 - flopy.mf6.ModflowGwfghba(gwf, bhead=bhead, cond=cond) + flopy.mf6.ModflowGwfghba(gwf, maxbound=1, bhead=bhead, cond=cond) else: flopy.mf6.ModflowGwfghb(gwf, stress_period_data=[((0, 0, 0), 1.0, 1e6)]) diff --git a/autotest/test_gwf_uzf01.py b/autotest/test_gwf_uzf01.py index ad7c8c6949c..a19738efe3b 100644 --- a/autotest/test_gwf_uzf01.py +++ b/autotest/test_gwf_uzf01.py @@ -112,6 +112,7 @@ def get_model(ws, name, array_input=False): gwf, print_input=True, print_flows=True, + maxbound=1, bhead=bhead, cond=cond, save_flows=False, diff --git a/autotest/test_gwf_vsc01.py b/autotest/test_gwf_vsc01.py index 03e8270de5a..0354667aabb 100644 --- a/autotest/test_gwf_vsc01.py +++ b/autotest/test_gwf_vsc01.py @@ -145,6 +145,7 @@ def get_model(idx, ws, array_input=False): temp[0][0, i, ncol - 1] = initial_temperature flopy.mf6.ModflowGwfghba( gwf, + maxbound=nrow, pname="GHB-1", auxiliary="temperature", bhead=bhead, diff --git a/autotest/test_gwt_henry_nr.py b/autotest/test_gwt_henry_nr.py index fa5ebd60c7b..5581758812a 100644 --- a/autotest/test_gwt_henry_nr.py +++ b/autotest/test_gwt_henry_nr.py @@ -226,6 +226,7 @@ def get_model(ws, name, array_input=False): print_input=True, print_flows=True, save_flows=False, + maxbound=20, pname="GHB-1", auxiliary=["CONCENTRATION", "DENSITY"], bhead=bheadspd, diff --git a/autotest/test_netcdf_gwf_disv_uzf.py b/autotest/test_netcdf_gwf_disv_uzf.py index d678c8524b6..d4e8b0def24 100644 --- a/autotest/test_netcdf_gwf_disv_uzf.py +++ b/autotest/test_netcdf_gwf_disv_uzf.py @@ -88,6 +88,9 @@ def check_output(idx, test): f.write(" PRINT_INPUT\n") f.write(" PRINT_FLOWS\n") f.write("END options\n\n") + f.write("BEGIN dimensions\n") + f.write(" MAXBOUND 20\n") + f.write("END dimensions\n\n") f.write("BEGIN period 1\n") f.write(" bhead NETCDF\n") f.write(" cond NETCDF\n") diff --git a/autotest/test_netcdf_gwf_uzf01.py b/autotest/test_netcdf_gwf_uzf01.py index 5a319b0326c..b453a0024da 100644 --- a/autotest/test_netcdf_gwf_uzf01.py +++ b/autotest/test_netcdf_gwf_uzf01.py @@ -96,6 +96,9 @@ def check_output(idx, test, export): f.write(" PRINT_FLOWS\n") f.write(" OBS6 FILEIN gwf_uzf01a.ghb.obs\n") f.write("END options\n\n") + f.write("BEGIN dimensions\n") + f.write(" MAXBOUND 1\n") + f.write("END dimensions\n\n") f.write("BEGIN period 1\n") f.write(" bhead NETCDF\n") f.write(" cond NETCDF\n") diff --git a/autotest/test_netcdf_gwf_vsc01.py b/autotest/test_netcdf_gwf_vsc01.py index 51cc8a30eba..a5bd2c37a35 100644 --- a/autotest/test_netcdf_gwf_vsc01.py +++ b/autotest/test_netcdf_gwf_vsc01.py @@ -94,6 +94,9 @@ def check_output(idx, test, export): f.write("BEGIN options\n") f.write(" auxiliary TEMPERATURE\n") f.write("END options\n\n") + f.write("BEGIN dimensions\n") + f.write(" MAXBOUND 10\n") + f.write("END dimensions\n\n") f.write("BEGIN period 1\n") f.write(" bhead NETCDF\n") f.write(" cond NETCDF\n") diff --git a/autotest/test_netcdf_gwt_henry_nr.py b/autotest/test_netcdf_gwt_henry_nr.py index 0e4c75c735f..6bb6db96d60 100644 --- a/autotest/test_netcdf_gwt_henry_nr.py +++ b/autotest/test_netcdf_gwt_henry_nr.py @@ -101,6 +101,9 @@ def check_output(idx, test, export): f.write(" PRINT_INPUT\n") f.write(" PRINT_FLOWS\n") f.write("END options\n\n") + f.write("BEGIN dimensions\n") + f.write(" MAXBOUND 20\n") + f.write("END dimensions\n\n") for i in range(1001): f.write(f"BEGIN period {i + 1}\n") f.write(" bhead NETCDF\n") diff --git a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn b/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn index c8ec87a3eeb..d15f6154e34 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn @@ -109,6 +109,16 @@ longname export array variables to netcdf output files. description keyword that specifies input griddata arrays should be written to the model output netcdf file. extended true +# --------------------- gwf ghba dimensions --------------------- + +block dimensions +name maxbound +type integer +reader urword +optional false +longname maximum number of general-head boundaries in any stress period +description REPLACE maxbound {'{#1}': 'general-head boundary'} + # --------------------- gwf ghba period --------------------- block period diff --git a/src/Idm/gwf-ghbaidm.f90 b/src/Idm/gwf-ghbaidm.f90 index 2d8c888a1b9..1b06e5a2649 100644 --- a/src/Idm/gwf-ghbaidm.f90 +++ b/src/Idm/gwf-ghbaidm.f90 @@ -23,6 +23,7 @@ module GwfGhbaInputModule logical :: obs6_filename = .false. logical :: mover = .false. logical :: export_nc = .false. + logical :: maxbound = .false. logical :: bhead = .false. logical :: cond = .false. logical :: auxvar = .false. @@ -234,6 +235,24 @@ module GwfGhbaInputModule .false. & ! timeseries ) + type(InputParamDefinitionType), parameter :: & + gwfghba_maxbound = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBA', & ! subcomponent + 'DIMENSIONS', & ! block + 'MAXBOUND', & ! tag name + 'MAXBOUND', & ! fortran variable + 'INTEGER', & ! type + '', & ! shape + 'maximum number of general-head boundaries in any stress period', & ! longname + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + type(InputParamDefinitionType), parameter :: & gwfghba_bhead = InputParamDefinitionType & ( & @@ -302,6 +321,7 @@ module GwfGhbaInputModule gwfghba_obs6_filename, & gwfghba_mover, & gwfghba_export_nc, & + gwfghba_maxbound, & gwfghba_bhead, & gwfghba_cond, & gwfghba_auxvar & @@ -338,6 +358,12 @@ module GwfGhbaInputModule .false. & ! block_variable ), & InputBlockDefinitionType( & + 'DIMENSIONS', & ! blockname + .true., & ! required + .false., & ! aggregate + .false. & ! block_variable + ), & + InputBlockDefinitionType( & 'PERIOD', & ! blockname .true., & ! required .false., & ! aggregate diff --git a/src/Model/GroundWaterFlow/gwf-ghba.f90 b/src/Model/GroundWaterFlow/gwf-ghba.f90 index 3c690721827..eea977ce511 100644 --- a/src/Model/GroundWaterFlow/gwf-ghba.f90 +++ b/src/Model/GroundWaterFlow/gwf-ghba.f90 @@ -147,11 +147,8 @@ subroutine ghba_dimensions(this) class(GhbaType), intent(inout) :: this ! -- local ! - ! -- set maxbound - this%maxbound = this%dis%nodesuser - ! - ! -- set nbound, which applies for duration of simulation - this%nbound = this%dis%nodesuser + ! -- source dimensions + call this%BndExtType%source_dimensions() ! ! -- Call define_listlabel to construct the list label that is written ! when PRINT_INPUT option is used. @@ -188,28 +185,31 @@ subroutine ghba_rp(this) ! -- modules use TdisModule, only: kper use ConstantsModule, only: LINELENGTH + use MemoryManagerExtModule, only: mem_set_value ! -- dummy class(GhbaType), intent(inout) :: this - integer(I4B) :: i, noder + integer(I4B) :: i, noder, nodeuser character(len=LINELENGTH) :: nodestr + logical(LGP) :: found ! if (this%iper /= kper) return ! - ! -- Update the nodelist + ! update nbound + call mem_set_value(this%nbound, 'NBOUND', this%input_mempath, & + found) + ! + ! -- Set the nodelist do i = 1, this%nbound - if (this%bhead(i) == DNODATA) then - this%nodelist(i) = 0 + nodeuser = this%nodeulist(i) + noder = this%dis%get_nodenumber(nodeuser, 1) + if (noder >= 0) then + this%nodelist(i) = noder else - noder = this%dis%get_nodenumber(i, 1) - if (noder > 0) then - this%nodelist(i) = noder - else - call this%dis%nodeu_to_string(i, nodestr) - write (errmsg, *) & - ' Cell is outside active grid domain: '// & - trim(adjustl(nodestr)) - call store_error(errmsg) - end if + call this%dis%nodeu_to_string(i, nodestr) + write (errmsg, *) & + ' Cell is outside active grid domain: '// & + trim(adjustl(nodestr)) + call store_error(errmsg) end if end do ! @@ -235,50 +235,49 @@ end subroutine ghba_rp !< subroutine ghba_ck(this) ! -- modules + use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, count_errors, store_error_unit ! -- dummy class(GhbaType), intent(inout) :: this ! -- local + character(len=LINELENGTH) :: errmsg integer(I4B) :: i - integer(I4B) :: noder + integer(I4B) :: node real(DP) :: bt ! -- formats - character(len=*), parameter :: fmtghberr = & + character(len=*), parameter :: fmtghbaerr = & "('GHBA BOUNDARY (',i0,') HEAD (',f10.3,') IS LESS THAN CELL & &BOTTOM (',f10.3,')')" character(len=*), parameter :: fmtcondmulterr = & "('GHBA BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS & - &NO DATA VALUE OR LESS THAN ZERO')" + &LESS THAN ZERO')" character(len=*), parameter :: fmtconderr = & - "('GHBA BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS NO DATA VALUE & - &OR LESS THAN ZERO')" + "('GHBA BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN & + &ZERO')" ! ! -- check stress period data do i = 1, this%nbound - noder = this%nodelist(i) - if (noder == 0) cycle - bt = this%dis%bot(noder) + node = this%nodelist(i) + bt = this%dis%bot(node) ! -- accumulate errors - if (this%bhead(i) < bt .and. this%icelltype(noder) /= 0) then - write (errmsg, fmt=fmtghberr) i, this%bhead(i), bt + if (this%bhead(i) < bt .and. this%icelltype(node) /= 0) then + write (errmsg, fmt=fmtghbaerr) i, this%bhead(i), bt call store_error(errmsg) end if if (this%iauxmultcol > 0) then - if (this%auxvar(this%iauxmultcol, i) == DNODATA .or. & - this%auxvar(this%iauxmultcol, i) < DZERO) then + if (this%auxvar(this%iauxmultcol, i) < DZERO) then write (errmsg, fmt=fmtcondmulterr) & i, this%auxvar(this%iauxmultcol, i) call store_error(errmsg) end if end if - if (this%cond(i) == DNODATA .or. & - this%cond(i) < DZERO) then + if (this%cond(i) < DZERO) then write (errmsg, fmt=fmtconderr) i, this%cond(i) call store_error(errmsg) end if end do ! - !write summary of ghb package error messages + !write summary of ghba package error messages if (count_errors() > 0) then call store_error_unit(this%inunit) end if @@ -286,18 +285,21 @@ end subroutine ghba_ck !> @brief Formulate the HCOF and RHS terms !! - !! Skip if no GHBs + !! Skip if no GHBAs !< subroutine ghba_cf(this) ! -- dummy class(GhbaType) :: this ! -- local - integer(I4B) :: i, noder + integer(I4B) :: i, node + ! + ! -- Return if no ghbas + if (this%nbound .eq. 0) return ! + ! -- Calculate hcof and rhs for each ghba entry do i = 1, this%nbound - noder = this%nodelist(i) - if (noder == 0) cycle - if (this%ibound(noder) .le. 0) then + node = this%nodelist(i) + if (this%ibound(node) .le. 0) then this%hcof(i) = DZERO this%rhs(i) = DZERO cycle @@ -317,27 +319,27 @@ subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) integer(I4B), dimension(:), intent(in) :: idxglo class(MatrixBaseType), pointer :: matrix_sln ! -- local - integer(I4B) :: i, noder, ipos + integer(I4B) :: i, n, ipos real(DP) :: cond, bhead, qghba ! ! -- pakmvrobj fc if (this%imover == 1) then call this%pakmvrobj%fc() end if - + ! + ! -- Copy package rhs and hcof into solution rhs and amat do i = 1, this%nbound - noder = this%nodelist(i) - if (noder == 0) cycle - rhs(noder) = rhs(noder) + this%rhs(i) - ipos = ia(noder) + n = this%nodelist(i) + rhs(n) = rhs(n) + this%rhs(i) + ipos = ia(n) call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) ! ! -- If mover is active and this boundary is discharging, ! store available water (as positive value). bhead = this%bhead(i) - if (this%imover == 1 .and. this%xnew(noder) > bhead) then + if (this%imover == 1 .and. this%xnew(n) > bhead) then cond = this%cond_mult(i) - qghba = cond * (this%xnew(noder) - bhead) + qghba = cond * (this%xnew(n) - bhead) call this%pakmvrobj%accumulate_qformvr(i, qghba) end if end do diff --git a/src/Model/ModelUtilities/BoundaryPackageExt.f90 b/src/Model/ModelUtilities/BoundaryPackageExt.f90 index 17102607c36..ea4a48cdc7d 100644 --- a/src/Model/ModelUtilities/BoundaryPackageExt.f90 +++ b/src/Model/ModelUtilities/BoundaryPackageExt.f90 @@ -32,7 +32,8 @@ module BndExtModule ! -- scalars integer(I4B), pointer :: iper ! -- arrays - integer(I4B), dimension(:, :), pointer, contiguous :: cellid => null() + integer(I4B), dimension(:, :), pointer, contiguous :: cellid => null() !< input user cellid list + integer(I4B), dimension(:), pointer, contiguous :: nodeulist => null() !< input user nodelist contains procedure :: bnd_df => bndext_df procedure :: bnd_rp => bndext_rp @@ -163,6 +164,7 @@ subroutine bndext_da(this) ! ! -- deallocate checkin paths call mem_deallocate(this%cellid, 'CELLID', this%memoryPath) + call mem_deallocate(this%nodeulist, 'NODEULIST', this%memoryPath) call mem_deallocate(this%boundname_cst, 'BOUNDNAME_IDM', this%memoryPath) call mem_deallocate(this%auxvar, 'AUXVAR_IDM', this%memoryPath) ! @@ -226,11 +228,14 @@ subroutine bndext_allocate_arrays(this, nodelist, auxvar) ! ! -- set input context pointers call mem_setptr(this%cellid, 'CELLID', this%input_mempath) + call mem_setptr(this%nodeulist, 'NODEULIST', this%input_mempath) call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%input_mempath) ! ! -- checkin input context pointers call mem_checkin(this%cellid, 'CELLID', this%memoryPath, & 'CELLID', this%input_mempath) + call mem_checkin(this%nodeulist, 'NODEULIST', this%memoryPath, & + 'NODEULIST', this%input_mempath) call mem_checkin(this%boundname_cst, LENBOUNDNAME, 'BOUNDNAME_IDM', & this%memoryPath, 'BOUNDNAME', this%input_mempath) ! diff --git a/src/Utilities/Export/DisNCMesh.f90 b/src/Utilities/Export/DisNCMesh.f90 index 65e616731a9..18976d9f5af 100644 --- a/src/Utilities/Export/DisNCMesh.f90 +++ b/src/Utilities/Export/DisNCMesh.f90 @@ -188,11 +188,12 @@ subroutine package_step(this, export_pkg) class(ExportPackageType), pointer, intent(in) :: export_pkg type(InputParamDefinitionType), pointer :: idt integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:), pointer, contiguous :: dbl1d, nodes real(DP), dimension(:, :), pointer, contiguous :: dbl2d character(len=LINELENGTH) :: nc_tag integer(I4B) :: iaux, iparam, nvals integer(I4B) :: k, n + integer(I4B), pointer :: nbound ! initialize iaux = 0 @@ -229,49 +230,77 @@ subroutine package_step(this, export_pkg) select case (idt%shape) case ('NCPL') this%var_ids%export(1) = export_pkg%varids_param(iparam, 1) + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, & + export_pkg%mf6_input%mempath, nc_tag, & + export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) case ('NODES') + nvals = this%dis%nodesuser + allocate (nodes(nvals)) + nodes = DNODATA do k = 1, this%dis%nlay this%var_ids%export(k) = export_pkg%varids_param(iparam, k) end do + call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) + call mem_setptr(int1d, 'NODEULIST', export_pkg%mf6_input%mempath) + call mem_setptr(nbound, 'NBOUND', export_pkg%mf6_input%mempath) + do n = 1, nbound + nodes(int1d(n)) = dbl1d(n) + end do + call nc_export_dbl1d(nodes, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, & + export_pkg%mf6_input%mempath, nc_tag, & + export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + deallocate (nodes) case default end select - call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, & - this%y_dim, this%var_ids, this%dis, idt, & - export_pkg%mf6_input%mempath, nc_tag, & - export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, kper, iaux, this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) select case (idt%shape) case ('NAUX NCPL') nvals = this%dis%nrow * this%dis%ncol + allocate (nodes(nvals)) + do iaux = 1, size(dbl2d, dim=1) !naux + this%var_ids%export(1) = export_pkg%varids_aux(iaux, 1) + do n = 1, nvals + nodes(n) = dbl2d(iaux, n) + end do + call nc_export_dbl1d(nodes, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, & + export_pkg%mf6_input%mempath, nc_tag, & + export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + end do + deallocate (nodes) case ('NAUX NODES') nvals = this%dis%nodesuser - case default - end select - allocate (dbl1d(nvals)) - do iaux = 1, size(dbl2d, dim=1) !naux - select case (idt%shape) - case ('NAUX NCPL') - this%var_ids%export(1) = export_pkg%varids_aux(iaux, 1) - case ('NAUX NODES') + allocate (nodes(nvals)) + call mem_setptr(int1d, 'NODEULIST', export_pkg%mf6_input%mempath) + call mem_setptr(nbound, 'NBOUND', export_pkg%mf6_input%mempath) + do iaux = 1, size(dbl2d, dim=1) ! naux + nodes = DNODATA do k = 1, this%dis%nlay this%var_ids%export(k) = export_pkg%varids_aux(iaux, k) end do - case default - end select - do n = 1, nvals - dbl1d(n) = dbl2d(iaux, n) + do n = 1, nbound + nodes(int1d(n)) = dbl2d(iaux, n) + end do + call nc_export_dbl1d(nodes, this%ncid, this%dim_ids, this%x_dim, & + this%y_dim, this%var_ids, this%dis, idt, & + export_pkg%mf6_input%mempath, nc_tag, & + export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + end do - call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%x_dim, & - this%y_dim, this%var_ids, this%dis, idt, & - export_pkg%mf6_input%mempath, nc_tag, & - export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, kper, iaux, this%nc_fname) - end do - deallocate (dbl1d) + deallocate (nodes) + case default + end select case default ! no-op, no other datatypes exported end select diff --git a/src/Utilities/Export/DisNCStructured.f90 b/src/Utilities/Export/DisNCStructured.f90 index 310438a0464..9c7984b3d7a 100644 --- a/src/Utilities/Export/DisNCStructured.f90 +++ b/src/Utilities/Export/DisNCStructured.f90 @@ -543,10 +543,11 @@ subroutine package_step(this, export_pkg) class(ExportPackageType), pointer, intent(in) :: export_pkg type(InputParamDefinitionType), pointer :: idt integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:), pointer, contiguous :: dbl1d, nodes real(DP), dimension(:, :), pointer, contiguous :: dbl2d character(len=LINELENGTH) :: nc_tag integer(I4B) :: iaux, iparam, nvals, n + integer(I4B), pointer :: nbound ! initialize iaux = 0 @@ -581,35 +582,74 @@ subroutine package_step(this, export_pkg) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) this%var_ids%export = export_pkg%varids_param(iparam, 1) - call nc_export_array(dbl1d, this%ncid, this%dim_ids, this%var_ids, & - this%dis, idt, export_pkg%mf6_input%mempath, & - nc_tag, export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%latlon, this%deflate, & - this%shuffle, this%chunk_z, this%chunk_y, & - this%chunk_x, kper, iaux, this%nc_fname) + select case (idt%shape) + case ('NCPL') + call nc_export_array(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%latlon, this%deflate, & + this%shuffle, this%chunk_z, this%chunk_y, & + this%chunk_x, kper, iaux, this%nc_fname) + case ('NODES') + nvals = this%dis%nodesuser + allocate (nodes(nvals)) + nodes = DNODATA + call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) + call mem_setptr(int1d, 'NODEULIST', export_pkg%mf6_input%mempath) + call mem_setptr(nbound, 'NBOUND', export_pkg%mf6_input%mempath) + do n = 1, nbound + nodes(int1d(n)) = dbl1d(n) + end do + call nc_export_array(nodes, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%latlon, this%deflate, & + this%shuffle, this%chunk_z, this%chunk_y, & + this%chunk_x, kper, iaux, this%nc_fname) + deallocate (nodes) + case default + end select case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) select case (idt%shape) case ('NAUX NCPL') nvals = this%dis%nrow * this%dis%ncol + allocate (nodes(nvals)) + do iaux = 1, size(dbl2d, dim=1) !naux + this%var_ids%export = export_pkg%varids_aux(iaux, 1) + do n = 1, nvals + nodes(n) = dbl2d(iaux, n) + end do + call nc_export_array(nodes, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%latlon, this%deflate, & + this%shuffle, this%chunk_z, this%chunk_y, & + this%chunk_x, kper, iaux, this%nc_fname) + end do + deallocate (nodes) case ('NAUX NODES') nvals = this%dis%nodesuser + allocate (nodes(nvals)) + call mem_setptr(int1d, 'NODEULIST', export_pkg%mf6_input%mempath) + call mem_setptr(nbound, 'NBOUND', export_pkg%mf6_input%mempath) + do iaux = 1, size(dbl2d, dim=1) ! naux + nodes = DNODATA + this%var_ids%export = export_pkg%varids_aux(iaux, 1) + do n = 1, nbound + nodes(int1d(n)) = dbl2d(iaux, n) + end do + call nc_export_array(nodes, this%ncid, this%dim_ids, this%var_ids, & + this%dis, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%latlon, this%deflate, & + this%shuffle, this%chunk_z, this%chunk_y, & + this%chunk_x, kper, iaux, this%nc_fname) + + end do + deallocate (nodes) case default end select - allocate (dbl1d(nvals)) - do iaux = 1, size(dbl2d, dim=1) !naux - this%var_ids%export = export_pkg%varids_aux(iaux, 1) - do n = 1, nvals - dbl1d(n) = dbl2d(iaux, n) - end do - call nc_export_array(dbl1d, this%ncid, this%dim_ids, this%var_ids, & - this%dis, idt, export_pkg%mf6_input%mempath, & - nc_tag, export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%latlon, this%deflate, & - this%shuffle, this%chunk_z, this%chunk_y, & - this%chunk_x, kper, iaux, this%nc_fname) - end do - deallocate (dbl1d) case default ! no-op, no other datatypes exported end select diff --git a/src/Utilities/Export/DisvNCMesh.f90 b/src/Utilities/Export/DisvNCMesh.f90 index 2ec71f8c0d7..81d79d6d818 100644 --- a/src/Utilities/Export/DisvNCMesh.f90 +++ b/src/Utilities/Export/DisvNCMesh.f90 @@ -187,11 +187,12 @@ subroutine package_step(this, export_pkg) class(ExportPackageType), pointer, intent(in) :: export_pkg type(InputParamDefinitionType), pointer :: idt integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:), pointer, contiguous :: dbl1d, nodes real(DP), dimension(:, :), pointer, contiguous :: dbl2d character(len=LINELENGTH) :: nc_tag integer(I4B) :: iaux, iparam, nvals integer(I4B) :: k, n + integer(I4B), pointer :: nbound ! initialize iaux = 0 @@ -227,47 +228,72 @@ subroutine package_step(this, export_pkg) select case (idt%shape) case ('NCPL') this%var_ids%export(1) = export_pkg%varids_param(iparam, 1) + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) case ('NODES') + nvals = this%disv%nodesuser + allocate (nodes(nvals)) + nodes = DNODATA do k = 1, this%disv%nlay this%var_ids%export(k) = export_pkg%varids_param(iparam, k) end do + call mem_setptr(dbl1d, idt%mf6varname, export_pkg%mf6_input%mempath) + call mem_setptr(int1d, 'NODEULIST', export_pkg%mf6_input%mempath) + call mem_setptr(nbound, 'NBOUND', export_pkg%mf6_input%mempath) + do n = 1, nbound + nodes(int1d(n)) = dbl1d(n) + end do + call nc_export_dbl1d(nodes, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + deallocate (nodes) case default end select - call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & - this%disv, idt, export_pkg%mf6_input%mempath, & - nc_tag, export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, kper, iaux, this%nc_fname) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, export_pkg%mf6_input%mempath) select case (idt%shape) case ('NAUX NCPL') nvals = this%disv%ncpl + allocate (nodes(nvals)) + do iaux = 1, size(dbl2d, dim=1) !naux + this%var_ids%export(1) = export_pkg%varids_aux(iaux, 1) + do n = 1, nvals + nodes(n) = dbl2d(iaux, n) + end do + call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) + end do + deallocate (nodes) case ('NAUX NODES') nvals = this%disv%nodesuser - case default - end select - allocate (dbl1d(nvals)) - do iaux = 1, size(dbl2d, dim=1) !naux - select case (idt%shape) - case ('NAUX NCPL') - this%var_ids%export(1) = export_pkg%varids_aux(iaux, 1) - case ('NAUX NODES') + allocate (nodes(nvals)) + call mem_setptr(int1d, 'NODEULIST', export_pkg%mf6_input%mempath) + call mem_setptr(nbound, 'NBOUND', export_pkg%mf6_input%mempath) + do iaux = 1, size(dbl2d, dim=1) ! naux + nodes = DNODATA do k = 1, this%disv%nlay this%var_ids%export(k) = export_pkg%varids_aux(iaux, k) end do - case default - end select - do n = 1, nvals - dbl1d(n) = dbl2d(iaux, n) + do n = 1, nbound + nodes(int1d(n)) = dbl2d(iaux, n) + end do + call nc_export_dbl1d(nodes, this%ncid, this%dim_ids, this%var_ids, & + this%disv, idt, export_pkg%mf6_input%mempath, & + nc_tag, export_pkg%mf6_input%subcomponent_name, & + this%gridmap_name, this%deflate, this%shuffle, & + this%chunk_face, kper, iaux, this%nc_fname) end do - call nc_export_dbl1d(dbl1d, this%ncid, this%dim_ids, this%var_ids, & - this%disv, idt, export_pkg%mf6_input%mempath, & - nc_tag, export_pkg%mf6_input%subcomponent_name, & - this%gridmap_name, this%deflate, this%shuffle, & - this%chunk_face, kper, iaux, this%nc_fname) - end do - deallocate (dbl1d) + deallocate (nodes) + case default + end select case default ! no-op, no other datatypes exported end select diff --git a/src/Utilities/Idm/BoundInputContext.f90 b/src/Utilities/Idm/BoundInputContext.f90 index e6282c50e84..daeb53c2d21 100644 --- a/src/Utilities/Idm/BoundInputContext.f90 +++ b/src/Utilities/Idm/BoundInputContext.f90 @@ -51,7 +51,9 @@ module BoundInputContextModule real(DP), dimension(:, :), pointer, & contiguous :: auxvar => null() !< auxiliary variable array integer(I4B), dimension(:), pointer, contiguous :: mshape => null() !< model shape - logical(LGP) :: readasarrays !< grid or list based input + logical(LGP) :: readasarrays !< grid or layer array input + logical(LGP) :: readarray_layer !< array layer reader + logical(LGP) :: readarray_grid !< array grid reader type(DynamicPackageParamsType) :: package_params type(ModflowInputType) :: mf6_input !< description of input contains @@ -70,13 +72,16 @@ module BoundInputContextModule !> @brief create boundary input context !! !< - subroutine create(this, mf6_input, readasarrays) + subroutine create(this, mf6_input, readarray_grid, readarray_layer) class(BoundInputContextType) :: this type(ModflowInputType), intent(in) :: mf6_input - logical(LGP), intent(in) :: readasarrays + logical(LGP), intent(in) :: readarray_grid + logical(LGP), intent(in) :: readarray_layer this%mf6_input = mf6_input - this%readasarrays = readasarrays + this%readarray_grid = readarray_grid + this%readarray_layer = readarray_layer + this%readasarrays = readarray_grid .or. readarray_layer ! create the dynamic package input context call this%allocate_scalars() @@ -145,6 +150,7 @@ subroutine allocate_arrays(this) use MemoryManagerExtModule, only: mem_set_value class(BoundInputContextType) :: this integer(I4B), dimension(:, :), pointer, contiguous :: cellid + integer(I4B), dimension(:), pointer, contiguous :: nodeulist ! set auxname_cst and iauxmultcol if (this%naux > 0) then @@ -159,6 +165,11 @@ subroutine allocate_arrays(this) call mem_allocate(cellid, 0, 0, 'CELLID', this%mf6_input%mempath) end if + ! allocate nodeulist + if (.not. this%readarray_grid) then + call mem_allocate(nodeulist, 0, 'NODEULIST', this%mf6_input%mempath) + end if + ! set pointer to BOUNDNAME call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%mf6_input%mempath) @@ -256,7 +267,7 @@ subroutine array_params_create(this, params, nparam, input_name) case ('NCPL', 'NAUX NCPL') asize = this%ncpl case ('NODES', 'NAUX NODES') - asize = this%nodes + asize = this%maxbound case default asize = 0 end select diff --git a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 index 770cd7c3f76..4628eae65ba 100644 --- a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 @@ -14,7 +14,7 @@ module IdmMf6FileModule use ConstantsModule, only: LINELENGTH use SimModule, only: store_error, store_error_filename use BlockParserModule, only: BlockParserType - use ModflowInputModule, only: ModflowInputType, getModflowInput + use ModflowInputModule, only: ModflowInputType use InputLoadTypeModule, only: StaticPkgLoadBaseType, DynamicPkgLoadBaseType use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType use NCFileVarsModule, only: NCPackageVarsType diff --git a/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 b/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 index 5545e03ed54..486207d3c57 100644 --- a/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 @@ -26,7 +26,7 @@ module LoadMf6FileModule use InputDefinitionModule, only: InputParamDefinitionType use DefinitionSelectModule, only: get_param_definition_type, & get_aggregate_definition_type - use ModflowInputModule, only: ModflowInputType, getModflowInput + use ModflowInputModule, only: ModflowInputType use MemoryManagerModule, only: mem_allocate, mem_setptr use MemoryHelperModule, only: create_mem_path use StructArrayModule, only: StructArrayType diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 index 712776c0f6f..18e9a03169a 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 @@ -13,10 +13,10 @@ module GridArrayLoadModule 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 MemoryManagerModule, only: mem_allocate, mem_setptr use CharacterStringModule, only: CharacterStringType use BlockParserModule, only: BlockParserType - use ModflowInputModule, only: ModflowInputType, getModflowInput + use ModflowInputModule, only: ModflowInputType use BoundInputContextModule, only: BoundInputContextType, ReadStateVarType use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType @@ -29,6 +29,7 @@ module GridArrayLoadModule type, extends(AsciiDynamicPkgLoadBaseType) :: GridArrayLoadType type(ReadStateVarType), dimension(:), allocatable :: param_reads !< read states for current load type(BoundInputContextType) :: bound_context + integer(I4B), dimension(:), pointer, contiguous :: nodeulist contains procedure :: ainit procedure :: df @@ -69,7 +70,13 @@ subroutine ainit(this, mf6_input, component_name, & call loader%load(parser, mf6_input, this%nc_vars, this%input_name, iout) ! initialize input context memory - call this%bound_context%create(mf6_input, this%readarray_grid) + call this%bound_context%create(mf6_input, & + readarray_grid=.true., & + readarray_layer=.false.) + + ! allocate user nodelist + call mem_allocate(this%nodeulist, this%bound_context%maxbound, & + 'NODEULIST', mf6_input%mempath) ! allocate dfn params call this%params_alloc() @@ -84,7 +91,6 @@ subroutine ad(this) end subroutine ad subroutine rp(this, parser) - use MemoryManagerModule, only: mem_setptr use BlockParserModule, only: BlockParserType use InputDefinitionModule, only: InputParamDefinitionType use DefinitionSelectModule, only: get_param_definition_type @@ -148,7 +154,9 @@ subroutine rp(this, parser) end subroutine rp subroutine destroy(this) + use MemoryManagerModule, only: mem_deallocate class(GridArrayLoadType), intent(inout) :: this + call mem_deallocate(this%nodeulist) end subroutine destroy subroutine reset(this) @@ -156,13 +164,15 @@ subroutine reset(this) class(GridArrayLoadType), intent(inout) :: this integer(I4B) :: n, m + this%bound_context%nbound = 0 + do n = 1, this%nparam ! reset read state this%param_reads(n)%invar = 0 end do ! explicitly reset auxvar array each period - do m = 1, this%bound_context%nodes + do m = 1, this%bound_context%maxbound do n = 1, this%bound_context%naux this%bound_context%auxvar(n, m) = DZERO end do @@ -196,15 +206,12 @@ end subroutine params_alloc subroutine param_load(this, parser, idt, mempath, layered, netcdf, iaux) use TdisModule, only: kper use ConstantsModule, only: DNODATA - 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 LayeredArrayReaderModule, only: read_dbl1d_layered, & - read_int1d_layered + use LayeredArrayReaderModule, only: read_dbl1d_layered use LoadNCInputModule, only: netcdf_read_array use SourceCommonModule, only: get_shape_from_string, get_layered_shape use IdmLoggerModule, only: idm_log_var @@ -214,60 +221,77 @@ subroutine param_load(this, parser, idt, mempath, layered, netcdf, iaux) character(len=*), intent(in) :: mempath logical(LGP), intent(in) :: layered logical(LGP), intent(in) :: netcdf - integer(I4B), dimension(:), pointer, contiguous :: int1d - real(DP), dimension(:), pointer, contiguous :: dbl1d + real(DP), dimension(:), pointer, contiguous :: dbl1d, nodes real(DP), dimension(:, :), pointer, contiguous :: dbl2d integer(I4B), dimension(:), allocatable :: layer_shape - integer(I4B) :: iaux, iparam, n, nlay + integer(I4B) :: iaux, iparam, n, nlay, nnode + + nnode = 0 select case (idt%datatype) - case ('INTEGER1D') - call mem_setptr(int1d, idt%mf6varname, mempath) - if (netcdf) then - call netcdf_read_array(int1d, this%bound_context%mshape, idt, & - this%mf6_input, this%nc_vars, this%input_name, & - this%iout, kper) - else if (layered) then - call get_layered_shape(this%bound_context%mshape, nlay, layer_shape) - call read_int1d_layered(parser, int1d, idt%mf6varname, nlay, layer_shape) - else - call read_int1d(parser, int1d, idt%mf6varname) - end if - call idm_log_var(int1d, idt%tagname, mempath, this%iout) case ('DOUBLE1D') call mem_setptr(dbl1d, idt%mf6varname, mempath) + allocate (nodes(this%bound_context%nodes)) if (netcdf) then - call netcdf_read_array(dbl1d, this%bound_context%mshape, idt, & + call netcdf_read_array(nodes, this%bound_context%mshape, idt, & this%mf6_input, this%nc_vars, this%input_name, & this%iout, kper) else if (layered) then call get_layered_shape(this%bound_context%mshape, nlay, layer_shape) - call read_dbl1d_layered(parser, dbl1d, idt%mf6varname, nlay, layer_shape) + call read_dbl1d_layered(parser, nodes, idt%mf6varname, nlay, layer_shape) else - call read_dbl1d(parser, dbl1d, idt%mf6varname) + call read_dbl1d(parser, nodes, idt%mf6varname) end if - call idm_log_var(dbl1d, idt%tagname, mempath, this%iout) + + call idm_log_var(nodes, idt%tagname, mempath, this%iout) + + do n = 1, this%bound_context%nodes + if (nodes(n) /= DNODATA) then + nnode = nnode + 1 + dbl1d(nnode) = nodes(n) + if (this%bound_context%nbound == 0) then + this%nodeulist(nnode) = n + else if (this%nodeulist(nnode) /= n) then + write (errmsg, '(a,i0)') 'Grid input position mismatch param='// & + trim(idt%tagname)//', period=', kper + call store_error(errmsg) + call store_error_filename(this%input_name) + end if + end if + end do + deallocate (nodes) case ('DOUBLE2D') call mem_setptr(dbl2d, idt%mf6varname, mempath) - allocate (dbl1d(this%bound_context%nodes)) + allocate (nodes(this%bound_context%nodes)) if (netcdf) then - call netcdf_read_array(dbl1d, this%bound_context%mshape, idt, & + call netcdf_read_array(nodes, this%bound_context%mshape, idt, & this%mf6_input, this%nc_vars, this%input_name, & this%iout, kper, iaux) else if (layered) then call get_layered_shape(this%bound_context%mshape, nlay, layer_shape) - call read_dbl1d_layered(parser, dbl1d, idt%mf6varname, nlay, layer_shape) + call read_dbl1d_layered(parser, nodes, idt%mf6varname, nlay, layer_shape) else - call read_dbl1d(parser, dbl1d, idt%mf6varname) + call read_dbl1d(parser, nodes, idt%mf6varname) end if + call idm_log_var(nodes, idt%tagname, mempath, this%iout) + do n = 1, this%bound_context%nodes - dbl2d(iaux, n) = dbl1d(n) + if (nodes(n) /= DNODATA) then + nnode = nnode + 1 + dbl2d(iaux, nnode) = nodes(n) + if (this%bound_context%nbound == 0) then + this%nodeulist(nnode) = n + else if (this%nodeulist(nnode) /= n) then + write (errmsg, '(a,i0)') 'Grid input position mismatch param='// & + trim(idt%tagname)//', period=', kper + call store_error(errmsg) + call store_error_filename(this%input_name) + end if + end if end do - - call idm_log_var(dbl1d, idt%tagname, mempath, this%iout) - deallocate (dbl1d) + deallocate (nodes) case default errmsg = 'IDM unimplemented. GridArrayLoad::param_load & &datatype='//trim(idt%datatype) @@ -275,6 +299,9 @@ subroutine param_load(this, parser, idt, mempath, layered, netcdf, iaux) call store_error_filename(this%input_name) end select + ! set nbound + if (this%bound_context%nbound == 0) this%bound_context%nbound = nnode + ! if param is tracked set read state iparam = ifind(this%param_names, idt%tagname) if (iparam > 0) then diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 index 864bc69fa41..682a1be7d02 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 @@ -16,7 +16,7 @@ module LayerArrayLoadModule use MemoryManagerModule, only: mem_allocate, mem_reallocate, mem_setptr use CharacterStringModule, only: CharacterStringType use BlockParserModule, only: BlockParserType - use ModflowInputModule, only: ModflowInputType, getModflowInput + use ModflowInputModule, only: ModflowInputType use BoundInputContextModule, only: BoundInputContextType, ReadStateVarType use TimeArraySeriesManagerModule, only: TimeArraySeriesManagerType, & tasmanager_cr @@ -104,7 +104,9 @@ subroutine ainit(this, mf6_input, component_name, & end if ! initialize input context memory - call this%bound_context%create(mf6_input, this%readarray_layer) + call this%bound_context%create(mf6_input, & + readarray_grid=.false., & + readarray_layer=.true.) ! allocate dfn params call this%params_alloc() diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 index 5ccebd457ff..30dd91d4802 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 @@ -11,7 +11,7 @@ module ListLoadModule use InputDefinitionModule, only: InputParamDefinitionType use MemoryManagerModule, only: mem_setptr use CharacterStringModule, only: CharacterStringType - use ModflowInputModule, only: ModflowInputType, getModflowInput + use ModflowInputModule, only: ModflowInputType use TimeSeriesManagerModule, only: TimeSeriesManagerType, tsmanager_cr use StructArrayModule, only: StructArrayType, constructStructArray, & destructStructArray @@ -98,7 +98,9 @@ subroutine ainit(this, mf6_input, component_name, component_input_name, & end if ! initialize package input context - call this%bound_context%create(mf6_input, .false.) + call this%bound_context%create(mf6_input, & + readarray_grid=.false., & + readarray_layer=.false.) ! store in scope SA cols for list input call this%bound_context%bound_params(this%param_names, this%nparam, & diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileStoInput.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileStoInput.f90 index 2648724f108..16ed3f780a3 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileStoInput.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileStoInput.f90 @@ -9,7 +9,7 @@ module Mf6FileStoInputModule use ConstantsModule, only: LINELENGTH use InputDefinitionModule, only: InputParamDefinitionType use MemoryManagerModule, only: mem_setptr, mem_allocate - use ModflowInputModule, only: ModflowInputType, getModflowInput + use ModflowInputModule, only: ModflowInputType use AsciiInputLoadTypeModule, only: AsciiDynamicPkgLoadBaseType implicit none From 26846f0a8112892ee1e45d06f37146a3b6bbee01 Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 2 Jun 2025 16:04:19 -0400 Subject: [PATCH 16/22] consolidate ghb package code --- autotest/test_gwf_disv_uzf.py | 4 +- autotest/test_gwf_sfr_inactive02.py | 2 +- autotest/test_gwf_uzf01.py | 6 +- autotest/test_gwf_vsc01.py | 7 +- autotest/test_gwt_henry_nr.py | 4 +- autotest/test_netcdf_gwf_disv_uzf.py | 13 +- autotest/test_netcdf_gwf_uzf01.py | 15 +- autotest/test_netcdf_gwf_vsc01.py | 11 +- autotest/test_netcdf_gwt_henry_nr.py | 19 +- .../dfn/{gwf-ghba.dfn => gwf-ghbg.dfn} | 17 +- msvs/mf6core.vfproj | 3 +- src/Idm/{gwf-ghbaidm.f90 => gwf-ghbgidm.f90} | 144 +++--- src/Idm/selector/IdmGwfDfnSelector.f90 | 24 +- src/Model/GroundWaterFlow/gwf-buy.f90 | 67 --- src/Model/GroundWaterFlow/gwf-ghb.f90 | 16 +- src/Model/GroundWaterFlow/gwf-ghba.f90 | 461 ------------------ src/Model/GroundWaterFlow/gwf-vsc.f90 | 22 +- src/Model/GroundWaterFlow/gwf.f90 | 12 +- .../ModelUtilities/BoundaryPackageExt.f90 | 69 ++- src/Utilities/Export/NCExportCreate.f90 | 2 +- src/Utilities/Idm/BoundInputContext.f90 | 18 +- src/Utilities/Idm/InputLoadType.f90 | 23 +- src/Utilities/Idm/ModflowInput.f90 | 13 +- src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 | 17 +- .../Idm/mf6blockfile/Mf6FileGridArray.f90 | 4 +- .../Idm/mf6blockfile/Mf6FileLayerArray.f90 | 4 +- .../Idm/mf6blockfile/Mf6FileList.f90 | 4 +- src/meson.build | 3 +- utils/idmloader/dfns.txt | 2 +- 29 files changed, 275 insertions(+), 731 deletions(-) rename doc/mf6io/mf6ivar/dfn/{gwf-ghba.dfn => gwf-ghbg.dfn} (81%) rename src/Idm/{gwf-ghbaidm.f90 => gwf-ghbgidm.f90} (74%) delete mode 100644 src/Model/GroundWaterFlow/gwf-ghba.f90 diff --git a/autotest/test_gwf_disv_uzf.py b/autotest/test_gwf_disv_uzf.py index 2a8479317c5..787c821642a 100644 --- a/autotest/test_gwf_disv_uzf.py +++ b/autotest/test_gwf_disv_uzf.py @@ -109,7 +109,7 @@ uzf_spd.update({t: spd}) -# Work up the GHB / GHBA boundary +# Work up the GHB / GHBG boundary ghb_ids = [(ncol - 1) + i * ncol for i in range(nrow)] ghb_spd = [] abhead = np.full((nlay, ncpl), DNODATA, dtype=float) @@ -173,7 +173,7 @@ def get_model(ws, name, array_input=False): # general-head boundary if array_input: - ghb = flopy.mf6.ModflowGwfghba( + ghb = flopy.mf6.ModflowGwfghbg( gwf, print_flows=True, maxbound=20, bhead=abhead, cond=acond ) else: diff --git a/autotest/test_gwf_sfr_inactive02.py b/autotest/test_gwf_sfr_inactive02.py index 43f8de2a505..41858dedbb8 100644 --- a/autotest/test_gwf_sfr_inactive02.py +++ b/autotest/test_gwf_sfr_inactive02.py @@ -71,7 +71,7 @@ def get_model(ws, name, array_input=False): cond = np.full(nlay * nrow * ncol, DNODATA, dtype=float) bhead[0] = 1.0 cond[0] = 1e6 - flopy.mf6.ModflowGwfghba(gwf, maxbound=1, bhead=bhead, cond=cond) + flopy.mf6.ModflowGwfghbg(gwf, maxbound=1, bhead=bhead, cond=cond) else: flopy.mf6.ModflowGwfghb(gwf, stress_period_data=[((0, 0, 0), 1.0, 1e6)]) diff --git a/autotest/test_gwf_uzf01.py b/autotest/test_gwf_uzf01.py index a19738efe3b..78fb72eec3b 100644 --- a/autotest/test_gwf_uzf01.py +++ b/autotest/test_gwf_uzf01.py @@ -101,14 +101,14 @@ def get_model(ws, name, array_input=False): transient={0: True}, ) - # ghb / ghba + # ghb / ghbg if array_input: - ghb_obs = {f"{name}.ghb.obs.csv": [("100_1_1", "GHBA", (99, 0, 0))]} + ghb_obs = {f"{name}.ghb.obs.csv": [("100_1_1", "GHB", (99, 0, 0))]} bhead = np.full(nlay * nrow * ncol, DNODATA, dtype=float) cond = np.full(nlay * nrow * ncol, DNODATA, dtype=float) bhead[nlay - 1] = 1.5 cond[nlay - 1] = 1.0 - ghb = flopy.mf6.ModflowGwfghba( + ghb = flopy.mf6.ModflowGwfghbg( gwf, print_input=True, print_flows=True, diff --git a/autotest/test_gwf_vsc01.py b/autotest/test_gwf_vsc01.py index 0354667aabb..170945794ee 100644 --- a/autotest/test_gwf_vsc01.py +++ b/autotest/test_gwf_vsc01.py @@ -143,7 +143,7 @@ def get_model(idx, ws, array_input=False): bhead[0][0, i, ncol - 1] = top cond[0][0, i, ncol - 1] = ghbcond temp[0][0, i, ncol - 1] = initial_temperature - flopy.mf6.ModflowGwfghba( + flopy.mf6.ModflowGwfghbg( gwf, maxbound=nrow, pname="GHB-1", @@ -269,10 +269,7 @@ def check_output(idx, ws, array_input=False): fname = os.path.join(ws, fname) assert os.path.isfile(fname) budobj = flopy.utils.CellBudgetFile(fname, precision="double") - if array_input: - outbud = budobj.get_data(text=" GHBA") - else: - outbud = budobj.get_data(text=" GHB") + outbud = budobj.get_data(text=" GHB") # Establish known answer: stored_ans = -151.63446156218242 diff --git a/autotest/test_gwt_henry_nr.py b/autotest/test_gwt_henry_nr.py index 5581758812a..73ad6b1ec78 100644 --- a/autotest/test_gwt_henry_nr.py +++ b/autotest/test_gwt_henry_nr.py @@ -219,9 +219,9 @@ def get_model(ws, name, array_input=False): auxiliary="CONCENTRATION", ) - # ghb / ghba + # ghb / ghbg if array_input: - ghb1 = flopy.mf6.ModflowGwfghba( + ghb1 = flopy.mf6.ModflowGwfghbg( gwf, print_input=True, print_flows=True, diff --git a/autotest/test_netcdf_gwf_disv_uzf.py b/autotest/test_netcdf_gwf_disv_uzf.py index d4e8b0def24..0b5b9464f67 100644 --- a/autotest/test_netcdf_gwf_disv_uzf.py +++ b/autotest/test_netcdf_gwf_disv_uzf.py @@ -1,7 +1,7 @@ """ NetCDF test version of test_gwf_disv_uzf. The primary aim is to test -that GHBA package NetCDF array input (bhead and cond) gives the same -results as test_gwf_disv_uzf list based (GHB) and array based (GHBA) +that GHBG package NetCDF array input (bhead and cond) gives the same +results as test_gwf_disv_uzf list based (GHB) and array based (GHBG) ascii input runs. This test compares heads in the the NetCDF file to those in the FloPy binary output head file. """ @@ -35,7 +35,7 @@ def build_models(idx, test): sim, mc = build(idx, test) gwf = mc.gwf[0] - gwf.get_package("GHBA_0").export_array_netcdf = True + gwf.get_package("GHBG_0").export_array_netcdf = True name = cases[idx] @@ -50,7 +50,7 @@ def check_output(idx, test): name = test.name ws = Path(test.workspace / "mf6") - # check outputs of GHB / GHBA ascii input runs + # check outputs of GHB / GHBG ascii input runs check(test.workspace, name) check(ws, name) @@ -77,14 +77,15 @@ def check_output(idx, test): f.write(f" IC6 {name}.ic ic\n") f.write(f" NPF6 {name}.npf npf\n") f.write(f" STO6 {name}.sto sto\n") - f.write(f" GHBA6 {name}.ghba ghba_0\n") + f.write(f" GHB6 {name}.ghbg ghbg_0\n") f.write(f" UZF6 {name}.uzf uzf_0\n") f.write(f" OC6 {name}.oc oc\n") f.write(f" OBS6 {name}.obs head_obs\n") f.write("END packages\n") - with open(ws / f"{name}.ghba", "w") as f: + with open(ws / f"{name}.ghbg", "w") as f: f.write("BEGIN options\n") + f.write(" READARRAYGRID\n") f.write(" PRINT_INPUT\n") f.write(" PRINT_FLOWS\n") f.write("END options\n\n") diff --git a/autotest/test_netcdf_gwf_uzf01.py b/autotest/test_netcdf_gwf_uzf01.py index b453a0024da..321d9e3b23d 100644 --- a/autotest/test_netcdf_gwf_uzf01.py +++ b/autotest/test_netcdf_gwf_uzf01.py @@ -1,7 +1,7 @@ """ NetCDF test version of test_gwf_uzf01. The primary aim is to test -that GHBA package NetCDF array input (bhead and cond) gives the same -results as test_gwf_uzf01 list based (GHB) and array based (GHBA) +that GHBG package NetCDF array input (bhead and cond) gives the same +results as test_gwf_uzf01 list based (GHB) and array based (GHBG) ascii input runs. This test compares heads in the the NetCDF file to those in the FloPy binary output head file. """ @@ -37,8 +37,8 @@ def build_models(idx, test, export): sim, mc = build(idx, test) gwf = mc.gwf[0] - ghba = gwf.get_package("GHBA_0") - ghba.export_array_netcdf = True + ghbg = gwf.get_package("GHBG_0") + ghbg.export_array_netcdf = True if export == "ugrid": gwf.name_file.nc_mesh2d_filerecord = f"{name}.nc" @@ -54,7 +54,7 @@ def check_output(idx, test, export): name = test.name ws = Path(test.workspace / "mf6") - # check outputs of GHB / GHBA ascii input runs + # check outputs of GHB / GHBG ascii input runs check(test.workspace, name) check(ws, name) @@ -84,14 +84,15 @@ def check_output(idx, test, export): f.write(f" IC6 {name}.ic ic\n") f.write(f" NPF6 {name}.npf npf\n") f.write(f" STO6 {name}.sto sto\n") - f.write(f" GHBA6 {name}.ghba ghba_0\n") + f.write(f" GHB6 {name}.ghbg ghbg_0\n") f.write(f" UZF6 {name}.uzf uzf_0\n") f.write(f" OC6 {name}.oc oc\n") f.write(f" OBS6 {name}.obs head_obs\n") f.write("END packages\n") - with open(ws / f"{name}.ghba", "w") as f: + with open(ws / f"{name}.ghbg", "w") as f: f.write("BEGIN options\n") + f.write(" READARRAYGRID\n") f.write(" PRINT_INPUT\n") f.write(" PRINT_FLOWS\n") f.write(" OBS6 FILEIN gwf_uzf01a.ghb.obs\n") diff --git a/autotest/test_netcdf_gwf_vsc01.py b/autotest/test_netcdf_gwf_vsc01.py index a5bd2c37a35..4a89275e894 100644 --- a/autotest/test_netcdf_gwf_vsc01.py +++ b/autotest/test_netcdf_gwf_vsc01.py @@ -1,8 +1,8 @@ """ NetCDF test version of test_gwf_vsc01. The primary aim is to test -that GHBA package NetCDF array input (bhead, cond, and temperature +that GHBG package NetCDF array input (bhead, cond, and temperature auxiliary arrays) gives the same results as test_gwf_vsc01 list based -(GHB) and array based (GHBA) ascii input runs. This test compares +(GHB) and array based (GHBG) ascii input runs. This test compares heads in the the NetCDF file to those in the FloPy binary output head file. """ @@ -55,7 +55,7 @@ def check_output(idx, test, export): name = "gwf-" + test.name ws = Path(test.workspace / "mf6") - # check outputs of GHB / GHBA ascii input runs + # check outputs of GHB / GHBG ascii input runs check(idx, test.workspace, array_input=False) check(idx, ws, array_input=True) @@ -85,13 +85,14 @@ def check_output(idx, test, export): f.write(f" IC6 {name}.ic ic\n") if viscosity_on[idx]: f.write(f" VSC6 {name}.vsc vsc\n") - f.write(f" GHBA6 {name}.ghba ghb-1\n") + f.write(f" GHB6 {name}.ghbg ghb-1\n") f.write(f" CHD6 {name}.chd chd-1\n") f.write(f" OC6 {name}.oc oc\n") f.write("END packages\n") - with open(ws / f"{name}.ghba", "w") as f: + with open(ws / f"{name}.ghbg", "w") as f: f.write("BEGIN options\n") + f.write(" READARRAYGRID\n") f.write(" auxiliary TEMPERATURE\n") f.write("END options\n\n") f.write("BEGIN dimensions\n") diff --git a/autotest/test_netcdf_gwt_henry_nr.py b/autotest/test_netcdf_gwt_henry_nr.py index 6bb6db96d60..91a70bc39dc 100644 --- a/autotest/test_netcdf_gwt_henry_nr.py +++ b/autotest/test_netcdf_gwt_henry_nr.py @@ -1,8 +1,8 @@ """ NetCDF test version of test_gwt_henry_nr. The primary aim is to test -that GHBA package NetCDF array input (bhead, cond, concentration and +that GHBG package NetCDF array input (bhead, cond, concentration and density auxiliary arrays) gives the same results as test_gwt_henry_nr -list based (GHB) and array based (GHBA) ascii input runs. This test +list based (GHB) and array based (GHBG) ascii input runs. This test compares heads in the the NetCDF file to those in the FloPy binary output head file. """ @@ -54,14 +54,14 @@ def check_output(idx, test, export): from test_gwt_henry_nr import check_output as check name = "gwf_" + test.name - ghba_ws = Path(test.workspace / "mf6") + ghbg_ws = Path(test.workspace / "mf6") ws = Path(test.workspace / "mf6" / "netcdf") - shutil.copytree(ghba_ws, ws) + shutil.copytree(ghbg_ws, ws) - # check outputs of GHB / GHBA ascii input runs + # check outputs of GHB / GHBG ascii input runs check(test.workspace, test.name, test.sims[0]) # check(ws, test.name, test.sims[0]) - check(ghba_ws, test.name, test.sims[0]) + check(ghbg_ws, test.name, test.sims[0]) # verify format of generated netcdf file with nc.Dataset(ws / f"{name}.nc") as ds: @@ -90,13 +90,14 @@ def check_output(idx, test, export): f.write(f" STO6 {name}.sto sto\n") f.write(f" BUY6 {name}.buy buy\n") f.write(f" DRN6 {name}.drn drn-1\n") - f.write(f" GHBA6 {name}.ghba ghb-1\n") + f.write(f" GHB6 {name}.ghbg ghb-1\n") f.write(f" WEL6 {name}.wel wel-1\n") f.write(f" OC6 {name}.oc oc\n") f.write("END packages\n") - with open(ws / f"{name}.ghba", "w") as f: + with open(ws / f"{name}.ghbg", "w") as f: f.write("BEGIN options\n") + f.write(" READARRAYGRID\n") f.write(" auxiliary CONCENTRATION DENSITY\n") f.write(" PRINT_INPUT\n") f.write(" PRINT_FLOWS\n") @@ -132,7 +133,7 @@ def check_output(idx, test, export): names = [name, "gwt_" + test.name] for i, e in enumerate(ext): fpth1 = os.path.join( - ghba_ws, + ghbg_ws, f"{names[i]}.{e}", ) fpth2 = os.path.join(ws, f"{names[i]}.{e}") diff --git a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn b/doc/mf6io/mf6ivar/dfn/gwf-ghbg.dfn similarity index 81% rename from doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn rename to doc/mf6io/mf6ivar/dfn/gwf-ghbg.dfn index d15f6154e34..f64486dcf7a 100644 --- a/doc/mf6io/mf6ivar/dfn/gwf-ghba.dfn +++ b/doc/mf6io/mf6ivar/dfn/gwf-ghbg.dfn @@ -1,7 +1,16 @@ -# --------------------- gwf ghba options --------------------- +# --------------------- gwf ghbg options --------------------- # flopy multi-package # package-type stress-package +block options +name readarraygrid +type keyword +reader urword +optional false +longname use array-based grid input +description indicates that array-based grid input will be used for the general-head boundary package. This keyword must be specified to use array-based grid input. When READARRAYGRID is specified, values must be provided for every cell within a model grid, even those cells that have an IDOMAIN value less than one. Values assigned to cells with IDOMAIN values less than one are not used and have no effect on simulation results. No data cells should contain the value DNODATA (3.0E+30). +default_value True + block options name auxiliary type string @@ -43,7 +52,7 @@ name save_flows type keyword reader urword optional true -longname save GHBA flows to budget file +longname save GHBG flows to budget file description REPLACE save_flows {'{#1}': 'general-head boundary'} mf6internal ipakcb @@ -109,7 +118,7 @@ longname export array variables to netcdf output files. description keyword that specifies input griddata arrays should be written to the model output netcdf file. extended true -# --------------------- gwf ghba dimensions --------------------- +# --------------------- gwf ghbg dimensions --------------------- block dimensions name maxbound @@ -119,7 +128,7 @@ optional false longname maximum number of general-head boundaries in any stress period description REPLACE maxbound {'{#1}': 'general-head boundary'} -# --------------------- gwf ghba period --------------------- +# --------------------- gwf ghbg period --------------------- block period name iper diff --git a/msvs/mf6core.vfproj b/msvs/mf6core.vfproj index fb0e37f701a..442825324d1 100644 --- a/msvs/mf6core.vfproj +++ b/msvs/mf6core.vfproj @@ -175,7 +175,7 @@ - + @@ -277,7 +277,6 @@ - diff --git a/src/Idm/gwf-ghbaidm.f90 b/src/Idm/gwf-ghbgidm.f90 similarity index 74% rename from src/Idm/gwf-ghbaidm.f90 rename to src/Idm/gwf-ghbgidm.f90 index 1b06e5a2649..cc1a685ed10 100644 --- a/src/Idm/gwf-ghbaidm.f90 +++ b/src/Idm/gwf-ghbgidm.f90 @@ -1,17 +1,18 @@ ! ** Do Not Modify! MODFLOW 6 system generated file. ** -module GwfGhbaInputModule +module GwfGhbgInputModule use ConstantsModule, only: LENVARNAME use InputDefinitionModule, only: InputParamDefinitionType, & InputBlockDefinitionType private - public gwf_ghba_param_definitions - public gwf_ghba_aggregate_definitions - public gwf_ghba_block_definitions - public GwfGhbaParamFoundType - public gwf_ghba_multi_package - public gwf_ghba_subpackages + public gwf_ghbg_param_definitions + public gwf_ghbg_aggregate_definitions + public gwf_ghbg_block_definitions + public GwfGhbgParamFoundType + public gwf_ghbg_multi_package + public gwf_ghbg_subpackages - type GwfGhbaParamFoundType + type GwfGhbgParamFoundType + logical :: readarraygrid = .false. logical :: auxiliary = .false. logical :: auxmultname = .false. logical :: iprpak = .false. @@ -27,21 +28,39 @@ module GwfGhbaInputModule logical :: bhead = .false. logical :: cond = .false. logical :: auxvar = .false. - end type GwfGhbaParamFoundType + end type GwfGhbgParamFoundType - logical :: gwf_ghba_multi_package = .true. + logical :: gwf_ghbg_multi_package = .true. character(len=16), parameter :: & - gwf_ghba_subpackages(*) = & + gwf_ghbg_subpackages(*) = & [ & ' ' & ] type(InputParamDefinitionType), parameter :: & - gwfghba_auxiliary = InputParamDefinitionType & + gwfghbg_readarraygrid = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent + 'OPTIONS', & ! block + 'READARRAYGRID', & ! tag name + 'READARRAYGRID', & ! fortran variable + 'KEYWORD', & ! type + '', & ! shape + 'use array-based grid input', & ! longname + .true., & ! required + .false., & ! multi-record + .false., & ! preserve case + .false., & ! layered + .false. & ! timeseries + ) + + type(InputParamDefinitionType), parameter :: & + gwfghbg_auxiliary = InputParamDefinitionType & + ( & + 'GWF', & ! component + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'AUXILIARY', & ! tag name 'AUXILIARY', & ! fortran variable @@ -56,10 +75,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_auxmultname = InputParamDefinitionType & + gwfghbg_auxmultname = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'AUXMULTNAME', & ! tag name 'AUXMULTNAME', & ! fortran variable @@ -74,10 +93,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_iprpak = InputParamDefinitionType & + gwfghbg_iprpak = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'PRINT_INPUT', & ! tag name 'IPRPAK', & ! fortran variable @@ -92,10 +111,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_iprflow = InputParamDefinitionType & + gwfghbg_iprflow = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'PRINT_FLOWS', & ! tag name 'IPRFLOW', & ! fortran variable @@ -110,16 +129,16 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_ipakcb = InputParamDefinitionType & + gwfghbg_ipakcb = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'SAVE_FLOWS', & ! tag name 'IPAKCB', & ! fortran variable 'KEYWORD', & ! type '', & ! shape - 'save GHBA flows to budget file', & ! longname + 'save GHBG flows to budget file', & ! longname .false., & ! required .false., & ! multi-record .false., & ! preserve case @@ -128,10 +147,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_obs_filerecord = InputParamDefinitionType & + gwfghbg_obs_filerecord = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'OBS_FILERECORD', & ! tag name 'OBS_FILERECORD', & ! fortran variable @@ -146,10 +165,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_obs6 = InputParamDefinitionType & + gwfghbg_obs6 = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'OBS6', & ! tag name 'OBS6', & ! fortran variable @@ -164,10 +183,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_filein = InputParamDefinitionType & + gwfghbg_filein = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'FILEIN', & ! tag name 'FILEIN', & ! fortran variable @@ -182,10 +201,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_obs6_filename = InputParamDefinitionType & + gwfghbg_obs6_filename = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'OBS6_FILENAME', & ! tag name 'OBS6_FILENAME', & ! fortran variable @@ -200,10 +219,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_mover = InputParamDefinitionType & + gwfghbg_mover = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'MOVER', & ! tag name 'MOVER', & ! fortran variable @@ -218,10 +237,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_export_nc = InputParamDefinitionType & + gwfghbg_export_nc = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'OPTIONS', & ! block 'EXPORT_ARRAY_NETCDF', & ! tag name 'EXPORT_NC', & ! fortran variable @@ -236,10 +255,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_maxbound = InputParamDefinitionType & + gwfghbg_maxbound = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'DIMENSIONS', & ! block 'MAXBOUND', & ! tag name 'MAXBOUND', & ! fortran variable @@ -254,10 +273,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_bhead = InputParamDefinitionType & + gwfghbg_bhead = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'PERIOD', & ! block 'BHEAD', & ! tag name 'BHEAD', & ! fortran variable @@ -272,10 +291,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_cond = InputParamDefinitionType & + gwfghbg_cond = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'PERIOD', & ! block 'COND', & ! tag name 'COND', & ! fortran variable @@ -290,10 +309,10 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwfghba_auxvar = InputParamDefinitionType & + gwfghbg_auxvar = InputParamDefinitionType & ( & 'GWF', & ! component - 'GHBA', & ! subcomponent + 'GHBG', & ! subcomponent 'PERIOD', & ! block 'AUX', & ! tag name 'AUXVAR', & ! fortran variable @@ -308,27 +327,28 @@ module GwfGhbaInputModule ) type(InputParamDefinitionType), parameter :: & - gwf_ghba_param_definitions(*) = & + gwf_ghbg_param_definitions(*) = & [ & - gwfghba_auxiliary, & - gwfghba_auxmultname, & - gwfghba_iprpak, & - gwfghba_iprflow, & - gwfghba_ipakcb, & - gwfghba_obs_filerecord, & - gwfghba_obs6, & - gwfghba_filein, & - gwfghba_obs6_filename, & - gwfghba_mover, & - gwfghba_export_nc, & - gwfghba_maxbound, & - gwfghba_bhead, & - gwfghba_cond, & - gwfghba_auxvar & + gwfghbg_readarraygrid, & + gwfghbg_auxiliary, & + gwfghbg_auxmultname, & + gwfghbg_iprpak, & + gwfghbg_iprflow, & + gwfghbg_ipakcb, & + gwfghbg_obs_filerecord, & + gwfghbg_obs6, & + gwfghbg_filein, & + gwfghbg_obs6_filename, & + gwfghbg_mover, & + gwfghbg_export_nc, & + gwfghbg_maxbound, & + gwfghbg_bhead, & + gwfghbg_cond, & + gwfghbg_auxvar & ] type(InputParamDefinitionType), parameter :: & - gwf_ghba_aggregate_definitions(*) = & + gwf_ghbg_aggregate_definitions(*) = & [ & InputParamDefinitionType & ( & @@ -349,11 +369,11 @@ module GwfGhbaInputModule ] type(InputBlockDefinitionType), parameter :: & - gwf_ghba_block_definitions(*) = & + gwf_ghbg_block_definitions(*) = & [ & InputBlockDefinitionType( & 'OPTIONS', & ! blockname - .false., & ! required + .true., & ! required .false., & ! aggregate .false. & ! block_variable ), & @@ -371,4 +391,4 @@ module GwfGhbaInputModule ) & ] -end module GwfGhbaInputModule +end module GwfGhbgInputModule diff --git a/src/Idm/selector/IdmGwfDfnSelector.f90 b/src/Idm/selector/IdmGwfDfnSelector.f90 index ac5a7de83a6..ed1a3ef704b 100644 --- a/src/Idm/selector/IdmGwfDfnSelector.f90 +++ b/src/Idm/selector/IdmGwfDfnSelector.f90 @@ -14,7 +14,7 @@ module IdmGwfDfnSelectorModule use GwfEvtInputModule use GwfEvtaInputModule use GwfGhbInputModule - use GwfGhbaInputModule + use GwfGhbgInputModule use GwfIcInputModule use GwfNpfInputModule use GwfRchInputModule @@ -75,8 +75,8 @@ function gwf_param_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, gwf_evta_param_definitions) case ('GHB') call set_param_pointer(input_definition, gwf_ghb_param_definitions) - case ('GHBA') - call set_param_pointer(input_definition, gwf_ghba_param_definitions) + case ('GHBG') + call set_param_pointer(input_definition, gwf_ghbg_param_definitions) case ('IC') call set_param_pointer(input_definition, gwf_ic_param_definitions) case ('NPF') @@ -119,8 +119,8 @@ function gwf_aggregate_definitions(subcomponent) result(input_definition) call set_param_pointer(input_definition, gwf_evta_aggregate_definitions) case ('GHB') call set_param_pointer(input_definition, gwf_ghb_aggregate_definitions) - case ('GHBA') - call set_param_pointer(input_definition, gwf_ghba_aggregate_definitions) + case ('GHBG') + call set_param_pointer(input_definition, gwf_ghbg_aggregate_definitions) case ('IC') call set_param_pointer(input_definition, gwf_ic_aggregate_definitions) case ('NPF') @@ -163,8 +163,8 @@ function gwf_block_definitions(subcomponent) result(input_definition) call set_block_pointer(input_definition, gwf_evta_block_definitions) case ('GHB') call set_block_pointer(input_definition, gwf_ghb_block_definitions) - case ('GHBA') - call set_block_pointer(input_definition, gwf_ghba_block_definitions) + case ('GHBG') + call set_block_pointer(input_definition, gwf_ghbg_block_definitions) case ('IC') call set_block_pointer(input_definition, gwf_ic_block_definitions) case ('NPF') @@ -206,8 +206,8 @@ function gwf_idm_multi_package(subcomponent) result(multi_package) multi_package = gwf_evta_multi_package case ('GHB') multi_package = gwf_ghb_multi_package - case ('GHBA') - multi_package = gwf_ghba_multi_package + case ('GHBG') + multi_package = gwf_ghbg_multi_package case ('IC') multi_package = gwf_ic_multi_package case ('NPF') @@ -252,8 +252,8 @@ function gwf_idm_subpackages(subcomponent) result(subpackages) call set_subpkg_pointer(subpackages, gwf_evta_subpackages) case ('GHB') call set_subpkg_pointer(subpackages, gwf_ghb_subpackages) - case ('GHBA') - call set_subpkg_pointer(subpackages, gwf_ghba_subpackages) + case ('GHBG') + call set_subpkg_pointer(subpackages, gwf_ghbg_subpackages) case ('IC') call set_subpkg_pointer(subpackages, gwf_ic_subpackages) case ('NPF') @@ -296,7 +296,7 @@ function gwf_idm_integrated(subcomponent) result(integrated) integrated = .true. case ('GHB') integrated = .true. - case ('GHBA') + case ('GHBG') integrated = .true. case ('IC') integrated = .true. diff --git a/src/Model/GroundWaterFlow/gwf-buy.f90 b/src/Model/GroundWaterFlow/gwf-buy.f90 index 33a17648544..2559dee5312 100644 --- a/src/Model/GroundWaterFlow/gwf-buy.f90 +++ b/src/Model/GroundWaterFlow/gwf-buy.f90 @@ -353,12 +353,6 @@ subroutine buy_cf_bnd(this, packobj, hnew) !, hcof, rhs, auxnam, auxvar) call buy_cf_ghb(packobj, hnew, this%dense, this%elev, this%denseref, & locelev, locdense, locconc, this%drhodc, this%crhoref, & this%ctemp, this%iform) - case ('GHBA') - ! - ! -- general head boundary - call buy_cf_ghba(packobj, hnew, this%dense, this%elev, this%denseref, & - locelev, locdense, locconc, this%drhodc, this%crhoref, & - this%ctemp, this%iform) case ('RIV') ! ! -- river @@ -497,67 +491,6 @@ subroutine buy_cf_ghb(packobj, hnew, dense, elev, denseref, locelev, & end select end subroutine buy_cf_ghb - !> @brief Fill ghb coefficients - !< - subroutine buy_cf_ghba(packobj, hnew, dense, elev, denseref, locelev, & - locdense, locconc, drhodc, crhoref, ctemp, & - iform) - ! -- modules - use BndModule, only: BndType - use GhbaModule, only: GhbaType - class(BndType), pointer :: packobj - ! -- dummy - real(DP), intent(in), dimension(:) :: hnew - real(DP), intent(in), dimension(:) :: dense - real(DP), intent(in), dimension(:) :: elev - real(DP), intent(in) :: denseref - integer(I4B), intent(in) :: locelev - integer(I4B), intent(in) :: locdense - integer(I4B), dimension(:), intent(in) :: locconc - real(DP), dimension(:), intent(in) :: drhodc - real(DP), dimension(:), intent(in) :: crhoref - real(DP), dimension(:), intent(inout) :: ctemp - integer(I4B), intent(in) :: iform - ! -- local - integer(I4B) :: n - integer(I4B) :: node - real(DP) :: denseghb - real(DP) :: elevghb - real(DP) :: hghb - real(DP) :: cond - real(DP) :: hcofterm, rhsterm - ! - ! -- Process density terms for each GHB - select type (packobj) - type is (GhbaType) - do n = 1, packobj%nbound - node = packobj%nodelist(n) - if (node == 0) cycle - if (packobj%ibound(node) <= 0) cycle - ! - ! -- density - denseghb = get_bnd_density(n, locdense, locconc, denseref, & - drhodc, crhoref, ctemp, packobj%auxvar) - ! - ! -- elevation - elevghb = elev(node) - if (locelev > 0) elevghb = packobj%auxvar(locelev, n) - ! - ! -- boundary head and conductance - hghb = packobj%bound_value(1, n) - cond = packobj%bound_value(2, n) - ! - ! -- calculate HCOF and RHS terms - call calc_ghb_hcof_rhs_terms(denseref, denseghb, dense(node), & - elevghb, elev(node), hghb, hnew(node), & - cond, iform, rhsterm, hcofterm) - packobj%hcof(n) = packobj%hcof(n) + hcofterm - packobj%rhs(n) = packobj%rhs(n) - rhsterm - ! - end do - end select - end subroutine buy_cf_ghba - !> @brief Calculate density hcof and rhs terms for ghb conditions !< subroutine calc_ghb_hcof_rhs_terms(denseref, denseghb, densenode, & diff --git a/src/Model/GroundWaterFlow/gwf-ghb.f90 b/src/Model/GroundWaterFlow/gwf-ghb.f90 index 117fe87d0a9..5cc3aca77ba 100644 --- a/src/Model/GroundWaterFlow/gwf-ghb.f90 +++ b/src/Model/GroundWaterFlow/gwf-ghb.f90 @@ -1,5 +1,5 @@ module ghbmodule - use KindModule, only: DP, I4B + use KindModule, only: DP, I4B, LGP use ConstantsModule, only: DZERO, LENFTYPE, LENPACKAGENAME use SimVariablesModule, only: errmsg use SimModule, only: count_errors, store_error, store_error_filename @@ -100,36 +100,34 @@ subroutine ghb_options(this) ! -- modules use MemoryManagerExtModule, only: mem_set_value use CharacterStringModule, only: CharacterStringType - use GwfGhbInputModule, only: GwfGhbParamFoundType ! -- dummy class(GhbType), intent(inout) :: this ! -- local - type(GwfGhbParamFoundType) :: found + logical(LGP) :: found_mover ! ! -- source base class options call this%BndExtType%source_options() ! ! -- source options from input context - call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover) + call mem_set_value(this%imover, 'MOVER', this%input_mempath, found_mover) ! ! -- log ghb specific options - call this%log_ghb_options(found) + call this%log_ghb_options(found_mover) end subroutine ghb_options !> @brief Log options specific to GhbType !< - subroutine log_ghb_options(this, found) + subroutine log_ghb_options(this, found_mover) ! -- modules - use GwfGhbInputModule, only: GwfGhbParamFoundType ! -- dummy class(GhbType), intent(inout) :: this !< BndExtType object - type(GwfGhbParamFoundType), intent(in) :: found + logical(LGP), intent(in) :: found_mover ! ! -- log found options write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & //' OPTIONS' ! - if (found%mover) then + if (found_mover) then write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' end if ! diff --git a/src/Model/GroundWaterFlow/gwf-ghba.f90 b/src/Model/GroundWaterFlow/gwf-ghba.f90 deleted file mode 100644 index eea977ce511..00000000000 --- a/src/Model/GroundWaterFlow/gwf-ghba.f90 +++ /dev/null @@ -1,461 +0,0 @@ -module ghbamodule - use KindModule, only: DP, I4B, LGP - use ConstantsModule, only: DZERO, DNODATA, LENFTYPE, LENPACKAGENAME - use SimVariablesModule, only: errmsg - use SimModule, only: count_errors, store_error, store_error_filename - use MemoryHelperModule, only: create_mem_path - use BndModule, only: BndType - use BndExtModule, only: BndExtType - use ObsModule, only: DefaultObsIdProcessor - use MatrixBaseModule - ! - implicit none - ! - private - public :: ghba_create - public :: GhbaType - ! - character(len=LENFTYPE) :: ftype = 'GHBA' - character(len=LENPACKAGENAME) :: text = ' GHBA' - ! - type, extends(BndExtType) :: GhbaType - real(DP), dimension(:), pointer, contiguous :: bhead => null() !< GHBA boundary head - real(DP), dimension(:), pointer, contiguous :: cond => null() !< GHBA hydraulic conductance - contains - procedure :: allocate_arrays => ghba_allocate_arrays - procedure :: source_options => ghba_options - procedure :: source_dimensions => ghba_dimensions - procedure :: log_ghba_options - procedure :: bnd_rp => ghba_rp - procedure :: bnd_ck => ghba_ck - procedure :: bnd_cf => ghba_cf - procedure :: bnd_fc => ghba_fc - procedure :: bnd_da => ghba_da - procedure :: define_listlabel - procedure :: bound_value => ghba_bound_value - procedure :: cond_mult - ! -- methods for observations - procedure, public :: bnd_obs_supported => ghba_obs_supported - procedure, public :: bnd_df_obs => ghba_df_obs - procedure, public :: ghba_store_user_cond - end type GhbaType - -contains - - !> @brief Create a New Ghba Package and point bndobj to the new package - !< - subroutine ghba_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, & - mempath) - ! -- dummy - class(BndType), pointer :: packobj - integer(I4B), intent(in) :: id - integer(I4B), intent(in) :: ibcnum - integer(I4B), intent(in) :: inunit - integer(I4B), intent(in) :: iout - character(len=*), intent(in) :: namemodel - character(len=*), intent(in) :: pakname - character(len=*), intent(in) :: mempath - ! -- local - type(GhbaType), pointer :: ghbaobj - ! - ! -- allocate the object and assign values to object variables - allocate (ghbaobj) - packobj => ghbaobj - ! - ! -- create name and memory path - call packobj%set_names(ibcnum, namemodel, pakname, ftype, mempath) - packobj%text = text - ! - ! -- allocate scalars - call packobj%allocate_scalars() - ! - ! -- initialize package - call packobj%pack_initialize() - ! - packobj%inunit = inunit - packobj%iout = iout - packobj%id = id - packobj%ibcnum = ibcnum - packobj%ictMemPath = create_mem_path(namemodel, 'NPF') - end subroutine ghba_create - - !> @brief Deallocate memory - !< - subroutine ghba_da(this) - ! -- modules - use MemoryManagerModule, only: mem_deallocate - ! -- dummy - class(GhbaType) :: this - ! - ! -- Deallocate parent package - call this%BndExtType%bnd_da() - ! - ! -- arrays - call mem_deallocate(this%bhead, 'BHEAD', this%memoryPath) - call mem_deallocate(this%cond, 'COND', this%memoryPath) - end subroutine ghba_da - - !> @brief Set options specific to GhbaType - !< - subroutine ghba_options(this) - ! -- modules - use MemoryManagerExtModule, only: mem_set_value - use CharacterStringModule, only: CharacterStringType - use GwfGhbaInputModule, only: GwfGhbaParamFoundType - ! -- dummy - class(GhbaType), intent(inout) :: this - ! -- local - type(GwfGhbaParamFoundType) :: found - ! - ! -- source base class options - call this%BndExtType%source_options() - ! - ! -- source options from input context - call mem_set_value(this%imover, 'MOVER', this%input_mempath, found%mover) - ! - ! -- log ghba specific options - call this%log_ghba_options(found) - end subroutine ghba_options - - !> @brief Log options specific to GhbaType - !< - subroutine log_ghba_options(this, found) - ! -- modules - use GwfGhbaInputModule, only: GwfGhbaParamFoundType - ! -- dummy - class(GhbaType), intent(inout) :: this !< BndExtType object - type(GwfGhbaParamFoundType), intent(in) :: found - ! - ! -- log found options - write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(this%text)) & - //' OPTIONS' - ! - if (found%mover) then - write (this%iout, '(4x,A)') 'MOVER OPTION ENABLED' - end if - ! - ! -- close logging block - write (this%iout, '(1x,a)') & - 'END OF '//trim(adjustl(this%text))//' OPTIONS' - end subroutine log_ghba_options - - !> @brief Set dimensions specific to GhbaType - !< - subroutine ghba_dimensions(this) - ! -- modules - ! -- dummy - class(GhbaType), intent(inout) :: this - ! -- local - ! - ! -- source dimensions - call this%BndExtType%source_dimensions() - ! - ! -- Call define_listlabel to construct the list label that is written - ! when PRINT_INPUT option is used. - call this%define_listlabel() - end subroutine ghba_dimensions - - !> @brief Allocate arrays - !< - subroutine ghba_allocate_arrays(this, nodelist, auxvar) - ! -- modules - use MemoryManagerModule, only: mem_setptr, mem_checkin - ! -- dummy - class(GhbaType) :: this - integer(I4B), dimension(:), pointer, contiguous, optional :: nodelist - real(DP), dimension(:, :), pointer, contiguous, optional :: auxvar - ! - ! -- call base type allocate arrays - call this%BndExtType%allocate_arrays(nodelist, auxvar) - ! - ! -- set ghba input context pointers - call mem_setptr(this%bhead, 'BHEAD', this%input_mempath) - call mem_setptr(this%cond, 'COND', this%input_mempath) - ! - ! --checkin ghba input context pointers - call mem_checkin(this%bhead, 'BHEAD', this%memoryPath, & - 'BHEAD', this%input_mempath) - call mem_checkin(this%cond, 'COND', this%memoryPath, & - 'COND', this%input_mempath) - end subroutine ghba_allocate_arrays - - !> @brief Read and prepare - !< - subroutine ghba_rp(this) - ! -- modules - use TdisModule, only: kper - use ConstantsModule, only: LINELENGTH - use MemoryManagerExtModule, only: mem_set_value - ! -- dummy - class(GhbaType), intent(inout) :: this - integer(I4B) :: i, noder, nodeuser - character(len=LINELENGTH) :: nodestr - logical(LGP) :: found - ! - if (this%iper /= kper) return - ! - ! update nbound - call mem_set_value(this%nbound, 'NBOUND', this%input_mempath, & - found) - ! - ! -- Set the nodelist - do i = 1, this%nbound - nodeuser = this%nodeulist(i) - noder = this%dis%get_nodenumber(nodeuser, 1) - if (noder >= 0) then - this%nodelist(i) = noder - else - call this%dis%nodeu_to_string(i, nodestr) - write (errmsg, *) & - ' Cell is outside active grid domain: '// & - trim(adjustl(nodestr)) - call store_error(errmsg) - end if - end do - ! - ! -- exit if errors were found - if (count_errors() > 0) then - write (errmsg, *) count_errors(), ' errors encountered.' - call store_error(errmsg) - call store_error_filename(this%input_fname) - end if - ! - ! -- store user cond - if (this%ivsc == 1) then - call this%ghba_store_user_cond() - end if - ! - ! -- Write the list to iout if requested - if (this%iprpak /= 0) then - call this%write_list() - end if - end subroutine ghba_rp - - !> @brief Check ghba boundary condition data - !< - subroutine ghba_ck(this) - ! -- modules - use ConstantsModule, only: LINELENGTH - use SimModule, only: store_error, count_errors, store_error_unit - ! -- dummy - class(GhbaType), intent(inout) :: this - ! -- local - character(len=LINELENGTH) :: errmsg - integer(I4B) :: i - integer(I4B) :: node - real(DP) :: bt - ! -- formats - character(len=*), parameter :: fmtghbaerr = & - "('GHBA BOUNDARY (',i0,') HEAD (',f10.3,') IS LESS THAN CELL & - &BOTTOM (',f10.3,')')" - character(len=*), parameter :: fmtcondmulterr = & - "('GHBA BOUNDARY (',i0,') CONDUCTANCE MULTIPLIER (',g10.3,') IS & - &LESS THAN ZERO')" - character(len=*), parameter :: fmtconderr = & - "('GHBA BOUNDARY (',i0,') CONDUCTANCE (',g10.3,') IS LESS THAN & - &ZERO')" - ! - ! -- check stress period data - do i = 1, this%nbound - node = this%nodelist(i) - bt = this%dis%bot(node) - ! -- accumulate errors - if (this%bhead(i) < bt .and. this%icelltype(node) /= 0) then - write (errmsg, fmt=fmtghbaerr) i, this%bhead(i), bt - call store_error(errmsg) - end if - if (this%iauxmultcol > 0) then - if (this%auxvar(this%iauxmultcol, i) < DZERO) then - write (errmsg, fmt=fmtcondmulterr) & - i, this%auxvar(this%iauxmultcol, i) - call store_error(errmsg) - end if - end if - if (this%cond(i) < DZERO) then - write (errmsg, fmt=fmtconderr) i, this%cond(i) - call store_error(errmsg) - end if - end do - ! - !write summary of ghba package error messages - if (count_errors() > 0) then - call store_error_unit(this%inunit) - end if - end subroutine ghba_ck - - !> @brief Formulate the HCOF and RHS terms - !! - !! Skip if no GHBAs - !< - subroutine ghba_cf(this) - ! -- dummy - class(GhbaType) :: this - ! -- local - integer(I4B) :: i, node - ! - ! -- Return if no ghbas - if (this%nbound .eq. 0) return - ! - ! -- Calculate hcof and rhs for each ghba entry - do i = 1, this%nbound - node = this%nodelist(i) - if (this%ibound(node) .le. 0) then - this%hcof(i) = DZERO - this%rhs(i) = DZERO - cycle - end if - this%hcof(i) = -this%cond_mult(i) - this%rhs(i) = -this%cond_mult(i) * this%bhead(i) - end do - end subroutine ghba_cf - - !> @brief Copy rhs and hcof into solution rhs and amat - !< - subroutine ghba_fc(this, rhs, ia, idxglo, matrix_sln) - ! -- dummy - class(GhbaType) :: this - real(DP), dimension(:), intent(inout) :: rhs - integer(I4B), dimension(:), intent(in) :: ia - integer(I4B), dimension(:), intent(in) :: idxglo - class(MatrixBaseType), pointer :: matrix_sln - ! -- local - integer(I4B) :: i, n, ipos - real(DP) :: cond, bhead, qghba - ! - ! -- pakmvrobj fc - if (this%imover == 1) then - call this%pakmvrobj%fc() - end if - ! - ! -- Copy package rhs and hcof into solution rhs and amat - do i = 1, this%nbound - n = this%nodelist(i) - rhs(n) = rhs(n) + this%rhs(i) - ipos = ia(n) - call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i)) - ! - ! -- If mover is active and this boundary is discharging, - ! store available water (as positive value). - bhead = this%bhead(i) - if (this%imover == 1 .and. this%xnew(n) > bhead) then - cond = this%cond_mult(i) - qghba = cond * (this%xnew(n) - bhead) - call this%pakmvrobj%accumulate_qformvr(i, qghba) - end if - end do - end subroutine ghba_fc - - !> @brief Define the list heading that is written to iout when PRINT_INPUT - !! option is used - !< - subroutine define_listlabel(this) - ! -- dummy - class(GhbaType), intent(inout) :: this - ! - ! -- create the header list label - this%listlabel = trim(this%filtyp)//' NO.' - if (this%dis%ndim == 3) then - write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER' - write (this%listlabel, '(a, a7)') trim(this%listlabel), 'ROW' - write (this%listlabel, '(a, a7)') trim(this%listlabel), 'COL' - elseif (this%dis%ndim == 2) then - write (this%listlabel, '(a, a7)') trim(this%listlabel), 'LAYER' - write (this%listlabel, '(a, a7)') trim(this%listlabel), 'CELL2D' - else - write (this%listlabel, '(a, a7)') trim(this%listlabel), 'NODE' - end if - write (this%listlabel, '(a, a16)') trim(this%listlabel), 'STAGE' - write (this%listlabel, '(a, a16)') trim(this%listlabel), 'CONDUCTANCE' - end subroutine define_listlabel - - ! -- Procedures related to observations - - !> @brief Return true because GHBA package supports observations - !! - !! Overrides BndType%bnd_obs_supported() - !< - logical function ghba_obs_supported(this) - implicit none - ! -- dummy - class(GhbaType) :: this - ! - ghba_obs_supported = .true. - end function ghba_obs_supported - - !> @brief Store observation type supported by GHBA package - !! - !! Overrides BndType%bnd_df_obs - !< - subroutine ghba_df_obs(this) - implicit none - ! -- dummy - class(GhbaType) :: this - ! -- local - integer(I4B) :: indx - ! - call this%obs%StoreObsType('ghba', .true., indx) - this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor - ! - ! -- Store obs type and assign procedure pointer - ! for to-mvr observation type. - call this%obs%StoreObsType('to-mvr', .true., indx) - this%obs%obsData(indx)%ProcessIdPtr => DefaultObsIdProcessor - end subroutine ghba_df_obs - - !> @brief Store user-specified conductance for GHBA boundary type - !< - subroutine ghba_store_user_cond(this) - ! -- modules - ! -- dummy - class(GhbaType), intent(inout) :: this !< BndExtType object - ! -- local - integer(I4B) :: n - ! - ! -- store backup copy of conductance values - do n = 1, this%nbound - this%condinput(n) = this%cond_mult(n) - end do - end subroutine ghba_store_user_cond - - !> @brief Apply multiplier to GHBA conductance if option AUXMULTCOL is used - !< - function cond_mult(this, row) result(cond) - ! -- modules - ! -- dummy variables - class(GhbaType), intent(inout) :: this !< BndExtType object - integer(I4B), intent(in) :: row - ! -- result - real(DP) :: cond - ! - if (this%iauxmultcol > 0) then - cond = this%cond(row) * this%auxvar(this%iauxmultcol, row) - else - cond = this%cond(row) - end if - end function cond_mult - - !> @brief Return requested boundary value - !< - function ghba_bound_value(this, col, row) result(bndval) - ! -- modules - ! -- dummy - class(GhbaType), intent(inout) :: this !< BndExtType object - integer(I4B), intent(in) :: col - integer(I4B), intent(in) :: row - ! -- result - real(DP) :: bndval - ! - select case (col) - case (1) - bndval = this%bhead(row) - case (2) - bndval = this%cond_mult(row) - case default - errmsg = 'Programming error. GHBA bound value requested column '& - &'outside range of ncolbnd (2).' - call store_error(errmsg) - call store_error_filename(this%input_fname) - end select - end function ghba_bound_value - -end module ghbamodule diff --git a/src/Model/GroundWaterFlow/gwf-vsc.f90 b/src/Model/GroundWaterFlow/gwf-vsc.f90 index 1d8d1ce7fd8..c29a8651137 100644 --- a/src/Model/GroundWaterFlow/gwf-vsc.f90 +++ b/src/Model/GroundWaterFlow/gwf-vsc.f90 @@ -234,7 +234,6 @@ subroutine vsc_ar_bnd(this, packobj) use BndModule, only: BndType use DrnModule, only: DrnType use GhbModule, only: GhbType - use GhbaModule, only: GhbaType use RivModule, only: RivType use LakModule, only: LakType use SfrModule, only: SfrType @@ -254,21 +253,14 @@ subroutine vsc_ar_bnd(this, packobj) end select case ('GHB') ! - ! -- activate viscosity for the general head boundary package + ! -- activate viscosity for the drain package select type (packobj) type is (GhbType) call packobj%bnd_activate_viscosity() end select - case ('GHBA') - ! - ! -- activate viscosity for the general head boundary array package - select type (packobj) - type is (GhbaType) - call packobj%bnd_activate_viscosity() - end select case ('RIV') ! - ! -- activate viscosity for the river package + ! -- activate viscosity for the drain package select type (packobj) type is (RivType) call packobj%bnd_activate_viscosity() @@ -421,7 +413,7 @@ subroutine vsc_ad_bnd(this, packobj, hnew) ! ! -- apply viscosity terms to inflow from boundary based on package type select case (packobj%filtyp) - case ('GHB', 'GHBA', 'DRN', 'RIV') + case ('GHB', 'DRN', 'RIV') ! ! -- general head, drain, and river boundary call vsc_ad_standard_bnd(packobj, hnew, this%visc, this%viscref, & @@ -475,7 +467,6 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & use DrnModule, only: DrnType use RivModule, only: RivType use GhbModule, only: GhbType - use GhbaModule, only: GhbaType class(BndType), pointer :: packobj ! -- dummy real(DP), intent(in), dimension(:) :: hnew @@ -499,7 +490,6 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & node = packobj%nodelist(n) ! ! -- Check if boundary cell is active, cycle if not - if (node == 0) cycle if (packobj%ibound(node) <= 0) cycle ! ! -- calculate the viscosity associated with the boundary @@ -521,12 +511,6 @@ subroutine vsc_ad_standard_bnd(packobj, hnew, visc, viscref, locelev, & packobj%cond(n) = update_bnd_cond(viscbnd, viscref, & packobj%condinput(n)) end select - case ('GHBA') - select type (packobj) - type is (GhbaType) - packobj%cond(n) = update_bnd_cond(viscbnd, viscref, & - packobj%condinput(n)) - end select case ('RIV') select type (packobj) type is (RivType) diff --git a/src/Model/GroundWaterFlow/gwf.f90 b/src/Model/GroundWaterFlow/gwf.f90 index 6dafcdd1d17..2468e18f81d 100644 --- a/src/Model/GroundWaterFlow/gwf.f90 +++ b/src/Model/GroundWaterFlow/gwf.f90 @@ -118,7 +118,7 @@ module GwfModule !< integer(I4B), parameter :: GWF_NMULTIPKG = 50 character(len=LENPACKAGETYPE), dimension(GWF_NMULTIPKG) :: GWF_MULTIPKG - data GWF_MULTIPKG/'WEL6 ', 'DRN6 ', 'RIV6 ', 'GHB6 ', 'GHBA6', & ! 5 + data GWF_MULTIPKG/'WEL6 ', 'DRN6 ', 'RIV6 ', 'GHB6 ', ' ', & ! 5 &'RCH6 ', 'EVT6 ', 'CHD6 ', 'CSUB6', ' ', & ! 10 &'MAW6 ', 'SFR6 ', 'LAK6 ', 'UZF6 ', 'API6 ', & ! 15 &35*' '/ ! 50 @@ -1219,7 +1219,6 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, & use DrnModule, only: drn_create use RivModule, only: riv_create use GhbModule, only: ghb_create - use GhbaModule, only: ghba_create use RchModule, only: rch_create use EvtModule, only: evt_create use MawModule, only: maw_create @@ -1258,9 +1257,6 @@ subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, & case ('GHB6') call ghb_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & pakname, mempath) - case ('GHBA6') - call ghba_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & - pakname, mempath) case ('RCH6') call rch_create(packobj, ipakid, ipaknum, inunit, iout, this%name, & pakname, mempath) @@ -1498,9 +1494,9 @@ subroutine create_packages(this) this%inoc = inunit case ('OBS6') this%inobs = inunit - case ('WEL6', 'DRN6', 'RIV6', 'GHB6', 'GHBA6', & - 'RCH6', 'EVT6', 'API6', 'CHD6', 'MAW6', & - 'SFR6', 'LAK6', 'UZF6') + case ('WEL6', 'DRN6', 'RIV6', 'GHB6', 'RCH6', & + 'EVT6', 'API6', 'CHD6', 'MAW6', 'SFR6', & + 'LAK6', 'UZF6') call expandarray(bndpkgs) bndpkgs(size(bndpkgs)) = n case default diff --git a/src/Model/ModelUtilities/BoundaryPackageExt.f90 b/src/Model/ModelUtilities/BoundaryPackageExt.f90 index ea4a48cdc7d..f5dfc8be57d 100644 --- a/src/Model/ModelUtilities/BoundaryPackageExt.f90 +++ b/src/Model/ModelUtilities/BoundaryPackageExt.f90 @@ -31,6 +31,8 @@ module BndExtModule ! -- characters ! -- scalars integer(I4B), pointer :: iper + logical(LGP), pointer :: readarraygrid + logical(LGP), pointer :: readarraylayer ! -- arrays integer(I4B), dimension(:, :), pointer, contiguous :: cellid => null() !< input user cellid list integer(I4B), dimension(:), pointer, contiguous :: nodeulist => null() !< input user nodelist @@ -135,22 +137,48 @@ subroutine bndext_rp(this) class(BndExtType), intent(inout) :: this !< BndExtType object ! -- local variables logical(LGP) :: found - integer(I4B) :: n + integer(I4B) :: n, noder, nodeuser + character(len=LINELENGTH) :: nodestr ! if (this%iper /= kper) return ! ! -- copy nbound from input context call mem_set_value(this%nbound, 'NBOUND', this%input_mempath, & found) - ! - ! -- convert cellids to node numbers - call this%nodelist_update() - ! - ! -- update boundname string list - if (this%inamedbound /= 0) then - do n = 1, size(this%boundname_cst) - this%boundname(n) = this%boundname_cst(n) + + if (this%readarraygrid) then + ! -- Set the nodelist + do n = 1, this%nbound + nodeuser = this%nodeulist(n) + noder = this%dis%get_nodenumber(nodeuser, 1) + if (noder >= 0) then + this%nodelist(n) = noder + else + call this%dis%nodeu_to_string(n, nodestr) + write (errmsg, *) & + ' Cell is outside active grid domain: '// & + trim(adjustl(nodestr)) + call store_error(errmsg) + end if end do + ! + ! -- exit if errors were found + if (count_errors() > 0) then + write (errmsg, *) count_errors(), ' errors encountered.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if + else + ! + ! -- convert cellids to node numbers + call this%nodelist_update() + ! + ! -- update boundname string list + if (this%inamedbound /= 0) then + do n = 1, size(this%boundname_cst) + this%boundname(n) = this%boundname_cst(n) + end do + end if end if end subroutine bndext_rp @@ -196,6 +224,7 @@ subroutine bndext_allocate_scalars(this) class(BndExtType) :: this !< BndExtType object ! -- local variables character(len=LENMEMPATH) :: input_mempath + logical(LGP) :: found ! ! -- set memory path input_mempath = create_mem_path(this%name_model, this%packName, idm_context) @@ -203,8 +232,28 @@ subroutine bndext_allocate_scalars(this) ! -- allocate base BndType scalars call this%BndType%allocate_scalars() ! - ! -- set pointers to period input data scalars + ! -- set IPER pointer call mem_setptr(this%iper, 'IPER', input_mempath) + + ! -- allocate internal scalars + allocate (this%readarraygrid) + allocate (this%readarraylayer) + + ! -- initialize internal scalars + this%readarraygrid = .false. + this%readarraylayer = .false. + + ! -- update internal scalars based on user input + call mem_set_value(this%readarraygrid, 'READARRAYGRID', input_mempath, found) + call mem_set_value(this%readarraylayer, 'READARRAYLAYER', & + input_mempath, found) + + ! -- no packages currently use READARRAYLAYER + if (this%readarraylayer) then + write (errmsg, '(a)') 'READARRAYLAYER is not currently supported.' + call store_error(errmsg) + call store_error_filename(this%input_fname) + end if end subroutine bndext_allocate_scalars !> @ brief Allocate package arrays diff --git a/src/Utilities/Export/NCExportCreate.f90 b/src/Utilities/Export/NCExportCreate.f90 index de15680d6e5..ed3e18b9f5f 100644 --- a/src/Utilities/Export/NCExportCreate.f90 +++ b/src/Utilities/Export/NCExportCreate.f90 @@ -171,7 +171,7 @@ subroutine create_export_pkglist(pkglist, loaders, iout) call mem_set_value(export_arrays, 'EXPORT_NC', & dynamic_pkg%mf6_input%mempath, found) - readasarrays = (dynamic_pkg%readarray_layer .or. dynamic_pkg%readarray_grid) + readasarrays = (dynamic_pkg%readarraylayer .or. dynamic_pkg%readarraygrid) if (export_arrays > 0 .and. readasarrays) then select type (dynamic_pkg) type is (Mf6FileDynamicPkgLoadType) diff --git a/src/Utilities/Idm/BoundInputContext.f90 b/src/Utilities/Idm/BoundInputContext.f90 index daeb53c2d21..2e14b4cedef 100644 --- a/src/Utilities/Idm/BoundInputContext.f90 +++ b/src/Utilities/Idm/BoundInputContext.f90 @@ -52,8 +52,8 @@ module BoundInputContextModule contiguous :: auxvar => null() !< auxiliary variable array integer(I4B), dimension(:), pointer, contiguous :: mshape => null() !< model shape logical(LGP) :: readasarrays !< grid or layer array input - logical(LGP) :: readarray_layer !< array layer reader - logical(LGP) :: readarray_grid !< array grid reader + logical(LGP) :: readarraylayer !< array layer reader + logical(LGP) :: readarraygrid !< array grid reader type(DynamicPackageParamsType) :: package_params type(ModflowInputType) :: mf6_input !< description of input contains @@ -72,16 +72,16 @@ module BoundInputContextModule !> @brief create boundary input context !! !< - subroutine create(this, mf6_input, readarray_grid, readarray_layer) + subroutine create(this, mf6_input, readarraygrid, readarraylayer) class(BoundInputContextType) :: this type(ModflowInputType), intent(in) :: mf6_input - logical(LGP), intent(in) :: readarray_grid - logical(LGP), intent(in) :: readarray_layer + logical(LGP), intent(in) :: readarraygrid + logical(LGP), intent(in) :: readarraylayer this%mf6_input = mf6_input - this%readarray_grid = readarray_grid - this%readarray_layer = readarray_layer - this%readasarrays = readarray_grid .or. readarray_layer + this%readarraygrid = readarraygrid + this%readarraylayer = readarraylayer + this%readasarrays = readarraygrid .or. readarraylayer ! create the dynamic package input context call this%allocate_scalars() @@ -166,7 +166,7 @@ subroutine allocate_arrays(this) end if ! allocate nodeulist - if (.not. this%readarray_grid) then + if (.not. this%readarraygrid) then call mem_allocate(nodeulist, 0, 'NODEULIST', this%mf6_input%mempath) end if diff --git a/src/Utilities/Idm/InputLoadType.f90 b/src/Utilities/Idm/InputLoadType.f90 index 98f421ee7b6..381f9593577 100644 --- a/src/Utilities/Idm/InputLoadType.f90 +++ b/src/Utilities/Idm/InputLoadType.f90 @@ -82,8 +82,8 @@ module InputLoadTypeModule character(len=LINELENGTH) :: component_input_name !< component input name, e.g. model name file character(len=LINELENGTH) :: input_name !< input name, e.g. package *.chd file character(len=LINELENGTH), dimension(:), allocatable :: param_names !< dynamic param tagnames - logical(LGP) :: readarray_layer - logical(LGP) :: readarray_grid + logical(LGP) :: readarraylayer + logical(LGP) :: readarraygrid integer(I4B) :: iperblock !< index of period block on block definition list integer(I4B) :: iout !< inunit number for logging integer(I4B) :: nparam !< number of in scope params @@ -356,8 +356,8 @@ subroutine dynamic_init(this, mf6_input, component_name, component_input_name, & this%component_name = component_name this%component_input_name = component_input_name this%input_name = input_name - this%readarray_layer = .false. - this%readarray_grid = .false. + this%readarraylayer = .false. + this%readarraygrid = .false. this%iperblock = iperblock this%nparam = 0 this%iout = iout @@ -373,20 +373,23 @@ subroutine dynamic_init(this, mf6_input, component_name, component_input_name, & call store_error_filename(this%input_name) end if - ! set readarray_layer and readarray_grid + ! set readarraylayer and readarraygrid if (mf6_input%block_dfns(iperblock)%aggregate) then ! no-op, list based input else do iparam = 1, size(mf6_input%param_dfns) idt => mf6_input%param_dfns(iparam) if (idt%blockname == 'OPTIONS') then - if (idt%tagname == 'READASARRAYS') then - this%readarray_layer = .true. - exit - end if + select case (idt%tagname) + case ('READARRAYLAYER', 'READASARRAYS') + this%readarraylayer = .true. + case ('READARRAYGRID') + this%readarraygrid = .true. + case default + ! no-op + end select end if end do - if (.not. this%readarray_layer) this%readarray_grid = .true. end if end subroutine dynamic_init diff --git a/src/Utilities/Idm/ModflowInput.f90 b/src/Utilities/Idm/ModflowInput.f90 index ac463b6e63f..8f52da4b2ca 100644 --- a/src/Utilities/Idm/ModflowInput.f90 +++ b/src/Utilities/Idm/ModflowInput.f90 @@ -99,7 +99,7 @@ function update_sc_type(filetype, filename, component_type, subcomponent_type) & character(len=LENPACKAGETYPE) :: sc_type sc_type = subcomponent_type select case (subcomponent_type) - case ('RCH', 'EVT', 'SCP') + case ('RCH', 'EVT', 'SCP', 'GHB') sc_type = read_as_arrays(filetype, filename, component_type, & subcomponent_type) case default @@ -138,10 +138,15 @@ function read_as_arrays(filetype, filename, component_type, subcomponent_type) & call parser%GetNextLine(endOfBlock) if (endOfBlock) exit call parser%GetStringCaps(keyword) - if (keyword == 'READASARRAYS') then + select case (keyword) + case ('READASARRAYS') write (sc_type, '(a)') trim(subcomponent_type)//'A' - exit - end if + case ('READARRAYLAYER') + write (sc_type, '(a)') trim(subcomponent_type)//'L' + case ('READARRAYGRID') + write (sc_type, '(a)') trim(subcomponent_type)//'G' + case default + end select end do end if diff --git a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 index 4628eae65ba..7bcef6795ec 100644 --- a/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/IdmMf6File.f90 @@ -282,12 +282,21 @@ subroutine dynamic_create_loader(this) if (this%mf6_input%subcomponent_type == 'STO') then allocate (sto_loader) this%rp_loader => sto_loader - else if (this%readarray_layer) then + else if (this%readarraylayer) then + select case (this%mf6_input%subcomponent_type) + case ('EVTA', 'RCHA') + ! no-op + case default + call dev_feature('Input file "'//trim(this%input_name)// & + '" READARRAYLAYER option is still under development, install the & + &nightly build or compile from source with IDEVELOPMODE = 1.', & + this%iout) + end select allocate (arrlayer_loader) this%rp_loader => arrlayer_loader - else if (this%readarray_grid) then - call dev_feature(trim(this%mf6_input%subcomponent_type)// & - ' package input is still under development, install the & + else if (this%readarraygrid) then + call dev_feature('Input file "'//trim(this%input_name)// & + '" READARRAYGRID option is still under development, install the & &nightly build or compile from source with IDEVELOPMODE = 1.', & this%iout) allocate (arrgrid_loader) diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 index 18e9a03169a..cf6691847dc 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileGridArray.f90 @@ -71,8 +71,8 @@ subroutine ainit(this, mf6_input, component_name, & ! initialize input context memory call this%bound_context%create(mf6_input, & - readarray_grid=.true., & - readarray_layer=.false.) + readarraygrid=.true., & + readarraylayer=.false.) ! allocate user nodelist call mem_allocate(this%nodeulist, this%bound_context%maxbound, & diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 index 682a1be7d02..5ad47a1654c 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileLayerArray.f90 @@ -105,8 +105,8 @@ subroutine ainit(this, mf6_input, component_name, & ! initialize input context memory call this%bound_context%create(mf6_input, & - readarray_grid=.false., & - readarray_layer=.true.) + readarraygrid=.false., & + readarraylayer=.true.) ! allocate dfn params call this%params_alloc() diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 index 30dd91d4802..feb77a7422f 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileList.f90 @@ -99,8 +99,8 @@ subroutine ainit(this, mf6_input, component_name, component_input_name, & ! initialize package input context call this%bound_context%create(mf6_input, & - readarray_grid=.false., & - readarray_layer=.false.) + readarraygrid=.false., & + readarraylayer=.false.) ! store in scope SA cols for list input call this%bound_context%bound_params(this%param_names, this%nparam, & diff --git a/src/meson.build b/src/meson.build index 4d0fc5c488f..55d80a403a6 100644 --- a/src/meson.build +++ b/src/meson.build @@ -65,7 +65,7 @@ modflow_sources = files( 'Idm' / 'gwf-evtidm.f90', 'Idm' / 'gwf-evtaidm.f90', 'Idm' / 'gwf-ghbidm.f90', - 'Idm' / 'gwf-ghbaidm.f90', + 'Idm' / 'gwf-ghbgidm.f90', 'Idm' / 'gwf-icidm.f90', 'Idm' / 'gwf-namidm.f90', 'Idm' / 'gwf-npfidm.f90', @@ -182,7 +182,6 @@ modflow_sources = files( 'Model' / 'GroundWaterFlow' / 'gwf-drn.f90', 'Model' / 'GroundWaterFlow' / 'gwf-evt.f90', 'Model' / 'GroundWaterFlow' / 'gwf-ghb.f90', - 'Model' / 'GroundWaterFlow' / 'gwf-ghba.f90', 'Model' / 'GroundWaterFlow' / 'gwf-hfb.f90', 'Model' / 'GroundWaterFlow' / 'gwf-ic.f90', 'Model' / 'GroundWaterFlow' / 'gwf-lak.f90', diff --git a/utils/idmloader/dfns.txt b/utils/idmloader/dfns.txt index 3de63c81e58..dd441d657fb 100644 --- a/utils/idmloader/dfns.txt +++ b/utils/idmloader/dfns.txt @@ -9,7 +9,7 @@ gwf-drn.dfn gwf-evt.dfn gwf-evta.dfn gwf-ghb.dfn -gwf-ghba.dfn +gwf-ghbg.dfn gwf-ic.dfn gwf-npf.dfn gwf-rch.dfn From faab3cba06055b54bc2f55254921f1fa9d82667c Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 2 Jun 2025 17:29:23 -0400 Subject: [PATCH 17/22] update makefile --- make/makefile | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/make/makefile b/make/makefile index 7595e04f752..4af4dd0879a 100644 --- a/make/makefile +++ b/make/makefile @@ -31,22 +31,23 @@ SOURCEDIR24=../src/Timing SOURCEDIR25=../src/Utilities SOURCEDIR26=../src/Utilities/ArrayRead SOURCEDIR27=../src/Utilities/Export -SOURCEDIR28=../src/Utilities/Idm -SOURCEDIR29=../src/Utilities/Idm/mf6blockfile -SOURCEDIR30=../src/Utilities/Idm/netcdf -SOURCEDIR31=../src/Utilities/Libraries -SOURCEDIR32=../src/Utilities/Libraries/blas -SOURCEDIR33=../src/Utilities/Libraries/daglib -SOURCEDIR34=../src/Utilities/Libraries/rcm -SOURCEDIR35=../src/Utilities/Libraries/sparsekit -SOURCEDIR36=../src/Utilities/Libraries/sparskit2 -SOURCEDIR37=../src/Utilities/Matrix -SOURCEDIR38=../src/Utilities/Memory -SOURCEDIR39=../src/Utilities/Observation -SOURCEDIR40=../src/Utilities/OutputControl -SOURCEDIR41=../src/Utilities/Performance -SOURCEDIR42=../src/Utilities/TimeSeries -SOURCEDIR43=../src/Utilities/Vector +SOURCEDIR28=../src/Utilities/Export/tmp +SOURCEDIR29=../src/Utilities/Idm +SOURCEDIR30=../src/Utilities/Idm/mf6blockfile +SOURCEDIR31=../src/Utilities/Idm/netcdf +SOURCEDIR32=../src/Utilities/Libraries +SOURCEDIR33=../src/Utilities/Libraries/blas +SOURCEDIR34=../src/Utilities/Libraries/daglib +SOURCEDIR35=../src/Utilities/Libraries/rcm +SOURCEDIR36=../src/Utilities/Libraries/sparsekit +SOURCEDIR37=../src/Utilities/Libraries/sparskit2 +SOURCEDIR38=../src/Utilities/Matrix +SOURCEDIR39=../src/Utilities/Memory +SOURCEDIR40=../src/Utilities/Observation +SOURCEDIR41=../src/Utilities/OutputControl +SOURCEDIR42=../src/Utilities/Performance +SOURCEDIR43=../src/Utilities/TimeSeries +SOURCEDIR44=../src/Utilities/Vector VPATH = \ ${SOURCEDIR1} \ @@ -91,7 +92,8 @@ ${SOURCEDIR39} \ ${SOURCEDIR40} \ ${SOURCEDIR41} \ ${SOURCEDIR42} \ -${SOURCEDIR43} +${SOURCEDIR43} \ +${SOURCEDIR44} .SUFFIXES: .f90 .F90 .o @@ -173,7 +175,7 @@ $(OBJDIR)/gwf-npfidm.o \ $(OBJDIR)/gwf-namidm.o \ $(OBJDIR)/gwf-icidm.o \ $(OBJDIR)/gwf-ghbidm.o \ -$(OBJDIR)/gwf-ghbaidm.o \ +$(OBJDIR)/gwf-ghbgidm.o \ $(OBJDIR)/gwf-evtidm.o \ $(OBJDIR)/gwf-evtaidm.o \ $(OBJDIR)/gwf-drnidm.o \ @@ -314,7 +316,6 @@ $(OBJDIR)/mf6lists.o \ $(OBJDIR)/gwf-lak.o \ $(OBJDIR)/GwfVscInputData.o \ $(OBJDIR)/gwf-ghb.o \ -$(OBJDIR)/gwf-ghba.o \ $(OBJDIR)/gwf-drn.o \ $(OBJDIR)/IndexMap.o \ $(OBJDIR)/ArrayReaderBase.o \ @@ -511,6 +512,7 @@ $(OBJDIR)/IdmLoad.o \ $(OBJDIR)/ConnectionBuilder.o \ $(OBJDIR)/comarg.o \ $(OBJDIR)/mf6core.o \ +$(OBJDIR)/gwf-welaidm.o \ $(OBJDIR)/BaseGeometry.o \ $(OBJDIR)/mf6.o \ $(OBJDIR)/StringList.o \ @@ -524,6 +526,7 @@ $(OBJDIR)/GwfSfrCommon.o \ $(OBJDIR)/gwf-sfr-transient.o \ $(OBJDIR)/gwf-sfr-steady.o \ $(OBJDIR)/gwf-sfr-constant.o \ +$(OBJDIR)/gwf-wela.o \ $(OBJDIR)/RectangularGeometry.o \ $(OBJDIR)/CircularGeometry.o \ $(OBJDIR)/ExplicitModel.o \ From cc06bd9679deb29abdff3fef02246da13e4102e3 Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 2 Jun 2025 19:04:44 -0400 Subject: [PATCH 18/22] rebuild makefiles --- make/makedefaults | 4 ++-- utils/zonebudget/make/makedefaults | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/make/makedefaults b/make/makedefaults index efd53aa4f46..4bb3fc86074 100644 --- a/make/makedefaults +++ b/make/makedefaults @@ -57,11 +57,11 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - 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 + 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=f2018 -cpp endif else ifeq ($(FC), gfortran) - 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 + 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=f2018 -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp diff --git a/utils/zonebudget/make/makedefaults b/utils/zonebudget/make/makedefaults index 991eb997dd5..2627609f1b7 100644 --- a/utils/zonebudget/make/makedefaults +++ b/utils/zonebudget/make/makedefaults @@ -57,11 +57,11 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - 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 + 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=f2018 -cpp endif else ifeq ($(FC), gfortran) - 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 + 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=f2018 -cpp endif ifeq ($(FC), $(filter $(FC), ifort mpiifort)) FFLAGS ?= -no-heap-arrays -fpe0 -traceback -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp From f9b6268b234bb134dd8959e8f366f60d18c34bbb Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 2 Jun 2025 20:03:33 -0400 Subject: [PATCH 19/22] rebuild makefiles --- make/makefile | 2 -- 1 file changed, 2 deletions(-) diff --git a/make/makefile b/make/makefile index 4af4dd0879a..f6c71870589 100644 --- a/make/makefile +++ b/make/makefile @@ -512,7 +512,6 @@ $(OBJDIR)/IdmLoad.o \ $(OBJDIR)/ConnectionBuilder.o \ $(OBJDIR)/comarg.o \ $(OBJDIR)/mf6core.o \ -$(OBJDIR)/gwf-welaidm.o \ $(OBJDIR)/BaseGeometry.o \ $(OBJDIR)/mf6.o \ $(OBJDIR)/StringList.o \ @@ -526,7 +525,6 @@ $(OBJDIR)/GwfSfrCommon.o \ $(OBJDIR)/gwf-sfr-transient.o \ $(OBJDIR)/gwf-sfr-steady.o \ $(OBJDIR)/gwf-sfr-constant.o \ -$(OBJDIR)/gwf-wela.o \ $(OBJDIR)/RectangularGeometry.o \ $(OBJDIR)/CircularGeometry.o \ $(OBJDIR)/ExplicitModel.o \ From 092af66c050a63c6eed382d3e3262d034a116498 Mon Sep 17 00:00:00 2001 From: mjreno Date: Wed, 4 Jun 2025 13:04:36 -0400 Subject: [PATCH 20/22] restore makedefaults --- autotest/test_gwt_henry_nr.py | 46 ++++++++++--------- make/makedefaults | 4 +- .../ModelUtilities/BoundaryPackageExt.f90 | 4 ++ utils/zonebudget/make/makedefaults | 4 +- 4 files changed, 33 insertions(+), 25 deletions(-) diff --git a/autotest/test_gwt_henry_nr.py b/autotest/test_gwt_henry_nr.py index 73ad6b1ec78..ac0b51b60d6 100644 --- a/autotest/test_gwt_henry_nr.py +++ b/autotest/test_gwt_henry_nr.py @@ -167,8 +167,8 @@ def get_model(ws, name, array_input=False): drnspd = {} if array_input: bheadspd = {} - condspd = {} - auxspd = {} + ghbcondspd = {} + ghbauxspd = {} else: ghbspd = {} for kper in range(nper): @@ -176,36 +176,40 @@ def get_model(ws, name, array_input=False): sl = sealevel else: sl = sealevelts[kper] + sl = np.round(sl, decimals=8) drnlist = [] if array_input: - abhead = np.full((nlay, nrow, ncol), DNODATA, dtype=float) - acond = np.full((nlay, nrow, ncol), DNODATA, dtype=float) - aconc = np.full((nlay, nrow, ncol), DNODATA, dtype=float) - adens = np.full((nlay, nrow, ncol), DNODATA, dtype=float) + bhead = np.full((nlay, nrow, ncol), DNODATA, dtype=float) + ghbcond = np.full((nlay, nrow, ncol), DNODATA, dtype=float) + ghbconc = np.full((nlay, nrow, ncol), DNODATA, dtype=float) + ghbdens = np.full((nlay, nrow, ncol), DNODATA, dtype=float) else: ghblist = [] - nbound = 0 + ghbbnd = 0 + drnbnd = 0 for k, i, j in zip(kidx, iidx, jidx): zcell = zcellcenters[k, i, j] cond = 864.0 * (delz * delc) / (0.5 * delr) if zcell > sl: drnlist.append([(k, i, j), zcell, 864.0, 0.0]) + drnbnd += 1 else: if array_input: - abhead[k, i, j] = sl - acond[k, i, j] = 864.0 - aconc[k, i, j] = 35.0 - adens[k, i, j] = 1024.5 + bhead[k, i, j] = sl + ghbcond[k, i, j] = 864.0 + ghbconc[k, i, j] = 35.0 + ghbdens[k, i, j] = 1024.5 else: ghblist.append([(k, i, j), sl, 864.0, 35.0, 1024.5]) - nbound += 1 - if array_input and zcell <= sl: - bheadspd[kper] = abhead - condspd[kper] = acond - auxspd[kper] = [aconc, adens] - elif len(ghblist) > 0: - ghbspd[kper] = ghblist - if len(drnlist) > 0: + ghbbnd += 1 + if ghbbnd > 0: + if array_input: + bheadspd[kper] = bhead + ghbcondspd[kper] = ghbcond + ghbauxspd[kper] = [ghbconc, ghbdens] + else: + ghbspd[kper] = ghblist + if drnbnd > 0: drnspd[kper] = drnlist # drn @@ -230,8 +234,8 @@ def get_model(ws, name, array_input=False): pname="GHB-1", auxiliary=["CONCENTRATION", "DENSITY"], bhead=bheadspd, - cond=condspd, - aux=auxspd, + cond=ghbcondspd, + aux=ghbauxspd, ) else: ghb1 = flopy.mf6.ModflowGwfghb( diff --git a/make/makedefaults b/make/makedefaults index 4bb3fc86074..efd53aa4f46 100644 --- a/make/makedefaults +++ b/make/makedefaults @@ -57,11 +57,11 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - 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=f2018 -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 -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2018 -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 -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp diff --git a/src/Model/ModelUtilities/BoundaryPackageExt.f90 b/src/Model/ModelUtilities/BoundaryPackageExt.f90 index f5dfc8be57d..3799a29ae12 100644 --- a/src/Model/ModelUtilities/BoundaryPackageExt.f90 +++ b/src/Model/ModelUtilities/BoundaryPackageExt.f90 @@ -201,6 +201,10 @@ subroutine bndext_da(this) call mem_setptr(this%auxvar, 'AUXVAR', this%memoryPath) ! ! -- scalars + deallocate (this%readarraygrid) + deallocate (this%readarraylayer) + nullify (this%readarraygrid) + nullify (this%readarraylayer) nullify (this%iper) ! ! -- deallocate diff --git a/utils/zonebudget/make/makedefaults b/utils/zonebudget/make/makedefaults index 2627609f1b7..991eb997dd5 100644 --- a/utils/zonebudget/make/makedefaults +++ b/utils/zonebudget/make/makedefaults @@ -57,11 +57,11 @@ OPTLEVEL ?= -O2 # set the fortran flags ifeq ($(detected_OS), Windows) ifeq ($(FC), gfortran) - 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=f2018 -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 -fall-intrinsics -pedantic -Wcharacter-truncation $(OS_macro) -Wtabs -Wline-truncation -Wunused-label -Wunused-variable -std=f2018 -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 -Qdiag-disable:7416 -Qdiag-disable:7025 -Qdiag-disable:5268 -fpp From 1d1cf7ffdf1abdd893486f5b078b7658ac4b6c3f Mon Sep 17 00:00:00 2001 From: mjreno Date: Thu, 12 Jun 2025 13:42:58 -0400 Subject: [PATCH 21/22] add mesh global attribute --- src/Utilities/Export/DisNCStructured.f90 | 2 +- src/Utilities/Export/MeshNCModel.f90 | 8 +++++- src/Utilities/Export/NCModel.f90 | 18 +++++++++---- src/Utilities/Idm/netcdf/NCContextBuild.f90 | 29 +++++++++++++++++---- 4 files changed, 45 insertions(+), 12 deletions(-) diff --git a/src/Utilities/Export/DisNCStructured.f90 b/src/Utilities/Export/DisNCStructured.f90 index 9c7984b3d7a..5f7ee126892 100644 --- a/src/Utilities/Export/DisNCStructured.f90 +++ b/src/Utilities/Export/DisNCStructured.f90 @@ -725,7 +725,7 @@ subroutine add_global_att(this) ! source (MODFLOW 6) call nf_verify(nf90_put_att(this%ncid, NF90_GLOBAL, 'source', & this%annotation%source), this%nc_fname) - ! export type (MODFLOW 6) + ! grid type (MODFLOW 6) call nf_verify(nf90_put_att(this%ncid, NF90_GLOBAL, 'modflow_grid', & this%annotation%grid), this%nc_fname) ! MODFLOW 6 model type diff --git a/src/Utilities/Export/MeshNCModel.f90 b/src/Utilities/Export/MeshNCModel.f90 index 5f9b482dda2..894344af186 100644 --- a/src/Utilities/Export/MeshNCModel.f90 +++ b/src/Utilities/Export/MeshNCModel.f90 @@ -320,9 +320,15 @@ subroutine add_global_att(this) ! source (MODFLOW 6) call nf_verify(nf90_put_att(this%ncid, NF90_GLOBAL, 'source', & this%annotation%source), this%nc_fname) - ! export type (MODFLOW 6) + ! grid type (MODFLOW 6) call nf_verify(nf90_put_att(this%ncid, NF90_GLOBAL, 'modflow_grid', & this%annotation%grid), this%nc_fname) + ! mesh type (MODFLOW 6) + if (this%annotation%mesh /= '') then + call nf_verify(nf90_put_att(this%ncid, NF90_GLOBAL, 'mesh', & + this%annotation%mesh), this%nc_fname) + + end if ! MODFLOW 6 model type call nf_verify(nf90_put_att(this%ncid, NF90_GLOBAL, 'modflow_model', & this%annotation%model), this%nc_fname) diff --git a/src/Utilities/Export/NCModel.f90 b/src/Utilities/Export/NCModel.f90 index ba9e67206b2..3db9ddc4a3d 100644 --- a/src/Utilities/Export/NCModel.f90 +++ b/src/Utilities/Export/NCModel.f90 @@ -55,6 +55,7 @@ module NCModelExportModule type :: NCExportAnnotation character(len=LINELENGTH) :: title !< file scoped title attribute character(len=LINELENGTH) :: model !< file scoped model attribute + character(len=LINELENGTH) :: mesh !< mesh type character(len=LINELENGTH) :: grid !< grid type character(len=LINELENGTH) :: history !< file scoped history attribute character(len=LINELENGTH) :: source !< file scoped source attribute @@ -196,18 +197,20 @@ end subroutine epkg_destroy !> @brief set netcdf file scoped attributes !< - subroutine set(this, modelname, modeltype, modelfname, nctype) + subroutine set(this, modelname, modeltype, modelfname, nctype, disenum) use VersionModule, only: VERSION class(NCExportAnnotation), intent(inout) :: this character(len=*), intent(in) :: modelname character(len=*), intent(in) :: modeltype character(len=*), intent(in) :: modelfname integer(I4B), intent(in) :: nctype + integer(I4B), intent(in) :: disenum character(len=LINELENGTH) :: fullname integer :: values(8) this%title = '' this%model = '' + this%mesh = '' this%grid = '' this%history = '' this%source = '' @@ -244,11 +247,16 @@ subroutine set(this, modelname, modeltype, modelfname, nctype) this%title = trim(this%title)//' array input' end if - ! set export type + ! set mesh type if (nctype == NETCDF_MESH2D) then - this%grid = 'LAYERED MESH' - else if (nctype == NETCDF_STRUCTURED) then + this%mesh = 'LAYERED' + end if + + ! set grid type + if (disenum == DIS) then this%grid = 'STRUCTURED' + else if (disenum == DISV) then + this%grid = 'VERTEX' end if ! model description string @@ -315,7 +323,7 @@ subroutine export_init(this, modelname, modeltype, modelfname, nc_fname, & this%chunking_active = .false. ! set file scoped attributes - call this%annotation%set(modelname, modeltype, modelfname, nctype) + call this%annotation%set(modelname, modeltype, modelfname, nctype, disenum) ! set dependent variable basename select case (modeltype) diff --git a/src/Utilities/Idm/netcdf/NCContextBuild.f90 b/src/Utilities/Idm/netcdf/NCContextBuild.f90 index 774612fa32e..eaae5a420ce 100644 --- a/src/Utilities/Idm/netcdf/NCContextBuild.f90 +++ b/src/Utilities/Idm/netcdf/NCContextBuild.f90 @@ -8,8 +8,8 @@ module NCContextBuildModule use KindModule, only: DP, I4B, LGP use ConstantsModule, only: LINELENGTH, LENCOMPONENTNAME - use SimModule, only: store_error, store_error_filename - use SimVariablesModule, only: errmsg + use SimModule, only: store_error, store_warning, store_error_filename + use SimVariablesModule, only: errmsg, warnmsg use NCFileVarsModule, only: NCFileVarsType use NetCDFCommonModule, only: nf_verify, NETCDF_ATTR_STRLEN use netcdf @@ -112,23 +112,42 @@ end subroutine add_package_var !> @brief verify global attribute modflow_grid is present and return value !< function verify_global_attr(modeltype, modelname, input_name, nc_fname, ncid) & - result(grid) + result(nctype) use InputOutputModule, only: lowcase, upcase character(len=*), intent(in) :: modeltype character(len=*), intent(in) :: modelname character(len=*), intent(in) :: input_name character(len=*), intent(in) :: nc_fname integer(I4B), intent(in) :: ncid - character(len=NETCDF_ATTR_STRLEN) :: grid + character(len=NETCDF_ATTR_STRLEN) :: grid, mesh, nctype ! initialize grid grid = '' + mesh = '' + nctype = '' ! verify expected mf6_modeltype file attribute if (nf90_get_att(ncid, NF90_GLOBAL, "modflow_grid", & grid) == NF90_NOERR) then - ! set grid to upper case call upcase(grid) + if (nf90_get_att(ncid, NF90_GLOBAL, "mesh", & + mesh) == NF90_NOERR) then + call upcase(mesh) + if (mesh == 'LAYERED') then + nctype = 'LAYERED MESH' + else + errmsg = 'NetCDF unsupported mesh type: "'//trim(mesh)//'".' + call store_error(errmsg) + call store_error_filename(nc_fname) + end if + else if (grid == 'STRUCTURED') then + nctype = 'STRUCTURED' + else if (grid == 'VERTEX' .or. grid == 'LAYERED MESH') then + warnmsg = 'Verify "modflow_grid" and "mesh" global & + &attributes in file: '//trim(nc_fname) + call store_warning(warnmsg) + nctype = 'LAYERED MESH' + end if else errmsg = 'NetCDF input file global attribute "modflow_grid" not found.' call store_error(errmsg) From 0493a6ea2d4d29a3abec00c7ce9bda80a35c32ef Mon Sep 17 00:00:00 2001 From: mjreno Date: Fri, 13 Jun 2025 17:05:46 -0400 Subject: [PATCH 22/22] modflow_input attr should contain tag name --- src/Utilities/Export/NCModel.f90 | 2 +- src/Utilities/Idm/netcdf/NCArrayReader.f90 | 36 +++++++++++----------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/Utilities/Export/NCModel.f90 b/src/Utilities/Export/NCModel.f90 index 3db9ddc4a3d..2d29fbf77fc 100644 --- a/src/Utilities/Export/NCModel.f90 +++ b/src/Utilities/Export/NCModel.f90 @@ -429,7 +429,7 @@ function input_attribute(this, pkgname, idt) result(attr) attr = '' if (this%input_attr > 0) then attr = trim(this%modelname)//memPathSeparator//trim(pkgname)// & - memPathSeparator//trim(idt%mf6varname) + memPathSeparator//trim(idt%tagname) end if end function input_attribute diff --git a/src/Utilities/Idm/netcdf/NCArrayReader.f90 b/src/Utilities/Idm/netcdf/NCArrayReader.f90 index 7126f8ea1bc..fca3773e302 100644 --- a/src/Utilities/Idm/netcdf/NCArrayReader.f90 +++ b/src/Utilities/Idm/netcdf/NCArrayReader.f90 @@ -80,7 +80,7 @@ subroutine nc_array_load_int1d(int1d, mshape, idt, mf6_input, nc_vars, & call load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, & iper, input_fname) else - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) call load_integer1d_type(int1d, mf6_input, mshape, idt, nc_vars, & varid, input_fname) end if @@ -107,7 +107,7 @@ subroutine nc_array_load_int2d(int2d, mshape, idt, mf6_input, nc_vars, & call load_integer2d_layered(int2d, mf6_input, mshape, idt, nc_vars, & input_fname) else - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) call load_integer2d_type(int2d, mf6_input, mshape, idt, nc_vars, & varid, input_fname) end if @@ -133,7 +133,7 @@ subroutine nc_array_load_int3d(int3d, mshape, idt, mf6_input, nc_vars, & call load_integer3d_layered(int3d, mf6_input, mshape, idt, nc_vars, & input_fname) else - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) call load_integer3d_type(int3d, mf6_input, mshape, idt, nc_vars, & varid, input_fname) end if @@ -175,7 +175,7 @@ subroutine nc_array_load_dbl1d(dbl1d, mshape, idt, mf6_input, nc_vars, & call load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & iper, input_fname, iaux) else - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) call load_double1d_type(dbl1d, mf6_input, mshape, idt, nc_vars, & varid, input_fname) end if @@ -202,7 +202,7 @@ subroutine nc_array_load_dbl2d(dbl2d, mshape, idt, mf6_input, nc_vars, & call load_double2d_layered(dbl2d, mf6_input, mshape, idt, nc_vars, & input_fname) else - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) call load_double2d_type(dbl2d, mf6_input, mshape, idt, nc_vars, & varid, input_fname) end if @@ -228,7 +228,7 @@ subroutine nc_array_load_dbl3d(dbl3d, mshape, idt, mf6_input, nc_vars, & call load_double3d_layered(dbl3d, mf6_input, mshape, idt, nc_vars, & input_fname) else - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) call load_double3d_type(dbl3d, mf6_input, mshape, idt, nc_vars, & varid, input_fname) end if @@ -296,7 +296,7 @@ subroutine load_integer1d_spd(int1d, mf6_input, mshape, idt, nc_vars, & istp = ixstp() ! set varid - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) call get_layered_shape(mshape, nlay, layer_shape) ncpl = product(layer_shape) @@ -348,7 +348,7 @@ subroutine load_integer1d_layered(int1d, mf6_input, mshape, idt, nc_vars, & ncpl = product(layer_shape) index_start = 1 do k = 1, nlay - varid = nc_vars%varid(idt%mf6varname, layer=k) + varid = nc_vars%varid(idt%tagname, layer=k) index_stop = index_start + ncpl - 1 int1d_ptr(1:ncpl) => int1d(index_start:index_stop) call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d_ptr), & @@ -380,7 +380,7 @@ subroutine load_integer1d_layered_spd(int1d, mf6_input, mshape, idt, nc_vars, & nvals = product(mshape) ncpl = product(layer_shape) - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) select case (idt%shape) case ('NCPL', 'NAUX NCPL') call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d, & @@ -449,7 +449,7 @@ subroutine load_integer2d_layered(int2d, mf6_input, mshape, idt, nc_vars, & call get_layered_shape(mshape, nlay, layer_shape) ncpl = layer_shape(1) do k = 1, nlay - varid = nc_vars%varid(idt%mf6varname, layer=k) + varid = nc_vars%varid(idt%tagname, layer=k) int1d_ptr(1:ncpl) => int2d(1:ncpl, k) call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d_ptr), & nc_vars%nc_fname) @@ -493,7 +493,7 @@ subroutine load_integer3d_layered(int3d, mf6_input, mshape, idt, nc_vars, & ncpl = product(layer_shape) do k = 1, nlay - varid = nc_vars%varid(idt%mf6varname, layer=k) + varid = nc_vars%varid(idt%tagname, layer=k) index_stop = index_start + ncpl - 1 int1d_ptr(1:ncpl) => int3d(:, :, k:k) call nf_verify(nf90_get_var(nc_vars%ncid, varid, int1d_ptr), & @@ -570,9 +570,9 @@ subroutine load_double1d_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & ! set varid if (present(iaux)) then - varid = nc_vars%varid(idt%mf6varname, iaux=iaux) + varid = nc_vars%varid(idt%tagname, iaux=iaux) else - varid = nc_vars%varid(idt%mf6varname) + varid = nc_vars%varid(idt%tagname) end if call get_layered_shape(mshape, nlay, layer_shape) @@ -631,7 +631,7 @@ subroutine load_double1d_layered(dbl1d, mf6_input, mshape, idt, nc_vars, & ncpl = product(layer_shape) do k = 1, nlay - varid = nc_vars%varid(idt%mf6varname, layer=k) + varid = nc_vars%varid(idt%tagname, layer=k) index_stop = index_start + ncpl - 1 dbl1d_ptr(1:ncpl) => dbl1d(index_start:index_stop) call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), & @@ -667,9 +667,9 @@ subroutine load_double1d_layered_spd(dbl1d, mf6_input, mshape, idt, nc_vars, & do k = 1, nlay if (present(iaux)) then - varid = nc_vars%varid(idt%mf6varname, layer=k, iaux=iaux) + varid = nc_vars%varid(idt%tagname, layer=k, iaux=iaux) else - varid = nc_vars%varid(idt%mf6varname, layer=k) + varid = nc_vars%varid(idt%tagname, layer=k) end if call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr, & start=(/1, istp/), count=(/ncpl, 1/)), & @@ -745,7 +745,7 @@ subroutine load_double2d_layered(dbl2d, mf6_input, mshape, idt, nc_vars, & call get_layered_shape(mshape, nlay, layer_shape) ncpl = layer_shape(1) do k = 1, nlay - varid = nc_vars%varid(idt%mf6varname, layer=k) + varid = nc_vars%varid(idt%tagname, layer=k) dbl1d_ptr(1:ncpl) => dbl2d(1:ncpl, k) call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), & nc_vars%nc_fname) @@ -791,7 +791,7 @@ subroutine load_double3d_layered(dbl3d, mf6_input, mshape, idt, nc_vars, & ncpl = product(layer_shape) index_start = 1 do k = 1, nlay - varid = nc_vars%varid(idt%mf6varname, layer=k) + varid = nc_vars%varid(idt%tagname, layer=k) index_stop = index_start + ncpl - 1 dbl1d_ptr(1:ncpl) => dbl3d(:, :, k:k) call nf_verify(nf90_get_var(nc_vars%ncid, varid, dbl1d_ptr), &