16 character(len=LENPACKAGENAME) ::
text =
' PRTFMI'
20 integer(I4B) :: max_faces
21 double precision,
allocatable,
public :: sourceflows(:)
22 double precision,
allocatable,
public :: sinkflows(:)
23 double precision,
allocatable,
public :: storageflows(:)
24 double precision,
allocatable,
public :: boundaryflows(:)
37 subroutine fmi_cr(fmiobj, name_model, input_mempath, inunit, iout)
40 character(len=*),
intent(in) :: name_model
41 character(len=*),
intent(in) :: input_mempath
42 integer(I4B),
intent(inout) :: inunit
43 integer(I4B),
intent(in) :: iout
49 call fmiobj%set_names(1, name_model,
'FMI',
'FMI', input_mempath)
53 call fmiobj%allocate_scalars()
56 fmiobj%inunit = inunit
60 fmiobj%depvartype =
'TRACKS '
72 character(len=15) :: nodestr
73 character(len=*),
parameter :: fmtdry = &
74 &
"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,'; RESET AS INACTIVE')"
75 character(len=*),
parameter :: fmtrewet = &
76 &
"(/1X,'DRY CELL REACTIVATED AT ', a)"
81 this%iflowsupdated = 1
84 if (this%iubud /= 0)
then
85 call this%advance_bfr()
89 if (this%iuhds /= 0)
then
90 call this%advance_hfr()
94 if (this%iumvr /= 0)
then
95 call this%mvrbudobj%bfr_advance(this%dis, this%iout)
99 call this%accumulate_flows()
102 do n = 1, this%dis%nodes
106 if (this%gwfsat(n) > dzero)
then
107 this%ibdgwfsat0(n) = 1
109 this%ibdgwfsat0(n) = 0
113 if (this%ibound(n) > 0)
then
114 if (this%gwfhead(n) ==
dhdry)
then
117 call this%dis%noder_to_string(n, nodestr)
118 write (this%iout, fmtdry) trim(nodestr)
123 if (this%ibound(n) == 0)
then
124 if (this%gwfhead(n) /=
dhdry)
then
127 call this%dis%noder_to_string(n, nodestr)
128 write (this%iout, fmtrewet) trim(nodestr)
142 integer(I4B),
intent(in) :: idryinactive
145 call this%FlowModelInterfaceType%fmi_df(dis, idryinactive)
148 this%max_faces = this%dis%get_max_npolyverts() + 2
149 allocate (this%StorageFlows(this%dis%nodes))
150 allocate (this%SourceFlows(this%dis%nodes))
151 allocate (this%SinkFlows(this%dis%nodes))
152 allocate (this%BoundaryFlows(this%dis%nodes * this%max_faces))
162 integer(I4B) :: j, i, ip, ib
163 integer(I4B) :: ioffset, iflowface, iauxiflowface
165 character(len=LENAUXNAME) :: auxname
168 this%StorageFlows =
dzero
169 if (this%igwfstrgss /= 0) &
170 this%StorageFlows = this%StorageFlows + &
172 if (this%igwfstrgsy /= 0) &
173 this%StorageFlows = this%StorageFlows + &
176 this%SourceFlows =
dzero
177 this%SinkFlows =
dzero
178 this%BoundaryFlows =
dzero
179 do ip = 1, this%nflowpack
181 naux = this%gwfpackages(ip)%naux
184 auxname = this%gwfpackages(ip)%auxname(j)
185 if (trim(adjustl(auxname)) ==
"IFLOWFACE")
then
191 do ib = 1, this%gwfpackages(ip)%nbound
192 i = this%gwfpackages(ip)%nodelist(ib)
194 if (this%ibound(i) <= 0) cycle
195 qbnd = this%gwfpackages(ip)%get_flow(ib)
198 if (iauxiflowface > 0)
then
199 iflowface = nint(this%gwfpackages(ip)%auxvar(iauxiflowface, ib))
201 if (iflowface < 0) iflowface = iflowface + this%max_faces + 1
203 if (iflowface .gt. 0)
then
204 ioffset = (i - 1) * this%max_faces
205 this%BoundaryFlows(ioffset + iflowface) = &
206 this%BoundaryFlows(ioffset + iflowface) + qbnd
207 else if (qbnd .gt.
dzero)
then
208 this%SourceFlows(i) = this%SourceFlows(i) + qbnd
209 else if (qbnd .lt.
dzero)
then
210 this%SinkFlows(i) = this%SinkFlows(i) + qbnd
This module contains simulation constants.
real(dp), parameter dhdry
real dry cell constant
integer(i4b), parameter lenpackagename
maximum length of the package name
integer(i4b), parameter lenauxname
maximum length of a aux variable
real(dp), parameter dzero
real constant zero
This module defines variable data types.
subroutine accumulate_flows(this)
Accumulate flows.
subroutine fmi_ad(this)
Time step advance.
subroutine prtfmi_df(this, dis, idryinactive)
Define the flow model interface.
character(len=lenpackagename) text
subroutine, public fmi_cr(fmiobj, name_model, input_mempath, inunit, iout)
Create a new PrtFmi object.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string