16 character(len=LENPACKAGENAME) ::
text =
' PRTFMI'
20 double precision,
allocatable,
public :: sourceflows(:)
21 double precision,
allocatable,
public :: sinkflows(:)
22 double precision,
allocatable,
public :: storageflows(:)
23 double precision,
allocatable,
public :: boundaryflows(:)
36 subroutine fmi_cr(fmiobj, name_model, inunit, iout)
39 character(len=*),
intent(in) :: name_model
40 integer(I4B),
intent(inout) :: inunit
41 integer(I4B),
intent(in) :: iout
47 call fmiobj%set_names(1, name_model,
'FMI',
'FMI')
51 call fmiobj%allocate_scalars()
54 fmiobj%inunit = inunit
58 call fmiobj%parser%Initialize(fmiobj%inunit, fmiobj%iout)
61 fmiobj%depvartype =
'TRACKS '
73 character(len=15) :: nodestr
74 character(len=*),
parameter :: fmtdry = &
75 &
"(/1X,'WARNING: DRY CELL ENCOUNTERED AT ',a,'; RESET AS INACTIVE')"
76 character(len=*),
parameter :: fmtrewet = &
77 &
"(/1X,'DRY CELL REACTIVATED AT ', a)"
82 this%iflowsupdated = 1
85 if (this%iubud /= 0)
then
86 call this%advance_bfr()
90 if (this%iuhds /= 0)
then
91 call this%advance_hfr()
95 if (this%iumvr /= 0)
then
96 call this%mvrbudobj%bfr_advance(this%dis, this%iout)
100 call this%accumulate_flows()
103 do n = 1, this%dis%nodes
107 if (this%gwfsat(n) > dzero)
then
108 this%ibdgwfsat0(n) = 1
110 this%ibdgwfsat0(n) = 0
114 if (this%ibound(n) > 0)
then
115 if (this%gwfhead(n) ==
dhdry)
then
118 call this%dis%noder_to_string(n, nodestr)
119 write (this%iout, fmtdry) trim(nodestr)
124 if (this%ibound(n) == 0)
then
125 if (this%gwfhead(n) /=
dhdry)
then
128 call this%dis%noder_to_string(n, nodestr)
129 write (this%iout, fmtrewet) trim(nodestr)
143 integer(I4B),
intent(in) :: idryinactive
146 call this%FlowModelInterfaceType%fmi_df(dis, idryinactive)
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 * 10))
162 integer :: j, i, ip, ib
163 integer :: ioffset, iflowface, iauxiflowface
164 double precision :: qbnd
165 character(len=LENAUXNAME) :: auxname
168 this%StorageFlows = 0d0
169 if (this%igwfstrgss /= 0) &
170 this%StorageFlows = this%StorageFlows + &
172 if (this%igwfstrgsy /= 0) &
173 this%StorageFlows = this%StorageFlows + &
177 this%SourceFlows = 0d0
179 this%BoundaryFlows = 0d0
180 do ip = 1, this%nflowpack
182 naux = this%gwfpackages(ip)%naux
185 auxname = this%gwfpackages(ip)%auxname(j)
186 if (trim(adjustl(auxname)) ==
"IFLOWFACE")
then
195 do ib = 1, this%gwfpackages(ip)%nbound
196 i = this%gwfpackages(ip)%nodelist(ib)
198 if (this%ibound(i) <= 0) cycle
199 qbnd = this%gwfpackages(ip)%get_flow(ib)
201 if (iauxiflowface > 0)
then
203 iflowface = nint(this%gwfpackages(ip)%auxvar(iauxiflowface, ib))
204 if (iflowface < 0) iflowface = iflowface + 11
210 if (iflowface .gt. 0)
then
211 ioffset = (i - 1) * 10
212 this%BoundaryFlows(ioffset + iflowface) = &
213 this%BoundaryFlows(ioffset + iflowface) + qbnd
214 else if (qbnd .gt. 0d0)
then
215 this%SourceFlows(i) = this%SourceFlows(i) + qbnd
216 else if (qbnd .lt. 0d0)
then
217 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, public fmi_cr(fmiobj, name_model, inunit, iout)
Create a new PrtFmi object.
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
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