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 <[email protected]>

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

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()

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()

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

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

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

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

src/Utilities/Idm/LoadMf6FileType.f90

@@ -50,15 +50,14 @@ 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
     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
     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