MODFLOW 6  version 6.8.0.dev0
USGS Modular Hydrologic Model
LoadMf6File.f90
Go to the documentation of this file.
1 !> @brief This module contains the LoadMf6FileModule
2 !!
3 !! This module contains the input data model routines for
4 !! loading static data from a MODFLOW 6 input file using the
5 !! block parser.
6 !!
7 !<
9 
10  use kindmodule, only: dp, i4b, lgp
11  use simvariablesmodule, only: errmsg
12  use simmodule, only: store_error
25  use inputoutputmodule, only: parseline
36 
37  implicit none
38  private
39  public :: loadmf6filetype
40  public :: read_control_record
41 
42  !> @brief Fortran workaround for allocatable arrays of pointers; wraps a StructArray pointer for deferred TS linking.
43  !<
44  type :: staticsatype
45  type(structarraytype), pointer :: sa => null()
46  end type staticsatype
47 
48  !> @brief Static parser based input loader
49  !!
50  !! This type defines a static input context loader
51  !! for traditional mf6 ascii input files.
52  !!
53  !<
55  type(blockparsertype), pointer :: parser !< ascii block parser
56  integer(I4B), dimension(:), pointer, contiguous :: mshape => null() !< model shape
57  type(structarraytype), pointer :: structarray => null() !< structarray for loading list input
58  type(staticsatype), allocatable :: ts_sas(:) !< saved structarrays for deferred TS linking
59  type(modflowinputtype) :: mf6_input !< description of input
60  type(ncpackagevarstype), pointer :: nc_vars => null()
61  character(len=LINELENGTH) :: filename !< name of ascii input file
62  character(len=LINELENGTH), dimension(:), allocatable :: block_tags !< read block tags
63  logical(LGP) :: ts_active !< is timeseries active
64  logical(LGP) :: export !< is array export active
65  logical(LGP) :: readasarrays
66  logical(LGP) :: readarraygrid
67  integer(I4B) :: inamedbound
68  integer(I4B) :: iauxiliary
69  integer(I4B) :: iout !< inunit for list log
70  contains
71  procedure :: load
72  procedure :: init
73  procedure :: load_block
74  procedure :: finalize
75  procedure :: parse_block
76  procedure :: block_post_process
77  procedure :: parse_io_tag
78  procedure :: parse_record_tag
79  procedure :: load_tag
80  procedure :: block_index_dfn
82  procedure :: save_ts_sa
83  procedure :: ts_sa_count
84  procedure :: get_ts_sa
85  procedure :: cleanup
86  end type loadmf6filetype
87 
88 contains
89 
90  !> @brief load all static input blocks
91  !!
92  !! Invoke this routine to load all static input blocks
93  !! in single call.
94  !!
95  !<
96  subroutine load(this, parser, mf6_input, nc_vars, filename, iout)
98  class(loadmf6filetype) :: this
99  type(blockparsertype), target, intent(inout) :: parser
100  type(modflowinputtype), intent(in) :: mf6_input
101  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
102  character(len=*), intent(in) :: filename
103  integer(I4B), intent(in) :: iout
104  integer(I4B) :: iblk
105 
106  ! initialize static load
107  call this%init(parser, mf6_input, filename, iout)
108 
109  ! set netcdf vars
110  this%nc_vars => nc_vars
111 
112  ! process blocks
113  do iblk = 1, size(this%mf6_input%block_dfns)
114  ! don't load dynamic input data
115  if (this%mf6_input%block_dfns(iblk)%blockname == 'PERIOD') exit
116  ! load the block
117  call this%load_block(iblk)
118  end do
119 
120  ! finalize static load
121  call this%finalize()
122  end subroutine load
123 
124  !> @brief init
125  !!
126  !! init / finalize are only used when load_block() will be called
127  !!
128  !<
129  subroutine init(this, parser, mf6_input, filename, iout)
130  use memorymanagermodule, only: get_isize
131  class(loadmf6filetype) :: this
132  type(blockparsertype), target, intent(inout) :: parser
133  type(modflowinputtype), intent(in) :: mf6_input
134  character(len=*), intent(in) :: filename
135  integer(I4B), intent(in) :: iout
136  integer(I4B) :: isize
137 
138  this%parser => parser
139  this%mf6_input = mf6_input
140  this%filename = filename
141  this%ts_active = .false.
142  this%export = .false.
143  this%readasarrays = .false.
144  this%readarraygrid = .false.
145  this%inamedbound = 0
146  this%iauxiliary = 0
147  this%iout = iout
148 
149  call get_isize('MODEL_SHAPE', mf6_input%component_mempath, isize)
150  if (isize > 0) then
151  call mem_setptr(this%mshape, 'MODEL_SHAPE', mf6_input%component_mempath)
152  end if
153 
154  ! init ts stuctarray list
155  allocate (this%ts_sas(0))
156 
157  ! log lst file header
158  call idm_log_header(this%mf6_input%component_name, &
159  this%mf6_input%subcomponent_name, this%iout)
160  end subroutine init
161 
162  !> @brief load a single block
163  !!
164  !! Assumed in order load of single (next) block. If a
165  !! StructArray object is allocated to load this block
166  !! it persists until this routine (or finalize) is
167  !! called again.
168  !!
169  !<
170  subroutine load_block(this, iblk)
172  class(loadmf6filetype) :: this
173  integer(I4B), intent(in) :: iblk
174 
175  ! reset structarray if it was created for previous block
176  if (associated(this%structarray)) then
177  ! destroy the structured array reader
178  call destructstructarray(this%structarray)
179  end if
180 
181  allocate (this%block_tags(0))
182  ! load the block
183  call this%parse_block(iblk, .false.)
184  ! post process block
185  call this%block_post_process(iblk)
186  ! cleanup
187  deallocate (this%block_tags)
188  end subroutine load_block
189 
190  !> @brief finalize
191  !!
192  !! init / finalize are only used when load_block() will be called
193  !!
194  !<
195  subroutine finalize(this)
197  class(loadmf6filetype) :: this
198  ! cleanup
199  if (associated(this%structarray)) then
200  ! destroy the structured array reader
201  call destructstructarray(this%structarray)
202  end if
203  ! close logging block
204  call idm_log_close(this%mf6_input%component_name, &
205  this%mf6_input%subcomponent_name, this%iout)
206  end subroutine finalize
207 
208  !> @brief Post parse block handling
209  !!
210  !<
211  subroutine block_post_process(this, iblk)
213  class(loadmf6filetype) :: this
214  integer(I4B), intent(in) :: iblk
215  type(inputparamdefinitiontype), pointer :: idt
216  integer(I4B) :: iparam
217  integer(I4B), pointer :: intptr
218 
219  ! update state based on read tags
220  do iparam = 1, size(this%block_tags)
221  select case (this%mf6_input%block_dfns(iblk)%blockname)
222  case ('OPTIONS')
223  if (this%block_tags(iparam) == 'AUXILIARY') then
224  this%iauxiliary = 1
225  else if (this%block_tags(iparam) == 'BOUNDNAMES') then
226  this%inamedbound = 1
227  else if (this%block_tags(iparam) == 'READASARRAYS') then
228  this%readasarrays = .true.
229  else if (this%block_tags(iparam) == 'READARRAYGRID') then
230  this%readarraygrid = .true.
231  else if (this%block_tags(iparam) == 'TS6_FILENAME') then
232  this%ts_active = .true.
233  else if (this%block_tags(iparam) == 'EXPORT_ARRAY_ASCII') then
234  this%export = .true.
235  end if
236  case default
237  end select
238  end do
239 
240  ! update input context allocations based on dfn set and input
241  select case (this%mf6_input%block_dfns(iblk)%blockname)
242  case ('OPTIONS')
243  ! allocate naux and set to 0 if not allocated
244  do iparam = 1, size(this%mf6_input%param_dfns)
245  idt => this%mf6_input%param_dfns(iparam)
246  if (idt%blockname == 'OPTIONS' .and. &
247  idt%tagname == 'AUXILIARY') then
248  if (this%iauxiliary == 0) then
249  call mem_allocate(intptr, 'NAUX', this%mf6_input%mempath)
250  intptr = 0
251  end if
252  exit
253  end if
254  end do
255  case ('DIMENSIONS')
256  ! set model shape if discretization dimensions have been read
257  if (this%mf6_input%pkgtype(1:3) == 'DIS') then
258  call set_model_shape(this%mf6_input%pkgtype, this%filename, &
259  this%mf6_input%component_mempath, &
260  this%mf6_input%mempath, this%mshape)
261  end if
262  case default
263  end select
264  end subroutine block_post_process
265 
266  !> @brief parse block
267  !!
268  !<
269  recursive subroutine parse_block(this, iblk, recursive_call)
270  use memorytypemodule, only: memorytype
272  class(loadmf6filetype) :: this
273  integer(I4B), intent(in) :: iblk
274  logical(LGP), intent(in) :: recursive_call !< true if recursive call
275  logical(LGP) :: isblockfound
276  logical(LGP) :: endofblock
277  logical(LGP) :: supportopenclose
278  integer(I4B) :: ierr
279  logical(LGP) :: found, required
280  type(memorytype), pointer :: mt
281  character(len=LINELENGTH) :: tag
282  type(inputparamdefinitiontype), pointer :: idt
283 
284  ! disu vertices/cell2d blocks are contingent on NVERT dimension
285  if (this%mf6_input%pkgtype == 'DISU6' .or. &
286  this%mf6_input%pkgtype == 'DISV1D6' .or. &
287  this%mf6_input%pkgtype == 'DISV2D6') then
288  if (this%mf6_input%block_dfns(iblk)%blockname == 'VERTICES' .or. &
289  this%mf6_input%block_dfns(iblk)%blockname == 'CELL2D') then
290  call get_from_memorystore('NVERT', this%mf6_input%mempath, mt, found, &
291  .false.)
292  if (.not. found) return
293  if (mt%intsclr == 0) return
294  end if
295  end if
296 
297  ! block open/close support
298  supportopenclose = (this%mf6_input%block_dfns(iblk)%blockname /= 'GRIDDATA')
299 
300  ! parser search for block
301  required = this%mf6_input%block_dfns(iblk)%required .and. .not. recursive_call
302  call this%parser%GetBlock(this%mf6_input%block_dfns(iblk)%blockname, &
303  isblockfound, ierr, &
304  supportopenclose=supportopenclose, &
305  blockrequired=required)
306  ! process block
307  if (isblockfound) then
308  if (this%mf6_input%block_dfns(iblk)%aggregate) then
309  ! process block recarray type, set of variable 1d/2d types
310  call this%parse_structarray_block(iblk)
311  else
312  do
313  ! process each line in block
314  call this%parser%GetNextLine(endofblock)
315  if (endofblock) exit
316  ! process line as tag(s)
317  call this%parser%GetStringCaps(tag)
318  idt => get_param_definition_type( &
319  this%mf6_input%param_dfns, &
320  this%mf6_input%component_type, &
321  this%mf6_input%subcomponent_type, &
322  this%mf6_input%block_dfns(iblk)%blockname, &
323  tag, this%filename)
324  if (idt%in_record) then
325  call this%parse_record_tag(iblk, idt, .false.)
326  else
327  call this%load_tag(iblk, idt)
328  end if
329  end do
330  end if
331  end if
332 
333  ! recurse if block is reloadable and was just read
334  if (this%mf6_input%block_dfns(iblk)%block_variable) then
335  if (isblockfound) then
336  call this%parse_block(iblk, .true.)
337  end if
338  end if
339  end subroutine parse_block
340 
341  subroutine parse_io_tag(this, iblk, pkgtype, which, tag)
343  class(loadmf6filetype) :: this
344  integer(I4B), intent(in) :: iblk
345  character(len=*), intent(in) :: pkgtype
346  character(len=*), intent(in) :: which
347  character(len=*), intent(in) :: tag
348  type(inputparamdefinitiontype), pointer :: idt !< input data type object describing this record
349  ! matches, read and load file name
350  idt => &
351  get_param_definition_type(this%mf6_input%param_dfns, &
352  this%mf6_input%component_type, &
353  this%mf6_input%subcomponent_type, &
354  this%mf6_input%block_dfns(iblk)%blockname, &
355  tag, this%filename)
356  ! load io tag
357  call load_io_tag(this%parser, idt, this%mf6_input%mempath, which, this%iout)
358  call expandarray(this%block_tags)
359  this%block_tags(size(this%block_tags)) = trim(idt%tagname)
360  end subroutine parse_io_tag
361 
362  recursive subroutine parse_record_tag(this, iblk, inidt, recursive_call)
366  class(loadmf6filetype) :: this
367  integer(I4B), intent(in) :: iblk
368  type(inputparamdefinitiontype), pointer, intent(in) :: inidt
369  logical(LGP), intent(in) :: recursive_call !< true if recursive call
370  type(inputparamdefinitiontype), pointer :: idt
371  character(len=40), dimension(:), allocatable :: words
372  integer(I4B) :: n, istart, nwords
373  character(len=LINELENGTH) :: tag
374 
375  nullify (idt)
376  istart = 1
377 
378  if (recursive_call) then
379  call split_record_dfn_tag1(this%mf6_input%param_dfns, &
380  this%mf6_input%component_type, &
381  this%mf6_input%subcomponent_type, &
382  inidt%tagname, nwords, words)
383  call this%load_tag(iblk, inidt)
384  istart = 3
385  else
386  call this%parser%GetStringCaps(tag)
387  if (tag /= '') then
388  call split_record_dfn_tag2(this%mf6_input%param_dfns, &
389  this%mf6_input%component_type, &
390  this%mf6_input%subcomponent_type, &
391  inidt%tagname, tag, nwords, words)
392  if (nwords == 4 .and. &
393  (tag == 'FILEIN' .or. &
394  tag == 'FILEOUT')) then
395  call this%parse_io_tag(iblk, words(2), words(3), words(4))
396  nwords = 0
397  else
398  idt => get_param_definition_type( &
399  this%mf6_input%param_dfns, &
400  this%mf6_input%component_type, &
401  this%mf6_input%subcomponent_type, &
402  this%mf6_input%block_dfns(iblk)%blockname, &
403  tag, this%filename)
404  ! avoid namespace collisions (CIM)
405  if (tag /= 'PRINT_FORMAT') call this%load_tag(iblk, inidt)
406  call this%load_tag(iblk, idt)
407  istart = 4
408  end if
409  else
410  call this%load_tag(iblk, inidt)
411  nwords = 0
412  end if
413  end if
414 
415  if (istart > 1 .and. nwords == 0) then
416  write (errmsg, '(5a)') &
417  '"', trim(this%mf6_input%block_dfns(iblk)%blockname), &
418  '" block input record that includes keyword "', trim(inidt%tagname), &
419  '" is not properly formed.'
420  call store_error(errmsg)
421  call this%parser%StoreErrorUnit()
422  end if
423 
424  do n = istart, nwords
425  idt => get_param_definition_type( &
426  this%mf6_input%param_dfns, &
427  this%mf6_input%component_type, &
428  this%mf6_input%subcomponent_type, &
429  this%mf6_input%block_dfns(iblk)%blockname, &
430  words(n), this%filename)
431  if (idt_datatype(idt) == 'RECORD') then
432  call this%parser%GetStringCaps(tag)
433  idt => get_param_definition_type( &
434  this%mf6_input%param_dfns, &
435  this%mf6_input%component_type, &
436  this%mf6_input%subcomponent_type, &
437  this%mf6_input%block_dfns(iblk)%blockname, &
438  tag, this%filename)
439  call this%parse_record_tag(iblk, idt, .true.)
440  exit
441  else
442  if (idt%tagname /= 'FORMAT') then
443  call this%parser%GetStringCaps(tag)
444  if (tag == '') then
445  exit
446  else if (idt%tagname /= tag) then
447  write (errmsg, '(5a)') 'Expecting record input tag "', &
448  trim(idt%tagname), '" but instead found "', trim(tag), '".'
449  call store_error(errmsg)
450  call this%parser%StoreErrorUnit()
451  end if
452  end if
453  call this%load_tag(iblk, idt)
454  end if
455  end do
456 
457  if (allocated(words)) deallocate (words)
458  end subroutine parse_record_tag
459 
460  !> @brief load input keyword
461  !! Load input associated with tag key into the memory manager.
462  !<
463  subroutine load_tag(this, iblk, idt)
466  class(loadmf6filetype) :: this
467  integer(I4B), intent(in) :: iblk
468  type(inputparamdefinitiontype), pointer, intent(in) :: idt !< input data type object describing this record
469  character(len=LINELENGTH) :: dev_msg
470 
471  ! check if input param is developmode
472  if (idt%developmode) then
473  dev_msg = 'Input tag "'//trim(idt%tagname)// &
474  &'" read from file "'//trim(this%filename)// &
475  &'" is still under development. Install the &
476  &nightly build or compile from source with IDEVELOPMODE = 1.'
477  call developmode(dev_msg, this%iout)
478  end if
479 
480  ! allocate and load data type
481  select case (idt%datatype)
482  case ('KEYWORD')
483  call load_keyword_type(this%parser, idt, this%mf6_input%mempath, this%iout)
484  ! check/set as dev option
485  if (idt%tagname(1:4) == 'DEV_' .and. &
486  this%mf6_input%block_dfns(iblk)%blockname == 'OPTIONS') then
487  call this%parser%DevOpt()
488  end if
489  case ('STRING')
490  if (idt%shape == 'NAUX') then
491  call load_auxvar_names(this%parser, idt, this%mf6_input%mempath, &
492  this%iout)
493  else
494  call load_string_type(this%parser, idt, this%mf6_input%mempath, this%iout)
495  end if
496  case ('INTEGER')
497  call load_integer_type(this%parser, idt, this%mf6_input%mempath, this%iout)
498  case ('INTEGER1D')
499  call load_integer1d_type(this%parser, idt, this%mf6_input, this%mshape, &
500  this%export, this%nc_vars, this%filename, &
501  this%iout)
502  case ('INTEGER2D')
503  call load_integer2d_type(this%parser, idt, this%mf6_input, this%mshape, &
504  this%export, this%nc_vars, this%filename, &
505  this%iout)
506  case ('INTEGER3D')
507  call load_integer3d_type(this%parser, idt, this%mf6_input, this%mshape, &
508  this%export, this%nc_vars, this%filename, &
509  this%iout)
510  case ('DOUBLE')
511  call load_double_type(this%parser, idt, this%mf6_input%mempath, this%iout)
512  case ('DOUBLE1D')
513  call load_double1d_type(this%parser, idt, this%mf6_input, this%mshape, &
514  this%export, this%nc_vars, this%filename, this%iout)
515  case ('DOUBLE2D')
516  call load_double2d_type(this%parser, idt, this%mf6_input, this%mshape, &
517  this%export, this%nc_vars, this%filename, this%iout)
518  case ('DOUBLE3D')
519  call load_double3d_type(this%parser, idt, this%mf6_input, this%mshape, &
520  this%export, this%nc_vars, this%filename, this%iout)
521  case default
522  write (errmsg, '(a,a)') 'Failure reading data for tag: ', trim(idt%tagname)
523  call store_error(errmsg)
524  call this%parser%StoreErrorUnit()
525  end select
526 
527  call expandarray(this%block_tags)
528  this%block_tags(size(this%block_tags)) = trim(idt%tagname)
529  end subroutine load_tag
530 
531  function block_index_dfn(this, iblk) result(idt)
532  class(loadmf6filetype) :: this
533  integer(I4B), intent(in) :: iblk
534  type(inputparamdefinitiontype) :: idt !< input data type object describing this record
535  character(len=LENVARNAME) :: varname
536  integer(I4B) :: ilen
537  character(len=3) :: block_suffix = 'NUM'
538 
539  ! assign first column as the block number
540  ilen = len_trim(this%mf6_input%block_dfns(iblk)%blockname)
541 
542  if (ilen > (lenvarname - len(block_suffix))) then
543  varname = &
544  this%mf6_input%block_dfns(iblk)% &
545  blockname(1:(lenvarname - len(block_suffix)))//block_suffix
546  else
547  varname = trim(this%mf6_input%block_dfns(iblk)%blockname)//block_suffix
548  end if
549 
550  idt%component_type = trim(this%mf6_input%component_type)
551  idt%subcomponent_type = trim(this%mf6_input%subcomponent_type)
552  idt%blockname = trim(this%mf6_input%block_dfns(iblk)%blockname)
553  idt%tagname = varname
554  idt%mf6varname = varname
555  idt%datatype = 'INTEGER'
556  end function block_index_dfn
557 
558  !> @brief parse a structured array record into memory manager
559  !!
560  !! A structarray is similar to a numpy recarray. It it used to
561  !! load a list of data in which each column in the list may be a
562  !! different type. Each column in the list is stored as a 1d
563  !! vector.
564  !!
565  !<
566  subroutine parse_structarray_block(this, iblk)
569  class(loadmf6filetype) :: this
570  integer(I4B), intent(in) :: iblk
571  type(loadcontexttype) :: ctx
572  character(len=LINELENGTH), dimension(:), allocatable :: param_names
573  type(inputparamdefinitiontype), pointer :: idt !< input data type object describing this record
574  type(inputparamdefinitiontype), target :: blockvar_idt
575  integer(I4B) :: blocknum
576  integer(I4B), pointer :: nrow
577  integer(I4B) :: nrows, nrowsread
578  integer(I4B) :: ibinary, oc_inunit
579  integer(I4B) :: icol, iparam
580  integer(I4B) :: ncol, nparam
581 
582  ! initialize load context
583  call ctx%init(this%mf6_input, blockname= &
584  this%mf6_input%block_dfns(iblk)%blockname)
585  ! set in scope params for load
586  call ctx%tags(param_names, nparam, this%filename)
587  ! set input definition for this block
588  idt => &
589  get_aggregate_definition_type(this%mf6_input%aggregate_dfns, &
590  this%mf6_input%component_type, &
591  this%mf6_input%subcomponent_type, &
592  this%mf6_input%block_dfns(iblk)%blockname)
593  ! if block is reloadable read the block number
594  if (this%mf6_input%block_dfns(iblk)%block_variable) then
595  blocknum = this%parser%GetInteger()
596  else
597  blocknum = 0
598  end if
599 
600  ! set ncol
601  ncol = nparam
602  ! add col if block is reloadable
603  if (blocknum > 0) ncol = ncol + 1
604  ! use shape to set the max num of rows
605  if (idt%shape /= '') then
606  call mem_setptr(nrow, idt%shape, this%mf6_input%mempath)
607  nrows = nrow
608  else
609  nrows = -1
610  end if
611 
612  ! create a structured array
613  this%structarray => constructstructarray(this%mf6_input, ncol, nrows, &
614  blocknum, this%mf6_input%mempath, &
615  this%mf6_input%component_mempath)
616  ! create structarray vectors for each column
617  do icol = 1, ncol
618  ! if block is reloadable, block number is first column
619  if (blocknum > 0) then
620  if (icol == 1) then
621  blockvar_idt = this%block_index_dfn(iblk)
622  idt => blockvar_idt
623  call this%structarray%mem_create_vector(icol, idt)
624  ! continue as this column managed by internally SA object
625  cycle
626  end if
627  ! set indexes (where first column is blocknum)
628  iparam = icol - 1
629  else
630  ! set indexes (no blocknum column)
631  iparam = icol
632  end if
633  ! set pointer to input definition for this 1d vector
634  idt => &
635  get_param_definition_type(this%mf6_input%param_dfns, &
636  this%mf6_input%component_type, &
637  this%mf6_input%subcomponent_type, &
638  this%mf6_input%block_dfns(iblk)%blockname, &
639  param_names(iparam), this%filename)
640  ! allocate variable in memory manager
641  call this%structarray%mem_create_vector(icol, idt)
642  end do
643 
644  ! finish context setup after allocating vectors
645  call ctx%allocate_arrays()
646 
647  ! read the block control record
648  ibinary = read_control_record(this%parser, oc_inunit, this%iout)
649 
650  if (ibinary == 1) then
651  ! read from binary
652  nrowsread = this%structarray%read_from_binary(oc_inunit, this%iout)
653  call this%parser%terminateblock()
654  close (oc_inunit)
655  else
656  ! read from ascii
657  nrowsread = this%structarray%read_from_parser(this%parser, this%ts_active, &
658  this%iout, this%filename)
659  ! save structarray for deferred TS linking in df() if any strlocs were stored
660  if (this%ts_active) call this%save_ts_sa()
661  end if
662 
663  ! clean up
664  call ctx%destroy()
665  end subroutine parse_structarray_block
666 
667  !> @brief Return number of saved static StructArrays with deferred TS strlocs
668  !<
669  function ts_sa_count(this) result(n)
670  class(loadmf6filetype), intent(in) :: this
671  integer(I4B) :: n
672  n = size(this%ts_sas)
673  end function ts_sa_count
674 
675  !> @brief Return the n-th saved static StructArray pointer
676  !<
677  function get_ts_sa(this, n) result(sa)
678  class(loadmf6filetype), intent(in) :: this
679  integer(I4B), intent(in) :: n
680  type(structarraytype), pointer :: sa
681  sa => this%ts_sas(n)%sa
682  end function get_ts_sa
683 
684  !> @brief load type keyword
685  !<
686  subroutine load_keyword_type(parser, idt, memoryPath, iout)
687  type(blockparsertype), intent(inout) :: parser !< block parser
688  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
689  character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
690  integer(I4B), intent(in) :: iout !< unit number for output
691  integer(I4B), pointer :: intvar
692  call mem_allocate(intvar, idt%mf6varname, memorypath)
693  intvar = 1
694  call idm_log_var(intvar, idt%tagname, memorypath, idt%datatype, iout)
695  end subroutine load_keyword_type
696 
697  !> @brief load type string
698  !<
699  subroutine load_string_type(parser, idt, memoryPath, iout)
700  use constantsmodule, only: lenbigline
701  type(blockparsertype), intent(inout) :: parser !< block parser
702  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
703  character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
704  integer(I4B), intent(in) :: iout !< unit number for output
705  character(len=LINELENGTH), pointer :: cstr
706  character(len=LENBIGLINE), pointer :: bigcstr
707  integer(I4B) :: ilen
708  select case (idt%shape)
709  case ('LENBIGLINE')
710  ilen = lenbigline
711  call mem_allocate(bigcstr, ilen, idt%mf6varname, memorypath)
712  call parser%GetString(bigcstr, (.not. idt%preserve_case))
713  call idm_log_var(bigcstr, idt%tagname, memorypath, iout)
714  case default
715  ilen = linelength
716  call mem_allocate(cstr, ilen, idt%mf6varname, memorypath)
717  call parser%GetString(cstr, (.not. idt%preserve_case))
718  call idm_log_var(cstr, idt%tagname, memorypath, iout)
719  end select
720  end subroutine load_string_type
721 
722  !> @brief load io tag
723  !<
724  subroutine load_io_tag(parser, idt, memoryPath, which, iout)
728  type(blockparsertype), intent(inout) :: parser !< block parser
729  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
730  character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
731  character(len=*), intent(in) :: which
732  integer(I4B), intent(in) :: iout !< unit number for output
733  character(len=LINELENGTH) :: cstr
734  type(characterstringtype), dimension(:), pointer, contiguous :: charstr1d
735  integer(I4B) :: ilen, isize, idx
736  ilen = linelength
737  if (which == 'FILEIN') then
738  call get_isize(idt%mf6varname, memorypath, isize)
739  if (isize < 0) then
740  call mem_allocate(charstr1d, ilen, 1, idt%mf6varname, memorypath)
741  idx = 1
742  else
743  call mem_setptr(charstr1d, idt%mf6varname, memorypath)
744  call mem_reallocate(charstr1d, ilen, isize + 1, idt%mf6varname, &
745  memorypath)
746  idx = isize + 1
747  end if
748  call parser%GetString(cstr, (.not. idt%preserve_case))
749  charstr1d(idx) = cstr
750  else if (which == 'FILEOUT') then
751  call load_string_type(parser, idt, memorypath, iout)
752  end if
753  end subroutine load_io_tag
754 
755  !> @brief load aux variable names
756  !!
757  !<
758  subroutine load_auxvar_names(parser, idt, memoryPath, iout)
760  use inputoutputmodule, only: urdaux
762  type(blockparsertype), intent(inout) :: parser !< block parser
763  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
764  character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
765  integer(I4B), intent(in) :: iout !< unit number for output
766  character(len=:), allocatable :: line
767  character(len=LENAUXNAME), dimension(:), allocatable :: caux
768  integer(I4B) :: lloc
769  integer(I4B) :: istart
770  integer(I4B) :: istop
771  integer(I4B) :: i
772  character(len=LENPACKAGENAME) :: text = ''
773  integer(I4B), pointer :: intvar
774  type(characterstringtype), dimension(:), &
775  pointer, contiguous :: acharstr1d !< variable for allocation
776  call mem_allocate(intvar, idt%shape, memorypath)
777  intvar = 0
778  call parser%GetRemainingLine(line)
779  lloc = 1
780  call urdaux(intvar, parser%iuactive, iout, lloc, &
781  istart, istop, caux, line, text)
782  call mem_allocate(acharstr1d, lenauxname, intvar, idt%mf6varname, memorypath)
783  do i = 1, intvar
784  acharstr1d(i) = caux(i)
785  end do
786  deallocate (line)
787  deallocate (caux)
788  end subroutine load_auxvar_names
789 
790  !> @brief load type integer
791  !<
792  subroutine load_integer_type(parser, idt, memoryPath, iout)
793  type(blockparsertype), intent(inout) :: parser !< block parser
794  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
795  character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
796  integer(I4B), intent(in) :: iout !< unit number for output
797  integer(I4B), pointer :: intvar
798  call mem_allocate(intvar, idt%mf6varname, memorypath)
799  intvar = parser%GetInteger()
800  call idm_log_var(intvar, idt%tagname, memorypath, idt%datatype, iout)
801  end subroutine load_integer_type
802 
803  !> @brief load type 1d integer
804  !<
805  subroutine load_integer1d_type(parser, idt, mf6_input, mshape, export, &
806  nc_vars, input_fname, iout)
809  type(blockparsertype), intent(inout) :: parser !< block parser
810  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
811  type(modflowinputtype), intent(in) :: mf6_input !< description of input
812  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
813  logical(LGP), intent(in) :: export !< export to ascii layer files
814  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
815  character(len=*), intent(in) :: input_fname !< ascii input file name
816  integer(I4B), intent(in) :: iout !< unit number for output
817  integer(I4B), dimension(:), pointer, contiguous :: int1d
818  integer(I4B) :: nlay
819  integer(I4B) :: nvals
820  integer(I4B), dimension(:), allocatable :: array_shape
821  integer(I4B), dimension(:), allocatable :: layer_shape
822  character(len=LINELENGTH) :: keyword
823 
824  ! Check if it is a full grid sized array (NODES), otherwise use
825  ! idt%shape to construct shape from variables in memoryPath
826  if (idt%shape == 'NODES') then
827  nvals = product(mshape)
828  else
829  call get_shape_from_string(idt%shape, array_shape, mf6_input%mempath)
830  nvals = array_shape(1)
831  end if
832 
833  ! allocate memory for the array
834  call mem_allocate(int1d, nvals, idt%mf6varname, mf6_input%mempath)
835 
836  ! read keyword
837  keyword = ''
838  call parser%GetStringCaps(keyword)
839 
840  ! check for "NETCDF" and "LAYERED"
841  if (keyword == 'NETCDF') then
842  call netcdf_read_array(int1d, mshape, idt, mf6_input, nc_vars, &
843  input_fname, iout)
844  else if (keyword == 'LAYERED' .and. idt%layered) then
845  call get_layered_shape(mshape, nlay, layer_shape)
846  call read_int1d_layered(parser, int1d, idt%mf6varname, nlay, layer_shape)
847  else
848  call read_int1d(parser, int1d, idt%mf6varname)
849  end if
850 
851  ! log information on the loaded array to the list file
852  call idm_log_var(int1d, idt%tagname, mf6_input%mempath, iout)
853 
854  ! create export file for griddata parameters if optioned
855  if (export) then
856  if (idt%blockname == 'GRIDDATA') then
857  call idm_export(int1d, idt%tagname, mf6_input%mempath, idt%shape, iout)
858  end if
859  end if
860  end subroutine load_integer1d_type
861 
862  !> @brief load type 2d integer
863  !<
864  subroutine load_integer2d_type(parser, idt, mf6_input, mshape, export, &
865  nc_vars, input_fname, iout)
868  type(blockparsertype), intent(inout) :: parser !< block parser
869  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
870  type(modflowinputtype), intent(in) :: mf6_input !< description of input
871  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
872  logical(LGP), intent(in) :: export !< export to ascii layer files
873  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
874  character(len=*), intent(in) :: input_fname !< ascii input file name
875  integer(I4B), intent(in) :: iout !< unit number for output
876  integer(I4B), dimension(:, :), pointer, contiguous :: int2d
877  integer(I4B) :: nlay
878  integer(I4B) :: nsize1, nsize2
879  integer(I4B), dimension(:), allocatable :: array_shape
880  integer(I4B), dimension(:), allocatable :: layer_shape
881  character(len=LINELENGTH) :: keyword
882 
883  ! determine the array shape from the input data definition (idt%shape),
884  ! which looks like "NCOL, NROW, NLAY"
885  call get_shape_from_string(idt%shape, array_shape, mf6_input%mempath)
886  nsize1 = array_shape(1)
887  nsize2 = array_shape(2)
888 
889  ! create a new 3d memory managed variable
890  call mem_allocate(int2d, nsize1, nsize2, idt%mf6varname, mf6_input%mempath)
891 
892  ! read keyword
893  keyword = ''
894  call parser%GetStringCaps(keyword)
895 
896  ! check for "NETCDF" and "LAYERED"
897  if (keyword == 'NETCDF') then
898  call netcdf_read_array(int2d, mshape, idt, mf6_input, nc_vars, &
899  input_fname, iout)
900  else if (keyword == 'LAYERED' .and. idt%layered) then
901  call get_layered_shape(mshape, nlay, layer_shape)
902  call read_int2d_layered(parser, int2d, idt%mf6varname, nlay, layer_shape)
903  else
904  call read_int2d(parser, int2d, idt%mf6varname)
905  end if
906 
907  ! log information on the loaded array to the list file
908  call idm_log_var(int2d, idt%tagname, mf6_input%mempath, iout)
909 
910  ! create export file for griddata parameters if optioned
911  if (export) then
912  if (idt%blockname == 'GRIDDATA') then
913  call idm_export(int2d, idt%tagname, mf6_input%mempath, idt%shape, iout)
914  end if
915  end if
916  end subroutine load_integer2d_type
917 
918  !> @brief load type 3d integer
919  !<
920  subroutine load_integer3d_type(parser, idt, mf6_input, mshape, export, &
921  nc_vars, input_fname, iout)
924  type(blockparsertype), intent(inout) :: parser !< block parser
925  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
926  type(modflowinputtype), intent(in) :: mf6_input !< description of input
927  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
928  logical(LGP), intent(in) :: export !< export to ascii layer files
929  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
930  character(len=*), intent(in) :: input_fname !< ascii input file name
931  integer(I4B), intent(in) :: iout !< unit number for output
932  integer(I4B), dimension(:, :, :), pointer, contiguous :: int3d
933  integer(I4B) :: nlay
934  integer(I4B) :: nsize1, nsize2, nsize3
935  integer(I4B), dimension(:), allocatable :: array_shape
936  integer(I4B), dimension(:), allocatable :: layer_shape
937  integer(I4B), dimension(:), pointer, contiguous :: int1d_ptr
938  character(len=LINELENGTH) :: keyword
939 
940  ! determine the array shape from the input data definition (idt%shape),
941  ! which looks like "NCOL, NROW, NLAY"
942  call get_shape_from_string(idt%shape, array_shape, mf6_input%mempath)
943  nsize1 = array_shape(1)
944  nsize2 = array_shape(2)
945  nsize3 = array_shape(3)
946 
947  ! create a new 3d memory managed variable
948  call mem_allocate(int3d, nsize1, nsize2, nsize3, idt%mf6varname, &
949  mf6_input%mempath)
950 
951  ! read keyword
952  keyword = ''
953  call parser%GetStringCaps(keyword)
954 
955  ! check for "NETCDF" and "LAYERED"
956  if (keyword == 'NETCDF') then
957  call netcdf_read_array(int3d, mshape, idt, mf6_input, nc_vars, &
958  input_fname, iout)
959  else if (keyword == 'LAYERED' .and. idt%layered) then
960  call get_layered_shape(mshape, nlay, layer_shape)
961  call read_int3d_layered(parser, int3d, idt%mf6varname, nlay, &
962  layer_shape)
963  else
964  int1d_ptr(1:nsize1 * nsize2 * nsize3) => int3d(:, :, :)
965  call read_int1d(parser, int1d_ptr, idt%mf6varname)
966  end if
967 
968  ! log information on the loaded array to the list file
969  call idm_log_var(int3d, idt%tagname, mf6_input%mempath, iout)
970 
971  ! create export file for griddata parameters if optioned
972  if (export) then
973  if (idt%blockname == 'GRIDDATA') then
974  call idm_export(int3d, idt%tagname, mf6_input%mempath, idt%shape, iout)
975  end if
976  end if
977  end subroutine load_integer3d_type
978 
979  !> @brief load type double
980  !<
981  subroutine load_double_type(parser, idt, memoryPath, iout)
982  type(blockparsertype), intent(inout) :: parser !< block parser
983  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
984  character(len=*), intent(in) :: memoryPath !< memorypath to put loaded information
985  integer(I4B), intent(in) :: iout !< unit number for output
986  real(DP), pointer :: dblvar
987  call mem_allocate(dblvar, idt%mf6varname, memorypath)
988  dblvar = parser%GetDouble()
989  call idm_log_var(dblvar, idt%tagname, memorypath, iout)
990  end subroutine load_double_type
991 
992  !> @brief load type 1d double
993  !<
994  subroutine load_double1d_type(parser, idt, mf6_input, mshape, export, &
995  nc_vars, input_fname, iout)
998  type(blockparsertype), intent(inout) :: parser !< block parser
999  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
1000  type(modflowinputtype), intent(in) :: mf6_input !< description of input
1001  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
1002  logical(LGP), intent(in) :: export !< export to ascii layer files
1003  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
1004  character(len=*), intent(in) :: input_fname !< ascii input file name
1005  integer(I4B), intent(in) :: iout !< unit number for output
1006  real(DP), dimension(:), pointer, contiguous :: dbl1d
1007  integer(I4B) :: nlay
1008  integer(I4B) :: nvals
1009  integer(I4B), dimension(:), allocatable :: array_shape
1010  integer(I4B), dimension(:), allocatable :: layer_shape
1011  character(len=LINELENGTH) :: keyword
1012 
1013  ! Check if it is a full grid sized array (NODES)
1014  if (idt%shape == 'NODES') then
1015  nvals = product(mshape)
1016  else
1017  call get_shape_from_string(idt%shape, array_shape, mf6_input%mempath)
1018  nvals = array_shape(1)
1019  end if
1020 
1021  ! allocate memory for the array
1022  call mem_allocate(dbl1d, nvals, idt%mf6varname, mf6_input%mempath)
1023 
1024  ! read keyword
1025  keyword = ''
1026  call parser%GetStringCaps(keyword)
1027 
1028  ! check for "NETCDF" and "LAYERED"
1029  if (keyword == 'NETCDF') then
1030  call netcdf_read_array(dbl1d, mshape, idt, mf6_input, nc_vars, &
1031  input_fname, iout)
1032  else if (keyword == 'LAYERED' .and. idt%layered) then
1033  call get_layered_shape(mshape, nlay, layer_shape)
1034  call read_dbl1d_layered(parser, dbl1d, idt%mf6varname, nlay, layer_shape)
1035  else
1036  call read_dbl1d(parser, dbl1d, idt%mf6varname)
1037  end if
1038 
1039  ! log information on the loaded array to the list file
1040  call idm_log_var(dbl1d, idt%tagname, mf6_input%mempath, iout)
1041 
1042  ! create export file for griddata parameters if optioned
1043  if (export) then
1044  if (idt%blockname == 'GRIDDATA') then
1045  call idm_export(dbl1d, idt%tagname, mf6_input%mempath, idt%shape, iout)
1046  end if
1047  end if
1048  end subroutine load_double1d_type
1049 
1050  !> @brief load type 2d double
1051  !<
1052  subroutine load_double2d_type(parser, idt, mf6_input, mshape, export, &
1053  nc_vars, input_fname, iout)
1056  type(blockparsertype), intent(inout) :: parser !< block parser
1057  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
1058  type(modflowinputtype), intent(in) :: mf6_input !< description of input
1059  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
1060  logical(LGP), intent(in) :: export !< export to ascii layer files
1061  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
1062  character(len=*), intent(in) :: input_fname !< ascii input file name
1063  integer(I4B), intent(in) :: iout !< unit number for output
1064  real(DP), dimension(:, :), pointer, contiguous :: dbl2d
1065  integer(I4B) :: nlay
1066  integer(I4B) :: nsize1, nsize2
1067  integer(I4B), dimension(:), allocatable :: array_shape
1068  integer(I4B), dimension(:), allocatable :: layer_shape
1069  character(len=LINELENGTH) :: keyword
1070 
1071  ! determine the array shape from the input data definition (idt%shape),
1072  ! which looks like "NCOL, NROW, NLAY"
1073  call get_shape_from_string(idt%shape, array_shape, mf6_input%mempath)
1074  nsize1 = array_shape(1)
1075  nsize2 = array_shape(2)
1076 
1077  ! create a new 3d memory managed variable
1078  call mem_allocate(dbl2d, nsize1, nsize2, idt%mf6varname, mf6_input%mempath)
1079 
1080  ! read keyword
1081  keyword = ''
1082  call parser%GetStringCaps(keyword)
1083 
1084  ! check for "NETCDF" and "LAYERED"
1085  if (keyword == 'NETCDF') then
1086  call netcdf_read_array(dbl2d, mshape, idt, mf6_input, nc_vars, &
1087  input_fname, iout)
1088  else if (keyword == 'LAYERED' .and. idt%layered) then
1089  call get_layered_shape(mshape, nlay, layer_shape)
1090  call read_dbl2d_layered(parser, dbl2d, idt%mf6varname, nlay, layer_shape)
1091  else
1092  call read_dbl2d(parser, dbl2d, idt%mf6varname)
1093  end if
1094 
1095  ! log information on the loaded array to the list file
1096  call idm_log_var(dbl2d, idt%tagname, mf6_input%mempath, iout)
1097 
1098  ! create export file for griddata parameters if optioned
1099  if (export) then
1100  if (idt%blockname == 'GRIDDATA') then
1101  call idm_export(dbl2d, idt%tagname, mf6_input%mempath, idt%shape, iout)
1102  end if
1103  end if
1104  end subroutine load_double2d_type
1105 
1106  !> @brief load type 3d double
1107  !<
1108  subroutine load_double3d_type(parser, idt, mf6_input, mshape, export, &
1109  nc_vars, input_fname, iout)
1112  type(blockparsertype), intent(inout) :: parser !< block parser
1113  type(inputparamdefinitiontype), intent(in) :: idt !< input data type object describing this record
1114  type(modflowinputtype), intent(in) :: mf6_input !< description of input
1115  integer(I4B), dimension(:), contiguous, pointer, intent(in) :: mshape !< model shape
1116  logical(LGP), intent(in) :: export !< export to ascii layer files
1117  type(ncpackagevarstype), pointer, intent(in) :: nc_vars
1118  character(len=*), intent(in) :: input_fname !< ascii input file name
1119  integer(I4B), intent(in) :: iout !< unit number for output
1120  real(DP), dimension(:, :, :), pointer, contiguous :: dbl3d
1121  integer(I4B) :: nlay
1122  integer(I4B) :: nsize1, nsize2, nsize3
1123  integer(I4B), dimension(:), allocatable :: array_shape
1124  integer(I4B), dimension(:), allocatable :: layer_shape
1125  real(DP), dimension(:), pointer, contiguous :: dbl1d_ptr
1126  character(len=LINELENGTH) :: keyword
1127 
1128  ! determine the array shape from the input data definition (idt%shape),
1129  ! which looks like "NCOL, NROW, NLAY"
1130  call get_shape_from_string(idt%shape, array_shape, mf6_input%mempath)
1131  nsize1 = array_shape(1)
1132  nsize2 = array_shape(2)
1133  nsize3 = array_shape(3)
1134 
1135  ! create a new 3d memory managed variable
1136  call mem_allocate(dbl3d, nsize1, nsize2, nsize3, idt%mf6varname, &
1137  mf6_input%mempath)
1138 
1139  ! read keyword
1140  keyword = ''
1141  call parser%GetStringCaps(keyword)
1142 
1143  ! check for "NETCDF" and "LAYERED"
1144  if (keyword == 'NETCDF') then
1145  call netcdf_read_array(dbl3d, mshape, idt, mf6_input, nc_vars, &
1146  input_fname, iout)
1147  else if (keyword == 'LAYERED' .and. idt%layered) then
1148  call get_layered_shape(mshape, nlay, layer_shape)
1149  call read_dbl3d_layered(parser, dbl3d, idt%mf6varname, nlay, &
1150  layer_shape)
1151  else
1152  dbl1d_ptr(1:nsize1 * nsize2 * nsize3) => dbl3d(:, :, :)
1153  call read_dbl1d(parser, dbl1d_ptr, idt%mf6varname)
1154  end if
1155 
1156  ! log information on the loaded array to the list file
1157  call idm_log_var(dbl3d, idt%tagname, mf6_input%mempath, iout)
1158 
1159  ! create export file for griddata parameters if optioned
1160  if (export) then
1161  if (idt%blockname == 'GRIDDATA') then
1162  call idm_export(dbl3d, idt%tagname, mf6_input%mempath, idt%shape, iout)
1163  end if
1164  end if
1165  end subroutine load_double3d_type
1166 
1167  function read_control_record(parser, oc_inunit, iout) result(ibinary)
1168  use simmodule, only: store_error_unit
1169  use inputoutputmodule, only: urword
1170  use inputoutputmodule, only: openfile
1171  use openspecmodule, only: form, access
1172  use constantsmodule, only: linelength
1174  type(blockparsertype), intent(inout) :: parser
1175  integer(I4B), intent(inout) :: oc_inunit
1176  integer(I4B), intent(in) :: iout
1177  integer(I4B) :: ibinary
1178  integer(I4B) :: lloc, istart, istop, idum, inunit, itmp, ierr
1179  integer(I4B) :: nunopn = 99
1180  character(len=:), allocatable :: line
1181  character(len=LINELENGTH) :: fname
1182  logical(LGP) :: exists
1183  real(dp) :: r
1184  character(len=*), parameter :: fmtocne = &
1185  &"('Specified OPEN/CLOSE file ',(A),' does not exist')"
1186  character(len=*), parameter :: fmtobf = &
1187  &"(1X,/1X,'OPENING BINARY FILE ON UNIT ',I0,':',/1X,A)"
1188 
1189  ! initialize oc_inunit and ibinary
1190  oc_inunit = 0
1191  ibinary = 0
1192  inunit = parser%getunit()
1193 
1194  ! Read to the first non-commented line
1195  lloc = 1
1196  call parser%line_reader%rdcom(inunit, iout, line, ierr)
1197  call urword(line, lloc, istart, istop, 1, idum, r, iout, inunit)
1198 
1199  if (line(istart:istop) == 'OPEN/CLOSE') then
1200  ! get filename
1201  call urword(line, lloc, istart, istop, 0, idum, r, &
1202  iout, inunit)
1203  fname = line(istart:istop)
1204  ! check to see if file OPEN/CLOSE file exists
1205  inquire (file=fname, exist=exists)
1206  if (.not. exists) then
1207  write (errmsg, fmtocne) line(istart:istop)
1208  call store_error(errmsg)
1209  call store_error('Specified OPEN/CLOSE file does not exist')
1210  call store_error_unit(inunit)
1211  end if
1212 
1213  ! Check for (BINARY) keyword
1214  call urword(line, lloc, istart, istop, 1, idum, r, &
1215  iout, inunit)
1216 
1217  if (line(istart:istop) == '(BINARY)') ibinary = 1
1218  ! Open the file depending on ibinary flag
1219  if (ibinary == 1) then
1220  oc_inunit = nunopn
1221  itmp = iout
1222  if (iout > 0) then
1223  itmp = 0
1224  write (iout, fmtobf) oc_inunit, trim(adjustl(fname))
1225  end if
1226  call openfile(oc_inunit, itmp, fname, 'OPEN/CLOSE', &
1227  fmtarg_opt=form, accarg_opt=access)
1228  end if
1229  end if
1230 
1231  if (ibinary == 0) then
1232  call parser%line_reader%bkspc(parser%getunit())
1233  end if
1234  end function read_control_record
1235 
1236  !> @brief Save structarray pointer for deferred TS linking
1237  !!
1238  !! Saves the current structarray pointer when it contains TS string locs,
1239  !! then nullifies the pointer so load_block does not destroy it.
1240  !<
1241  subroutine save_ts_sa(this)
1242  class(loadmf6filetype), intent(inout) :: this
1243  type(structvectortype), pointer :: svect
1244  type(staticsatype), allocatable :: tmp(:)
1245  logical(LGP) :: has_ts
1246  integer(I4B) :: m, n
1247 
1248  ! check if any column has deferred TS strlocs
1249  has_ts = .false.
1250  do m = 1, this%structarray%count()
1251  svect => this%structarray%get(m)
1252  if (svect%idt%timeseries .and. svect%ts_strlocs%count() > 0) then
1253  has_ts = .true.
1254  exit
1255  end if
1256  end do
1257 
1258  if (has_ts) then
1259  n = size(this%ts_sas)
1260  allocate (tmp(n + 1))
1261  tmp(1:n) = this%ts_sas
1262  tmp(n + 1)%sa => this%structarray
1263  call move_alloc(tmp, this%ts_sas)
1264  ! nullify so load_block does not destroy the saved SA
1265  nullify (this%structarray)
1266  end if
1267  end subroutine save_ts_sa
1268 
1269  !> @brief Clean up saved static structarrays
1270  !!
1271  !! Called from destroy() of dynamic loaders.
1272  !<
1273  subroutine cleanup(this)
1275  class(loadmf6filetype), intent(inout) :: this
1276  integer(I4B) :: n
1277  do n = 1, size(this%ts_sas)
1278  if (associated(this%ts_sas(n)%sa)) then
1279  call destructstructarray(this%ts_sas(n)%sa)
1280  nullify (this%ts_sas(n)%sa)
1281  end if
1282  end do
1283  deallocate (this%ts_sas)
1284  end subroutine cleanup
1285 
1286 end module loadmf6filemodule
subroutine init()
Definition: GridSorting.f90:25
This module contains block parser methods.
Definition: BlockParser.f90:7
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
integer(i4b), parameter lenpackagename
maximum length of the package name
Definition: Constants.f90:23
integer(i4b), parameter lenbigline
maximum length of a big line
Definition: Constants.f90:15
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
integer(i4b), parameter lenauxname
maximum length of a aux variable
Definition: Constants.f90:35
This module contains the DefinitionSelectModule.
subroutine, public split_record_dfn_tag1(input_definition_types, component_type, subcomponent_type, tagname, nwords, words)
Return aggregate definition.
type(inputparamdefinitiontype) function, pointer, public get_aggregate_definition_type(input_definition_types, component_type, subcomponent_type, blockname)
Return aggregate definition.
subroutine, public split_record_dfn_tag2(input_definition_types, component_type, subcomponent_type, tagname, tag2, nwords, words)
Return aggregate definition.
character(len=linelength) function, public idt_datatype(idt)
return input definition type datatype
type(inputparamdefinitiontype) function, pointer, public get_param_definition_type(input_definition_types, component_type, subcomponent_type, blockname, tagname, filename, found)
Return parameter definition.
subroutine, public read_dbl1d(parser, dbl1d, aname)
subroutine, public read_dbl2d(parser, dbl2d, aname)
Disable development features in release mode.
Definition: FeatureFlags.f90:2
subroutine, public developmode(errmsg, iunit)
Terminate if in release mode (guard development features)
This module contains the Input Data Model Logger Module.
Definition: IdmLogger.f90:7
subroutine, public idm_log_close(component, subcomponent, iout)
@ brief log the closing message
Definition: IdmLogger.f90:56
subroutine, public idm_log_header(component, subcomponent, iout)
@ brief log a header message
Definition: IdmLogger.f90:44
Input definition module.
subroutine, public urdaux(naux, inunit, iout, lloc, istart, istop, auxname, line, text)
Read auxiliary variables from an input line.
subroutine, public parseline(line, nwords, words, inunit, filename)
Parse a line into words.
subroutine, public openfile(iu, iout, fname, ftype, fmtarg_opt, accarg_opt, filstat_opt, mode_opt)
Open a file.
Definition: InputOutput.f90:30
subroutine, public urword(line, icol, istart, istop, ncode, n, r, iout, in)
Extract a word from a string.
subroutine, public read_int1d(parser, int1d, aname)
subroutine, public read_int2d(parser, int2d, aname)
This module defines variable data types.
Definition: kind.f90:8
subroutine, public read_int1d_layered(parser, int1d, aname, nlay, layer_shape)
subroutine, public read_dbl1d_layered(parser, dbl1d, aname, nlay, layer_shape)
subroutine, public read_dbl2d_layered(parser, dbl2d, aname, nlay, layer_shape)
subroutine, public read_int3d_layered(parser, int3d, aname, nlay, layer_shape)
subroutine, public read_dbl3d_layered(parser, dbl3d, aname, nlay, layer_shape)
subroutine, public read_int2d_layered(parser, int2d, aname, nlay, layer_shape)
This module contains the LoadContextModule.
Definition: LoadContext.f90:10
This module contains the LoadMf6FileModule.
Definition: LoadMf6File.f90:8
subroutine cleanup(this)
Clean up saved static structarrays.
type(inputparamdefinitiontype) function block_index_dfn(this, iblk)
subroutine load_integer1d_type(parser, idt, mf6_input, mshape, export, nc_vars, input_fname, iout)
load type 1d integer
subroutine load_io_tag(parser, idt, memoryPath, which, iout)
load io tag
subroutine load_double3d_type(parser, idt, mf6_input, mshape, export, nc_vars, input_fname, iout)
load type 3d double
subroutine load_string_type(parser, idt, memoryPath, iout)
load type string
type(structarraytype) function, pointer get_ts_sa(this, n)
Return the n-th saved static StructArray pointer.
subroutine load_keyword_type(parser, idt, memoryPath, iout)
load type keyword
subroutine load_auxvar_names(parser, idt, memoryPath, iout)
load aux variable names
subroutine load_double1d_type(parser, idt, mf6_input, mshape, export, nc_vars, input_fname, iout)
load type 1d double
subroutine load_block(this, iblk)
load a single block
subroutine parse_io_tag(this, iblk, pkgtype, which, tag)
subroutine save_ts_sa(this)
Save structarray pointer for deferred TS linking.
subroutine load_double2d_type(parser, idt, mf6_input, mshape, export, nc_vars, input_fname, iout)
load type 2d double
subroutine load_integer_type(parser, idt, memoryPath, iout)
load type integer
recursive subroutine parse_block(this, iblk, recursive_call)
parse block
subroutine load_integer3d_type(parser, idt, mf6_input, mshape, export, nc_vars, input_fname, iout)
load type 3d integer
subroutine block_post_process(this, iblk)
Post parse block handling.
integer(i4b) function ts_sa_count(this)
Return number of saved static StructArrays with deferred TS strlocs.
subroutine finalize(this)
finalize
subroutine load_tag(this, iblk, idt)
load input keyword Load input associated with tag key into the memory manager.
subroutine load_double_type(parser, idt, memoryPath, iout)
load type double
subroutine load_integer2d_type(parser, idt, mf6_input, mshape, export, nc_vars, input_fname, iout)
load type 2d integer
subroutine parse_structarray_block(this, iblk)
parse a structured array record into memory manager
subroutine load(this, parser, mf6_input, nc_vars, filename, iout)
load all static input blocks
Definition: LoadMf6File.f90:97
integer(i4b) function, public read_control_record(parser, oc_inunit, iout)
recursive subroutine parse_record_tag(this, iblk, inidt, recursive_call)
This module contains the LoadNCInputModule.
Definition: LoadNCInput.F90:7
subroutine, public get_from_memorystore(name, mem_path, mt, found, check)
@ brief Get a memory type entry from the memory list
subroutine, public get_isize(name, mem_path, isize)
@ brief Get the number of elements for this variable
This module contains the ModflowInputModule.
Definition: ModflowInput.f90:9
This module contains the NCFileVarsModule.
Definition: NCFileVars.f90:7
character(len=20) access
Definition: OpenSpec.f90:7
character(len=20) form
Definition: OpenSpec.f90:7
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
Definition: Sim.f90:168
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
This module contains the SourceCommonModule.
Definition: SourceCommon.f90:7
subroutine, public get_layered_shape(mshape, nlay, layer_shape)
subroutine, public get_shape_from_string(shape_string, array_shape, memoryPath)
subroutine, public set_model_shape(ftype, fname, model_mempath, dis_mempath, model_shape)
routine for setting the model shape
This module contains the StructArrayModule.
Definition: StructArray.f90:8
type(structarraytype) function, pointer, public constructstructarray(mf6_input, ncol, nrow, blocknum, mempath, component_mempath)
constructor for a struct_array
Definition: StructArray.f90:80
subroutine, public destructstructarray(struct_array)
destructor for a struct_array
This module contains the StructVectorModule.
Definition: StructVector.f90:7
This class is used to store a single deferred-length character string. It was designed to work in an ...
Definition: CharString.f90:23
Input parameter definition. Describes an input parameter.
derived type for boundary package input context
Definition: LoadContext.f90:65
Static parser based input loader.
Definition: LoadMf6File.f90:54
Fortran workaround for allocatable arrays of pointers; wraps a StructArray pointer for deferred TS li...
Definition: LoadMf6File.f90:44
derived type for storing input definition for a file
Type describing input variables for a package in NetCDF file.
Definition: NCFileVars.f90:22
type for structured array
Definition: StructArray.f90:41
derived type for generic vector