56 integer(I4B),
dimension(:),
pointer,
contiguous :: mshape => null()
61 character(len=LINELENGTH) :: filename
62 character(len=LINELENGTH),
dimension(:),
allocatable :: block_tags
63 logical(LGP) :: ts_active
64 logical(LGP) :: export
65 logical(LGP) :: readasarrays
66 logical(LGP) :: readarraygrid
67 integer(I4B) :: inamedbound
68 integer(I4B) :: iauxiliary
96 subroutine load(this, parser, mf6_input, nc_vars, filename, iout)
102 character(len=*),
intent(in) :: filename
103 integer(I4B),
intent(in) :: iout
107 call this%init(parser, mf6_input, filename, iout)
110 this%nc_vars => nc_vars
113 do iblk = 1,
size(this%mf6_input%block_dfns)
115 if (this%mf6_input%block_dfns(iblk)%blockname ==
'PERIOD')
exit
117 call this%load_block(iblk)
129 subroutine init(this, parser, mf6_input, filename, iout)
134 character(len=*),
intent(in) :: filename
135 integer(I4B),
intent(in) :: iout
136 integer(I4B) :: isize
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.
149 call get_isize(
'MODEL_SHAPE', mf6_input%component_mempath, isize)
151 call mem_setptr(this%mshape,
'MODEL_SHAPE', mf6_input%component_mempath)
155 allocate (this%ts_sas(0))
159 this%mf6_input%subcomponent_name, this%iout)
173 integer(I4B),
intent(in) :: iblk
176 if (
associated(this%structarray))
then
181 allocate (this%block_tags(0))
183 call this%parse_block(iblk, .false.)
185 call this%block_post_process(iblk)
187 deallocate (this%block_tags)
199 if (
associated(this%structarray))
then
205 this%mf6_input%subcomponent_name, this%iout)
214 integer(I4B),
intent(in) :: iblk
216 integer(I4B) :: iparam
217 integer(I4B),
pointer :: intptr
220 do iparam = 1,
size(this%block_tags)
221 select case (this%mf6_input%block_dfns(iblk)%blockname)
223 if (this%block_tags(iparam) ==
'AUXILIARY')
then
225 else if (this%block_tags(iparam) ==
'BOUNDNAMES')
then
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
241 select case (this%mf6_input%block_dfns(iblk)%blockname)
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)
257 if (this%mf6_input%pkgtype(1:3) ==
'DIS')
then
259 this%mf6_input%component_mempath, &
260 this%mf6_input%mempath, this%mshape)
273 integer(I4B),
intent(in) :: iblk
274 logical(LGP),
intent(in) :: recursive_call
275 logical(LGP) :: isblockfound
276 logical(LGP) :: endofblock
277 logical(LGP) :: supportopenclose
279 logical(LGP) :: found, required
281 character(len=LINELENGTH) :: tag
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
292 if (.not. found)
return
293 if (mt%intsclr == 0)
return
298 supportopenclose = (this%mf6_input%block_dfns(iblk)%blockname /=
'GRIDDATA')
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)
307 if (isblockfound)
then
308 if (this%mf6_input%block_dfns(iblk)%aggregate)
then
310 call this%parse_structarray_block(iblk)
314 call this%parser%GetNextLine(endofblock)
317 call this%parser%GetStringCaps(tag)
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, &
324 if (idt%in_record)
then
325 call this%parse_record_tag(iblk, idt, .false.)
327 call this%load_tag(iblk, idt)
334 if (this%mf6_input%block_dfns(iblk)%block_variable)
then
335 if (isblockfound)
then
336 call this%parse_block(iblk, .true.)
344 integer(I4B),
intent(in) :: iblk
345 character(len=*),
intent(in) :: pkgtype
346 character(len=*),
intent(in) :: which
347 character(len=*),
intent(in) :: tag
352 this%mf6_input%component_type, &
353 this%mf6_input%subcomponent_type, &
354 this%mf6_input%block_dfns(iblk)%blockname, &
357 call load_io_tag(this%parser, idt, this%mf6_input%mempath, which, this%iout)
359 this%block_tags(
size(this%block_tags)) = trim(idt%tagname)
367 integer(I4B),
intent(in) :: iblk
369 logical(LGP),
intent(in) :: recursive_call
371 character(len=40),
dimension(:),
allocatable :: words
372 integer(I4B) :: n, istart, nwords
373 character(len=LINELENGTH) :: tag
378 if (recursive_call)
then
380 this%mf6_input%component_type, &
381 this%mf6_input%subcomponent_type, &
382 inidt%tagname, nwords, words)
383 call this%load_tag(iblk, inidt)
386 call this%parser%GetStringCaps(tag)
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))
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, &
405 if (tag /=
'PRINT_FORMAT')
call this%load_tag(iblk, inidt)
406 call this%load_tag(iblk, idt)
410 call this%load_tag(iblk, inidt)
415 if (istart > 1 .and. nwords == 0)
then
417 '"', trim(this%mf6_input%block_dfns(iblk)%blockname), &
418 '" block input record that includes keyword "', trim(inidt%tagname), &
419 '" is not properly formed.'
421 call this%parser%StoreErrorUnit()
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)
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, &
439 call this%parse_record_tag(iblk, idt, .true.)
442 if (idt%tagname /=
'FORMAT')
then
443 call this%parser%GetStringCaps(tag)
446 else if (idt%tagname /= tag)
then
447 write (
errmsg,
'(5a)')
'Expecting record input tag "', &
448 trim(idt%tagname),
'" but instead found "', trim(tag),
'".'
450 call this%parser%StoreErrorUnit()
453 call this%load_tag(iblk, idt)
457 if (
allocated(words))
deallocate (words)
467 integer(I4B),
intent(in) :: iblk
469 character(len=LINELENGTH) :: dev_msg
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.'
481 select case (idt%datatype)
485 if (idt%tagname(1:4) ==
'DEV_' .and. &
486 this%mf6_input%block_dfns(iblk)%blockname ==
'OPTIONS')
then
487 call this%parser%DevOpt()
490 if (idt%shape ==
'NAUX')
then
500 this%export, this%nc_vars, this%filename, &
504 this%export, this%nc_vars, this%filename, &
508 this%export, this%nc_vars, this%filename, &
514 this%export, this%nc_vars, this%filename, this%iout)
517 this%export, this%nc_vars, this%filename, this%iout)
520 this%export, this%nc_vars, this%filename, this%iout)
522 write (
errmsg,
'(a,a)')
'Failure reading data for tag: ', trim(idt%tagname)
524 call this%parser%StoreErrorUnit()
528 this%block_tags(
size(this%block_tags)) = trim(idt%tagname)
533 integer(I4B),
intent(in) :: iblk
535 character(len=LENVARNAME) :: varname
537 character(len=3) :: block_suffix =
'NUM'
540 ilen = len_trim(this%mf6_input%block_dfns(iblk)%blockname)
542 if (ilen > (
lenvarname - len(block_suffix)))
then
544 this%mf6_input%block_dfns(iblk)% &
545 blockname(1:(
lenvarname - len(block_suffix)))//block_suffix
547 varname = trim(this%mf6_input%block_dfns(iblk)%blockname)//block_suffix
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'
570 integer(I4B),
intent(in) :: iblk
572 character(len=LINELENGTH),
dimension(:),
allocatable :: param_names
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
583 call ctx%init(this%mf6_input, blockname= &
584 this%mf6_input%block_dfns(iblk)%blockname)
586 call ctx%tags(param_names, nparam, this%filename)
590 this%mf6_input%component_type, &
591 this%mf6_input%subcomponent_type, &
592 this%mf6_input%block_dfns(iblk)%blockname)
594 if (this%mf6_input%block_dfns(iblk)%block_variable)
then
595 blocknum = this%parser%GetInteger()
603 if (blocknum > 0) ncol = ncol + 1
605 if (idt%shape /=
'')
then
606 call mem_setptr(nrow, idt%shape, this%mf6_input%mempath)
614 blocknum, this%mf6_input%mempath, &
615 this%mf6_input%component_mempath)
619 if (blocknum > 0)
then
621 blockvar_idt = this%block_index_dfn(iblk)
623 call this%structarray%mem_create_vector(icol, idt)
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)
641 call this%structarray%mem_create_vector(icol, idt)
645 call ctx%allocate_arrays()
650 if (ibinary == 1)
then
652 nrowsread = this%structarray%read_from_binary(oc_inunit, this%iout)
653 call this%parser%terminateblock()
657 nrowsread = this%structarray%read_from_parser(this%parser, this%ts_active, &
658 this%iout, this%filename)
660 if (this%ts_active)
call this%save_ts_sa()
672 n =
size(this%ts_sas)
679 integer(I4B),
intent(in) :: n
681 sa => this%ts_sas(n)%sa
689 character(len=*),
intent(in) :: memoryPath
690 integer(I4B),
intent(in) :: iout
691 integer(I4B),
pointer :: intvar
694 call idm_log_var(intvar, idt%tagname, memorypath, idt%datatype, iout)
703 character(len=*),
intent(in) :: memoryPath
704 integer(I4B),
intent(in) :: iout
705 character(len=LINELENGTH),
pointer :: cstr
706 character(len=LENBIGLINE),
pointer :: bigcstr
708 select case (idt%shape)
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)
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)
730 character(len=*),
intent(in) :: memoryPath
731 character(len=*),
intent(in) :: which
732 integer(I4B),
intent(in) :: iout
733 character(len=LINELENGTH) :: cstr
735 integer(I4B) :: ilen, isize, idx
737 if (which ==
'FILEIN')
then
738 call get_isize(idt%mf6varname, memorypath, isize)
740 call mem_allocate(charstr1d, ilen, 1, idt%mf6varname, memorypath)
743 call mem_setptr(charstr1d, idt%mf6varname, memorypath)
748 call parser%GetString(cstr, (.not. idt%preserve_case))
749 charstr1d(idx) = cstr
750 else if (which ==
'FILEOUT')
then
764 character(len=*),
intent(in) :: memoryPath
765 integer(I4B),
intent(in) :: iout
766 character(len=:),
allocatable :: line
767 character(len=LENAUXNAME),
dimension(:),
allocatable :: caux
769 integer(I4B) :: istart
770 integer(I4B) :: istop
772 character(len=LENPACKAGENAME) :: text =
''
773 integer(I4B),
pointer :: intvar
775 pointer,
contiguous :: acharstr1d
778 call parser%GetRemainingLine(line)
780 call urdaux(intvar, parser%iuactive, iout, lloc, &
781 istart, istop, caux, line, text)
784 acharstr1d(i) = caux(i)
795 character(len=*),
intent(in) :: memoryPath
796 integer(I4B),
intent(in) :: iout
797 integer(I4B),
pointer :: intvar
799 intvar = parser%GetInteger()
800 call idm_log_var(intvar, idt%tagname, memorypath, idt%datatype, iout)
806 nc_vars, input_fname, iout)
812 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: mshape
813 logical(LGP),
intent(in) :: export
815 character(len=*),
intent(in) :: input_fname
816 integer(I4B),
intent(in) :: iout
817 integer(I4B),
dimension(:),
pointer,
contiguous :: int1d
819 integer(I4B) :: nvals
820 integer(I4B),
dimension(:),
allocatable :: array_shape
821 integer(I4B),
dimension(:),
allocatable :: layer_shape
822 character(len=LINELENGTH) :: keyword
826 if (idt%shape ==
'NODES')
then
827 nvals = product(mshape)
830 nvals = array_shape(1)
834 call mem_allocate(int1d, nvals, idt%mf6varname, mf6_input%mempath)
838 call parser%GetStringCaps(keyword)
841 if (keyword ==
'NETCDF')
then
844 else if (keyword ==
'LAYERED' .and. idt%layered)
then
848 call read_int1d(parser, int1d, idt%mf6varname)
852 call idm_log_var(int1d, idt%tagname, mf6_input%mempath, iout)
856 if (idt%blockname ==
'GRIDDATA')
then
857 call idm_export(int1d, idt%tagname, mf6_input%mempath, idt%shape, iout)
865 nc_vars, input_fname, iout)
871 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: mshape
872 logical(LGP),
intent(in) :: export
874 character(len=*),
intent(in) :: input_fname
875 integer(I4B),
intent(in) :: iout
876 integer(I4B),
dimension(:, :),
pointer,
contiguous :: int2d
878 integer(I4B) :: nsize1, nsize2
879 integer(I4B),
dimension(:),
allocatable :: array_shape
880 integer(I4B),
dimension(:),
allocatable :: layer_shape
881 character(len=LINELENGTH) :: keyword
886 nsize1 = array_shape(1)
887 nsize2 = array_shape(2)
890 call mem_allocate(int2d, nsize1, nsize2, idt%mf6varname, mf6_input%mempath)
894 call parser%GetStringCaps(keyword)
897 if (keyword ==
'NETCDF')
then
900 else if (keyword ==
'LAYERED' .and. idt%layered)
then
904 call read_int2d(parser, int2d, idt%mf6varname)
908 call idm_log_var(int2d, idt%tagname, mf6_input%mempath, iout)
912 if (idt%blockname ==
'GRIDDATA')
then
913 call idm_export(int2d, idt%tagname, mf6_input%mempath, idt%shape, iout)
921 nc_vars, input_fname, iout)
927 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: mshape
928 logical(LGP),
intent(in) :: export
930 character(len=*),
intent(in) :: input_fname
931 integer(I4B),
intent(in) :: iout
932 integer(I4B),
dimension(:, :, :),
pointer,
contiguous :: int3d
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
943 nsize1 = array_shape(1)
944 nsize2 = array_shape(2)
945 nsize3 = array_shape(3)
948 call mem_allocate(int3d, nsize1, nsize2, nsize3, idt%mf6varname, &
953 call parser%GetStringCaps(keyword)
956 if (keyword ==
'NETCDF')
then
959 else if (keyword ==
'LAYERED' .and. idt%layered)
then
964 int1d_ptr(1:nsize1 * nsize2 * nsize3) => int3d(:, :, :)
965 call read_int1d(parser, int1d_ptr, idt%mf6varname)
969 call idm_log_var(int3d, idt%tagname, mf6_input%mempath, iout)
973 if (idt%blockname ==
'GRIDDATA')
then
974 call idm_export(int3d, idt%tagname, mf6_input%mempath, idt%shape, iout)
984 character(len=*),
intent(in) :: memoryPath
985 integer(I4B),
intent(in) :: iout
986 real(DP),
pointer :: dblvar
988 dblvar = parser%GetDouble()
989 call idm_log_var(dblvar, idt%tagname, memorypath, iout)
995 nc_vars, input_fname, iout)
1001 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: mshape
1002 logical(LGP),
intent(in) :: export
1004 character(len=*),
intent(in) :: input_fname
1005 integer(I4B),
intent(in) :: iout
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
1014 if (idt%shape ==
'NODES')
then
1015 nvals = product(mshape)
1018 nvals = array_shape(1)
1022 call mem_allocate(dbl1d, nvals, idt%mf6varname, mf6_input%mempath)
1026 call parser%GetStringCaps(keyword)
1029 if (keyword ==
'NETCDF')
then
1032 else if (keyword ==
'LAYERED' .and. idt%layered)
then
1036 call read_dbl1d(parser, dbl1d, idt%mf6varname)
1040 call idm_log_var(dbl1d, idt%tagname, mf6_input%mempath, iout)
1044 if (idt%blockname ==
'GRIDDATA')
then
1045 call idm_export(dbl1d, idt%tagname, mf6_input%mempath, idt%shape, iout)
1053 nc_vars, input_fname, iout)
1059 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: mshape
1060 logical(LGP),
intent(in) :: export
1062 character(len=*),
intent(in) :: input_fname
1063 integer(I4B),
intent(in) :: iout
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
1074 nsize1 = array_shape(1)
1075 nsize2 = array_shape(2)
1078 call mem_allocate(dbl2d, nsize1, nsize2, idt%mf6varname, mf6_input%mempath)
1082 call parser%GetStringCaps(keyword)
1085 if (keyword ==
'NETCDF')
then
1088 else if (keyword ==
'LAYERED' .and. idt%layered)
then
1092 call read_dbl2d(parser, dbl2d, idt%mf6varname)
1096 call idm_log_var(dbl2d, idt%tagname, mf6_input%mempath, iout)
1100 if (idt%blockname ==
'GRIDDATA')
then
1101 call idm_export(dbl2d, idt%tagname, mf6_input%mempath, idt%shape, iout)
1109 nc_vars, input_fname, iout)
1115 integer(I4B),
dimension(:),
contiguous,
pointer,
intent(in) :: mshape
1116 logical(LGP),
intent(in) :: export
1118 character(len=*),
intent(in) :: input_fname
1119 integer(I4B),
intent(in) :: iout
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
1131 nsize1 = array_shape(1)
1132 nsize2 = array_shape(2)
1133 nsize3 = array_shape(3)
1136 call mem_allocate(dbl3d, nsize1, nsize2, nsize3, idt%mf6varname, &
1141 call parser%GetStringCaps(keyword)
1144 if (keyword ==
'NETCDF')
then
1147 else if (keyword ==
'LAYERED' .and. idt%layered)
then
1152 dbl1d_ptr(1:nsize1 * nsize2 * nsize3) => dbl3d(:, :, :)
1153 call read_dbl1d(parser, dbl1d_ptr, idt%mf6varname)
1157 call idm_log_var(dbl3d, idt%tagname, mf6_input%mempath, iout)
1161 if (idt%blockname ==
'GRIDDATA')
then
1162 call idm_export(dbl3d, idt%tagname, mf6_input%mempath, idt%shape, iout)
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
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)"
1192 inunit = parser%getunit()
1196 call parser%line_reader%rdcom(inunit, iout, line, ierr)
1197 call urword(line, lloc, istart, istop, 1, idum, r, iout, inunit)
1199 if (line(istart:istop) ==
'OPEN/CLOSE')
then
1201 call urword(line, lloc, istart, istop, 0, idum, r, &
1203 fname = line(istart:istop)
1205 inquire (file=fname, exist=exists)
1206 if (.not. exists)
then
1207 write (
errmsg, fmtocne) line(istart:istop)
1209 call store_error(
'Specified OPEN/CLOSE file does not exist')
1214 call urword(line, lloc, istart, istop, 1, idum, r, &
1217 if (line(istart:istop) ==
'(BINARY)') ibinary = 1
1219 if (ibinary == 1)
then
1224 write (iout, fmtobf) oc_inunit, trim(adjustl(fname))
1226 call openfile(oc_inunit, itmp, fname,
'OPEN/CLOSE', &
1231 if (ibinary == 0)
then
1232 call parser%line_reader%bkspc(parser%getunit())
1245 logical(LGP) :: has_ts
1246 integer(I4B) :: m, n
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
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)
1265 nullify (this%structarray)
1277 do n = 1,
size(this%ts_sas)
1278 if (
associated(this%ts_sas(n)%sa))
then
1280 nullify (this%ts_sas(n)%sa)
1283 deallocate (this%ts_sas)
This module contains block parser methods.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenpackagename
maximum length of the package name
integer(i4b), parameter lenbigline
maximum length of a big line
integer(i4b), parameter lenvarname
maximum length of a variable name
integer(i4b), parameter lenauxname
maximum length of a aux variable
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.
subroutine, public developmode(errmsg, iunit)
Terminate if in release mode (guard development features)
This module contains the Input Data Model Logger Module.
subroutine, public idm_log_close(component, subcomponent, iout)
@ brief log the closing message
subroutine, public idm_log_header(component, subcomponent, iout)
@ brief log a header message
subroutine, public read_int1d(parser, int1d, aname)
subroutine, public read_int2d(parser, int2d, aname)
This module defines variable data types.
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.
This module contains the LoadMf6FileModule.
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
integer(i4b) function, public read_control_record(parser, oc_inunit, iout)
recursive subroutine parse_record_tag(this, iblk, inidt, recursive_call)
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 NCFileVarsModule.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
This module contains the SourceCommonModule.
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.
type(structarraytype) function, pointer, public constructstructarray(mf6_input, ncol, nrow, blocknum, mempath, component_mempath)
constructor for a struct_array
subroutine, public destructstructarray(struct_array)
destructor for a struct_array
This module contains the StructVectorModule.
This class is used to store a single deferred-length character string. It was designed to work in an ...
derived type for boundary package input context
Static parser based input loader.
Fortran workaround for allocatable arrays of pointers; wraps a StructArray pointer for deferred TS li...
Type describing input variables for a package in NetCDF file.
type for structured array
derived type for generic vector