54 character(len=*),
parameter ::
ftype =
'SFE'
55 character(len=*),
parameter ::
flowtype =
'SFR'
56 character(len=16) ::
text =
' SFE'
62 integer(I4B),
pointer :: idxbudrain => null()
63 integer(I4B),
pointer :: idxbudevap => null()
64 integer(I4B),
pointer :: idxbudroff => null()
65 integer(I4B),
pointer :: idxbudiflw => null()
66 integer(I4B),
pointer :: idxbudoutf => null()
67 integer(I4B),
pointer :: idxbudsbcd => null()
69 real(dp),
dimension(:),
pointer,
contiguous :: temprain => null()
70 real(dp),
dimension(:),
pointer,
contiguous :: tempevap => null()
71 real(dp),
dimension(:),
pointer,
contiguous :: temproff => null()
72 real(dp),
dimension(:),
pointer,
contiguous :: tempiflw => null()
73 real(dp),
dimension(:),
pointer,
contiguous :: ktf => null()
74 real(dp),
dimension(:),
pointer,
contiguous :: rfeatthk => null()
104 subroutine sfe_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
105 fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
107 class(
bndtype),
pointer :: packobj
108 integer(I4B),
intent(in) :: id
109 integer(I4B),
intent(in) :: ibcnum
110 integer(I4B),
intent(in) :: inunit
111 integer(I4B),
intent(in) :: iout
112 character(len=*),
intent(in) :: namemodel
113 character(len=*),
intent(in) :: pakname
115 real(dp),
intent(in),
pointer :: eqnsclfac
117 character(len=*),
intent(in) :: dvt
118 character(len=*),
intent(in) :: dvu
119 character(len=*),
intent(in) :: dvua
128 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
132 call sfeobj%allocate_scalars()
135 call packobj%pack_initialize()
137 packobj%inunit = inunit
140 packobj%ibcnum = ibcnum
150 sfeobj%eqnsclfac => eqnsclfac
155 sfeobj%gwecommon => gwecommon
158 sfeobj%depvartype = dvt
159 sfeobj%depvarunit = dvu
160 sfeobj%depvarunitabbrev = dvua
171 character(len=LINELENGTH) :: errmsg
172 class(
bndtype),
pointer :: packobj
173 integer(I4B) :: ip, icount
174 integer(I4B) :: nbudterm
184 if (this%fmi%flows_from_file)
then
185 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
186 if (
associated(this%flowbudptr)) found = .true.
189 if (
associated(this%fmi%gwfbndlist))
then
192 do ip = 1, this%fmi%gwfbndlist%Count()
194 if (packobj%packName == this%flowpackagename)
then
199 this%flowpackagebnd => packobj
200 select type (packobj)
202 this%flowbudptr => packobj%budobj
211 if (.not. found)
then
212 write (errmsg,
'(a)')
'Could not find flow package with name '&
213 &//trim(adjustl(this%flowpackagename))//
'.'
215 call this%parser%StoreErrorUnit()
220 nbudterm = this%flowbudptr%nbudterm
221 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
224 write (this%iout,
'(/, a, a)') &
225 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
226 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
227 write (this%iout,
'(a, i0)') &
228 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
230 do ip = 1, this%flowbudptr%nbudterm
231 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
232 case (
'FLOW-JA-FACE')
234 this%idxbudssm(ip) = 0
237 this%idxbudssm(ip) = 0
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
269 this%idxbudssm(ip) = icount
272 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
273 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
274 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
276 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
279 this%idxbudsbcd = this%idxbudgwf
290 real(DP),
dimension(:),
intent(inout) :: rhs
291 integer(I4B),
dimension(:),
intent(in) :: ia
292 integer(I4B),
dimension(:),
intent(in) :: idxglo
295 integer(I4B) :: j, n, n1, n2
297 integer(I4B) :: iposd, iposoffd
298 integer(I4B) :: ipossymd, ipossymoffd
299 integer(I4B) :: auxpos
309 if (this%idxbudrain /= 0)
then
310 do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
311 call this%sfe_rain_term(j, n1, n2, rrate, rhsval, hcofval)
312 iloc = this%idxlocnode(n1)
313 iposd = this%idxpakdiag(n1)
314 call matrix_sln%add_value_pos(iposd, hcofval)
315 rhs(iloc) = rhs(iloc) + rhsval
320 if (this%idxbudevap /= 0)
then
321 do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
322 call this%sfe_evap_term(j, n1, n2, rrate, rhsval, hcofval)
323 iloc = this%idxlocnode(n1)
324 iposd = this%idxpakdiag(n1)
325 call matrix_sln%add_value_pos(iposd, hcofval)
326 rhs(iloc) = rhs(iloc) + rhsval
331 if (this%idxbudroff /= 0)
then
332 do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
333 call this%sfe_roff_term(j, n1, n2, rrate, rhsval, hcofval)
334 iloc = this%idxlocnode(n1)
335 iposd = this%idxpakdiag(n1)
336 call matrix_sln%add_value_pos(iposd, hcofval)
337 rhs(iloc) = rhs(iloc) + rhsval
342 if (this%idxbudiflw /= 0)
then
343 do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
344 call this%sfe_iflw_term(j, n1, n2, rrate, rhsval, hcofval)
345 iloc = this%idxlocnode(n1)
346 iposd = this%idxpakdiag(n1)
347 call matrix_sln%add_value_pos(iposd, hcofval)
348 rhs(iloc) = rhs(iloc) + rhsval
353 if (this%idxbudoutf /= 0)
then
354 do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
355 call this%sfe_outf_term(j, n1, n2, rrate, rhsval, hcofval)
356 iloc = this%idxlocnode(n1)
357 iposd = this%idxpakdiag(n1)
358 call matrix_sln%add_value_pos(iposd, hcofval)
359 rhs(iloc) = rhs(iloc) + rhsval
364 do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
367 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
368 if (this%iboundpak(n) /= 0)
then
371 auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
372 wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
375 ctherm = ktf * wa / s
378 iposd = this%idxdglo(j)
379 iposoffd = this%idxoffdglo(j)
380 call matrix_sln%add_value_pos(iposd, -ctherm)
381 call matrix_sln%add_value_pos(iposoffd, ctherm)
384 ipossymd = this%idxsymdglo(j)
385 ipossymoffd = this%idxsymoffdglo(j)
386 call matrix_sln%add_value_pos(ipossymd, -ctherm)
387 call matrix_sln%add_value_pos(ipossymoffd, ctherm)
399 integer(I4B) :: n1, n2
403 if (this%idxbudrain /= 0)
then
404 do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
405 call this%sfe_rain_term(j, n1, n2, rrate)
406 this%dbuff(n1) = this%dbuff(n1) + rrate
411 if (this%idxbudevap /= 0)
then
412 do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
413 call this%sfe_evap_term(j, n1, n2, rrate)
414 this%dbuff(n1) = this%dbuff(n1) + rrate
419 if (this%idxbudroff /= 0)
then
420 do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
421 call this%sfe_roff_term(j, n1, n2, rrate)
422 this%dbuff(n1) = this%dbuff(n1) + rrate
427 if (this%idxbudiflw /= 0)
then
428 do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
429 call this%sfe_iflw_term(j, n1, n2, rrate)
430 this%dbuff(n1) = this%dbuff(n1) + rrate
435 if (this%idxbudoutf /= 0)
then
436 do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
437 call this%sfe_outf_term(j, n1, n2, rrate)
438 this%dbuff(n1) = this%dbuff(n1) + rrate
453 integer(I4B) :: nbudterms
472 integer(I4B),
intent(inout) :: idx
474 integer(I4B) :: n, n1, n2
475 integer(I4B) :: maxlist, naux
477 character(len=LENBUDTXT) :: text
482 maxlist = this%flowbudptr%budterm(this%idxbudrain)%maxlist
484 call this%budobj%budterm(idx)%initialize(text, &
489 maxlist, .false., .false., &
493 text =
' EVAPORATION'
495 maxlist = this%flowbudptr%budterm(this%idxbudevap)%maxlist
497 call this%budobj%budterm(idx)%initialize(text, &
502 maxlist, .false., .false., &
508 maxlist = this%flowbudptr%budterm(this%idxbudroff)%maxlist
510 call this%budobj%budterm(idx)%initialize(text, &
515 maxlist, .false., .false., &
521 maxlist = this%flowbudptr%budterm(this%idxbudiflw)%maxlist
523 call this%budobj%budterm(idx)%initialize(text, &
528 maxlist, .false., .false., &
532 text =
' EXT-OUTFLOW'
534 maxlist = this%flowbudptr%budterm(this%idxbudoutf)%maxlist
536 call this%budobj%budterm(idx)%initialize(text, &
541 maxlist, .false., .false., &
545 text =
' STREAMBED-COND'
547 maxlist = this%flowbudptr%budterm(this%idxbudsbcd)%maxlist
549 call this%budobj%budterm(idx)%initialize(text, &
554 maxlist, .false., .false., &
556 call this%budobj%budterm(idx)%reset(maxlist)
559 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(n)
560 n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
561 call this%budobj%budterm(idx)%update_term(n1, n2, q)
570 integer(I4B),
intent(inout) :: idx
571 real(DP),
dimension(:),
intent(in) :: x
572 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
573 real(DP),
intent(inout) :: ccratin
574 real(DP),
intent(inout) :: ccratout
576 integer(I4B) :: j, n1, n2
577 integer(I4B) :: nlist
578 integer(I4B) :: igwfnode
579 integer(I4B) :: idiag
580 integer(I4B) :: auxpos
589 nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist
590 call this%budobj%budterm(idx)%reset(nlist)
592 call this%sfe_rain_term(j, n1, n2, q)
593 call this%budobj%budterm(idx)%update_term(n1, n2, q)
594 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
599 nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist
600 call this%budobj%budterm(idx)%reset(nlist)
602 call this%sfe_evap_term(j, n1, n2, q)
603 call this%budobj%budterm(idx)%update_term(n1, n2, q)
604 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
609 nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist
610 call this%budobj%budterm(idx)%reset(nlist)
612 call this%sfe_roff_term(j, n1, n2, q)
613 call this%budobj%budterm(idx)%update_term(n1, n2, q)
614 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
619 nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist
620 call this%budobj%budterm(idx)%reset(nlist)
622 call this%sfe_iflw_term(j, n1, n2, q)
623 call this%budobj%budterm(idx)%update_term(n1, n2, q)
624 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
629 nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist
630 call this%budobj%budterm(idx)%reset(nlist)
632 call this%sfe_outf_term(j, n1, n2, q)
633 call this%budobj%budterm(idx)%update_term(n1, n2, q)
634 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
639 call this%budobj%budterm(idx)%reset(this%maxbound)
640 do j = 1, this%flowbudptr%budterm(this%idxbudsbcd)%nlist
642 n1 = this%flowbudptr%budterm(this%idxbudsbcd)%id1(j)
643 if (this%iboundpak(n1) /= 0)
then
644 igwfnode = this%flowbudptr%budterm(this%idxbudsbcd)%id2(j)
646 auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
647 wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
649 s = this%rfeatthk(n1)
650 ctherm = ktf * wa / s
651 q = ctherm * (x(igwfnode) - this%xnewpak(n1))
653 call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
654 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
655 if (this%iboundpak(n1) /= 0)
then
657 this%simvals(n1) = this%simvals(n1) - q
658 idiag = this%dis%con%ia(igwfnode)
659 flowja(idiag) = flowja(idiag) - q
674 call this%TspAptType%allocate_scalars()
677 call mem_allocate(this%idxbudrain,
'IDXBUDRAIN', this%memoryPath)
678 call mem_allocate(this%idxbudevap,
'IDXBUDEVAP', this%memoryPath)
679 call mem_allocate(this%idxbudroff,
'IDXBUDROFF', this%memoryPath)
680 call mem_allocate(this%idxbudiflw,
'IDXBUDIFLW', this%memoryPath)
681 call mem_allocate(this%idxbudoutf,
'IDXBUDOUTF', this%memoryPath)
682 call mem_allocate(this%idxbudsbcd,
'IDXBUDSBCD', this%memoryPath)
705 call mem_allocate(this%temprain, this%ncv,
'TEMPRAIN', this%memoryPath)
706 call mem_allocate(this%tempevap, this%ncv,
'TEMPEVAP', this%memoryPath)
707 call mem_allocate(this%temproff, this%ncv,
'TEMPROFF', this%memoryPath)
708 call mem_allocate(this%tempiflw, this%ncv,
'TEMPIFLW', this%memoryPath)
711 call this%TspAptType%apt_allocate_arrays()
715 this%temprain(n) =
dzero
716 this%tempevap(n) =
dzero
717 this%temproff(n) =
dzero
718 this%tempiflw(n) =
dzero
749 call this%TspAptType%bnd_da()
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%idxbudrain)%id1(ientry)
768 n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry)
769 qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry)
770 ctmp = this%temprain(n1)
771 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
772 if (
present(rhsval)) rhsval = -rrate
773 if (
present(hcofval)) hcofval =
dzero
781 integer(I4B),
intent(in) :: ientry
782 integer(I4B),
intent(inout) :: n1
783 integer(I4B),
intent(inout) :: n2
784 real(DP),
intent(inout),
optional :: rrate
785 real(DP),
intent(inout),
optional :: rhsval
786 real(DP),
intent(inout),
optional :: hcofval
791 n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry)
792 n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry)
794 qbnd = this%flowbudptr%budterm(this%idxbudevap)%flow(ientry)
795 heatlat = this%gwecommon%gwerhow * this%gwecommon%gwelatheatvap
796 if (
present(rrate)) rrate = qbnd * heatlat
798 if (
present(rhsval)) rhsval = -rrate
799 if (
present(hcofval)) hcofval =
dzero
807 integer(I4B),
intent(in) :: ientry
808 integer(I4B),
intent(inout) :: n1
809 integer(I4B),
intent(inout) :: n2
810 real(DP),
intent(inout),
optional :: rrate
811 real(DP),
intent(inout),
optional :: rhsval
812 real(DP),
intent(inout),
optional :: hcofval
817 n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry)
818 n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry)
819 qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry)
820 ctmp = this%temproff(n1)
821 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
822 if (
present(rhsval)) rhsval = -rrate
823 if (
present(hcofval)) hcofval =
dzero
835 integer(I4B),
intent(in) :: ientry
836 integer(I4B),
intent(inout) :: n1
837 integer(I4B),
intent(inout) :: n2
838 real(DP),
intent(inout),
optional :: rrate
839 real(DP),
intent(inout),
optional :: rhsval
840 real(DP),
intent(inout),
optional :: hcofval
845 n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry)
846 n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry)
847 qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry)
848 ctmp = this%tempiflw(n1)
849 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
850 if (
present(rhsval)) rhsval = -rrate
851 if (
present(hcofval)) hcofval =
dzero
862 integer(I4B),
intent(in) :: ientry
863 integer(I4B),
intent(inout) :: n1
864 integer(I4B),
intent(inout) :: n2
865 real(DP),
intent(inout),
optional :: rrate
866 real(DP),
intent(inout),
optional :: rhsval
867 real(DP),
intent(inout),
optional :: hcofval
872 n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry)
873 n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry)
874 qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry)
875 ctmp = this%xnewpak(n1)
876 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
877 if (
present(rhsval)) rhsval =
dzero
878 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
895 call this%obs%StoreObsType(
'temperature', .false., indx)
900 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
905 call this%obs%StoreObsType(
'from-mvr', .true., indx)
910 call this%obs%StoreObsType(
'to-mvr', .true., indx)
915 call this%obs%StoreObsType(
'storage', .true., indx)
920 call this%obs%StoreObsType(
'constant', .true., indx)
925 call this%obs%StoreObsType(
'sfe', .true., indx)
930 call this%obs%StoreObsType(
'rainfall', .true., indx)
935 call this%obs%StoreObsType(
'evaporation', .true., indx)
940 call this%obs%StoreObsType(
'runoff', .true., indx)
945 call this%obs%StoreObsType(
'ext-inflow', .true., indx)
950 call this%obs%StoreObsType(
'ext-outflow', .true., indx)
962 logical,
intent(inout) :: found
966 select case (obsrv%ObsTypeId)
968 call this%rp_obs_byfeature(obsrv)
970 call this%rp_obs_byfeature(obsrv)
972 call this%rp_obs_byfeature(obsrv)
974 call this%rp_obs_byfeature(obsrv)
976 call this%rp_obs_byfeature(obsrv)
978 call this%rp_obs_byfeature(obsrv)
989 character(len=*),
intent(in) :: obstypeid
990 real(DP),
intent(inout) :: v
991 integer(I4B),
intent(in) :: jj
992 logical,
intent(inout) :: found
994 integer(I4B) :: n1, n2
997 select case (obstypeid)
999 if (this%iboundpak(jj) /= 0)
then
1000 call this%sfe_rain_term(jj, n1, n2, v)
1002 case (
'EVAPORATION')
1003 if (this%iboundpak(jj) /= 0)
then
1004 call this%sfe_evap_term(jj, n1, n2, v)
1007 if (this%iboundpak(jj) /= 0)
then
1008 call this%sfe_roff_term(jj, n1, n2, v)
1011 if (this%iboundpak(jj) /= 0)
then
1012 call this%sfe_iflw_term(jj, n1, n2, v)
1014 case (
'EXT-OUTFLOW')
1015 if (this%iboundpak(jj) /= 0)
then
1016 call this%sfe_outf_term(jj, n1, n2, v)
1030 integer(I4B),
intent(in) :: itemno
1031 character(len=*),
intent(in) :: keyword
1032 logical,
intent(inout) :: found
1034 character(len=LINELENGTH) :: text
1035 integer(I4B) :: ierr
1037 real(DP),
pointer :: bndElem => null()
1046 select case (keyword)
1048 ierr = this%apt_check_valid(itemno)
1052 call this%parser%GetString(text)
1054 bndelem => this%temprain(itemno)
1056 this%packName,
'BND', this%tsManager, &
1057 this%iprpak,
'RAINFALL')
1058 case (
'EVAPORATION')
1059 ierr = this%apt_check_valid(itemno)
1063 call this%parser%GetString(text)
1065 bndelem => this%tempevap(itemno)
1067 this%packName,
'BND', this%tsManager, &
1068 this%iprpak,
'EVAPORATION')
1070 ierr = this%apt_check_valid(itemno)
1074 call this%parser%GetString(text)
1076 bndelem => this%temproff(itemno)
1078 this%packName,
'BND', this%tsManager, &
1079 this%iprpak,
'RUNOFF')
1081 ierr = this%apt_check_valid(itemno)
1085 call this%parser%GetString(text)
1087 bndelem => this%tempiflw(itemno)
1089 this%packName,
'BND', this%tsManager, &
1090 this%iprpak,
'INFLOW')
1109 character(len=LINELENGTH) :: text
1110 character(len=LENBOUNDNAME) :: bndName, bndNameTemp
1111 character(len=9) :: cno
1112 character(len=50),
dimension(:),
allocatable :: caux
1113 integer(I4B) :: ierr
1114 logical :: isfound, endOfBlock
1116 integer(I4B) :: ii, jj
1117 integer(I4B) :: iaux
1118 integer(I4B) :: itmp
1119 integer(I4B) :: nlak
1120 integer(I4B) :: nconn
1121 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
1122 real(DP),
pointer :: bndElem => null()
1128 call mem_allocate(this%strt, this%ncv,
'STRT', this%memoryPath)
1129 call mem_allocate(this%ktf, this%ncv,
'KTF', this%memoryPath)
1130 call mem_allocate(this%rfeatthk, this%ncv,
'RFEATTHK', this%memoryPath)
1131 call mem_allocate(this%lauxvar, this%naux, this%ncv,
'LAUXVAR', &
1135 if (this%imatrows == 0)
then
1136 call mem_allocate(this%iboundpak, this%ncv,
'IBOUND', this%memoryPath)
1137 call mem_allocate(this%xnewpak, this%ncv,
'XNEWPAK', this%memoryPath)
1139 call mem_allocate(this%xoldpak, this%ncv,
'XOLDPAK', this%memoryPath)
1142 allocate (this%featname(this%ncv))
1146 this%strt(n) =
dep20
1148 this%rfeatthk(n) =
dzero
1149 this%lauxvar(:, n) =
dzero
1150 this%xoldpak(n) =
dep20
1151 if (this%imatrows == 0)
then
1152 this%iboundpak(n) = 1
1153 this%xnewpak(n) =
dep20
1158 if (this%naux > 0)
then
1159 allocate (caux(this%naux))
1163 allocate (nboundchk(this%ncv))
1169 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
1170 supportopenclose=.true.)
1174 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1179 call this%parser%GetNextLine(endofblock)
1180 if (endofblock)
exit
1181 n = this%parser%GetInteger()
1183 if (n < 1 .or. n > this%ncv)
then
1184 write (
errmsg,
'(a,1x,i6)') &
1185 'Itemno must be > 0 and <= ', this%ncv
1191 nboundchk(n) = nboundchk(n) + 1
1194 this%strt(n) = this%parser%GetDouble()
1197 this%ktf(n) = this%parser%GetDouble()
1198 this%rfeatthk(n) = this%parser%GetDouble()
1199 if (this%rfeatthk(n) <=
dzero)
then
1200 write (
errmsg,
'(4x,a)') &
1201 '****ERROR. Specified thickness used for thermal &
1202 &conduction MUST BE > 0 else divide by zero error occurs'
1208 do iaux = 1, this%naux
1209 call this%parser%GetString(caux(iaux))
1213 write (cno,
'(i9.9)') n
1214 bndname =
'Feature'//cno
1217 if (this%inamedbound /= 0)
then
1218 call this%parser%GetStringCaps(bndnametemp)
1219 if (bndnametemp /=
'')
then
1220 bndname = bndnametemp
1223 this%featname(n) = bndname
1227 do jj = 1, this%naux
1230 bndelem => this%lauxvar(jj, ii)
1232 this%packName,
'AUX', &
1233 this%tsManager, this%iprpak, &
1242 if (nboundchk(n) == 0)
then
1243 write (
errmsg,
'(a,1x,i0)')
'No data specified for feature', n
1245 else if (nboundchk(n) > 1)
then
1246 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1247 'Data for feature', n,
'specified', nboundchk(n),
'times'
1252 write (this%iout,
'(1x,a)') &
1253 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
1255 call store_error(
'Required packagedata block not found.')
1260 call this%parser%StoreErrorUnit()
1264 if (this%naux > 0)
then
1269 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_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.