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 :: vnew => null()
75 real(dp),
dimension(:),
pointer,
contiguous :: vold => null()
76 real(dp),
dimension(:),
pointer,
contiguous :: ktf => null()
77 real(dp),
dimension(:),
pointer,
contiguous :: rfeatthk => null()
110 subroutine sfe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
111 fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
113 class(
bndtype),
pointer :: packobj
114 integer(I4B),
intent(in) :: id
115 integer(I4B),
intent(in) :: ibcnum
116 integer(I4B),
intent(in) :: inunit
117 integer(I4B),
intent(in) :: iout
118 character(len=*),
intent(in) :: namemodel
119 character(len=*),
intent(in) :: pakname
121 real(dp),
intent(in),
pointer :: eqnsclfac
123 character(len=*),
intent(in) :: dvt
124 character(len=*),
intent(in) :: dvu
125 character(len=*),
intent(in) :: dvua
134 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
138 call sfeobj%allocate_scalars()
141 call packobj%pack_initialize()
143 packobj%inunit = inunit
146 packobj%ibcnum = ibcnum
156 sfeobj%eqnsclfac => eqnsclfac
161 sfeobj%gwecommon => gwecommon
164 sfeobj%depvartype = dvt
165 sfeobj%depvarunit = dvu
166 sfeobj%depvarunitabbrev = dvua
177 character(len=LINELENGTH) :: errmsg
178 class(
bndtype),
pointer :: packobj
179 integer(I4B) :: ip, icount
180 integer(I4B) :: nbudterm
190 if (this%fmi%flows_from_file)
then
191 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
192 if (
associated(this%flowbudptr)) found = .true.
195 if (
associated(this%fmi%gwfbndlist))
then
198 do ip = 1, this%fmi%gwfbndlist%Count()
200 if (packobj%packName == this%flowpackagename)
then
205 this%flowpackagebnd => packobj
206 select type (packobj)
208 this%flowbudptr => packobj%budobj
217 if (.not. found)
then
218 write (errmsg,
'(a)')
'Could not find flow package with name '&
219 &//trim(adjustl(this%flowpackagename))//
'.'
221 call this%parser%StoreErrorUnit()
226 nbudterm = this%flowbudptr%nbudterm
227 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
230 write (this%iout,
'(/, a, a)') &
231 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
232 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
233 write (this%iout,
'(a, i0)') &
234 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
236 do ip = 1, this%flowbudptr%nbudterm
237 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
238 case (
'FLOW-JA-FACE')
240 this%idxbudssm(ip) = 0
243 this%idxbudssm(ip) = 0
246 this%idxbudssm(ip) = 0
249 this%idxbudssm(ip) = 0
252 this%idxbudssm(ip) = 0
255 this%idxbudssm(ip) = 0
258 this%idxbudssm(ip) = 0
261 this%idxbudssm(ip) = 0
264 this%idxbudssm(ip) = 0
267 this%idxbudssm(ip) = 0
270 this%idxbudssm(ip) = 0
275 this%idxbudssm(ip) = icount
278 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
279 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
280 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
282 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
293 real(DP),
dimension(:),
intent(inout) :: rhs
294 integer(I4B),
dimension(:),
intent(in) :: ia
295 integer(I4B),
dimension(:),
intent(in) :: idxglo
298 integer(I4B) :: j, n1, n2
300 integer(I4B) :: iposd, iposoffd
301 integer(I4B) :: ipossymd, ipossymoffd
307 if (this%idxbudrain /= 0)
then
308 do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
309 call this%sfe_rain_term(j, n1, n2, rrate, rhsval, hcofval)
310 iloc = this%idxlocnode(n1)
311 iposd = this%idxpakdiag(n1)
312 call matrix_sln%add_value_pos(iposd, hcofval)
313 rhs(iloc) = rhs(iloc) + rhsval
318 if (this%idxbudevap /= 0)
then
319 do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
320 call this%sfe_evap_term(j, n1, n2, rrate, rhsval, hcofval)
321 iloc = this%idxlocnode(n1)
322 iposd = this%idxpakdiag(n1)
323 call matrix_sln%add_value_pos(iposd, hcofval)
324 rhs(iloc) = rhs(iloc) + rhsval
329 if (this%idxbudroff /= 0)
then
330 do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
331 call this%sfe_roff_term(j, n1, n2, rrate, rhsval, hcofval)
332 iloc = this%idxlocnode(n1)
333 iposd = this%idxpakdiag(n1)
334 call matrix_sln%add_value_pos(iposd, hcofval)
335 rhs(iloc) = rhs(iloc) + rhsval
340 if (this%idxbudiflw /= 0)
then
341 do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
342 call this%sfe_iflw_term(j, n1, n2, rrate, rhsval, hcofval)
343 iloc = this%idxlocnode(n1)
344 iposd = this%idxpakdiag(n1)
345 call matrix_sln%add_value_pos(iposd, hcofval)
346 rhs(iloc) = rhs(iloc) + rhsval
351 if (this%idxbudoutf /= 0)
then
352 do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
353 call this%sfe_outf_term(j, n1, n2, rrate, rhsval, hcofval)
354 iloc = this%idxlocnode(n1)
355 iposd = this%idxpakdiag(n1)
356 call matrix_sln%add_value_pos(iposd, hcofval)
357 rhs(iloc) = rhs(iloc) + rhsval
362 do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
365 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
366 if (this%iboundpak(n1) /= 0)
then
368 call this%sfe_sbcd_term(j, n1, n2, rrate, rhsval, hcofval)
371 iposd = this%idxdglo(j)
372 iposoffd = this%idxoffdglo(j)
373 call matrix_sln%add_value_pos(iposd, -hcofval)
374 call matrix_sln%add_value_pos(iposoffd, hcofval)
377 ipossymd = this%idxsymdglo(j)
378 ipossymoffd = this%idxsymoffdglo(j)
379 call matrix_sln%add_value_pos(ipossymd, -hcofval)
380 call matrix_sln%add_value_pos(ipossymoffd, hcofval)
392 integer(I4B) :: n1, n2
396 if (this%idxbudrain /= 0)
then
397 do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
398 call this%sfe_rain_term(j, n1, n2, rrate)
399 this%dbuff(n1) = this%dbuff(n1) + rrate
404 if (this%idxbudevap /= 0)
then
405 do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
406 call this%sfe_evap_term(j, n1, n2, rrate)
407 this%dbuff(n1) = this%dbuff(n1) + rrate
412 if (this%idxbudroff /= 0)
then
413 do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
414 call this%sfe_roff_term(j, n1, n2, rrate)
415 this%dbuff(n1) = this%dbuff(n1) + rrate
420 if (this%idxbudiflw /= 0)
then
421 do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
422 call this%sfe_iflw_term(j, n1, n2, rrate)
423 this%dbuff(n1) = this%dbuff(n1) + rrate
428 if (this%idxbudoutf /= 0)
then
429 do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
430 call this%sfe_outf_term(j, n1, n2, rrate)
431 this%dbuff(n1) = this%dbuff(n1) + rrate
446 integer(I4B) :: nbudterms
465 integer(I4B),
intent(inout) :: idx
467 integer(I4B) :: n, n1, n2
468 integer(I4B) :: maxlist, naux
470 character(len=LENBUDTXT) :: text
475 maxlist = this%flowbudptr%budterm(this%idxbudrain)%maxlist
477 call this%budobj%budterm(idx)%initialize(text, &
482 maxlist, .false., .false., &
486 text =
' EVAPORATION'
488 maxlist = this%flowbudptr%budterm(this%idxbudevap)%maxlist
490 call this%budobj%budterm(idx)%initialize(text, &
495 maxlist, .false., .false., &
501 maxlist = this%flowbudptr%budterm(this%idxbudroff)%maxlist
503 call this%budobj%budterm(idx)%initialize(text, &
508 maxlist, .false., .false., &
514 maxlist = this%flowbudptr%budterm(this%idxbudiflw)%maxlist
516 call this%budobj%budterm(idx)%initialize(text, &
521 maxlist, .false., .false., &
525 text =
' EXT-OUTFLOW'
527 maxlist = this%flowbudptr%budterm(this%idxbudoutf)%maxlist
529 call this%budobj%budterm(idx)%initialize(text, &
534 maxlist, .false., .false., &
538 text =
' STRMBD-COND'
540 maxlist = this%flowbudptr%budterm(this%idxbudgwf)%maxlist
542 call this%budobj%budterm(idx)%initialize(text, &
547 maxlist, .false., .false., &
549 call this%budobj%budterm(idx)%reset(maxlist)
552 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(n)
553 n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
554 call this%budobj%budterm(idx)%update_term(n1, n2, q)
563 integer(I4B),
intent(inout) :: idx
564 real(DP),
dimension(:),
intent(in) :: x
565 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
566 real(DP),
intent(inout) :: ccratin
567 real(DP),
intent(inout) :: ccratout
569 integer(I4B) :: j, n1, n2
570 integer(I4B) :: igwfnode
571 integer(I4B) :: nlist
572 integer(I4B) :: idiag
577 nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist
578 call this%budobj%budterm(idx)%reset(nlist)
580 call this%sfe_rain_term(j, n1, n2, q)
581 call this%budobj%budterm(idx)%update_term(n1, n2, q)
582 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
587 nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist
588 call this%budobj%budterm(idx)%reset(nlist)
590 call this%sfe_evap_term(j, n1, n2, q)
591 call this%budobj%budterm(idx)%update_term(n1, n2, q)
592 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
597 nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist
598 call this%budobj%budterm(idx)%reset(nlist)
600 call this%sfe_roff_term(j, n1, n2, q)
601 call this%budobj%budterm(idx)%update_term(n1, n2, q)
602 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
607 nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist
608 call this%budobj%budterm(idx)%reset(nlist)
610 call this%sfe_iflw_term(j, n1, n2, q)
611 call this%budobj%budterm(idx)%update_term(n1, n2, q)
612 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
617 nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist
618 call this%budobj%budterm(idx)%reset(nlist)
620 call this%sfe_outf_term(j, n1, n2, q)
621 call this%budobj%budterm(idx)%update_term(n1, n2, q)
622 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
628 nlist = this%flowbudptr%budterm(this%idxbudgwf)%nlist
629 call this%budobj%budterm(idx)%reset(nlist)
631 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
632 if (this%iboundpak(n1) /= 0)
then
635 call this%sfe_sbcd_term(j, n1, igwfnode, q)
636 call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
637 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
640 this%simvals(n1) = this%simvals(n1) - q
641 idiag = this%dis%con%ia(igwfnode)
642 flowja(idiag) = flowja(idiag) - q
657 call this%TspAptType%allocate_scalars()
660 call mem_allocate(this%idxbudrain,
'IDXBUDRAIN', this%memoryPath)
661 call mem_allocate(this%idxbudevap,
'IDXBUDEVAP', this%memoryPath)
662 call mem_allocate(this%idxbudroff,
'IDXBUDROFF', this%memoryPath)
663 call mem_allocate(this%idxbudiflw,
'IDXBUDIFLW', this%memoryPath)
664 call mem_allocate(this%idxbudoutf,
'IDXBUDOUTF', this%memoryPath)
686 call mem_allocate(this%temprain, this%ncv,
'TEMPRAIN', this%memoryPath)
687 call mem_allocate(this%tempevap, this%ncv,
'TEMPEVAP', this%memoryPath)
688 call mem_allocate(this%temproff, this%ncv,
'TEMPROFF', this%memoryPath)
689 call mem_allocate(this%tempiflw, this%ncv,
'TEMPIFLW', this%memoryPath)
691 call mem_allocate(this%vnew, this%ncv,
'VNEW', this%memoryPath)
692 call mem_allocate(this%vold, this%ncv,
'VOLD', this%memoryPath)
695 call this%TspAptType%apt_allocate_arrays()
699 this%temprain(n) =
dzero
700 this%tempevap(n) =
dzero
701 this%temproff(n) =
dzero
702 this%tempiflw(n) =
dzero
717 call this%TspAptType%bnd_ad()
721 this%vold(n) = this%vnew(n)
755 call this%TspAptType%bnd_da()
763 integer(I4B),
intent(in) :: ientry
764 integer(I4B),
intent(inout) :: n1
765 integer(I4B),
intent(inout) :: n2
766 real(DP),
intent(inout),
optional :: rrate
767 real(DP),
intent(inout),
optional :: rhsval
768 real(DP),
intent(inout),
optional :: hcofval
773 n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry)
774 n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry)
775 qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry)
776 ctmp = this%temprain(n1)
777 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
778 if (
present(rhsval)) rhsval = -rrate
779 if (
present(hcofval)) hcofval =
dzero
787 integer(I4B),
intent(in) :: ientry
788 integer(I4B),
intent(inout) :: n1
789 integer(I4B),
intent(inout) :: n2
790 real(DP),
intent(inout),
optional :: rrate
791 real(DP),
intent(inout),
optional :: rhsval
792 real(DP),
intent(inout),
optional :: hcofval
797 n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry)
798 n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry)
800 qbnd = this%flowbudptr%budterm(this%idxbudevap)%flow(ientry)
801 heatlat = this%gwecommon%gwerhow * this%gwecommon%gwelatheatvap
802 if (
present(rrate)) rrate = qbnd * heatlat
803 if (
present(rhsval)) rhsval = -rrate
804 if (
present(hcofval)) hcofval =
dzero
812 integer(I4B),
intent(in) :: ientry
813 integer(I4B),
intent(inout) :: n1
814 integer(I4B),
intent(inout) :: n2
815 real(DP),
intent(inout),
optional :: rrate
816 real(DP),
intent(inout),
optional :: rhsval
817 real(DP),
intent(inout),
optional :: hcofval
822 n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry)
823 n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry)
824 qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry)
825 ctmp = this%temproff(n1)
826 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
827 if (
present(rhsval)) rhsval = -rrate
828 if (
present(hcofval)) hcofval =
dzero
840 integer(I4B),
intent(in) :: ientry
841 integer(I4B),
intent(inout) :: n1
842 integer(I4B),
intent(inout) :: n2
843 real(DP),
intent(inout),
optional :: rrate
844 real(DP),
intent(inout),
optional :: rhsval
845 real(DP),
intent(inout),
optional :: hcofval
850 n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry)
851 n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry)
852 qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry)
853 ctmp = this%tempiflw(n1)
854 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
855 if (
present(rhsval)) rhsval = -rrate
856 if (
present(hcofval)) hcofval =
dzero
867 integer(I4B),
intent(in) :: ientry
868 integer(I4B),
intent(inout) :: n1
869 integer(I4B),
intent(inout) :: n2
870 real(DP),
intent(inout),
optional :: rrate
871 real(DP),
intent(inout),
optional :: rhsval
872 real(DP),
intent(inout),
optional :: hcofval
877 n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry)
878 n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry)
879 qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry)
880 ctmp = this%xnewpak(n1)
881 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
882 if (
present(rhsval)) rhsval =
dzero
883 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
891 subroutine sfe_sbcd_term(this, ientry, n1, igwfnode, rrate, rhsval, hcofval)
894 integer(I4B),
intent(in) :: ientry
895 integer(I4B),
intent(inout) :: n1
896 integer(I4B),
intent(inout) :: igwfnode
897 real(DP),
intent(inout),
optional :: rrate
898 real(DP),
intent(inout),
optional :: rhsval
899 real(DP),
intent(inout),
optional :: hcofval
901 integer(I4B) :: auxpos
908 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(ientry)
911 igwfnode = this%flowbudptr%budterm(this%idxbudgwf)%id2(ientry)
913 auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
914 wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, ientry)
916 s = this%rfeatthk(n1)
917 ctherm = ktf * wa / s
920 if (
present(rrate)) rrate = ctherm * (this%xnew(igwfnode) - this%xnewpak(n1))
921 if (
present(rhsval)) rhsval =
dzero
922 if (
present(hcofval)) hcofval = ctherm
939 call this%obs%StoreObsType(
'temperature', .false., indx)
944 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
949 call this%obs%StoreObsType(
'from-mvr', .true., indx)
954 call this%obs%StoreObsType(
'to-mvr', .true., indx)
959 call this%obs%StoreObsType(
'storage', .true., indx)
964 call this%obs%StoreObsType(
'constant', .true., indx)
969 call this%obs%StoreObsType(
'sfe', .true., indx)
974 call this%obs%StoreObsType(
'rainfall', .true., indx)
979 call this%obs%StoreObsType(
'evaporation', .true., indx)
984 call this%obs%StoreObsType(
'runoff', .true., indx)
989 call this%obs%StoreObsType(
'ext-inflow', .true., indx)
994 call this%obs%StoreObsType(
'ext-outflow', .true., indx)
999 call this%obs%StoreObsType(
'strmbd-cond', .true., indx)
1011 logical,
intent(inout) :: found
1015 select case (obsrv%ObsTypeId)
1017 call this%rp_obs_byfeature(obsrv)
1018 case (
'EVAPORATION')
1019 call this%rp_obs_byfeature(obsrv)
1021 call this%rp_obs_byfeature(obsrv)
1023 call this%rp_obs_byfeature(obsrv)
1024 case (
'EXT-OUTFLOW')
1025 call this%rp_obs_byfeature(obsrv)
1027 call this%rp_obs_byfeature(obsrv)
1028 case (
'STRMBD-COND')
1029 call this%rp_obs_byfeature(obsrv)
1040 character(len=*),
intent(in) :: obstypeid
1041 real(DP),
intent(inout) :: v
1042 integer(I4B),
intent(in) :: jj
1043 logical,
intent(inout) :: found
1045 integer(I4B) :: n1, n2
1048 select case (obstypeid)
1050 if (this%iboundpak(jj) /= 0)
then
1051 call this%sfe_rain_term(jj, n1, n2, v)
1053 case (
'EVAPORATION')
1054 if (this%iboundpak(jj) /= 0)
then
1055 call this%sfe_evap_term(jj, n1, n2, v)
1058 if (this%iboundpak(jj) /= 0)
then
1059 call this%sfe_roff_term(jj, n1, n2, v)
1062 if (this%iboundpak(jj) /= 0)
then
1063 call this%sfe_iflw_term(jj, n1, n2, v)
1065 case (
'EXT-OUTFLOW')
1066 if (this%iboundpak(jj) /= 0)
then
1067 call this%sfe_outf_term(jj, n1, n2, v)
1069 case (
'STRMBD-COND')
1070 if (this%iboundpak(jj) /= 0)
then
1071 call this%sfe_sbcd_term(jj, n1, n2, v)
1085 integer(I4B),
intent(in) :: itemno
1086 character(len=*),
intent(in) :: keyword
1087 logical,
intent(inout) :: found
1089 character(len=LINELENGTH) :: text
1090 integer(I4B) :: ierr
1092 real(DP),
pointer :: bndElem => null()
1101 select case (keyword)
1103 ierr = this%apt_check_valid(itemno)
1107 call this%parser%GetString(text)
1109 bndelem => this%temprain(itemno)
1111 this%packName,
'BND', this%tsManager, &
1112 this%iprpak,
'RAINFALL')
1113 case (
'EVAPORATION')
1114 ierr = this%apt_check_valid(itemno)
1118 call this%parser%GetString(text)
1120 bndelem => this%tempevap(itemno)
1122 this%packName,
'BND', this%tsManager, &
1123 this%iprpak,
'EVAPORATION')
1125 ierr = this%apt_check_valid(itemno)
1129 call this%parser%GetString(text)
1131 bndelem => this%temproff(itemno)
1133 this%packName,
'BND', this%tsManager, &
1134 this%iprpak,
'RUNOFF')
1136 ierr = this%apt_check_valid(itemno)
1140 call this%parser%GetString(text)
1142 bndelem => this%tempiflw(itemno)
1144 this%packName,
'BND', this%tsManager, &
1145 this%iprpak,
'INFLOW')
1164 character(len=LINELENGTH) :: text
1165 character(len=LENBOUNDNAME) :: bndName, bndNameTemp
1166 character(len=9) :: cno
1167 character(len=50),
dimension(:),
allocatable :: caux
1168 integer(I4B) :: ierr
1169 logical :: isfound, endOfBlock
1171 integer(I4B) :: ii, jj
1172 integer(I4B) :: iaux
1173 integer(I4B) :: itmp
1174 integer(I4B) :: nlak
1175 integer(I4B) :: nconn
1176 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
1177 real(DP),
pointer :: bndElem => null()
1183 call mem_allocate(this%strt, this%ncv,
'STRT', this%memoryPath)
1184 call mem_allocate(this%ktf, this%ncv,
'KTF', this%memoryPath)
1185 call mem_allocate(this%rfeatthk, this%ncv,
'RFEATTHK', this%memoryPath)
1186 call mem_allocate(this%lauxvar, this%naux, this%ncv,
'LAUXVAR', &
1190 if (this%imatrows == 0)
then
1191 call mem_allocate(this%iboundpak, this%ncv,
'IBOUND', this%memoryPath)
1192 call mem_allocate(this%xnewpak, this%ncv,
'XNEWPAK', this%memoryPath)
1194 call mem_allocate(this%xoldpak, this%ncv,
'XOLDPAK', this%memoryPath)
1197 allocate (this%featname(this%ncv))
1201 this%strt(n) =
dep20
1203 this%rfeatthk(n) =
dzero
1204 this%lauxvar(:, n) =
dzero
1205 this%xoldpak(n) =
dep20
1206 if (this%imatrows == 0)
then
1207 this%iboundpak(n) = 1
1208 this%xnewpak(n) =
dep20
1213 if (this%naux > 0)
then
1214 allocate (caux(this%naux))
1218 allocate (nboundchk(this%ncv))
1224 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
1225 supportopenclose=.true.)
1229 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1234 call this%parser%GetNextLine(endofblock)
1235 if (endofblock)
exit
1236 n = this%parser%GetInteger()
1238 if (n < 1 .or. n > this%ncv)
then
1239 write (
errmsg,
'(a,1x,i6)') &
1240 'Itemno must be > 0 and <= ', this%ncv
1246 nboundchk(n) = nboundchk(n) + 1
1249 this%strt(n) = this%parser%GetDouble()
1252 this%ktf(n) = this%parser%GetDouble()
1253 this%rfeatthk(n) = this%parser%GetDouble()
1254 if (this%rfeatthk(n) <=
dzero)
then
1255 write (
errmsg,
'(4x,a)') &
1256 '****ERROR. Specified thickness used for thermal &
1257 &conduction MUST BE > 0 else divide by zero error occurs'
1263 do iaux = 1, this%naux
1264 call this%parser%GetString(caux(iaux))
1268 write (cno,
'(i9.9)') n
1269 bndname =
'Feature'//cno
1272 if (this%inamedbound /= 0)
then
1273 call this%parser%GetStringCaps(bndnametemp)
1274 if (bndnametemp /=
'')
then
1275 bndname = bndnametemp
1278 this%featname(n) = bndname
1282 do jj = 1, this%naux
1285 bndelem => this%lauxvar(jj, ii)
1287 this%packName,
'AUX', &
1288 this%tsManager, this%iprpak, &
1297 if (nboundchk(n) == 0)
then
1298 write (
errmsg,
'(a,1x,i0)')
'No data specified for feature', n
1300 else if (nboundchk(n) > 1)
then
1301 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1302 'Data for feature', n,
'specified', nboundchk(n),
'times'
1307 write (this%iout,
'(1x,a)') &
1308 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
1310 call store_error(
'Required packagedata block not found.')
1315 call this%parser%StoreErrorUnit()
1319 if (this%naux > 0)
then
1324 deallocate (nboundchk)
1332 integer(I4B),
intent(in) :: icv
1333 real(DP),
intent(inout) :: vnew, vold
1334 real(DP),
intent(in) :: delt
1341 if (this%idxbudsto /= 0)
then
1342 qss = this%flowbudptr%budterm(this%idxbudsto)%flow(icv)
1343 vnew = this%flowbudptr%budterm(this%idxbudsto)%auxvar(1, icv)
1344 this%vnew(icv) = vnew
1345 if (qss /=
dzero)
then
1346 vold = vnew + qss * delt
1348 if (vnew ==
dzero)
then
1351 vold = this%vold(icv)
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_get_volumes(this, icv, vnew, vold, delt)
Return the sfr new volume and old volume.
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 sfe_ad(this)
Advance sfe package routine.
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.