From dca518ae8dfddf01c7a0cd9835a7578a82b22fb3 Mon Sep 17 00:00:00 2001 From: mjreno Date: Mon, 13 May 2024 08:13:16 -0400 Subject: [PATCH] feat(idm): support binary for regular, numeric list input blocks (#1783) * support binary for regular, numeric list input blocks * some cleanup * more cleanup * refactor to remove exchange reference in static loader --------- Co-authored-by: mjreno --- doc/ReleaseNotes/develop.tex | 1 + doc/mf6io/mf6ivar/dfn/exg-gwegwe.dfn | 1 + doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn | 1 + doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn | 1 + src/Exchange/DisConnExchange.f90 | 2 +- src/Idm/exg-gwegweidm.f90 | 8 +- src/Idm/exg-gwfgwfidm.f90 | 8 +- src/Idm/exg-gwtgwtidm.f90 | 8 +- src/Utilities/Idm/BoundInputContext.f90 | 21 +- src/Utilities/Idm/DynamicPackageParams.f90 | 48 +++-- src/Utilities/Idm/SourceCommon.f90 | 21 -- .../Idm/mf6blockfile/LoadMf6File.f90 | 203 +++++++++++++++--- .../Idm/mf6blockfile/Mf6FileListInput.f90 | 94 +------- .../Idm/mf6blockfile/StructArray.f90 | 5 +- 14 files changed, 235 insertions(+), 187 deletions(-) diff --git a/doc/ReleaseNotes/develop.tex b/doc/ReleaseNotes/develop.tex index 2fa10ce2031..c2e367100f1 100644 --- a/doc/ReleaseNotes/develop.tex +++ b/doc/ReleaseNotes/develop.tex @@ -8,6 +8,7 @@ \item A new Groundwater Energy (GWE) transport model is introduced to the code base for simulating heat transport in the subsurface. Additional information for activating the GWE model type within a MODFLOW 6 simulation is available within the mf6io.pdf document. New example problems have been developed for testing and demonstrating GWE capabilities (in addition to other internal tests that help verify the accuracy of GWE); however, additional changes to the code and input may be necessary in response to user needs and further testing. \item A new capability has been introduced to create parameter layer export files of user input data for packages including DIS, DISV, IC, NPF, DSP(GWT), MIP(PRT), and CND(GWE). The number of supported packages is expected to increase in the future. The capability can be turned on with the package EXPORT\_ARRAY\_ASCII option. The package parameter export set is pre-defined and currently focuses on griddata. The number of parameters per package may also increase in the future. \item Add capability to vary the hydraulic conductivity of the reach streambed (RHK) by stress period in the Streamflow Routing (SFR) package. RHK can be modified by stress period using the BEDK SFRSETTING. RHK can also be defined using a timeseries string in the PACKAGEDATA or PERIOD blocks. + \item Extend binary input support to all list style input blocks that have a regular shape and don't contain string fields (e.g. BOUNDNAME). \end{itemize} %\underline{EXAMPLES} diff --git a/doc/mf6io/mf6ivar/dfn/exg-gwegwe.dfn b/doc/mf6io/mf6ivar/dfn/exg-gwegwe.dfn index 315296422bf..7b79ce7e7ea 100644 --- a/doc/mf6io/mf6ivar/dfn/exg-gwegwe.dfn +++ b/doc/mf6io/mf6ivar/dfn/exg-gwegwe.dfn @@ -267,6 +267,7 @@ reader urword optional true longname auxiliary variables description represents the values of the auxiliary variables for each GWEGWE Exchange. The values of auxiliary variables must be present for each exchange. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. +mf6internal auxvar block exchangedata name boundname diff --git a/doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn b/doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn index e27195cb393..0f68acead6f 100644 --- a/doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn +++ b/doc/mf6io/mf6ivar/dfn/exg-gwfgwf.dfn @@ -307,6 +307,7 @@ reader urword optional true longname auxiliary variables description represents the values of the auxiliary variables for each GWFGWF Exchange. The values of auxiliary variables must be present for each exchange. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. +mf6internal auxvar block exchangedata name boundname diff --git a/doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn b/doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn index 7d8b419ddd1..11af74961a7 100644 --- a/doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn +++ b/doc/mf6io/mf6ivar/dfn/exg-gwtgwt.dfn @@ -267,6 +267,7 @@ reader urword optional true longname auxiliary variables description represents the values of the auxiliary variables for each GWTGWT Exchange. The values of auxiliary variables must be present for each exchange. The values must be specified in the order of the auxiliary variables specified in the OPTIONS block. +mf6internal auxvar block exchangedata name boundname diff --git a/src/Exchange/DisConnExchange.f90 b/src/Exchange/DisConnExchange.f90 index 3429c5bf963..5c758cb7d7d 100644 --- a/src/Exchange/DisConnExchange.f90 +++ b/src/Exchange/DisConnExchange.f90 @@ -291,7 +291,7 @@ subroutine source_data(this, iout) call mem_setptr(cl1, 'CL1', this%input_mempath) call mem_setptr(cl2, 'CL2', this%input_mempath) call mem_setptr(hwva, 'HWVA', this%input_mempath) - call mem_setptr(auxvar, 'AUX', this%input_mempath) + call mem_setptr(auxvar, 'AUXVAR', this%input_mempath) call mem_setptr(boundname, 'BOUNDNAME', this%input_mempath) ndim1 = size(cellidm1, dim=1) ndim2 = size(cellidm2, dim=1) diff --git a/src/Idm/exg-gwegweidm.f90 b/src/Idm/exg-gwegweidm.f90 index 588078857a2..5581f5e9098 100644 --- a/src/Idm/exg-gwegweidm.f90 +++ b/src/Idm/exg-gwegweidm.f90 @@ -36,7 +36,7 @@ module ExgGwegweInputModule logical :: cl1 = .false. logical :: cl2 = .false. logical :: hwva = .false. - logical :: aux = .false. + logical :: auxvar = .false. logical :: boundname = .false. end type ExgGwegweParamFoundType @@ -468,13 +468,13 @@ module ExgGwegweInputModule ) type(InputParamDefinitionType), parameter :: & - exggwegwe_aux = InputParamDefinitionType & + exggwegwe_auxvar = InputParamDefinitionType & ( & 'EXG', & ! component 'GWEGWE', & ! subcomponent 'EXCHANGEDATA', & ! block 'AUX', & ! tag name - 'AUX', & ! fortran variable + 'AUXVAR', & ! fortran variable 'DOUBLE1D', & ! type 'NAUX', & ! shape .false., & ! required @@ -529,7 +529,7 @@ module ExgGwegweInputModule exggwegwe_cl1, & exggwegwe_cl2, & exggwegwe_hwva, & - exggwegwe_aux, & + exggwegwe_auxvar, & exggwegwe_boundname & ] diff --git a/src/Idm/exg-gwfgwfidm.f90 b/src/Idm/exg-gwfgwfidm.f90 index 888f6422cb1..85f433aed80 100644 --- a/src/Idm/exg-gwfgwfidm.f90 +++ b/src/Idm/exg-gwfgwfidm.f90 @@ -40,7 +40,7 @@ module ExgGwfgwfInputModule logical :: cl1 = .false. logical :: cl2 = .false. logical :: hwva = .false. - logical :: aux = .false. + logical :: auxvar = .false. logical :: boundname = .false. end type ExgGwfgwfParamFoundType @@ -540,13 +540,13 @@ module ExgGwfgwfInputModule ) type(InputParamDefinitionType), parameter :: & - exggwfgwf_aux = InputParamDefinitionType & + exggwfgwf_auxvar = InputParamDefinitionType & ( & 'EXG', & ! component 'GWFGWF', & ! subcomponent 'EXCHANGEDATA', & ! block 'AUX', & ! tag name - 'AUX', & ! fortran variable + 'AUXVAR', & ! fortran variable 'DOUBLE1D', & ! type 'NAUX', & ! shape .false., & ! required @@ -605,7 +605,7 @@ module ExgGwfgwfInputModule exggwfgwf_cl1, & exggwfgwf_cl2, & exggwfgwf_hwva, & - exggwfgwf_aux, & + exggwfgwf_auxvar, & exggwfgwf_boundname & ] diff --git a/src/Idm/exg-gwtgwtidm.f90 b/src/Idm/exg-gwtgwtidm.f90 index dba0074ce73..76255bc488a 100644 --- a/src/Idm/exg-gwtgwtidm.f90 +++ b/src/Idm/exg-gwtgwtidm.f90 @@ -36,7 +36,7 @@ module ExgGwtgwtInputModule logical :: cl1 = .false. logical :: cl2 = .false. logical :: hwva = .false. - logical :: aux = .false. + logical :: auxvar = .false. logical :: boundname = .false. end type ExgGwtgwtParamFoundType @@ -468,13 +468,13 @@ module ExgGwtgwtInputModule ) type(InputParamDefinitionType), parameter :: & - exggwtgwt_aux = InputParamDefinitionType & + exggwtgwt_auxvar = InputParamDefinitionType & ( & 'EXG', & ! component 'GWTGWT', & ! subcomponent 'EXCHANGEDATA', & ! block 'AUX', & ! tag name - 'AUX', & ! fortran variable + 'AUXVAR', & ! fortran variable 'DOUBLE1D', & ! type 'NAUX', & ! shape .false., & ! required @@ -529,7 +529,7 @@ module ExgGwtgwtInputModule exggwtgwt_cl1, & exggwtgwt_cl2, & exggwtgwt_hwva, & - exggwtgwt_aux, & + exggwtgwt_auxvar, & exggwtgwt_boundname & ] diff --git a/src/Utilities/Idm/BoundInputContext.f90 b/src/Utilities/Idm/BoundInputContext.f90 index fd6af60c6a4..cecc3d7282d 100644 --- a/src/Utilities/Idm/BoundInputContext.f90 +++ b/src/Utilities/Idm/BoundInputContext.f90 @@ -133,7 +133,7 @@ subroutine allocate_scalars(this) end if ! ! -- initialize package params object - call this%package_params%init(this%mf6_input, this%readasarrays, & + call this%package_params%init(this%mf6_input, 'PERIOD', this%readasarrays, & this%naux, this%inamedbound) ! ! -- return @@ -167,22 +167,11 @@ subroutine allocate_arrays(this) call mem_allocate(cellid, 0, 0, 'CELLID', this%mf6_input%mempath) end if ! - ! -- allocate or set pointer to BOUNDNAME - if (this%inamedbound == 0) then - call mem_allocate(this%boundname_cst, LENBOUNDNAME, 0, & - 'BOUNDNAME', this%mf6_input%mempath) - ! - else - call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%mf6_input%mempath) - end if + ! -- set pointer to BOUNDNAME + call mem_setptr(this%boundname_cst, 'BOUNDNAME', this%mf6_input%mempath) ! - ! -- allocate or set pointer to AUXVAR - if (this%naux == 0) then - call mem_allocate(this%auxvar, 0, 0, 'AUXVAR', this%mf6_input%mempath) - ! - else - call mem_setptr(this%auxvar, 'AUXVAR', this%mf6_input%mempath) - end if + ! -- set pointer to AUXVAR + call mem_setptr(this%auxvar, 'AUXVAR', this%mf6_input%mempath) ! ! -- return return diff --git a/src/Utilities/Idm/DynamicPackageParams.f90 b/src/Utilities/Idm/DynamicPackageParams.f90 index 7cb43b53b5f..c4eec5f6dcd 100644 --- a/src/Utilities/Idm/DynamicPackageParams.f90 +++ b/src/Utilities/Idm/DynamicPackageParams.f90 @@ -5,7 +5,7 @@ module DynamicPackageParamsModule use KindModule, only: DP, I4B, LGP - use ConstantsModule, only: LINELENGTH, DZERO, IZERO + use ConstantsModule, only: LINELENGTH, LENBOUNDNAME, DZERO, IZERO use SimVariablesModule, only: errmsg use SimModule, only: store_error, store_error_filename use MemoryManagerModule, only: mem_allocate @@ -30,7 +30,8 @@ module DynamicPackageParamsModule !< type :: DynamicPackageParamsType character(len=LINELENGTH), dimension(:), allocatable :: params !< in scope param tags - integer(I4B) :: naux !< number of aux variables in package + character(len=LINELENGTH) :: blockname !< name of block + integer(I4B) :: iauxiliary !< package auxiliary active, 0=inactive, active for values > 0 integer(I4B) :: inamedbound !< package inamedbound setting integer(I4B) :: nparam !< number of in scope params type(ModflowInputType) :: mf6_input !< description of input @@ -47,19 +48,23 @@ module DynamicPackageParamsModule !> @brief initialize dynamic param filter !! !< - subroutine init(this, mf6_input, readasarrays, naux, inamedbound) + subroutine init(this, mf6_input, blockname, readasarrays, iauxiliary, & + inamedbound) ! -- modules ! -- dummy class(DynamicPackageParamsType) :: this type(ModflowInputType), intent(in) :: mf6_input + character(len=*) :: blockname logical(LGP), intent(in) :: readasarrays - integer(I4B), intent(in) :: naux + integer(I4B), intent(in) :: iauxiliary integer(I4B), intent(in) :: inamedbound + !integer(I4B) :: iparam ! -- local ! this%mf6_input = mf6_input + this%blockname = blockname this%nparam = 0 - this%naux = naux + this%iauxiliary = iauxiliary this%inamedbound = inamedbound ! ! -- determine in scope input params @@ -98,6 +103,8 @@ subroutine set_filtered_grid(this) ! -- local type(InputParamDefinitionType), pointer :: idt integer(I4B), dimension(:), allocatable :: idt_idxs + type(CharacterStringType), dimension(:), pointer, contiguous :: boundname + real(DP), dimension(:, :), pointer, contiguous :: auxvar integer(I4B) :: keepcnt, iparam logical(LGP) :: keep ! @@ -112,13 +119,18 @@ subroutine set_filtered_grid(this) ! -- assign param definition pointer idt => this%mf6_input%param_dfns(iparam) ! - if (idt%blockname /= 'PERIOD') then + if (idt%blockname /= this%blockname) then keep = .false. end if ! if (idt%tagname == 'AUX') then - if (this%naux == 0) then + if (this%iauxiliary == 0) then keep = .false. + call mem_allocate(auxvar, 0, 0, 'AUXVAR', this%mf6_input%mempath) + end if + if (this%inamedbound == 0) then + call mem_allocate(boundname, LENBOUNDNAME, 0, 'BOUNDNAME', & + this%mf6_input%mempath) end if end if ! @@ -160,6 +172,8 @@ subroutine set_filtered_list(this) ! -- local type(InputParamDefinitionType), pointer :: ra_idt, idt character(len=LINELENGTH), dimension(:), allocatable :: ra_cols + type(CharacterStringType), dimension(:), pointer, contiguous :: boundname + real(DP), dimension(:, :), pointer, contiguous :: auxvar integer(I4B) :: ra_ncol, icol, keepcnt logical(LGP) :: keep ! @@ -171,7 +185,7 @@ subroutine set_filtered_list(this) get_aggregate_definition_type(this%mf6_input%aggregate_dfns, & this%mf6_input%component_type, & this%mf6_input%subcomponent_type, & - 'PERIOD') + this%blockname) ! ! -- split recarray definition call idt_parse_rectype(ra_idt, ra_cols, ra_ncol) @@ -185,21 +199,26 @@ subroutine set_filtered_list(this) idt => get_param_definition_type(this%mf6_input%param_dfns, & this%mf6_input%component_type, & this%mf6_input%subcomponent_type, & - 'PERIOD', ra_cols(icol), '') + this%blockname, ra_cols(icol), '') ! if (ra_cols(icol) == 'RECARRAY') then ! no-op else if (ra_cols(icol) == 'AUX') then - if (this%naux > 0) then + if (this%iauxiliary > 0) then keep = .true. + else + call mem_allocate(auxvar, 0, 0, 'AUXVAR', this%mf6_input%mempath) end if else if (ra_cols(icol) == 'BOUNDNAME') then if (this%inamedbound /= 0) then keep = .true. + else + call mem_allocate(boundname, LENBOUNDNAME, 0, 'BOUNDNAME', & + this%mf6_input%mempath) end if else ! -- determine if the param is scope - keep = pkg_param_in_scope(this%mf6_input, ra_cols(icol)) + keep = pkg_param_in_scope(this%mf6_input, this%blockname, ra_cols(icol)) end if ! if (keep) then @@ -331,11 +350,12 @@ end subroutine allocate_param_dbl2d !> @brief determine if input param is in scope for a package !! !< - function pkg_param_in_scope(mf6_input, tagname) result(in_scope) + function pkg_param_in_scope(mf6_input, blockname, tagname) result(in_scope) ! -- modules use MemoryManagerModule, only: get_isize, mem_setptr ! -- dummy type(ModflowInputType), intent(in) :: mf6_input + character(len=*), intent(in) :: blockname character(len=*), intent(in) :: tagname ! -- return logical(LGP) :: in_scope @@ -350,7 +370,7 @@ function pkg_param_in_scope(mf6_input, tagname) result(in_scope) idt => get_param_definition_type(mf6_input%param_dfns, & mf6_input%component_type, & mf6_input%subcomponent_type, & - 'PERIOD', tagname, '') + blockname, tagname, '') ! if (idt%required) then ! -- required params always included @@ -376,6 +396,8 @@ function pkg_param_in_scope(mf6_input, tagname) result(in_scope) end if end if ! + case ('NAM') + in_scope = .true. case default errmsg = 'IDM unimplemented. DynamicPackageParamsType::pkg_param_in_scope & &add case tagname='//trim(idt%tagname) diff --git a/src/Utilities/Idm/SourceCommon.f90 b/src/Utilities/Idm/SourceCommon.f90 index cbd997ad08a..4e1246484f9 100644 --- a/src/Utilities/Idm/SourceCommon.f90 +++ b/src/Utilities/Idm/SourceCommon.f90 @@ -18,7 +18,6 @@ module SourceCommonModule public :: idm_component_type, idm_subcomponent_type, idm_subcomponent_name public :: set_model_shape public :: get_shape_from_string - public :: mem_allocate_naux public :: file_ext public :: ifind_charstr public :: filein_fname @@ -405,26 +404,6 @@ subroutine set_model_shape(ftype, fname, model_mempath, dis_mempath, & return end subroutine set_model_shape - subroutine mem_allocate_naux(mempath) - use MemoryManagerModule, only: mem_allocate, mem_setptr, get_isize - character(len=*), intent(in) :: mempath - integer(I4B), pointer :: naux - integer(I4B) :: isize - ! - ! -- initialize - nullify (naux) - ! - ! -- allocate optional input scalars locally - call get_isize('NAUX', mempath, isize) - if (isize < 0) then - call mem_allocate(naux, 'NAUX', mempath) - naux = 0 - end if - ! - ! -- return - return - end subroutine mem_allocate_naux - function ifind_charstr(array, str) use CharacterStringModule, only: CharacterStringType ! -- Find the first array element containing str diff --git a/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 b/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 index d1da5d94355..fa18336bc77 100644 --- a/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 +++ b/src/Utilities/Idm/mf6blockfile/LoadMf6File.f90 @@ -36,6 +36,7 @@ module LoadMf6FileModule implicit none private public :: LoadMf6FileType + public :: read_control_record !> @brief Static parser based input loader !! @@ -49,8 +50,12 @@ module LoadMf6FileModule type(StructArrayType), pointer :: structarray => null() !< structarray for loading list input type(ModflowInputType) :: mf6_input !< description of input character(len=LINELENGTH) :: filename !< name of ascii input file + character(len=LINELENGTH), dimension(:), allocatable :: block_tags !< read block tags logical(LGP) :: ts_active !< is timeseries active logical(LGP) :: export !< is array export active + logical(LGP) :: readasarrays + integer(I4B) :: inamedbound + integer(I4B) :: iauxiliary integer(I4B) :: iout !< inunit for list log contains procedure :: load @@ -129,6 +134,9 @@ subroutine init(this, parser, mf6_input, filename, iout) this%filename = filename this%ts_active = .false. this%export = .false. + this%readasarrays = .false. + this%inamedbound = 0 + this%iauxiliary = 0 this%iout = iout ! call get_isize('MODEL_SHAPE', mf6_input%component_mempath, isize) @@ -167,12 +175,16 @@ subroutine load_block(this, iblk) call destructStructArray(this%structarray) end if ! + allocate (this%block_tags(0)) + ! ! -- load the block call this%parse_block(iblk, .false.) ! ! -- post process block call this%block_post_process(iblk) ! + deallocate (this%block_tags) + ! ! --return return end subroutine load_block @@ -208,15 +220,37 @@ end subroutine finalize !< subroutine block_post_process(this, iblk) ! -- modules - use MemoryManagerModule, only: get_isize - use SourceCommonModule, only: set_model_shape, mem_allocate_naux + use ConstantsModule, only: LENBOUNDNAME + use CharacterStringModule, only: CharacterStringType + use SourceCommonModule, only: set_model_shape ! -- dummy class(LoadMf6FileType) :: this integer(I4B), intent(in) :: iblk ! -- local type(InputParamDefinitionType), pointer :: idt - integer(I4B) :: iparam, ts6_size, export_size + integer(I4B) :: iparam + integer(I4B), pointer :: intptr ! + ! -- update state based on read tags + do iparam = 1, size(this%block_tags) + select case (this%mf6_input%block_dfns(iblk)%blockname) + case ('OPTIONS') + if (this%block_tags(iparam) == 'AUXILIARY') then + this%iauxiliary = 1 + else if (this%block_tags(iparam) == 'BOUNDNAMES') then + this%inamedbound = 1 + else if (this%block_tags(iparam) == 'READASARRAYS') then + this%readasarrays = .true. + else if (this%block_tags(iparam) == 'TS6') then + this%ts_active = .true. + else if (this%block_tags(iparam) == 'EXPORT_ARRAY_ASCII') then + this%export = .true. + end if + case default + end select + end do + ! + ! -- update input context allocations based on dfn set and input select case (this%mf6_input%block_dfns(iblk)%blockname) case ('OPTIONS') ! -- allocate naux and set to 0 if not allocated @@ -225,25 +259,13 @@ subroutine block_post_process(this, iblk) ! if (idt%blockname == 'OPTIONS' .and. & idt%tagname == 'AUXILIARY') then - call mem_allocate_naux(this%mf6_input%mempath) + if (this%iauxiliary == 0) then + call mem_allocate(intptr, 'NAUX', this%mf6_input%mempath) + intptr = 0 + end if exit end if end do - ! - ! -- determine if TS6 files were provided in OPTIONS block - call get_isize('TS6_FILENAME', this%mf6_input%mempath, ts6_size) - ! - if (ts6_size > 0) then - this%ts_active = .true. - end if - ! - ! -- determine if EXPORT options were provided - call get_isize('EXPORT_ASCII', this%mf6_input%mempath, export_size) - ! - if (export_size > 0) then - this%export = .true. - end if - ! case ('DIMENSIONS') ! -- set model shape if discretization dimensions have been read if (this%mf6_input%pkgtype(1:3) == 'DIS') then @@ -434,6 +456,7 @@ end subroutine parse_keyword_tag !< recursive subroutine parse_tag(this, iblk, recursive_call) ! -- modules + use ArrayHandlersModule, only: expandarray ! -- dummy class(LoadMf6FileType) :: this integer(I4B), intent(in) :: iblk @@ -504,6 +527,10 @@ recursive subroutine parse_tag(this, iblk, recursive_call) call this%parse_tag(iblk, .true.) end if ! + ! + call expandarray(this%block_tags) + this%block_tags(size(this%block_tags)) = trim(idt%tagname) + ! ! -- return return end subroutine parse_tag @@ -552,20 +579,25 @@ end function block_index_dfn subroutine parse_structarray_block(this, iblk) ! -- modules use StructArrayModule, only: StructArrayType, constructStructArray + use DynamicPackageParamsModule, only: DynamicPackageParamsType ! -- dummy class(LoadMf6FileType) :: this integer(I4B), intent(in) :: iblk ! -- local + type(DynamicPackageParamsType) :: block_params type(InputParamDefinitionType), pointer :: idt !< input data type object describing this record type(InputParamDefinitionType), target :: blockvar_idt - integer(I4B) :: blocknum, iwords + integer(I4B) :: blocknum integer(I4B), pointer :: nrow integer(I4B) :: nrows, nrowsread - integer(I4B) :: icol + integer(I4B) :: ibinary, oc_inunit + integer(I4B) :: icol, iparam integer(I4B) :: ncol - integer(I4B) :: nwords - character(len=16), dimension(:), allocatable :: words - character(len=:), allocatable :: parse_str + ! + ! -- initialize package params object + call block_params%init(this%mf6_input, & + this%mf6_input%block_dfns(iblk)%blockname, & + this%readasarrays, this%iauxiliary, this%inamedbound) ! ! -- set input definition for this block idt => & @@ -581,12 +613,10 @@ subroutine parse_structarray_block(this, iblk) blocknum = 0 end if ! - ! -- identify variable names, ignore first RECARRAY column - parse_str = trim(idt%datatype)//' ' - call parseline(parse_str, nwords, words) - ncol = nwords - 1 + ! -- set ncol + ncol = block_params%nparam ! - ! -- a column will be prepended if block is reloadable + ! -- add col if block is reloadable if (blocknum > 0) ncol = ncol + 1 ! ! -- use shape to set the max num of rows @@ -619,11 +649,11 @@ subroutine parse_structarray_block(this, iblk) end if ! ! -- set indexes (where first column is blocknum) - iwords = icol + iparam = icol - 1 else ! ! -- set indexes (no blocknum column) - iwords = icol + 1 + iparam = icol end if ! ! -- set pointer to input definition for this 1d vector @@ -632,15 +662,33 @@ subroutine parse_structarray_block(this, iblk) this%mf6_input%component_type, & this%mf6_input%subcomponent_type, & this%mf6_input%block_dfns(iblk)%blockname, & - words(iwords), this%filename) + block_params%params(iparam), this%filename) ! ! -- allocate variable in memory manager call this%structarray%mem_create_vector(icol, idt) end do ! - ! -- read the structured array - nrowsread = this%structarray%read_from_parser(this%parser, this%ts_active, & - this%iout) + ! -- read the block control record + ibinary = read_control_record(this%parser, oc_inunit, this%iout) + ! + if (ibinary == 1) then + ! + ! -- read from binary + nrowsread = this%structarray%read_from_binary(oc_inunit, this%iout) + ! + call this%parser%terminateblock() + ! + close (oc_inunit) + ! + else + ! + ! -- read from ascii + nrowsread = this%structarray%read_from_parser(this%parser, this%ts_active, & + this%iout) + end if + ! + ! -- clean up + call block_params%destroy() ! ! -- return return @@ -1135,4 +1183,89 @@ subroutine get_layered_shape(mshape, nlay, layer_shape) end subroutine get_layered_shape + function read_control_record(parser, oc_inunit, iout) result(ibinary) + ! -- modules + use SimModule, only: store_error_unit + use InputOutputModule, only: urword + use InputOutputModule, only: openfile + use OpenSpecModule, only: form, access + use ConstantsModule, only: LINELENGTH + use BlockParserModule, only: BlockParserType + ! -- dummy + type(BlockParserType), intent(inout) :: parser + integer(I4B), intent(inout) :: oc_inunit + integer(I4B), intent(in) :: iout + ! -- return + integer(I4B) :: ibinary + ! -- local + integer(I4B) :: lloc, istart, istop, idum, inunit, itmp, ierr + integer(I4B) :: nunopn = 99 + character(len=:), allocatable :: line + character(len=LINELENGTH) :: fname + logical :: exists + real(DP) :: r + ! -- formats + character(len=*), parameter :: fmtocne = & + &"('Specified OPEN/CLOSE file ',(A),' does not exist')" + character(len=*), parameter :: fmtobf = & + &"(1X,/1X,'OPENING BINARY FILE ON UNIT ',I0,':',/1X,A)" + ! + ! -- initialize oc_inunit and ibinary + oc_inunit = 0 + ibinary = 0 + ! + inunit = parser%getunit() + ! + ! -- Read to the first non-commented line + lloc = 1 + call parser%line_reader%rdcom(inunit, iout, line, ierr) + call urword(line, lloc, istart, istop, 1, idum, r, iout, inunit) + ! + if (line(istart:istop) == 'OPEN/CLOSE') then + ! + ! -- get filename + call urword(line, lloc, istart, istop, 0, idum, r, & + iout, inunit) + ! + fname = line(istart:istop) + ! + ! -- check to see if file OPEN/CLOSE file exists + inquire (file=fname, exist=exists) + ! + if (.not. exists) then + write (errmsg, fmtocne) line(istart:istop) + call store_error(errmsg) + call store_error('Specified OPEN/CLOSE file does not exist') + call store_error_unit(inunit) + end if + ! + ! -- Check for (BINARY) keyword + call urword(line, lloc, istart, istop, 1, idum, r, & + iout, inunit) + ! + if (line(istart:istop) == '(BINARY)') ibinary = 1 + ! + ! -- Open the file depending on ibinary flag + if (ibinary == 1) then + oc_inunit = nunopn + itmp = iout + ! + if (iout > 0) then + itmp = 0 + write (iout, fmtobf) oc_inunit, trim(adjustl(fname)) + end if + ! + call openfile(oc_inunit, itmp, fname, 'OPEN/CLOSE', & + fmtarg_opt=form, accarg_opt=access) + end if + end if + ! + if (ibinary == 0) then + call parser%line_reader%bkspc(parser%getunit()) + end if + ! + ! -- return + return + end function read_control_record + end module LoadMf6FileModule diff --git a/src/Utilities/Idm/mf6blockfile/Mf6FileListInput.f90 b/src/Utilities/Idm/mf6blockfile/Mf6FileListInput.f90 index 52cc4646b31..9b989b6e63f 100644 --- a/src/Utilities/Idm/mf6blockfile/Mf6FileListInput.f90 +++ b/src/Utilities/Idm/mf6blockfile/Mf6FileListInput.f90 @@ -36,8 +36,6 @@ module Mf6FileListInputModule !< type, abstract, extends(AsciiDynamicPkgLoadBaseType) :: ListInputBaseType integer(I4B) :: ts_active - integer(I4B) :: ibinary - integer(I4B) :: oc_inunit type(TimeSeriesManagerType), pointer :: tsmanager => null() type(StructArrayType), pointer :: structarray => null() contains @@ -46,7 +44,6 @@ module Mf6FileListInputModule procedure :: df procedure :: ad procedure :: reset - procedure :: read_control_record end type ListInputBaseType !> @brief Boundary package list loader. @@ -142,32 +139,33 @@ end subroutine bndlist_init subroutine bndlist_rp(this, parser) ! -- modules use BlockParserModule, only: BlockParserType + use LoadMf6FileModule, only: read_control_record use StructVectorModule, only: StructVectorType use IdmLoggerModule, only: idm_log_header, idm_log_close ! -- dummy class(BoundListInputType), intent(inout) :: this type(BlockParserType), pointer, intent(inout) :: parser ! -- local + integer(I4B) :: ibinary + integer(I4B) :: oc_inunit logical(LGP) :: ts_active ! call this%reset() ! - call this%read_control_record(parser) + ibinary = read_control_record(parser, oc_inunit, this%iout) ! ! -- log lst file header call idm_log_header(this%mf6_input%component_name, & this%mf6_input%subcomponent_name, this%iout) ! - if (this%ibinary == 1) then + if (ibinary == 1) then ! this%bound_context%nbound = & - this%structarray%read_from_binary(this%oc_inunit, this%iout) + this%structarray%read_from_binary(oc_inunit, this%iout) ! call parser%terminateblock() ! - close (this%oc_inunit) - this%ibinary = 0 - this%oc_inunit = 0 + close (oc_inunit) ! else ! @@ -413,8 +411,6 @@ subroutine base_init(this, mf6_input, component_name, component_input_name, & ! ! -- initialize this%ts_active = 0 - this%ibinary = 0 - this%oc_inunit = 0 ! ! -- initialize static loader call loader%init(parser, mf6_input, this%input_name, iout) @@ -506,80 +502,4 @@ subroutine reset(this) return end subroutine reset - subroutine read_control_record(this, parser) - ! -- modules - use InputOutputModule, only: urword - use OpenSpecModule, only: form, access - use ConstantsModule, only: LINELENGTH - use BlockParserModule, only: BlockParserType - ! -- dummy - class(ListInputBaseType), intent(inout) :: this - type(BlockParserType), intent(inout) :: parser - ! -- local - integer(I4B) :: lloc, istart, istop, idum, inunit, itmp, ierr - integer(I4B) :: nunopn = 99 - character(len=:), allocatable :: line - character(len=LINELENGTH) :: fname - logical :: exists - real(DP) :: r - ! -- formats - character(len=*), parameter :: fmtocne = & - &"('Specified OPEN/CLOSE file ',(A),' does not exist')" - character(len=*), parameter :: fmtobf = & - &"(1X,/1X,'OPENING BINARY FILE ON UNIT ',I0,':',/1X,A)" - ! - inunit = parser%getunit() - ! - ! -- Read to the first non-commented line - lloc = 1 - call parser%line_reader%rdcom(inunit, this%iout, line, ierr) - call urword(line, lloc, istart, istop, 1, idum, r, this%iout, inunit) - ! - if (line(istart:istop) == 'OPEN/CLOSE') then - ! - ! -- get filename - call urword(line, lloc, istart, istop, 0, idum, r, & - this%iout, inunit) - ! - fname = line(istart:istop) - ! - ! -- check to see if file OPEN/CLOSE file exists - inquire (file=fname, exist=exists) - ! - if (.not. exists) then - write (errmsg, fmtocne) line(istart:istop) - call store_error(errmsg) - call store_error('Specified OPEN/CLOSE file does not exist') - call store_error_unit(inunit) - end if - ! - ! -- Check for (BINARY) keyword - call urword(line, lloc, istart, istop, 1, idum, r, & - this%iout, inunit) - ! - if (line(istart:istop) == '(BINARY)') this%ibinary = 1 - ! - ! -- Open the file depending on ibinary flag - if (this%ibinary == 1) then - this%oc_inunit = nunopn - itmp = this%iout - ! - if (this%iout > 0) then - itmp = 0 - write (this%iout, fmtobf) this%oc_inunit, trim(adjustl(fname)) - end if - ! - call openfile(this%oc_inunit, itmp, fname, 'OPEN/CLOSE', & - fmtarg_opt=form, accarg_opt=access) - end if - end if - ! - if (this%ibinary == 0) then - call parser%line_reader%bkspc(parser%getunit()) - end if - ! - ! -- return - return - end subroutine read_control_record - end module Mf6FileListInputModule diff --git a/src/Utilities/Idm/mf6blockfile/StructArray.f90 b/src/Utilities/Idm/mf6blockfile/StructArray.f90 index 42ed137c1c4..f316a1fd903 100644 --- a/src/Utilities/Idm/mf6blockfile/StructArray.f90 +++ b/src/Utilities/Idm/mf6blockfile/StructArray.f90 @@ -995,8 +995,9 @@ function read_from_binary(this, inunit, iout) result(irow) read (inunit, iostat=ierr) this%struct_vectors(j)%dbl1d(irow) case (3) ! -- memtype charstring ! - errmsg = 'IDM unimplemented. StructArray::read_from_binary string & - &types not supported for binary inputs.' + errmsg = 'List style binary inputs not supported & + &for text columns, tag='// & + trim(this%struct_vectors(j)%idt%tagname)//'.' call store_error(errmsg, terminate=.TRUE.) ! case (4) ! -- memtype intvector