22 character(len=LENPACKAGENAME) :: text =
''
23 logical,
pointer :: flows_from_file => null()
24 type(
listtype),
pointer :: gwfbndlist => null()
25 integer(I4B),
pointer :: iflowsupdated => null()
26 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound => null()
27 real(dp),
dimension(:),
pointer,
contiguous :: gwfflowja => null()
28 real(dp),
dimension(:, :),
pointer,
contiguous :: gwfspdis => null()
29 real(dp),
dimension(:),
pointer,
contiguous :: gwfhead => null()
30 real(dp),
dimension(:),
pointer,
contiguous :: gwfsat => null()
31 integer(I4B),
dimension(:),
pointer,
contiguous :: ibdgwfsat0 => null()
32 integer(I4B),
pointer :: idryinactive => null()
33 real(dp),
dimension(:),
pointer,
contiguous :: gwfstrgss => null()
34 real(dp),
dimension(:),
pointer,
contiguous :: gwfstrgsy => null()
35 integer(I4B),
pointer :: igwfstrgss => null()
36 integer(I4B),
pointer :: igwfstrgsy => null()
37 integer(I4B),
pointer :: iubud => null()
38 integer(I4B),
pointer :: iuhds => null()
39 integer(I4B),
pointer :: iumvr => null()
40 integer(I4B),
pointer :: nflowpack => null()
41 integer(I4B),
dimension(:),
pointer,
contiguous :: igwfmvrterm => null()
46 character(len=16),
dimension(:),
allocatable :: flowpacknamearray
47 character(len=LENVARNAME) :: depvartype =
''
76 subroutine fmi_df(this, dis, idryinactive)
82 integer(I4B),
intent(in) :: idryinactive
84 character(len=*),
parameter :: fmtfmi = &
85 "(1x,/1x,'FMI -- FLOW MODEL INTERFACE, VERSION 2, 8/17/2023', &
86 &' INPUT READ FROM UNIT ', i0, //)"
87 character(len=*),
parameter :: fmtfmi0 = &
88 "(1x,/1x,'FMI -- FLOW MODEL INTERFACE,'&
89 &' VERSION 2, 8/17/2023')"
92 if (this%iout > 0)
then
93 if (this%inunit /= 0)
then
94 write (this%iout, fmtfmi) this%inunit
96 write (this%iout, fmtfmi0)
97 if (this%flows_from_file)
then
98 write (this%iout,
'(a)')
' FLOWS ARE ASSUMED TO BE ZERO.'
100 write (this%iout,
'(a)')
' FLOWS PROVIDED BY A GWF MODEL IN THIS &
110 if (this%inunit /= 0)
then
111 call this%read_options()
115 if (this%inunit /= 0 .and. this%flows_from_file)
then
116 call this%read_packagedata()
117 call this%initialize_gwfterms_from_bfr()
121 if (.not. this%flows_from_file)
then
122 call this%initialize_gwfterms_from_gwfbndlist()
128 this%idryinactive = idryinactive
141 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
144 this%ibound => ibound
147 call this%allocate_arrays(this%dis%nodes)
163 call this%deallocate_gwfpackages()
166 deallocate (this%gwfpackages)
167 deallocate (this%flowpacknamearray)
171 if (this%flows_from_file)
then
194 call this%NumericalPackageType%da()
210 call this%NumericalPackageType%allocate_scalars()
213 call mem_allocate(this%flows_from_file,
'FLOWS_FROM_FILE', this%memoryPath)
214 call mem_allocate(this%iflowsupdated,
'IFLOWSUPDATED', this%memoryPath)
215 call mem_allocate(this%igwfstrgss,
'IGWFSTRGSS', this%memoryPath)
216 call mem_allocate(this%igwfstrgsy,
'IGWFSTRGSY', this%memoryPath)
220 call mem_allocate(this%nflowpack,
'NFLOWPACK', this%memoryPath)
221 call mem_allocate(this%idryinactive,
"IDRYINACTIVE", this%memoryPath)
225 this%flows_from_file = .true.
226 this%iflowsupdated = 1
233 this%idryinactive = 1
247 integer(I4B),
intent(in) :: nodes
253 call mem_allocate(this%ibdgwfsat0, nodes,
'IBDGWFSAT0', this%memoryPath)
255 this%ibdgwfsat0(n) = 1
260 if (this%flows_from_file)
then
262 'GWFFLOWJA', this%memoryPath)
263 call mem_allocate(this%gwfsat, nodes,
'GWFSAT', this%memoryPath)
264 call mem_allocate(this%gwfhead, nodes,
'GWFHEAD', this%memoryPath)
265 call mem_allocate(this%gwfspdis, 3, nodes,
'GWFSPDIS', this%memoryPath)
267 this%gwfsat(n) = done
268 this%gwfhead(n) =
dzero
269 this%gwfspdis(:, n) =
dzero
271 do n = 1,
size(this%gwfflowja)
272 this%gwfflowja(n) =
dzero
276 if (this%igwfstrgss == 0)
then
277 call mem_allocate(this%gwfstrgss, 1,
'GWFSTRGSS', this%memoryPath)
279 call mem_allocate(this%gwfstrgss, nodes,
'GWFSTRGSS', this%memoryPath)
281 if (this%igwfstrgsy == 0)
then
282 call mem_allocate(this%gwfstrgsy, 1,
'GWFSTRGSY', this%memoryPath)
284 call mem_allocate(this%gwfstrgsy, nodes,
'GWFSTRGSY', this%memoryPath)
286 do n = 1,
size(this%gwfstrgss)
287 this%gwfstrgss(n) =
dzero
289 do n = 1,
size(this%gwfstrgsy)
290 this%gwfstrgsy(n) =
dzero
295 if (this%inunit == 0)
call this%allocate_gwfpackages(this%nflowpack)
312 character(len=LINELENGTH) :: keyword
314 logical :: isfound, endOfBlock
317 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, blockrequired=.false., &
318 supportopenclose=.true.)
322 write (this%iout,
'(1x,a)')
'PROCESSING FMI OPTIONS'
324 call this%parser%GetNextLine(endofblock)
326 call this%parser%GetStringCaps(keyword)
327 select case (keyword)
331 write (
errmsg,
'(a,3(1x,a))') &
332 'UNKNOWN', trim(adjustl(this%text)),
'OPTION:', trim(keyword)
334 call this%parser%StoreErrorUnit()
337 write (this%iout,
'(1x,a)')
'END OF FMI OPTIONS'
355 character(len=LINELENGTH) :: keyword, fname
357 integer(I4B) :: inunit
359 logical :: isfound, endOfBlock
360 logical :: blockrequired
365 blockrequired = .true.
368 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
369 blockrequired=blockrequired, &
370 supportopenclose=.true.)
374 write (this%iout,
'(1x,a)')
'PROCESSING FMI PACKAGEDATA'
376 call this%parser%GetNextLine(endofblock)
378 call this%parser%GetStringCaps(keyword)
379 select case (keyword)
381 call this%parser%GetStringCaps(keyword)
382 if (keyword /=
'FILEIN')
then
383 call store_error(
'GWFBUDGET KEYWORD MUST BE FOLLOWED BY '// &
384 '"FILEIN" then by filename.')
385 call this%parser%StoreErrorUnit()
387 call this%parser%GetString(fname)
389 inquire (file=trim(fname), exist=exist)
390 if (.not. exist)
then
391 call store_error(
'Could not find file '//trim(fname))
392 call this%parser%StoreErrorUnit()
394 call openfile(inunit, this%iout, fname,
'DATA(BINARY)',
form, &
397 call this%initialize_bfr()
399 call this%parser%GetStringCaps(keyword)
400 if (keyword /=
'FILEIN')
then
401 call store_error(
'GWFHEAD KEYWORD MUST BE FOLLOWED BY '// &
402 '"FILEIN" then by filename.')
403 call this%parser%StoreErrorUnit()
405 call this%parser%GetString(fname)
406 inquire (file=trim(fname), exist=exist)
407 if (.not. exist)
then
408 call store_error(
'Could not find file '//trim(fname))
409 call this%parser%StoreErrorUnit()
412 call openfile(inunit, this%iout, fname,
'DATA(BINARY)',
form, &
415 call this%initialize_hfr()
417 call this%parser%GetStringCaps(keyword)
418 if (keyword /=
'FILEIN')
then
419 call store_error(
'GWFMOVER KEYWORD MUST BE FOLLOWED BY '// &
420 '"FILEIN" then by filename.')
421 call this%parser%StoreErrorUnit()
423 call this%parser%GetString(fname)
425 call openfile(inunit, this%iout, fname,
'DATA(BINARY)',
form, &
430 call this%mvrbudobj%fill_from_bfr(this%dis, this%iout)
432 write (
errmsg,
'(a,3(1x,a))') &
433 'UNKNOWN', trim(adjustl(this%text)),
'PACKAGEDATA:', trim(keyword)
437 write (this%iout,
'(1x,a)')
'END OF FMI PACKAGEDATA'
450 integer(I4B) :: ncrbud
453 call this%bfr%initialize(this%iubud, this%iout, ncrbud)
474 integer(I4B) :: nu, nr
475 integer(I4B) :: ip, i
478 character(len=*),
parameter :: fmtkstpkper = &
479 "(1x,/1x,'FMI READING BUDGET TERMS &
480 &FOR KSTP ', i0, ' KPER ', i0)"
481 character(len=*),
parameter :: fmtbudkstpkper = &
482 "(1x,/1x, 'FMI SETTING BUDGET TERMS &
483 &FOR KSTP ', i0, ' AND KPER ', &
484 &i0, ' TO BUDGET FILE TERMS FROM &
485 &KSTP ', i0, ' AND KPER ', i0)"
493 if (this%bfr%kstp == 1)
then
494 if (this%bfr%kpernext ==
kper + 1)
then
496 else if (this%bfr%endoffile)
then
499 else if (this%bfr%endoffile)
then
500 write (
errmsg,
'(4x,a)')
'REACHED END OF GWF BUDGET &
501 &FILE BEFORE READING SUFFICIENT BUDGET INFORMATION FOR THIS &
512 write (this%iout, fmtkstpkper)
kstp,
kper
517 do n = 1, this%bfr%nbudterms
518 call this%bfr%read_record(success, this%iout)
519 if (.not. success)
then
520 write (
errmsg,
'(4x,a)')
'GWF BUDGET READ NOT SUCCESSFUL'
526 if (
kper /= this%bfr%kper)
then
527 write (
errmsg,
'(4x,a)')
'PERIOD NUMBER IN BUDGET FILE &
528 &DOES NOT MATCH PERIOD NUMBER IN TRANSPORT MODEL. IF THERE &
529 &IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN &
530 &STRESS PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL &
531 &TIME STEPS ONE-FOR-ONE IN THAT STRESS PERIOD.'
537 if (this%bfr%kstp > 1 .and. (
kstp /= this%bfr%kstp))
then
538 write (
errmsg,
'(4x,a)')
'TIME STEP NUMBER IN BUDGET FILE &
539 &DOES NOT MATCH TIME STEP NUMBER IN TRANSPORT MODEL. IF THERE &
540 &IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN STRESS &
541 &PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS &
542 &ONE-FOR-ONE IN THAT STRESS PERIOD.'
549 select case (trim(adjustl(this%bfr%budtxt)))
550 case (
'FLOW-JA-FACE')
554 do ipos = 1,
size(this%bfr%flowja)
555 this%gwfflowja(ipos) = this%bfr%flowja(ipos)
558 do i = 1, this%bfr%nlist
559 nu = this%bfr%nodesrc(i)
560 nr = this%dis%get_nodenumber(nu, 0)
562 this%gwfspdis(1, nr) = this%bfr%auxvar(1, i)
563 this%gwfspdis(2, nr) = this%bfr%auxvar(2, i)
564 this%gwfspdis(3, nr) = this%bfr%auxvar(3, i)
567 do i = 1, this%bfr%nlist
568 nu = this%bfr%nodesrc(i)
569 nr = this%dis%get_nodenumber(nu, 0)
571 this%gwfsat(nr) = this%bfr%auxvar(1, i)
574 do nu = 1, this%dis%nodesuser
575 nr = this%dis%get_nodenumber(nu, 0)
577 this%gwfstrgss(nr) = this%bfr%flow(nu)
580 do nu = 1, this%dis%nodesuser
581 nr = this%dis%get_nodenumber(nu, 0)
583 this%gwfstrgsy(nr) = this%bfr%flow(nu)
586 call this%gwfpackages(ip)%copy_values( &
591 do i = 1, this%gwfpackages(ip)%nbound
592 nu = this%gwfpackages(ip)%nodelist(i)
593 nr = this%dis%get_nodenumber(nu, 0)
594 this%gwfpackages(ip)%nodelist(i) = nr
602 write (this%iout, fmtbudkstpkper)
kstp,
kper, this%bfr%kstp, this%bfr%kper
605 this%iflowsupdated = 0
617 call this%bfr%finalize()
629 call this%hfr%initialize(this%iuhds, this%iout)
641 integer(I4B) :: nu, nr, i, ilay
646 character(len=*),
parameter :: fmtkstpkper = &
647 "(1x,/1x,'FMI READING HEAD FOR &
648 &KSTP ', i0, ' KPER ', i0)"
649 character(len=*),
parameter :: fmthdskstpkper = &
650 "(1x,/1x, 'FMI SETTING HEAD FOR KSTP ', i0, ' AND KPER ', &
651 &i0, ' TO BINARY FILE HEADS FROM KSTP ', i0, ' AND KPER ', i0)"
659 if (this%hfr%kstp == 1)
then
660 if (this%hfr%kpernext ==
kper + 1)
then
662 else if (this%hfr%endoffile)
then
665 else if (this%hfr%endoffile)
then
666 write (
errmsg,
'(4x,a)')
'REACHED END OF GWF HEAD &
667 &FILE BEFORE READING SUFFICIENT HEAD INFORMATION FOR THIS &
678 write (this%iout, fmtkstpkper)
kstp,
kper
681 do ilay = 1, this%hfr%nlay
684 call this%hfr%read_record(success, this%iout)
685 if (.not. success)
then
686 write (
errmsg,
'(4x,a)')
'GWF HEAD READ NOT SUCCESSFUL'
692 if (
kper /= this%hfr%kper)
then
693 write (
errmsg,
'(4x,a)')
'PERIOD NUMBER IN HEAD FILE &
694 &DOES NOT MATCH PERIOD NUMBER IN TRANSPORT MODEL. IF THERE &
695 &IS MORE THAN ONE TIME STEP IN THE HEAD FILE FOR A GIVEN STRESS &
696 &PERIOD, HEAD FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS &
697 &ONE-FOR-ONE IN THAT STRESS PERIOD.'
703 if (this%hfr%kstp > 1 .and. (
kstp /= this%hfr%kstp))
then
704 write (
errmsg,
'(4x,a)')
'TIME STEP NUMBER IN HEAD FILE &
705 &DOES NOT MATCH TIME STEP NUMBER IN TRANSPORT MODEL. IF THERE &
706 &IS MORE THAN ONE TIME STEP IN THE HEAD FILE FOR A GIVEN STRESS &
707 &PERIOD, HEAD FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS &
708 &ONE-FOR-ONE IN THAT STRESS PERIOD.'
715 ncpl =
size(this%hfr%head)
717 nu = (ilay - 1) * ncpl + i
718 nr = this%dis%get_nodenumber(nu, 0)
719 val = this%hfr%head(i)
720 if (nr > 0) this%gwfhead(nr) = val
724 write (this%iout, fmthdskstpkper)
kstp,
kper, this%hfr%kstp, this%hfr%kper
753 integer(I4B) :: nflowpack
754 integer(I4B) :: i, ip
756 logical :: found_flowja
757 logical :: found_dataspdis
758 logical :: found_datasat
759 logical :: found_stoss
760 logical :: found_stosy
761 integer(I4B),
dimension(:),
allocatable :: imap
764 allocate (imap(this%bfr%nbudterms))
767 found_flowja = .false.
768 found_dataspdis = .false.
769 found_datasat = .false.
770 found_stoss = .false.
771 found_stosy = .false.
772 do i = 1, this%bfr%nbudterms
773 select case (trim(adjustl(this%bfr%budtxtarray(i))))
774 case (
'FLOW-JA-FACE')
775 found_flowja = .true.
777 found_dataspdis = .true.
779 found_datasat = .true.
787 nflowpack = nflowpack + 1
793 call this%allocate_gwfpackages(nflowpack)
798 do i = 1, this%bfr%nbudterms
799 if (imap(i) == 0) cycle
800 call this%gwfpackages(ip)%set_name(this%bfr%dstpackagenamearray(i), &
801 this%bfr%budtxtarray(i))
802 naux = this%bfr%nauxarray(i)
803 call this%gwfpackages(ip)%set_auxname(naux, this%bfr%auxtxtarray(1:naux, i))
811 if (imap(i) == 1)
then
812 this%flowpacknamearray(ip) = this%bfr%dstpackagenamearray(i)
818 if (.not. found_dataspdis)
then
819 write (
errmsg,
'(4x,a)')
'SPECIFIC DISCHARGE NOT FOUND IN &
820 &BUDGET FILE. SAVE_SPECIFIC_DISCHARGE AND &
821 &SAVE_FLOWS MUST BE ACTIVATED IN THE NPF PACKAGE.'
824 if (.not. found_datasat)
then
825 write (
errmsg,
'(4x,a)')
'SATURATION NOT FOUND IN &
826 &BUDGET FILE. SAVE_SATURATION AND &
827 &SAVE_FLOWS MUST BE ACTIVATED IN THE NPF PACKAGE.'
830 if (.not. found_flowja)
then
831 write (
errmsg,
'(4x,a)')
'FLOWJA NOT FOUND IN &
832 &BUDGET FILE. SAVE_FLOWS MUST &
833 &BE ACTIVATED IN THE NPF PACKAGE.'
837 call this%parser%StoreErrorUnit()
852 integer(I4B) :: ngwfpack
853 integer(I4B) :: ngwfterms
855 integer(I4B) :: imover
856 integer(I4B) :: ntomvr
857 integer(I4B) :: iterm
858 character(len=LENPACKAGENAME) :: budtxt
859 class(
bndtype),
pointer :: packobj => null()
862 ngwfpack = this%gwfbndlist%Count()
870 imover = packobj%imover
871 if (packobj%isadvpak /= 0) imover = 0
872 if (imover /= 0)
then
879 ngwfterms = ngwfpack + ntomvr
880 call this%allocate_gwfpackages(ngwfterms)
888 budtxt = adjustl(packobj%text)
889 call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt)
890 this%flowpacknamearray(iterm) = packobj%packName
895 imover = packobj%imover
896 if (packobj%isadvpak /= 0) imover = 0
897 if (imover /= 0)
then
898 budtxt = trim(adjustl(packobj%text))//
'-TO-MVR'
899 call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt)
900 this%flowpacknamearray(iterm) = packobj%packName
901 this%igwfmvrterm(iterm) = 1
920 integer(I4B),
intent(in) :: ngwfterms
923 character(len=LENMEMPATH) :: memPath
926 allocate (this%gwfpackages(ngwfterms))
927 allocate (this%flowpacknamearray(ngwfterms))
930 call mem_allocate(this%igwfmvrterm, ngwfterms,
'IGWFMVRTERM', this%memoryPath)
933 this%nflowpack = ngwfterms
934 do n = 1, this%nflowpack
935 this%igwfmvrterm(n) = 0
936 this%flowpacknamearray(n) =
''
940 write (mempath,
'(a, i0)') trim(this%memoryPath)//
'-FT', n
941 call this%gwfpackages(n)%initialize(mempath)
958 do n = 1, this%nflowpack
959 call this%gwfpackages(n)%da()
971 character(len=*),
intent(in) :: name
972 integer(I4B),
intent(inout) :: idx
978 do ip = 1,
size(this%flowpacknamearray)
979 if (this%flowpacknamearray(ip) == name)
then
985 call store_error(
'Error in get_package_index. Could not find '//name, &
This module contains the base boundary package.
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
subroutine, public budgetobject_cr_bfr(this, name, ibinun, iout, colconv1, colconv2)
Create a new budget object from a binary flow file.
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 lenvarname
maximum length of a variable name
real(dp), parameter dhalf
real constant 1/2
real(dp), parameter dem6
real constant 1e-6
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
integer(i4b), parameter lenmempath
maximum length of the memory path
real(dp), parameter done
real constant 1
subroutine allocate_scalars(this)
Allocate scalars.
subroutine fmi_ar(this, ibound)
Allocate the package.
subroutine allocate_gwfpackages(this, ngwfterms)
Allocate budget packages.
subroutine deallocate_gwfpackages(this)
Deallocate memory in the gwfpackages array.
subroutine read_options(this)
Read options from input file.
subroutine finalize_hfr(this)
Finalize the head file reader.
subroutine fmi_df(this, dis, idryinactive)
Define the flow model interface.
subroutine get_package_index(this, name, idx)
Find the package index for the package with the given name.
subroutine advance_bfr(this)
Advance the budget file reader.
subroutine initialize_gwfterms_from_gwfbndlist(this)
Initialize gwf terms from a GWF exchange.
subroutine initialize_hfr(this)
Initialize the head file reader.
subroutine fmi_da(this)
Deallocate variables.
subroutine read_packagedata(this)
Read packagedata block from input file.
subroutine advance_hfr(this)
Advance the head file reader.
subroutine initialize_gwfterms_from_bfr(this)
Initialize gwf terms from budget file.
subroutine finalize_bfr(this)
Finalize the budget file reader.
subroutine allocate_arrays(this, nodes)
Allocate arrays.
subroutine initialize_bfr(this)
Initialize the budget file reader.
This module defines variable data types.
This module contains the base numerical package type.
This module contains the PackageBudgetModule Module.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
A generic heterogeneous doubly-linked list.
Derived type for storing flows.