From 8758486b2c0420f2affcbdde406f9006b339d393 Mon Sep 17 00:00:00 2001 From: mjreno Date: Fri, 23 Dec 2022 17:47:39 -0500 Subject: [PATCH] refactor(idm): rework loading of filein/fileout record tags to input context (#1126) * match input definition param on blockname as well as component/subcomponent type * do not rely on fortran short-circuit behavior when evaluating compound logical expressions * refactor(idm): rework loading of filein/fileout record tags to input context Co-authored-by: mjreno --- src/Model/GroundWaterFlow/gwf3dis8.f90 | 3 +- src/Model/GroundWaterFlow/gwf3disu8.f90 | 2 +- src/Model/GroundWaterFlow/gwf3disv8.f90 | 2 +- src/Model/GroundWaterFlow/gwf3npf8.f90 | 2 +- src/Model/GroundWaterTransport/gwt1dsp.f90 | 2 +- src/Utilities/Idm/IdmMf6FileLoader.f90 | 23 ++-- src/Utilities/Idm/InputDefinitionSelector.f90 | 62 ++++++++- src/Utilities/Idm/LoadMf6FileType.f90 | 123 ++++++++++++------ src/Utilities/Idm/ModflowInput.f90 | 19 +-- 9 files changed, 161 insertions(+), 77 deletions(-) diff --git a/src/Model/GroundWaterFlow/gwf3dis8.f90 b/src/Model/GroundWaterFlow/gwf3dis8.f90 index d81cdffafe7..886fab9af76 100644 --- a/src/Model/GroundWaterFlow/gwf3dis8.f90 +++ b/src/Model/GroundWaterFlow/gwf3dis8.f90 @@ -106,8 +106,7 @@ subroutine dis_cr(dis, name_model, inunit, iout) ! ! -- Use the input data model routines to load the input data ! into memory - call input_load(dis%parser, 'DIS6', 'GWF', 'DIS', name_model, 'DIS', & - [character(len=LENPACKAGETYPE) ::], iout) + call input_load(dis%parser, 'DIS6', 'GWF', 'DIS', name_model, 'DIS', iout) end if ! ! -- Return diff --git a/src/Model/GroundWaterFlow/gwf3disu8.f90 b/src/Model/GroundWaterFlow/gwf3disu8.f90 index 02d1ff99b36..13c0bd84fcd 100644 --- a/src/Model/GroundWaterFlow/gwf3disu8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disu8.f90 @@ -127,7 +127,7 @@ subroutine disu_cr(dis, name_model, inunit, iout) ! -- Use the input data model routines to load the input data ! into memory call input_load(dis%parser, 'DISU6', 'GWF', 'DISU', name_model, 'DISU', & - [character(len=LENPACKAGETYPE) ::], iout) + iout) ! ! -- load disu call disnew%disu_load() diff --git a/src/Model/GroundWaterFlow/gwf3disv8.f90 b/src/Model/GroundWaterFlow/gwf3disv8.f90 index 4b5bfc9c7da..5db18e0a428 100644 --- a/src/Model/GroundWaterFlow/gwf3disv8.f90 +++ b/src/Model/GroundWaterFlow/gwf3disv8.f90 @@ -111,7 +111,7 @@ subroutine disv_cr(dis, name_model, inunit, iout) ! -- Use the input data model routines to load the input data ! into memory call input_load(dis%parser, 'DISV6', 'GWF', 'DISV', name_model, 'DISV', & - [character(len=LENPACKAGETYPE) ::], iout) + iout) ! ! -- load disv call disnew%disv_load() diff --git a/src/Model/GroundWaterFlow/gwf3npf8.f90 b/src/Model/GroundWaterFlow/gwf3npf8.f90 index 93e68055722..dc1999cf419 100644 --- a/src/Model/GroundWaterFlow/gwf3npf8.f90 +++ b/src/Model/GroundWaterFlow/gwf3npf8.f90 @@ -195,7 +195,7 @@ subroutine npf_cr(npfobj, name_model, inunit, iout) ! -- Use the input data model routines to load the input data ! into memory call input_load(npfobj%parser, 'NPF6', 'GWF', 'NPF', npfobj%name_model, & - 'NPF', [character(len=LENPACKAGETYPE) :: 'TVK6'], iout) + 'NPF', iout) end if ! ! -- Return diff --git a/src/Model/GroundWaterTransport/gwt1dsp.f90 b/src/Model/GroundWaterTransport/gwt1dsp.f90 index 3c421b1af4b..c61c926267c 100644 --- a/src/Model/GroundWaterTransport/gwt1dsp.f90 +++ b/src/Model/GroundWaterTransport/gwt1dsp.f90 @@ -122,7 +122,7 @@ subroutine dsp_cr(dspobj, name_model, inunit, iout, fmi) ! -- Use the input data model routines to load the input data ! into memory call input_load(dspobj%parser, 'DSP6', 'GWT', 'DSP', dspobj%name_model, & - 'DSP', [character(len=LENPACKAGETYPE) ::], iout) + 'DSP', iout) end if ! ! -- Return diff --git a/src/Utilities/Idm/IdmMf6FileLoader.f90 b/src/Utilities/Idm/IdmMf6FileLoader.f90 index dba8ef7ae0f..5212b1a516f 100644 --- a/src/Utilities/Idm/IdmMf6FileLoader.f90 +++ b/src/Utilities/Idm/IdmMf6FileLoader.f90 @@ -15,6 +15,10 @@ module IdmMf6FileLoaderModule private public :: input_load + interface input_load + module procedure input_load_blockparser + end interface input_load + !> @brief derived type for storing package loader !! !! This derived type is used to store a pointer to a @@ -51,30 +55,29 @@ subroutine generic_mf6_load(parser, mf6_input, iout) call idm_load(parser, mf6_input%file_type, & mf6_input%component_type, mf6_input%subcomponent_type, & mf6_input%component_name, mf6_input%subcomponent_name, & - mf6_input%subpackages, iout) + iout) end subroutine generic_mf6_load !> @brief main entry to mf6 input load !< - subroutine input_load(parser, filetype, & - component_type, subcomponent_type, & - component_name, subcomponent_name, & - subpackages, iout) + subroutine input_load_blockparser(parser, filetype, & + component_type, subcomponent_type, & + component_name, subcomponent_name, & + iout) type(BlockParserType), intent(inout) :: parser !< block parser character(len=*), intent(in) :: filetype !< file type to load, such as DIS6, DISV6, NPF6 character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE - character(len=*), dimension(:), intent(in) :: subpackages !< array of subpackage types, such as ["TVK6", "OBS6"] integer(I4B), intent(in) :: iout !< unit number for output type(ModflowInputType) :: mf6_input type(PackageLoad) :: pkgloader mf6_input = getModflowInput(filetype, component_type, & subcomponent_type, component_name, & - subcomponent_name, subpackages) + subcomponent_name) ! ! -- set mf6 parser based package loader by file type select case (filetype) @@ -85,8 +88,8 @@ subroutine input_load(parser, filetype, & ! -- invoke the selected load routine call pkgloader%load_package(parser, mf6_input, iout) ! - ! -- release allocated memory - call mf6_input%destroy() - end subroutine input_load + ! -- return + return + end subroutine input_load_blockparser end module IdmMf6FileLoaderModule diff --git a/src/Utilities/Idm/InputDefinitionSelector.f90 b/src/Utilities/Idm/InputDefinitionSelector.f90 index 17e030858b2..c93d997db0d 100644 --- a/src/Utilities/Idm/InputDefinitionSelector.f90 +++ b/src/Utilities/Idm/InputDefinitionSelector.f90 @@ -35,6 +35,7 @@ module InputDefinitionSelectorModule public :: param_definitions public :: get_param_definition_type public :: get_aggregate_definition_type + public :: split_record_definition contains @@ -134,11 +135,13 @@ end subroutine set_block_pointer !> @brief Return parameter definition !< function get_param_definition_type(input_definition_types, component_type, & - subcomponent_type, tagname) result(idt) + subcomponent_type, blockname, tagname) & + result(idt) type(InputParamDefinitionType), dimension(:), intent(in), target :: & input_definition_types character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF + character(len=*), intent(in) :: blockname !< name of the block character(len=*), intent(in) :: tagname !< name of the input tag type(InputParamDefinitionType), pointer :: idt !< corresponding InputParameterDefinitionType for this tag type(InputParamDefinitionType), pointer :: tmp_ptr @@ -149,6 +152,7 @@ function get_param_definition_type(input_definition_types, component_type, & tmp_ptr => input_definition_types(i) if (tmp_ptr%component_type == component_type .and. & tmp_ptr%subcomponent_type == subcomponent_type .and. & + tmp_ptr%blockname == blockname .and. & tmp_ptr%tagname == tagname) then idt => input_definition_types(i) exit @@ -193,4 +197,60 @@ function get_aggregate_definition_type(input_definition_types, component_type, & end if end function get_aggregate_definition_type + !> @brief Return aggregate definition + !! + !! Split a component RECORD datatype definition whose second element matches + !! tagname into an array of character tokens + !< + subroutine split_record_definition(input_definition_types, component_type, & + subcomponent_type, tagname, nwords, words) + use InputOutputModule, only: parseline + type(InputParamDefinitionType), dimension(:), intent(in), target :: & + input_definition_types + character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT + character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF + character(len=*), intent(in) :: tagname !< name of the input tag + integer(I4B), intent(inout) :: nwords + character(len=40), dimension(:), allocatable, intent(inout) :: words + type(InputParamDefinitionType), pointer :: tmp_ptr + integer(I4B) :: i + character(len=:), allocatable :: parse_str + ! + ! -- initialize to deallocated + if (allocated(words)) deallocate (words) + ! + ! -- return all tokens of multi-record type that matches the first + ! -- tag following the expected first token "RECORD" + do i = 1, size(input_definition_types) + ! + ! -- initialize + nwords = 0 + ! + ! -- set ptr to current definition + tmp_ptr => input_definition_types(i) + ! + ! -- match for definition to split + if (tmp_ptr%component_type == component_type .and. & + tmp_ptr%subcomponent_type == subcomponent_type .and. & + tmp_ptr%datatype(1:6) == 'RECORD') then + ! + ! -- set split string + parse_str = trim(input_definition_types(i)%datatype)//' ' + ! + ! -- split + call parseline(parse_str, nwords, words) + ! + ! -- check for match and manage memory + if (nwords >= 2) then + if (words(1) == 'RECORD' .and. words(2) == tagname) exit + end if + ! + ! -- deallocate + if (allocated(parse_str)) deallocate (parse_str) + if (allocated(words)) deallocate (words) + ! + end if + end do + end subroutine split_record_definition + end module InputDefinitionSelectorModule diff --git a/src/Utilities/Idm/LoadMf6FileType.f90 b/src/Utilities/Idm/LoadMf6FileType.f90 index 9ef40b14ee9..24ff10d6e33 100644 --- a/src/Utilities/Idm/LoadMf6FileType.f90 +++ b/src/Utilities/Idm/LoadMf6FileType.f90 @@ -50,7 +50,7 @@ module LoadMf6FileTypeModule subroutine idm_load_from_blockparser(parser, filetype, & component_type, subcomponent_type, & component_name, subcomponent_name, & - subpackages, iout) + iout) use SimVariablesModule, only: idm_context type(BlockParserType), intent(inout) :: parser !< block parser character(len=*), intent(in) :: filetype !< file type to load, such as DIS6, DISV6, NPF6 @@ -58,7 +58,6 @@ subroutine idm_load_from_blockparser(parser, filetype, & character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE - character(len=*), dimension(:), intent(in) :: subpackages !< array of subpackage types, such as ["TVK6", "OBS6"] integer(I4B), intent(in) :: iout !< unit number for output integer(I4B) :: iblock !< consecutive block number as defined in definition file type(ModflowInputType) :: mf6_input !< ModflowInputType @@ -68,7 +67,7 @@ subroutine idm_load_from_blockparser(parser, filetype, & ! -- construct input object mf6_input = getModflowInput(filetype, component_type, & subcomponent_type, component_name, & - subcomponent_name, subpackages) + subcomponent_name) ! ! -- model shape memory path componentMemPath = create_mem_path(component=mf6_input%component_name, & @@ -93,9 +92,6 @@ subroutine idm_load_from_blockparser(parser, filetype, & ! -- close logging statement call idm_log_close(mf6_input%component_name, & mf6_input%subcomponent_name, iout) - ! - ! -- release allocated memory - call mf6_input%destroy() end subroutine idm_load_from_blockparser !> @brief procedure to load a block @@ -120,11 +116,13 @@ subroutine parse_block(parser, mf6_input, iblock, mshape, iout) type(MemoryType), pointer :: mt ! ! -- disu vertices/cell2d blocks are contingent on NVERT dimension - if (mf6_input%file_type == 'DISU6' .and. & - (mf6_input%p_block_dfns(iblock)%blockname == 'VERTICES' .or. & - mf6_input%p_block_dfns(iblock)%blockname == 'CELL2D')) then - call get_from_memorylist('NVERT', mf6_input%memoryPath, mt, found, .false.) - if (.not. found .or. mt%intsclr == 0) return + if (mf6_input%file_type == 'DISU6') then + if (mf6_input%p_block_dfns(iblock)%blockname == 'VERTICES' .or. & + mf6_input%p_block_dfns(iblock)%blockname == 'CELL2D') then + call get_from_memorylist('NVERT', mf6_input%memoryPath, mt, found, & + .false.) + if (.not. found .or. mt%intsclr == 0) return + end if end if ! ! -- block open/close support @@ -156,40 +154,65 @@ subroutine parse_block(parser, mf6_input, iblock, mshape, iout) return end subroutine parse_block - !> @brief check subpackage - !! - !! Check and make sure that the subpackage is valid for - !! this input file and load the filename of the subpackage - !! into the memory manager. - !! - !< - subroutine subpackage_check(parser, mf6_input, checktag, iout) + subroutine parse_iofile_tag(parser, mf6_input, iblock, mshape, tag, found, & + iout) + use InputDefinitionSelectorModule, only: split_record_definition type(BlockParserType), intent(inout) :: parser !< block parser type(ModflowInputType), intent(in) :: mf6_input !< ModflowInputType - character(len=LINELENGTH), intent(in) :: checktag !< subpackage string, such as TVK6 + integer(I4B), intent(in) :: iblock !< consecutive block number as defined in definition file + integer(I4B), dimension(:), contiguous, pointer, intent(inout) :: mshape !< model shape + character(len=LINELENGTH), intent(in) :: tag + logical(LGP), intent(inout) :: found !< file tag was identified and loaded integer(I4B), intent(in) :: iout !< unit number for output - character(len=LINELENGTH) :: tag, fname_tag type(InputParamDefinitionType), pointer :: idt !< input data type object describing this record - integer(I4B) :: isubpkg - - do isubpkg = 1, size(mf6_input%subpackages) - if (checktag == mf6_input%subpackages(isubpkg)) then - fname_tag = trim(checktag)//'_FILENAME' - call parser%GetStringCaps(tag) - if (tag == 'FILEIN') then - idt => get_param_definition_type(mf6_input%p_param_dfns, & - mf6_input%component_type, & - mf6_input%subcomponent_type, & - fname_tag) - call load_string_type(parser, idt, mf6_input%memoryPath, iout) - else - errmsg = 'Subpackage keyword must be followed by "FILEIN" '// & - 'then by filename.' + character(len=40), dimension(:), allocatable :: words + integer(I4B) :: nwords + character(len=LINELENGTH) :: io_tag + ! + ! -- initialization + found = .false. + ! + ! -- get tokens in matching definition + call split_record_definition(mf6_input%p_param_dfns, & + mf6_input%component_type, & + mf6_input%subcomponent_type, & + tag, nwords, words) + ! + ! -- a filein/fileout record tag definition has 4 tokens + if (nwords == 4) then + ! + ! -- verify third definition token is FILEIN/FILEOUT + if (words(3) == 'FILEIN' .or. words(3) == 'FILEOUT') then + ! + ! -- read 3rd token + call parser%GetStringCaps(io_tag) + ! + ! -- check if 3rd token matches definition + if (.not. (io_tag == words(3))) then + errmsg = 'Expected "'//trim(words(3))//'" following keyword "'// & + trim(tag)//'" but instead found "'//trim(io_tag)//'"' call store_error(errmsg) + call parser%StoreErrorUnit() + ! + ! -- matches, read and load file name + else + idt => & + get_param_definition_type(mf6_input%p_param_dfns, & + mf6_input%component_type, & + mf6_input%subcomponent_type, & + mf6_input%p_block_dfns(iblock)%blockname, & + words(4)) + call load_string_type(parser, idt, mf6_input%memoryPath, iout) + ! + ! -- io tag loaded + found = .true. end if end if - end do - end subroutine subpackage_check + end if + ! + ! -- deallocate words + if (allocated(words)) deallocate (words) + end subroutine parse_iofile_tag !> @brief load an individual input record into memory !! @@ -208,6 +231,7 @@ recursive subroutine parse_tag(parser, mf6_input, iblock, mshape, iout, & logical(LGP), intent(in) :: recursive_call !< true if recursive call character(len=LINELENGTH) :: tag type(InputParamDefinitionType), pointer :: idt !< input data type object describing this record + logical(LGP) :: found_io_tag ! ! -- read tag name call parser%GetStringCaps(tag) @@ -222,17 +246,31 @@ recursive subroutine parse_tag(parser, mf6_input, iblock, mshape, iout, & idt => get_param_definition_type(mf6_input%p_param_dfns, & mf6_input%component_type, & mf6_input%subcomponent_type, & + mf6_input%p_block_dfns(iblock)%blockname, & tag) ! ! -- allocate and load data type select case (idt%datatype) case ('KEYWORD') - call load_keyword_type(parser, idt, mf6_input%memoryPath, iout) ! - ! -- load filename if subpackage tag - call subpackage_check(parser, mf6_input, tag, iout) + ! -- initialize, not a filein/fileout tag + found_io_tag = .false. + ! + ! -- if in record tag check and load if input/output file + if (idt%in_record) then + ! + ! -- identify and load the file name + call parse_iofile_tag(parser, mf6_input, iblock, mshape, tag, & + found_io_tag, iout) + end if + ! + if (.not. found_io_tag) then + ! + ! -- load standard keyword tag + call load_keyword_type(parser, idt, mf6_input%memoryPath, iout) + end if ! - ! -- set as dev option + ! -- check/set as dev option if (mf6_input%p_block_dfns(iblock)%blockname == 'OPTIONS' .and. & idt%tagname(1:4) == 'DEV_') then call parser%DevOpt() @@ -318,6 +356,7 @@ subroutine parse_structarray_block(parser, mf6_input, iblock, mshape, iout) idt => get_param_definition_type(mf6_input%p_param_dfns, & mf6_input%component_type, & mf6_input%subcomponent_type, & + mf6_input%p_block_dfns(iblock)%blockname, & words(icol + 1)) ! ! -- allocate variable in memory manager diff --git a/src/Utilities/Idm/ModflowInput.f90 b/src/Utilities/Idm/ModflowInput.f90 index 5ed0aaba08a..6bcd78b0d51 100644 --- a/src/Utilities/Idm/ModflowInput.f90 +++ b/src/Utilities/Idm/ModflowInput.f90 @@ -39,12 +39,9 @@ module ModflowInputModule character(len=LENCOMPONENTNAME) :: subcomponent_name character(len=LENMEMPATH) :: memoryPath character(len=LENMEMPATH) :: component - character(len=LENPACKAGETYPE), allocatable, dimension(:) :: subpackages type(InputBlockDefinitionType), dimension(:), pointer :: p_block_dfns type(InputParamDefinitionType), dimension(:), pointer :: p_aggregate_dfns type(InputParamDefinitionType), dimension(:), pointer :: p_param_dfns - contains - procedure :: destroy end type ModflowInputType contains @@ -52,15 +49,13 @@ module ModflowInputModule !> @brief function to return ModflowInputType !< function getModflowInput(ftype, component_type, & - subcomponent_type, component_name, subcomponent_name, & - subpackages) & + subcomponent_type, component_name, subcomponent_name) & result(mf6_input) character(len=*), intent(in) :: ftype !< file type to load, such as DIS6, DISV6, NPF6 character(len=*), intent(in) :: component_type !< component type, such as GWF or GWT character(len=*), intent(in) :: subcomponent_type !< subcomponent type, such as DIS or NPF character(len=*), intent(in) :: component_name !< component name, such as MYGWFMODEL character(len=*), intent(in) :: subcomponent_name !< subcomponent name, such as MYWELLPACKAGE - character(len=*), dimension(:), intent(in) :: subpackages !< array of subpackage types, such as ["TVK6", "OBS6"] type(ModflowInputType) :: mf6_input mf6_input%file_type = trim(ftype) @@ -68,8 +63,6 @@ function getModflowInput(ftype, component_type, & mf6_input%subcomponent_type = trim(subcomponent_type) mf6_input%component_name = trim(component_name) mf6_input%subcomponent_name = trim(subcomponent_name) - allocate (mf6_input%subpackages(size(subpackages))) - mf6_input%subpackages = subpackages mf6_input%memoryPath = create_mem_path(component_name, subcomponent_name, & idm_context) @@ -80,14 +73,4 @@ function getModflowInput(ftype, component_type, & mf6_input%p_param_dfns => param_definitions(mf6_input%component) end function getModflowInput - !> @brief function to release ModflowInputType allocated memory - !< - subroutine destroy(this) - class(ModflowInputType) :: this !< ModflowInputType - - if (allocated(this%subpackages)) then - deallocate (this%subpackages) - end if - end subroutine destroy - end module ModflowInputModule