22 character(len=LENPACKAGENAME) ::
text =
' GWTFMI'
25 character(len=LENBUDTXT),
dimension(NBDITEMS) ::
budtxt
26 data budtxt/
' FLOW-ERROR',
' FLOW-CORRECTION'/
29 real(dp),
dimension(:),
contiguous,
pointer :: concpack => null()
30 real(dp),
dimension(:),
contiguous,
pointer :: qmfrommvr => null()
39 integer(I4B),
dimension(:),
pointer,
contiguous :: iatp => null()
40 integer(I4B),
pointer :: iflowerr => null()
41 real(dp),
dimension(:),
pointer,
contiguous :: flowcorrect => null()
42 real(dp),
pointer :: eqnsclfac => null()
44 dimension(:),
pointer,
contiguous :: datp => null()
74 subroutine fmi_cr(fmiobj, name_model, inunit, iout, eqnsclfac, depvartype)
77 character(len=*),
intent(in) :: name_model
78 integer(I4B),
intent(in) :: inunit
79 integer(I4B),
intent(in) :: iout
80 real(dp),
intent(in),
pointer :: eqnsclfac
81 character(len=LENVARNAME),
intent(in) :: depvartype
87 call fmiobj%set_names(1, name_model,
'FMI',
'FMI')
91 call fmiobj%allocate_scalars()
94 fmiobj%inunit = inunit
98 call fmiobj%parser%Initialize(fmiobj%inunit, fmiobj%iout)
101 fmiobj%depvartype = depvartype
104 fmiobj%eqnsclfac => eqnsclfac
117 integer(I4B),
intent(in) :: inmvr
125 if (
associated(this%mvrbudobj) .and. inmvr == 0)
then
126 write (
errmsg,
'(a)')
'GWF water mover is active but the GWT MVT &
127 &package has not been specified. activate GWT MVT package.'
130 if (.not.
associated(this%mvrbudobj) .and. inmvr > 0)
then
131 write (
errmsg,
'(a)')
'GWF water mover terms are not available &
132 &but the GWT MVT package has been activated. Activate GWF-GWT &
133 &exchange or specify GWFMOVER in FMI PACKAGEDATA.'
149 real(DP),
intent(inout),
dimension(:) :: cnew
152 character(len=*),
parameter :: fmtdry = &
153 &
"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,'; RESET AS INACTIVE &
154 &WITH DRY CONCENTRATION = ', G13.5)"
155 character(len=*),
parameter :: fmtrewet = &
156 &
"(/1X,'DRY CELL REACTIVATED AT ', a,&
157 &' WITH STARTING CONCENTRATION =',G13.5)"
162 this%iflowsupdated = 1
165 if (this%iubud /= 0)
then
166 call this%advance_bfr()
170 if (this%iuhds /= 0)
then
171 call this%advance_hfr()
175 if (this%iumvr /= 0)
then
176 call this%mvrbudobj%bfr_advance(this%dis, this%iout)
180 if (this%flows_from_file .and. this%inunit /= 0)
then
181 do n = 1,
size(this%aptbudobj)
182 call this%aptbudobj(n)%ptr%bfr_advance(this%dis, this%iout)
187 if (this%idryinactive /= 0)
then
188 call this%set_active_status(cnew)
198 subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
201 integer,
intent(in) :: nodes
202 real(DP),
intent(in),
dimension(nodes) :: cold
203 integer(I4B),
intent(in) :: nja
205 integer(I4B),
intent(in),
dimension(nja) :: idxglo
206 real(DP),
intent(inout),
dimension(nodes) :: rhs
208 integer(I4B) :: n, idiag, idiag_sln
212 if (this%iflowerr /= 0)
then
217 idiag = this%dis%con%ia(n)
218 idiag_sln = idxglo(idiag)
220 qcorr = -this%gwfflowja(idiag) * this%eqnsclfac
221 call matrix_sln%add_value_pos(idiag_sln, qcorr)
238 real(DP),
intent(in),
dimension(:) :: cnew
239 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
242 integer(I4B) :: idiag
246 if (this%iflowerr /= 0)
then
249 do n = 1, this%dis%nodes
251 idiag = this%dis%con%ia(n)
252 if (this%ibound(n) > 0)
then
253 rate = -this%gwfflowja(idiag) * cnew(n) * this%eqnsclfac
255 this%flowcorrect(n) = rate
256 flowja(idiag) = flowja(idiag) + rate
266 subroutine fmi_bd(this, isuppress_output, model_budget)
272 integer(I4B),
intent(in) :: isuppress_output
273 type(
budgettype),
intent(inout) :: model_budget
279 if (this%iflowerr /= 0)
then
281 call model_budget%addentry(rin, rout,
delt,
budtxt(2), isuppress_output)
293 integer(I4B),
intent(in) :: icbcfl
294 integer(I4B),
intent(in) :: icbcun
296 integer(I4B) :: ibinun
297 integer(I4B) :: iprint, nvaluesp, nwidthp
298 character(len=1) :: cdatafmp =
' ', editdesc =
' '
302 if (this%ipakcb < 0)
then
304 elseif (this%ipakcb == 0)
then
309 if (icbcfl == 0) ibinun = 0
312 if (this%iflowerr == 0) ibinun = 0
315 if (ibinun /= 0)
then
320 call this%dis%record_array(this%flowcorrect, this%iout, iprint, -ibinun, &
321 budtxt(2), cdatafmp, nvaluesp, &
322 nwidthp, editdesc, dinact)
341 call this%deallocate_gwfpackages()
344 if (
associated(this%datp))
then
345 deallocate (this%datp)
346 deallocate (this%gwfpackages)
347 deallocate (this%flowpacknamearray)
352 deallocate (this%aptbudobj)
355 if (this%flows_from_file)
then
379 call this%NumericalPackageType%da()
397 call this%FlowModelInterfaceType%allocate_scalars()
400 call mem_allocate(this%iflowerr,
'IFLOWERR', this%memoryPath)
404 allocate (this%aptbudobj(0))
423 integer(I4B),
intent(in) :: nodes
428 call this%FlowModelInterfaceType%allocate_arrays(nodes)
431 if (this%iflowerr == 0)
then
432 call mem_allocate(this%flowcorrect, 1,
'FLOWCORRECT', this%memoryPath)
434 call mem_allocate(this%flowcorrect, nodes,
'FLOWCORRECT', this%memoryPath)
436 do n = 1,
size(this%flowcorrect)
437 this%flowcorrect(n) =
dzero
455 real(DP),
intent(inout),
dimension(:) :: cnew
460 real(DP) :: crewet, tflow, flownm
461 character(len=15) :: nodestr
463 character(len=*),
parameter :: fmtoutmsg1 = &
464 "(1x,'WARNING: DRY CELL ENCOUNTERED AT ', a,'; RESET AS INACTIVE WITH &
465 &DRY ', a, '=', G13.5)"
466 character(len=*),
parameter :: fmtoutmsg2 = &
467 &
"(1x,'DRY CELL REACTIVATED AT', a, 'WITH STARTING', a, '=', G13.5)"
469 do n = 1, this%dis%nodes
472 if (this%gwfsat(n) > dzero)
then
473 this%ibdgwfsat0(n) = 1
475 this%ibdgwfsat0(n) = 0
479 if (this%ibound(n) > 0)
then
480 if (this%gwfhead(n) ==
dhdry)
then
484 call this%dis%noder_to_string(n, nodestr)
485 write (this%iout, fmtoutmsg1) &
486 trim(nodestr), trim(adjustl(this%depvartype)),
dhdry
492 do n = 1, this%dis%nodes
495 if (cnew(n) ==
dhdry)
then
496 if (this%gwfhead(n) /=
dhdry)
then
501 do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1
502 m = this%dis%con%ja(ipos)
503 flownm = this%gwfflowja(ipos)
505 if (this%ibound(m) /= 0)
then
506 crewet = crewet + cnew(m) * flownm
507 tflow = tflow + this%gwfflowja(ipos)
511 if (tflow > dzero)
then
512 crewet = crewet / tflow
520 call this%dis%noder_to_string(n, nodestr)
521 write (this%iout, fmtoutmsg2) &
522 trim(nodestr), trim(adjustl(this%depvartype)), crewet
540 integer(I4B),
intent(in) :: n
541 real(dp),
intent(in) :: delt
550 vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n))
551 vnew = vcell * this%gwfsat(n)
553 if (this%igwfstrgss /= 0) vold = vold + this%gwfstrgss(n) * delt
554 if (this%igwfstrgsy /= 0) vold = vold + this%gwfstrgsy(n) * delt
555 satold = vold / vcell
571 character(len=LINELENGTH) :: keyword
573 logical :: isfound, endOfBlock
574 character(len=*),
parameter :: fmtisvflow = &
575 "(4x,'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED TO BINARY FILE &
576 &WHENEVER ICBCFL IS NOT ZERO AND FLOW IMBALANCE CORRECTION ACTIVE.')"
577 character(len=*),
parameter :: fmtifc = &
578 &
"(4x,'MASS WILL BE ADDED OR REMOVED TO COMPENSATE FOR FLOW IMBALANCE.')"
581 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, blockrequired=.false., &
582 supportopenclose=.true.)
586 write (this%iout,
'(1x,a)')
'PROCESSING FMI OPTIONS'
588 call this%parser%GetNextLine(endofblock)
590 call this%parser%GetStringCaps(keyword)
591 select case (keyword)
594 write (this%iout, fmtisvflow)
595 case (
'FLOW_IMBALANCE_CORRECTION')
596 write (this%iout, fmtifc)
599 write (
errmsg,
'(a,a)')
'Unknown FMI option: ', &
602 call this%parser%StoreErrorUnit()
605 write (this%iout,
'(1x,a)')
'END OF FMI OPTIONS'
626 character(len=LINELENGTH) :: keyword, fname
627 character(len=LENPACKAGENAME) :: pname
630 integer(I4B) :: inunit
632 logical :: isfound, endOfBlock
633 logical :: blockrequired
639 blockrequired = .true.
642 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
643 blockrequired=blockrequired, &
644 supportopenclose=.true.)
648 write (this%iout,
'(1x,a)')
'PROCESSING FMI PACKAGEDATA'
650 call this%parser%GetNextLine(endofblock)
652 call this%parser%GetStringCaps(keyword)
653 select case (keyword)
655 call this%parser%GetStringCaps(keyword)
656 if (keyword /=
'FILEIN')
then
657 call store_error(
'GWFBUDGET keyword must be followed by '// &
658 '"FILEIN" then by filename.')
659 call this%parser%StoreErrorUnit()
661 call this%parser%GetString(fname)
663 inquire (file=trim(fname), exist=exist)
664 if (.not. exist)
then
665 call store_error(
'Could not find file '//trim(fname))
666 call this%parser%StoreErrorUnit()
668 call openfile(inunit, this%iout, fname,
'DATA(BINARY)',
form, &
671 call this%initialize_bfr()
673 call this%parser%GetStringCaps(keyword)
674 if (keyword /=
'FILEIN')
then
675 call store_error(
'GWFHEAD keyword must be followed by '// &
676 '"FILEIN" then by filename.')
677 call this%parser%StoreErrorUnit()
679 call this%parser%GetString(fname)
680 inquire (file=trim(fname), exist=exist)
681 if (.not. exist)
then
682 call store_error(
'Could not find file '//trim(fname))
683 call this%parser%StoreErrorUnit()
686 call openfile(inunit, this%iout, fname,
'DATA(BINARY)',
form, &
689 call this%initialize_hfr()
691 call this%parser%GetStringCaps(keyword)
692 if (keyword /=
'FILEIN')
then
693 call store_error(
'GWFMOVER keyword must be followed by '// &
694 '"FILEIN" then by filename.')
695 call this%parser%StoreErrorUnit()
697 call this%parser%GetString(fname)
699 call openfile(inunit, this%iout, fname,
'DATA(BINARY)',
form, &
704 call this%mvrbudobj%fill_from_bfr(this%dis, this%iout)
708 allocate (tmpbudobj(iapt))
709 do i = 1,
size(this%aptbudobj)
710 tmpbudobj(i)%ptr => this%aptbudobj(i)%ptr
712 deallocate (this%aptbudobj)
713 allocate (this%aptbudobj(iapt + 1))
714 do i = 1,
size(tmpbudobj)
715 this%aptbudobj(i)%ptr => tmpbudobj(i)%ptr
717 deallocate (tmpbudobj)
722 call this%parser%GetStringCaps(keyword)
723 if (keyword /=
'FILEIN')
then
724 call store_error(
'Package name must be followed by '// &
725 '"FILEIN" then by filename.')
726 call this%parser%StoreErrorUnit()
728 call this%parser%GetString(fname)
730 call openfile(inunit, this%iout, fname,
'DATA(BINARY)',
form, &
733 this%iout, colconv2=[
'GWF '])
734 call budobjptr%fill_from_bfr(this%dis, this%iout)
735 this%aptbudobj(iapt)%ptr => budobjptr
738 write (this%iout,
'(1x,a)')
'END OF FMI PACKAGEDATA'
756 character(len=*),
intent(in) :: name
762 do i = 1,
size(this%aptbudobj)
763 if (this%aptbudobj(i)%ptr%name == name)
then
764 budobjptr => this%aptbudobj(i)%ptr
786 integer(I4B) :: nflowpack
787 integer(I4B) :: i, ip
789 logical :: found_flowja
790 logical :: found_dataspdis
791 logical :: found_datasat
792 logical :: found_stoss
793 logical :: found_stosy
794 integer(I4B),
dimension(:),
allocatable :: imap
797 allocate (imap(this%bfr%nbudterms))
800 found_flowja = .false.
801 found_dataspdis = .false.
802 found_datasat = .false.
803 found_stoss = .false.
804 found_stosy = .false.
805 do i = 1, this%bfr%nbudterms
806 select case (trim(adjustl(this%bfr%budtxtarray(i))))
807 case (
'FLOW-JA-FACE')
808 found_flowja = .true.
810 found_dataspdis = .true.
812 found_datasat = .true.
820 nflowpack = nflowpack + 1
826 call this%allocate_gwfpackages(nflowpack)
831 do i = 1, this%bfr%nbudterms
832 if (imap(i) == 0) cycle
833 call this%gwfpackages(ip)%set_name(this%bfr%dstpackagenamearray(i), &
834 this%bfr%budtxtarray(i))
835 naux = this%bfr%nauxarray(i)
836 call this%gwfpackages(ip)%set_auxname(naux, &
837 this%bfr%auxtxtarray(1:naux, i))
845 if (imap(i) == 1)
then
846 this%flowpacknamearray(ip) = this%bfr%dstpackagenamearray(i)
852 if (.not. found_dataspdis)
then
853 write (
errmsg,
'(a)')
'Specific discharge not found in &
854 &budget file. SAVE_SPECIFIC_DISCHARGE and &
855 &SAVE_FLOWS must be activated in the NPF package.'
858 if (.not. found_datasat)
then
859 write (
errmsg,
'(a)')
'Saturation not found in &
860 &budget file. SAVE_SATURATION and &
861 &SAVE_FLOWS must be activated in the NPF package.'
864 if (.not. found_flowja)
then
865 write (
errmsg,
'(a)')
'FLOWJA not found in &
866 &budget file. SAVE_FLOWS must &
867 &be activated in the NPF package.'
871 call this%parser%StoreErrorUnit()
888 integer(I4B) :: ngwfpack
889 integer(I4B) :: ngwfterms
891 integer(I4B) :: imover
892 integer(I4B) :: ntomvr
893 integer(I4B) :: iterm
894 character(len=LENPACKAGENAME) :: budtxt
895 class(
bndtype),
pointer :: packobj => null()
898 ngwfpack = this%gwfbndlist%Count()
906 imover = packobj%imover
907 if (packobj%isadvpak /= 0) imover = 0
908 if (imover /= 0)
then
915 ngwfterms = ngwfpack + ntomvr
916 call this%allocate_gwfpackages(ngwfterms)
924 budtxt = adjustl(packobj%text)
925 call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt)
926 this%flowpacknamearray(iterm) = packobj%packName
927 call this%gwfpackages(iterm)%set_auxname(packobj%naux, &
933 imover = packobj%imover
934 if (packobj%isadvpak /= 0) imover = 0
935 if (imover /= 0)
then
936 budtxt = trim(adjustl(packobj%text))//
'-TO-MVR'
937 call this%gwfpackages(iterm)%set_name(packobj%packName, budtxt)
938 this%flowpacknamearray(iterm) = packobj%packName
939 call this%gwfpackages(iterm)%set_auxname(packobj%naux, &
941 this%igwfmvrterm(iterm) = 1
961 integer(I4B),
intent(in) :: ngwfterms
964 character(len=LENMEMPATH) :: memPath
967 allocate (this%gwfpackages(ngwfterms))
968 allocate (this%flowpacknamearray(ngwfterms))
969 allocate (this%datp(ngwfterms))
972 call mem_allocate(this%iatp, ngwfterms,
'IATP', this%memoryPath)
973 call mem_allocate(this%igwfmvrterm, ngwfterms,
'IGWFMVRTERM', this%memoryPath)
976 this%nflowpack = ngwfterms
977 do n = 1, this%nflowpack
979 this%igwfmvrterm(n) = 0
980 this%flowpacknamearray(n) =
''
984 write (mempath,
'(a, i0)') trim(this%memoryPath)//
'-FT', n
985 call this%gwfpackages(n)%initialize(mempath)
1004 do n = 1, this%nflowpack
1005 call this%gwfpackages(n)%da()
This module contains the base boundary package.
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
This module contains the BudgetModule.
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
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
real(dp), parameter dhdry
real dry cell constant
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
This module defines variable data types.
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
real(dp), pointer, public delt
length of the current time step
real(dp) function gwfsatold(this, n, delt)
Calculate the previous saturation level.
integer(i4b), parameter nbditems
subroutine fmi_bd(this, isuppress_output, model_budget)
Calculate budget terms associated with FMI object.
subroutine gwtfmi_deallocate_gwfpackages(this)
Deallocate memory.
character(len=lenbudtxt), dimension(nbditems) budtxt
subroutine gwtfmi_allocate_scalars(this)
@ brief Allocate scalars
subroutine gwtfmi_allocate_arrays(this, nodes)
@ brief Allocate arrays for FMI object
subroutine initialize_gwfterms_from_gwfbndlist(this)
Initialize groundwater flow terms from the groundwater budget.
subroutine gwtfmi_allocate_gwfpackages(this, ngwfterms)
Initialize an array for storing PackageBudget objects.
subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs)
Calculate coefficients and fill matrix and rhs terms associated with FMI object.
subroutine initialize_gwfterms_from_bfr(this)
Initialize the groundwater flow terms based on the budget file reader.
subroutine fmi_rp(this, inmvr)
Read and prepare.
subroutine gwtfmi_read_options(this)
Read options from input file.
subroutine set_aptbudobj_pointer(this, name, budobjptr)
Set the pointer to a budget object.
subroutine set_active_status(this, cnew)
Set gwt transport cell status.
subroutine fmi_ot_flow(this, icbcfl, icbcun)
Save budget terms associated with FMI object.
character(len=lenpackagename) text
subroutine fmi_ad(this, cnew)
Advance routine for FMI object.
subroutine fmi_cq(this, cnew, flowja)
Calculate flow correction.
subroutine gwtfmi_da(this)
Deallocate variables.
subroutine gwtfmi_read_packagedata(this)
Read PACKAGEDATA block.
subroutine, public fmi_cr(fmiobj, name_model, inunit, iout, eqnsclfac, depvartype)
Create a new FMI object.
Derived type for the Budget object.
A generic heterogeneous doubly-linked list.
Derived type for storing flows.