56 character(len=*),
parameter ::
ftype =
'SFE'
57 character(len=*),
parameter ::
flowtype =
'SFR'
58 character(len=16) ::
text =
' SFE'
64 integer(I4B),
pointer :: idxbudrain => null()
65 integer(I4B),
pointer :: idxbudevap => null()
66 integer(I4B),
pointer :: idxbudroff => null()
67 integer(I4B),
pointer :: idxbudiflw => null()
68 integer(I4B),
pointer :: idxbudoutf => null()
70 real(dp),
dimension(:),
pointer,
contiguous :: temprain => null()
71 real(dp),
dimension(:),
pointer,
contiguous :: tempevap => null()
72 real(dp),
dimension(:),
pointer,
contiguous :: temproff => null()
73 real(dp),
dimension(:),
pointer,
contiguous :: tempiflw => null()
74 real(dp),
dimension(:),
pointer,
contiguous :: ktf => null()
75 real(dp),
dimension(:),
pointer,
contiguous :: rfeatthk => null()
106 subroutine sfe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
107 fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
109 class(
bndtype),
pointer :: packobj
110 integer(I4B),
intent(in) :: id
111 integer(I4B),
intent(in) :: ibcnum
112 integer(I4B),
intent(in) :: inunit
113 integer(I4B),
intent(in) :: iout
114 character(len=*),
intent(in) :: namemodel
115 character(len=*),
intent(in) :: pakname
117 real(dp),
intent(in),
pointer :: eqnsclfac
119 character(len=*),
intent(in) :: dvt
120 character(len=*),
intent(in) :: dvu
121 character(len=*),
intent(in) :: dvua
130 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
134 call sfeobj%allocate_scalars()
137 call packobj%pack_initialize()
139 packobj%inunit = inunit
142 packobj%ibcnum = ibcnum
152 sfeobj%eqnsclfac => eqnsclfac
157 sfeobj%gwecommon => gwecommon
160 sfeobj%depvartype = dvt
161 sfeobj%depvarunit = dvu
162 sfeobj%depvarunitabbrev = dvua
173 character(len=LINELENGTH) :: errmsg
174 class(
bndtype),
pointer :: packobj
175 integer(I4B) :: ip, icount
176 integer(I4B) :: nbudterm
186 if (this%fmi%flows_from_file)
then
187 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
188 if (
associated(this%flowbudptr)) found = .true.
191 if (
associated(this%fmi%gwfbndlist))
then
194 do ip = 1, this%fmi%gwfbndlist%Count()
196 if (packobj%packName == this%flowpackagename)
then
201 this%flowpackagebnd => packobj
202 select type (packobj)
204 this%flowbudptr => packobj%budobj
213 if (.not. found)
then
214 write (errmsg,
'(a)')
'Could not find flow package with name '&
215 &//trim(adjustl(this%flowpackagename))//
'.'
217 call this%parser%StoreErrorUnit()
222 nbudterm = this%flowbudptr%nbudterm
223 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
226 write (this%iout,
'(/, a, a)') &
227 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
228 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
229 write (this%iout,
'(a, i0)') &
230 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
232 do ip = 1, this%flowbudptr%nbudterm
233 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
234 case (
'FLOW-JA-FACE')
236 this%idxbudssm(ip) = 0
239 this%idxbudssm(ip) = 0
242 this%idxbudssm(ip) = 0
245 this%idxbudssm(ip) = 0
248 this%idxbudssm(ip) = 0
251 this%idxbudssm(ip) = 0
254 this%idxbudssm(ip) = 0
257 this%idxbudssm(ip) = 0
260 this%idxbudssm(ip) = 0
263 this%idxbudssm(ip) = 0
266 this%idxbudssm(ip) = 0
271 this%idxbudssm(ip) = icount
274 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
275 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
276 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
278 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
289 real(DP),
dimension(:),
intent(inout) :: rhs
290 integer(I4B),
dimension(:),
intent(in) :: ia
291 integer(I4B),
dimension(:),
intent(in) :: idxglo
294 integer(I4B) :: j, n1, n2
296 integer(I4B) :: iposd, iposoffd
297 integer(I4B) :: ipossymd, ipossymoffd
303 if (this%idxbudrain /= 0)
then
304 do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
305 call this%sfe_rain_term(j, n1, n2, rrate, rhsval, hcofval)
306 iloc = this%idxlocnode(n1)
307 iposd = this%idxpakdiag(n1)
308 call matrix_sln%add_value_pos(iposd, hcofval)
309 rhs(iloc) = rhs(iloc) + rhsval
314 if (this%idxbudevap /= 0)
then
315 do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
316 call this%sfe_evap_term(j, n1, n2, rrate, rhsval, hcofval)
317 iloc = this%idxlocnode(n1)
318 iposd = this%idxpakdiag(n1)
319 call matrix_sln%add_value_pos(iposd, hcofval)
320 rhs(iloc) = rhs(iloc) + rhsval
325 if (this%idxbudroff /= 0)
then
326 do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
327 call this%sfe_roff_term(j, n1, n2, rrate, rhsval, hcofval)
328 iloc = this%idxlocnode(n1)
329 iposd = this%idxpakdiag(n1)
330 call matrix_sln%add_value_pos(iposd, hcofval)
331 rhs(iloc) = rhs(iloc) + rhsval
336 if (this%idxbudiflw /= 0)
then
337 do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
338 call this%sfe_iflw_term(j, n1, n2, rrate, rhsval, hcofval)
339 iloc = this%idxlocnode(n1)
340 iposd = this%idxpakdiag(n1)
341 call matrix_sln%add_value_pos(iposd, hcofval)
342 rhs(iloc) = rhs(iloc) + rhsval
347 if (this%idxbudoutf /= 0)
then
348 do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
349 call this%sfe_outf_term(j, n1, n2, rrate, rhsval, hcofval)
350 iloc = this%idxlocnode(n1)
351 iposd = this%idxpakdiag(n1)
352 call matrix_sln%add_value_pos(iposd, hcofval)
353 rhs(iloc) = rhs(iloc) + rhsval
358 do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
361 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
362 if (this%iboundpak(n1) /= 0)
then
364 call this%sfe_sbcd_term(j, n1, n2, rrate, rhsval, hcofval)
367 iposd = this%idxdglo(j)
368 iposoffd = this%idxoffdglo(j)
369 call matrix_sln%add_value_pos(iposd, -hcofval)
370 call matrix_sln%add_value_pos(iposoffd, hcofval)
373 ipossymd = this%idxsymdglo(j)
374 ipossymoffd = this%idxsymoffdglo(j)
375 call matrix_sln%add_value_pos(ipossymd, -hcofval)
376 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
388 integer(I4B) :: n1, n2
392 if (this%idxbudrain /= 0)
then
393 do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
394 call this%sfe_rain_term(j, n1, n2, rrate)
395 this%dbuff(n1) = this%dbuff(n1) + rrate
400 if (this%idxbudevap /= 0)
then
401 do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
402 call this%sfe_evap_term(j, n1, n2, rrate)
403 this%dbuff(n1) = this%dbuff(n1) + rrate
408 if (this%idxbudroff /= 0)
then
409 do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
410 call this%sfe_roff_term(j, n1, n2, rrate)
411 this%dbuff(n1) = this%dbuff(n1) + rrate
416 if (this%idxbudiflw /= 0)
then
417 do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
418 call this%sfe_iflw_term(j, n1, n2, rrate)
419 this%dbuff(n1) = this%dbuff(n1) + rrate
424 if (this%idxbudoutf /= 0)
then
425 do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
426 call this%sfe_outf_term(j, n1, n2, rrate)
427 this%dbuff(n1) = this%dbuff(n1) + rrate
442 integer(I4B) :: nbudterms
461 integer(I4B),
intent(inout) :: idx
463 integer(I4B) :: n, n1, n2
464 integer(I4B) :: maxlist, naux
466 character(len=LENBUDTXT) :: text
471 maxlist = this%flowbudptr%budterm(this%idxbudrain)%maxlist
473 call this%budobj%budterm(idx)%initialize(text, &
478 maxlist, .false., .false., &
482 text =
' EVAPORATION'
484 maxlist = this%flowbudptr%budterm(this%idxbudevap)%maxlist
486 call this%budobj%budterm(idx)%initialize(text, &
491 maxlist, .false., .false., &
497 maxlist = this%flowbudptr%budterm(this%idxbudroff)%maxlist
499 call this%budobj%budterm(idx)%initialize(text, &
504 maxlist, .false., .false., &
510 maxlist = this%flowbudptr%budterm(this%idxbudiflw)%maxlist
512 call this%budobj%budterm(idx)%initialize(text, &
517 maxlist, .false., .false., &
521 text =
' EXT-OUTFLOW'
523 maxlist = this%flowbudptr%budterm(this%idxbudoutf)%maxlist
525 call this%budobj%budterm(idx)%initialize(text, &
530 maxlist, .false., .false., &
534 text =
' STRMBD-COND'
536 maxlist = this%flowbudptr%budterm(this%idxbudgwf)%maxlist
538 call this%budobj%budterm(idx)%initialize(text, &
543 maxlist, .false., .false., &
545 call this%budobj%budterm(idx)%reset(maxlist)
548 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(n)
549 n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
550 call this%budobj%budterm(idx)%update_term(n1, n2, q)
559 integer(I4B),
intent(inout) :: idx
560 real(DP),
dimension(:),
intent(in) :: x
561 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
562 real(DP),
intent(inout) :: ccratin
563 real(DP),
intent(inout) :: ccratout
565 integer(I4B) :: j, n1, n2
566 integer(I4B) :: igwfnode
567 integer(I4B) :: nlist
568 integer(I4B) :: idiag
573 nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist
574 call this%budobj%budterm(idx)%reset(nlist)
576 call this%sfe_rain_term(j, n1, n2, q)
577 call this%budobj%budterm(idx)%update_term(n1, n2, q)
578 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
583 nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist
584 call this%budobj%budterm(idx)%reset(nlist)
586 call this%sfe_evap_term(j, n1, n2, q)
587 call this%budobj%budterm(idx)%update_term(n1, n2, q)
588 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
593 nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist
594 call this%budobj%budterm(idx)%reset(nlist)
596 call this%sfe_roff_term(j, n1, n2, q)
597 call this%budobj%budterm(idx)%update_term(n1, n2, q)
598 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
603 nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist
604 call this%budobj%budterm(idx)%reset(nlist)
606 call this%sfe_iflw_term(j, n1, n2, q)
607 call this%budobj%budterm(idx)%update_term(n1, n2, q)
608 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
613 nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist
614 call this%budobj%budterm(idx)%reset(nlist)
616 call this%sfe_outf_term(j, n1, n2, q)
617 call this%budobj%budterm(idx)%update_term(n1, n2, q)
618 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
624 nlist = this%flowbudptr%budterm(this%idxbudgwf)%nlist
625 call this%budobj%budterm(idx)%reset(nlist)
627 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
628 if (this%iboundpak(n1) /= 0)
then
631 call this%sfe_sbcd_term(j, n1, igwfnode, q)
632 call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
633 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
636 this%simvals(n1) = this%simvals(n1) - q
637 idiag = this%dis%con%ia(igwfnode)
638 flowja(idiag) = flowja(idiag) - q
653 call this%TspAptType%allocate_scalars()
656 call mem_allocate(this%idxbudrain,
'IDXBUDRAIN', this%memoryPath)
657 call mem_allocate(this%idxbudevap,
'IDXBUDEVAP', this%memoryPath)
658 call mem_allocate(this%idxbudroff,
'IDXBUDROFF', this%memoryPath)
659 call mem_allocate(this%idxbudiflw,
'IDXBUDIFLW', this%memoryPath)
660 call mem_allocate(this%idxbudoutf,
'IDXBUDOUTF', this%memoryPath)
682 call mem_allocate(this%temprain, this%ncv,
'TEMPRAIN', this%memoryPath)
683 call mem_allocate(this%tempevap, this%ncv,
'TEMPEVAP', this%memoryPath)
684 call mem_allocate(this%temproff, this%ncv,
'TEMPROFF', this%memoryPath)
685 call mem_allocate(this%tempiflw, this%ncv,
'TEMPIFLW', this%memoryPath)
688 call this%TspAptType%apt_allocate_arrays()
692 this%temprain(n) =
dzero
693 this%tempevap(n) =
dzero
694 this%temproff(n) =
dzero
695 this%tempiflw(n) =
dzero
725 call this%TspAptType%bnd_da()
733 integer(I4B),
intent(in) :: ientry
734 integer(I4B),
intent(inout) :: n1
735 integer(I4B),
intent(inout) :: n2
736 real(DP),
intent(inout),
optional :: rrate
737 real(DP),
intent(inout),
optional :: rhsval
738 real(DP),
intent(inout),
optional :: hcofval
743 n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry)
744 n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry)
745 qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry)
746 ctmp = this%temprain(n1)
747 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
748 if (
present(rhsval)) rhsval = -rrate
749 if (
present(hcofval)) hcofval =
dzero
757 integer(I4B),
intent(in) :: ientry
758 integer(I4B),
intent(inout) :: n1
759 integer(I4B),
intent(inout) :: n2
760 real(DP),
intent(inout),
optional :: rrate
761 real(DP),
intent(inout),
optional :: rhsval
762 real(DP),
intent(inout),
optional :: hcofval
767 n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry)
768 n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry)
770 qbnd = this%flowbudptr%budterm(this%idxbudevap)%flow(ientry)
771 heatlat = this%gwecommon%gwerhow * this%gwecommon%gwelatheatvap
772 if (
present(rrate)) rrate = qbnd * heatlat
773 if (
present(rhsval)) rhsval = -rrate
774 if (
present(hcofval)) hcofval =
dzero
782 integer(I4B),
intent(in) :: ientry
783 integer(I4B),
intent(inout) :: n1
784 integer(I4B),
intent(inout) :: n2
785 real(DP),
intent(inout),
optional :: rrate
786 real(DP),
intent(inout),
optional :: rhsval
787 real(DP),
intent(inout),
optional :: hcofval
792 n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry)
793 n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry)
794 qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry)
795 ctmp = this%temproff(n1)
796 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
797 if (
present(rhsval)) rhsval = -rrate
798 if (
present(hcofval)) hcofval =
dzero
810 integer(I4B),
intent(in) :: ientry
811 integer(I4B),
intent(inout) :: n1
812 integer(I4B),
intent(inout) :: n2
813 real(DP),
intent(inout),
optional :: rrate
814 real(DP),
intent(inout),
optional :: rhsval
815 real(DP),
intent(inout),
optional :: hcofval
820 n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry)
821 n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry)
822 qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry)
823 ctmp = this%tempiflw(n1)
824 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
825 if (
present(rhsval)) rhsval = -rrate
826 if (
present(hcofval)) hcofval =
dzero
837 integer(I4B),
intent(in) :: ientry
838 integer(I4B),
intent(inout) :: n1
839 integer(I4B),
intent(inout) :: n2
840 real(DP),
intent(inout),
optional :: rrate
841 real(DP),
intent(inout),
optional :: rhsval
842 real(DP),
intent(inout),
optional :: hcofval
847 n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry)
848 n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry)
849 qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry)
850 ctmp = this%xnewpak(n1)
851 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
852 if (
present(rhsval)) rhsval =
dzero
853 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
861 subroutine sfe_sbcd_term(this, ientry, n1, igwfnode, rrate, rhsval, hcofval)
864 integer(I4B),
intent(in) :: ientry
865 integer(I4B),
intent(inout) :: n1
866 integer(I4B),
intent(inout) :: igwfnode
867 real(DP),
intent(inout),
optional :: rrate
868 real(DP),
intent(inout),
optional :: rhsval
869 real(DP),
intent(inout),
optional :: hcofval
871 integer(I4B) :: auxpos
878 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(ientry)
881 igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(ientry)
883 auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
884 wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, ientry)
886 s = this%rfeatthk(n1)
887 ctherm = ktf * wa / s
890 if (
present(rrate)) rrate = ctherm * (this%xnew(igwfnode) - this%xnewpak(n1))
891 if (
present(rhsval)) rhsval =
dzero
892 if (
present(hcofval)) hcofval = ctherm
909 call this%obs%StoreObsType(
'temperature', .false., indx)
914 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
919 call this%obs%StoreObsType(
'from-mvr', .true., indx)
924 call this%obs%StoreObsType(
'to-mvr', .true., indx)
929 call this%obs%StoreObsType(
'storage', .true., indx)
934 call this%obs%StoreObsType(
'constant', .true., indx)
939 call this%obs%StoreObsType(
'sfe', .true., indx)
944 call this%obs%StoreObsType(
'rainfall', .true., indx)
949 call this%obs%StoreObsType(
'evaporation', .true., indx)
954 call this%obs%StoreObsType(
'runoff', .true., indx)
959 call this%obs%StoreObsType(
'ext-inflow', .true., indx)
964 call this%obs%StoreObsType(
'ext-outflow', .true., indx)
969 call this%obs%StoreObsType(
'strmbd-cond', .true., indx)
981 logical,
intent(inout) :: found
985 select case (obsrv%ObsTypeId)
987 call this%rp_obs_byfeature(obsrv)
989 call this%rp_obs_byfeature(obsrv)
991 call this%rp_obs_byfeature(obsrv)
993 call this%rp_obs_byfeature(obsrv)
995 call this%rp_obs_byfeature(obsrv)
997 call this%rp_obs_byfeature(obsrv)
999 call this%rp_obs_byfeature(obsrv)
1010 character(len=*),
intent(in) :: obstypeid
1011 real(DP),
intent(inout) :: v
1012 integer(I4B),
intent(in) :: jj
1013 logical,
intent(inout) :: found
1015 integer(I4B) :: n1, n2
1018 select case (obstypeid)
1020 if (this%iboundpak(jj) /= 0)
then
1021 call this%sfe_rain_term(jj, n1, n2, v)
1023 case (
'EVAPORATION')
1024 if (this%iboundpak(jj) /= 0)
then
1025 call this%sfe_evap_term(jj, n1, n2, v)
1028 if (this%iboundpak(jj) /= 0)
then
1029 call this%sfe_roff_term(jj, n1, n2, v)
1032 if (this%iboundpak(jj) /= 0)
then
1033 call this%sfe_iflw_term(jj, n1, n2, v)
1035 case (
'EXT-OUTFLOW')
1036 if (this%iboundpak(jj) /= 0)
then
1037 call this%sfe_outf_term(jj, n1, n2, v)
1039 case (
'STRMBD-COND')
1040 if (this%iboundpak(jj) /= 0)
then
1041 call this%sfe_sbcd_term(jj, n1, n2, v)
1055 integer(I4B),
intent(in) :: itemno
1056 character(len=*),
intent(in) :: keyword
1057 logical,
intent(inout) :: found
1059 character(len=LINELENGTH) :: text
1060 integer(I4B) :: ierr
1062 real(DP),
pointer :: bndElem => null()
1071 select case (keyword)
1073 ierr = this%apt_check_valid(itemno)
1077 call this%parser%GetString(text)
1079 bndelem => this%temprain(itemno)
1081 this%packName,
'BND', this%tsManager, &
1082 this%iprpak,
'RAINFALL')
1083 case (
'EVAPORATION')
1084 ierr = this%apt_check_valid(itemno)
1088 call this%parser%GetString(text)
1090 bndelem => this%tempevap(itemno)
1092 this%packName,
'BND', this%tsManager, &
1093 this%iprpak,
'EVAPORATION')
1095 ierr = this%apt_check_valid(itemno)
1099 call this%parser%GetString(text)
1101 bndelem => this%temproff(itemno)
1103 this%packName,
'BND', this%tsManager, &
1104 this%iprpak,
'RUNOFF')
1106 ierr = this%apt_check_valid(itemno)
1110 call this%parser%GetString(text)
1112 bndelem => this%tempiflw(itemno)
1114 this%packName,
'BND', this%tsManager, &
1115 this%iprpak,
'INFLOW')
1134 character(len=LINELENGTH) :: text
1135 character(len=LENBOUNDNAME) :: bndName, bndNameTemp
1136 character(len=9) :: cno
1137 character(len=50),
dimension(:),
allocatable :: caux
1138 integer(I4B) :: ierr
1139 logical :: isfound, endOfBlock
1141 integer(I4B) :: ii, jj
1142 integer(I4B) :: iaux
1143 integer(I4B) :: itmp
1144 integer(I4B) :: nlak
1145 integer(I4B) :: nconn
1146 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
1147 real(DP),
pointer :: bndElem => null()
1153 call mem_allocate(this%strt, this%ncv,
'STRT', this%memoryPath)
1154 call mem_allocate(this%ktf, this%ncv,
'KTF', this%memoryPath)
1155 call mem_allocate(this%rfeatthk, this%ncv,
'RFEATTHK', this%memoryPath)
1156 call mem_allocate(this%lauxvar, this%naux, this%ncv,
'LAUXVAR', &
1160 if (this%imatrows == 0)
then
1161 call mem_allocate(this%iboundpak, this%ncv,
'IBOUND', this%memoryPath)
1162 call mem_allocate(this%xnewpak, this%ncv,
'XNEWPAK', this%memoryPath)
1164 call mem_allocate(this%xoldpak, this%ncv,
'XOLDPAK', this%memoryPath)
1167 allocate (this%featname(this%ncv))
1171 this%strt(n) =
dep20
1173 this%rfeatthk(n) =
dzero
1174 this%lauxvar(:, n) =
dzero
1175 this%xoldpak(n) =
dep20
1176 if (this%imatrows == 0)
then
1177 this%iboundpak(n) = 1
1178 this%xnewpak(n) =
dep20
1183 if (this%naux > 0)
then
1184 allocate (caux(this%naux))
1188 allocate (nboundchk(this%ncv))
1194 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
1195 supportopenclose=.true.)
1199 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1204 call this%parser%GetNextLine(endofblock)
1205 if (endofblock)
exit
1206 n = this%parser%GetInteger()
1208 if (n < 1 .or. n > this%ncv)
then
1209 write (
errmsg,
'(a,1x,i6)') &
1210 'Itemno must be > 0 and <= ', this%ncv
1216 nboundchk(n) = nboundchk(n) + 1
1219 this%strt(n) = this%parser%GetDouble()
1222 this%ktf(n) = this%parser%GetDouble()
1223 this%rfeatthk(n) = this%parser%GetDouble()
1224 if (this%rfeatthk(n) <=
dzero)
then
1225 write (
errmsg,
'(4x,a)') &
1226 '****ERROR. Specified thickness used for thermal &
1227 &conduction MUST BE > 0 else divide by zero error occurs'
1233 do iaux = 1, this%naux
1234 call this%parser%GetString(caux(iaux))
1238 write (cno,
'(i9.9)') n
1239 bndname =
'Feature'//cno
1242 if (this%inamedbound /= 0)
then
1243 call this%parser%GetStringCaps(bndnametemp)
1244 if (bndnametemp /=
'')
then
1245 bndname = bndnametemp
1248 this%featname(n) = bndname
1252 do jj = 1, this%naux
1255 bndelem => this%lauxvar(jj, ii)
1257 this%packName,
'AUX', &
1258 this%tsManager, this%iprpak, &
1267 if (nboundchk(n) == 0)
then
1268 write (
errmsg,
'(a,1x,i0)')
'No data specified for feature', n
1270 else if (nboundchk(n) > 1)
then
1271 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1272 'Data for feature', n,
'specified', nboundchk(n),
'times'
1277 write (this%iout,
'(1x,a)') &
1278 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
1280 call store_error(
'Required packagedata block not found.')
1285 call this%parser%StoreErrorUnit()
1289 if (this%naux > 0)
then
1294 deallocate (nboundchk)
This module contains the base boundary package.
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dep20
real constant 1e20
integer(i4b), parameter lenboundname
maximum length of a bound name
real(dp), parameter dzero
real constant zero
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
real(dp), parameter done
real constant 1
subroutine sfe_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
character(len= *), parameter flowtype
subroutine sfe_df_obs(this)
Observations.
subroutine allocate_scalars(this)
Allocate scalars specific to the streamflow energy transport (SFE) package.
subroutine sfe_setup_budobj(this, idx)
Set up the budget object that stores all the sfe flows.
integer(i4b) function sfe_get_nbudterms(this)
Function to return the number of budget terms just for this package.
subroutine sfe_outf_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Outflow term.
subroutine sfe_iflw_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Inflow Term.
subroutine sfe_set_stressperiod(this, itemno, keyword, found)
Sets the stress period attributes for keyword use.
subroutine sfe_rp_obs(this, obsrv, found)
Process package specific obs.
subroutine sfe_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
subroutine, public sfe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create a new sfe package.
subroutine sfe_sbcd_term(this, ientry, n1, igwfnode, rrate, rhsval, hcofval)
Streambed conduction term.
subroutine sfe_rain_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rain term.
subroutine sfe_evap_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Evaporative term.
character(len= *), parameter ftype
subroutine sfe_solve(this)
@ brief Add terms specific to sfr to the explicit sfe solve
subroutine sfe_allocate_arrays(this)
Allocate arrays specific to the streamflow energy transport (SFE) package.
subroutine sfe_roff_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Runoff term.
subroutine sfe_read_cvs(this)
Read feature information for this advanced package.
subroutine sfe_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to SFE.
subroutine sfe_da(this)
Deallocate memory.
subroutine find_sfe_package(this)
Find corresponding sfe package.
This module defines variable data types.
This module contains the derived types ObserveType and ObsDataType.
This module contains the SFR package methods.
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.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
subroutine, public read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, auxOrBnd, tsManager, iprpak, varName)
Call this subroutine from advanced packages to define timeseries link for a variable (varName).
subroutine, public apt_process_obsid(obsrv, dis, inunitobs, iout)
Process observation IDs for an advanced package.
subroutine, public apt_process_obsid12(obsrv, dis, inunitobs, iout)
Process observation IDs for a package.