53 character(len=*),
parameter ::
ftype =
'LKE'
54 character(len=*),
parameter ::
flowtype =
'LAK'
55 character(len=16) ::
text =
' LKE'
61 integer(I4B),
pointer :: idxbudrain => null()
62 integer(I4B),
pointer :: idxbudevap => null()
63 integer(I4B),
pointer :: idxbudroff => null()
64 integer(I4B),
pointer :: idxbudiflw => null()
65 integer(I4B),
pointer :: idxbudwdrl => null()
66 integer(I4B),
pointer :: idxbudoutf => null()
67 integer(I4B),
pointer :: idxbudlbcd => 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()
105 subroutine lke_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, &
106 fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
108 class(
bndtype),
pointer :: packobj
109 integer(I4B),
intent(in) :: id
110 integer(I4B),
intent(in) :: ibcnum
111 integer(I4B),
intent(in) :: inunit
112 integer(I4B),
intent(in) :: iout
113 character(len=*),
intent(in) :: namemodel
114 character(len=*),
intent(in) :: pakname
116 real(dp),
intent(in),
pointer :: eqnsclfac
118 character(len=*),
intent(in) :: dvt
119 character(len=*),
intent(in) :: dvu
120 character(len=*),
intent(in) :: dvua
129 call packobj%set_names(ibcnum, namemodel, pakname,
ftype)
133 call lkeobj%allocate_scalars()
136 call packobj%pack_initialize()
138 packobj%inunit = inunit
141 packobj%ibcnum = ibcnum
151 lkeobj%eqnsclfac => eqnsclfac
156 lkeobj%gwecommon => gwecommon
159 lkeobj%depvartype = dvt
160 lkeobj%depvarunit = dvu
161 lkeobj%depvarunitabbrev = dvua
172 character(len=LINELENGTH) :: errmsg
173 class(
bndtype),
pointer :: packobj
174 integer(I4B) :: ip, icount
175 integer(I4B) :: nbudterm
185 if (this%fmi%flows_from_file)
then
186 call this%fmi%set_aptbudobj_pointer(this%flowpackagename, this%flowbudptr)
187 if (
associated(this%flowbudptr)) found = .true.
190 if (
associated(this%fmi%gwfbndlist))
then
193 do ip = 1, this%fmi%gwfbndlist%Count()
195 if (packobj%packName == this%flowpackagename)
then
200 this%flowpackagebnd => packobj
201 select type (packobj)
203 this%flowbudptr => packobj%budobj
212 if (.not. found)
then
213 write (errmsg,
'(a)')
'Could not find flow package with name '&
214 &//trim(adjustl(this%flowpackagename))//
'.'
216 call this%parser%StoreErrorUnit()
221 nbudterm = this%flowbudptr%nbudterm
222 call mem_allocate(this%idxbudssm, nbudterm,
'IDXBUDSSM', this%memoryPath)
225 write (this%iout,
'(/, a, a)') &
226 'PROCESSING '//
ftype//
' INFORMATION FOR ', this%packName
227 write (this%iout,
'(a)')
' IDENTIFYING FLOW TERMS IN '//
flowtype//
' PACKAGE'
228 write (this%iout,
'(a, i0)') &
229 ' NUMBER OF '//
flowtype//
' = ', this%flowbudptr%ncv
231 do ip = 1, this%flowbudptr%nbudterm
232 select case (trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)))
233 case (
'FLOW-JA-FACE')
235 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
269 this%idxbudssm(ip) = 0
274 this%idxbudssm(ip) = icount
277 write (this%iout,
'(a, i0, " = ", a,/, a, i0)') &
278 ' TERM ', ip, trim(adjustl(this%flowbudptr%budterm(ip)%flowtype)), &
279 ' MAX NO. OF ENTRIES = ', this%flowbudptr%budterm(ip)%maxlist
281 write (this%iout,
'(a, //)')
'DONE PROCESSING '//
ftype//
' INFORMATION'
292 real(DP),
dimension(:),
intent(inout) :: rhs
293 integer(I4B),
dimension(:),
intent(in) :: ia
294 integer(I4B),
dimension(:),
intent(in) :: idxglo
297 integer(I4B) :: j, n, n1, n2
299 integer(I4B) :: iposd, iposoffd
300 integer(I4B) :: ipossymd, ipossymoffd
301 integer(I4B) :: auxpos
311 if (this%idxbudrain /= 0)
then
312 do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
313 call this%lke_rain_term(j, n1, n2, rrate, rhsval, hcofval)
314 iloc = this%idxlocnode(n1)
315 iposd = this%idxpakdiag(n1)
316 call matrix_sln%add_value_pos(iposd, hcofval)
317 rhs(iloc) = rhs(iloc) + rhsval
322 if (this%idxbudevap /= 0)
then
323 do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
324 call this%lke_evap_term(j, n1, n2, rrate, rhsval, hcofval)
325 iloc = this%idxlocnode(n1)
326 iposd = this%idxpakdiag(n1)
327 call matrix_sln%add_value_pos(iposd, hcofval)
328 rhs(iloc) = rhs(iloc) + rhsval
333 if (this%idxbudroff /= 0)
then
334 do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
335 call this%lke_roff_term(j, n1, n2, rrate, rhsval, hcofval)
336 iloc = this%idxlocnode(n1)
337 iposd = this%idxpakdiag(n1)
338 call matrix_sln%add_value_pos(iposd, hcofval)
339 rhs(iloc) = rhs(iloc) + rhsval
344 if (this%idxbudiflw /= 0)
then
345 do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
346 call this%lke_iflw_term(j, n1, n2, rrate, rhsval, hcofval)
347 iloc = this%idxlocnode(n1)
348 iposd = this%idxpakdiag(n1)
349 call matrix_sln%add_value_pos(iposd, hcofval)
350 rhs(iloc) = rhs(iloc) + rhsval
355 if (this%idxbudwdrl /= 0)
then
356 do j = 1, this%flowbudptr%budterm(this%idxbudwdrl)%nlist
357 call this%lke_wdrl_term(j, n1, n2, rrate, rhsval, hcofval)
358 iloc = this%idxlocnode(n1)
359 iposd = this%idxpakdiag(n1)
360 call matrix_sln%add_value_pos(iposd, hcofval)
361 rhs(iloc) = rhs(iloc) + rhsval
366 if (this%idxbudoutf /= 0)
then
367 do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
368 call this%lke_outf_term(j, n1, n2, rrate, rhsval, hcofval)
369 iloc = this%idxlocnode(n1)
370 iposd = this%idxpakdiag(n1)
371 call matrix_sln%add_value_pos(iposd, hcofval)
372 rhs(iloc) = rhs(iloc) + rhsval
377 do j = 1, this%flowbudptr%budterm(this%idxbudgwf)%nlist
380 n = this%flowbudptr%budterm(this%idxbudgwf)%id1(j)
381 if (this%iboundpak(n) /= 0)
then
384 auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
385 wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
388 ctherm = ktf * wa / s
391 iposd = this%idxdglo(j)
392 iposoffd = this%idxoffdglo(j)
393 call matrix_sln%add_value_pos(iposd, -ctherm)
394 call matrix_sln%add_value_pos(iposoffd, ctherm)
397 ipossymd = this%idxsymdglo(j)
398 ipossymoffd = this%idxsymoffdglo(j)
399 call matrix_sln%add_value_pos(ipossymd, -ctherm)
400 call matrix_sln%add_value_pos(ipossymoffd, ctherm)
412 integer(I4B) :: n1, n2
416 if (this%idxbudrain /= 0)
then
417 do j = 1, this%flowbudptr%budterm(this%idxbudrain)%nlist
418 call this%lke_rain_term(j, n1, n2, rrate)
419 this%dbuff(n1) = this%dbuff(n1) + rrate
424 if (this%idxbudevap /= 0)
then
425 do j = 1, this%flowbudptr%budterm(this%idxbudevap)%nlist
426 call this%lke_evap_term(j, n1, n2, rrate)
427 this%dbuff(n1) = this%dbuff(n1) + rrate
432 if (this%idxbudroff /= 0)
then
433 do j = 1, this%flowbudptr%budterm(this%idxbudroff)%nlist
434 call this%lke_roff_term(j, n1, n2, rrate)
435 this%dbuff(n1) = this%dbuff(n1) + rrate
440 if (this%idxbudiflw /= 0)
then
441 do j = 1, this%flowbudptr%budterm(this%idxbudiflw)%nlist
442 call this%lke_iflw_term(j, n1, n2, rrate)
443 this%dbuff(n1) = this%dbuff(n1) + rrate
448 if (this%idxbudwdrl /= 0)
then
449 do j = 1, this%flowbudptr%budterm(this%idxbudwdrl)%nlist
450 call this%lke_wdrl_term(j, n1, n2, rrate)
451 this%dbuff(n1) = this%dbuff(n1) + rrate
456 if (this%idxbudoutf /= 0)
then
457 do j = 1, this%flowbudptr%budterm(this%idxbudoutf)%nlist
458 call this%lke_outf_term(j, n1, n2, rrate)
459 this%dbuff(n1) = this%dbuff(n1) + rrate
472 integer(I4B) :: nbudterms
493 integer(I4B),
intent(inout) :: idx
495 integer(I4B) :: n, n1, n2
496 integer(I4B) :: maxlist, naux
498 character(len=LENBUDTXT) :: text
503 maxlist = this%flowbudptr%budterm(this%idxbudrain)%maxlist
505 call this%budobj%budterm(idx)%initialize(text, &
510 maxlist, .false., .false., &
514 text =
' EVAPORATION'
516 maxlist = this%flowbudptr%budterm(this%idxbudevap)%maxlist
518 call this%budobj%budterm(idx)%initialize(text, &
523 maxlist, .false., .false., &
529 maxlist = this%flowbudptr%budterm(this%idxbudroff)%maxlist
531 call this%budobj%budterm(idx)%initialize(text, &
536 maxlist, .false., .false., &
542 maxlist = this%flowbudptr%budterm(this%idxbudiflw)%maxlist
544 call this%budobj%budterm(idx)%initialize(text, &
549 maxlist, .false., .false., &
555 maxlist = this%flowbudptr%budterm(this%idxbudwdrl)%maxlist
557 call this%budobj%budterm(idx)%initialize(text, &
562 maxlist, .false., .false., &
567 text =
' EXT-OUTFLOW'
569 maxlist = this%flowbudptr%budterm(this%idxbudoutf)%maxlist
571 call this%budobj%budterm(idx)%initialize(text, &
576 maxlist, .false., .false., &
580 text =
' LAKEBED-COND'
582 maxlist = this%flowbudptr%budterm(this%idxbudlbcd)%maxlist
584 call this%budobj%budterm(idx)%initialize(text, &
589 maxlist, .false., .false., &
591 call this%budobj%budterm(idx)%reset(maxlist)
594 n1 = this%flowbudptr%budterm(this%idxbudgwf)%id1(n)
595 n2 = this%flowbudptr%budterm(this%idxbudgwf)%id2(n)
596 call this%budobj%budterm(idx)%update_term(n1, n2, q)
605 integer(I4B),
intent(inout) :: idx
606 real(DP),
dimension(:),
intent(in) :: x
607 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
608 real(DP),
intent(inout) :: ccratin
609 real(DP),
intent(inout) :: ccratout
611 integer(I4B) :: j, n1, n2
612 integer(I4B) :: nlist
613 integer(I4B) :: igwfnode
614 integer(I4B) :: idiag
615 integer(I4B) :: auxpos
624 nlist = this%flowbudptr%budterm(this%idxbudrain)%nlist
625 call this%budobj%budterm(idx)%reset(nlist)
627 call this%lke_rain_term(j, n1, n2, q)
628 call this%budobj%budterm(idx)%update_term(n1, n2, q)
629 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
634 nlist = this%flowbudptr%budterm(this%idxbudevap)%nlist
635 call this%budobj%budterm(idx)%reset(nlist)
637 call this%lke_evap_term(j, n1, n2, q)
638 call this%budobj%budterm(idx)%update_term(n1, n2, q)
639 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
644 nlist = this%flowbudptr%budterm(this%idxbudroff)%nlist
645 call this%budobj%budterm(idx)%reset(nlist)
647 call this%lke_roff_term(j, n1, n2, q)
648 call this%budobj%budterm(idx)%update_term(n1, n2, q)
649 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
654 nlist = this%flowbudptr%budterm(this%idxbudiflw)%nlist
655 call this%budobj%budterm(idx)%reset(nlist)
657 call this%lke_iflw_term(j, n1, n2, q)
658 call this%budobj%budterm(idx)%update_term(n1, n2, q)
659 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
664 nlist = this%flowbudptr%budterm(this%idxbudwdrl)%nlist
665 call this%budobj%budterm(idx)%reset(nlist)
667 call this%lke_wdrl_term(j, n1, n2, q)
668 call this%budobj%budterm(idx)%update_term(n1, n2, q)
669 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
674 nlist = this%flowbudptr%budterm(this%idxbudoutf)%nlist
675 call this%budobj%budterm(idx)%reset(nlist)
677 call this%lke_outf_term(j, n1, n2, q)
678 call this%budobj%budterm(idx)%update_term(n1, n2, q)
679 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
684 call this%budobj%budterm(idx)%reset(this%maxbound)
685 do j = 1, this%flowbudptr%budterm(this%idxbudlbcd)%nlist
687 n1 = this%flowbudptr%budterm(this%idxbudlbcd)%id1(j)
688 if (this%iboundpak(n1) /= 0)
then
689 igwfnode = this%flowbudptr%budterm(this%idxbudlbcd)%id2(j)
690 auxpos = this%flowbudptr%budterm(this%idxbudgwf)%naux
691 wa = this%flowbudptr%budterm(this%idxbudgwf)%auxvar(auxpos, j)
693 s = this%rfeatthk(n1)
694 ctherm = ktf * wa / s
695 q = ctherm * (x(igwfnode) - this%xnewpak(n1))
697 call this%budobj%budterm(idx)%update_term(n1, igwfnode, q)
698 call this%apt_accumulate_ccterm(n1, q, ccratin, ccratout)
699 if (this%iboundpak(n1) /= 0)
then
701 this%simvals(n1) = this%simvals(n1) - q
702 idiag = this%dis%con%ia(igwfnode)
703 flowja(idiag) = flowja(idiag) - q
718 call this%TspAptType%allocate_scalars()
721 call mem_allocate(this%idxbudrain,
'IDXBUDRAIN', this%memoryPath)
722 call mem_allocate(this%idxbudevap,
'IDXBUDEVAP', this%memoryPath)
723 call mem_allocate(this%idxbudroff,
'IDXBUDROFF', this%memoryPath)
724 call mem_allocate(this%idxbudiflw,
'IDXBUDIFLW', this%memoryPath)
725 call mem_allocate(this%idxbudwdrl,
'IDXBUDWDRL', this%memoryPath)
726 call mem_allocate(this%idxbudoutf,
'IDXBUDOUTF', this%memoryPath)
727 call mem_allocate(this%idxbudlbcd,
'IDXBUDLBCD', this%memoryPath)
751 call mem_allocate(this%temprain, this%ncv,
'TEMPRAIN', this%memoryPath)
752 call mem_allocate(this%tempevap, this%ncv,
'TEMPEVAP', this%memoryPath)
753 call mem_allocate(this%temproff, this%ncv,
'TEMPROFF', this%memoryPath)
754 call mem_allocate(this%tempiflw, this%ncv,
'TEMPIFLW', this%memoryPath)
757 call this%TspAptType%apt_allocate_arrays()
761 this%temprain(n) =
dzero
762 this%tempevap(n) =
dzero
763 this%temproff(n) =
dzero
764 this%tempiflw(n) =
dzero
797 call this%TspAptType%bnd_da()
806 integer(I4B),
intent(in) :: ientry
807 integer(I4B),
intent(inout) :: n1
808 integer(I4B),
intent(inout) :: n2
809 real(DP),
intent(inout),
optional :: rrate
810 real(DP),
intent(inout),
optional :: rhsval
811 real(DP),
intent(inout),
optional :: hcofval
816 n1 = this%flowbudptr%budterm(this%idxbudrain)%id1(ientry)
817 n2 = this%flowbudptr%budterm(this%idxbudrain)%id2(ientry)
818 qbnd = this%flowbudptr%budterm(this%idxbudrain)%flow(ientry)
819 ctmp = this%temprain(n1)
820 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
821 if (
present(rhsval)) rhsval = -rrate
822 if (
present(hcofval)) hcofval =
dzero
831 integer(I4B),
intent(in) :: ientry
832 integer(I4B),
intent(inout) :: n1
833 integer(I4B),
intent(inout) :: n2
834 real(DP),
intent(inout),
optional :: rrate
835 real(DP),
intent(inout),
optional :: rhsval
836 real(DP),
intent(inout),
optional :: hcofval
841 n1 = this%flowbudptr%budterm(this%idxbudevap)%id1(ientry)
842 n2 = this%flowbudptr%budterm(this%idxbudevap)%id2(ientry)
844 qbnd = this%flowbudptr%budterm(this%idxbudevap)%flow(ientry)
845 heatlat = this%gwecommon%gwerhow * this%gwecommon%gwelatheatvap
846 if (
present(rrate)) rrate = qbnd * heatlat
847 if (
present(rhsval)) rhsval = -rrate
848 if (
present(hcofval)) hcofval =
dzero
857 integer(I4B),
intent(in) :: ientry
858 integer(I4B),
intent(inout) :: n1
859 integer(I4B),
intent(inout) :: n2
860 real(DP),
intent(inout),
optional :: rrate
861 real(DP),
intent(inout),
optional :: rhsval
862 real(DP),
intent(inout),
optional :: hcofval
867 n1 = this%flowbudptr%budterm(this%idxbudroff)%id1(ientry)
868 n2 = this%flowbudptr%budterm(this%idxbudroff)%id2(ientry)
869 qbnd = this%flowbudptr%budterm(this%idxbudroff)%flow(ientry)
870 ctmp = this%temproff(n1)
871 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
872 if (
present(rhsval)) rhsval = -rrate
873 if (
present(hcofval)) hcofval =
dzero
885 integer(I4B),
intent(in) :: ientry
886 integer(I4B),
intent(inout) :: n1
887 integer(I4B),
intent(inout) :: n2
888 real(DP),
intent(inout),
optional :: rrate
889 real(DP),
intent(inout),
optional :: rhsval
890 real(DP),
intent(inout),
optional :: hcofval
895 n1 = this%flowbudptr%budterm(this%idxbudiflw)%id1(ientry)
896 n2 = this%flowbudptr%budterm(this%idxbudiflw)%id2(ientry)
897 qbnd = this%flowbudptr%budterm(this%idxbudiflw)%flow(ientry)
898 ctmp = this%tempiflw(n1)
899 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
900 if (
present(rhsval)) rhsval = -rrate
901 if (
present(hcofval)) hcofval =
dzero
913 integer(I4B),
intent(in) :: ientry
914 integer(I4B),
intent(inout) :: n1
915 integer(I4B),
intent(inout) :: n2
916 real(DP),
intent(inout),
optional :: rrate
917 real(DP),
intent(inout),
optional :: rhsval
918 real(DP),
intent(inout),
optional :: hcofval
923 n1 = this%flowbudptr%budterm(this%idxbudwdrl)%id1(ientry)
924 n2 = this%flowbudptr%budterm(this%idxbudwdrl)%id2(ientry)
925 qbnd = this%flowbudptr%budterm(this%idxbudwdrl)%flow(ientry)
926 ctmp = this%xnewpak(n1)
927 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
928 if (
present(rhsval)) rhsval =
dzero
929 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
941 integer(I4B),
intent(in) :: ientry
942 integer(I4B),
intent(inout) :: n1
943 integer(I4B),
intent(inout) :: n2
944 real(DP),
intent(inout),
optional :: rrate
945 real(DP),
intent(inout),
optional :: rhsval
946 real(DP),
intent(inout),
optional :: hcofval
951 n1 = this%flowbudptr%budterm(this%idxbudoutf)%id1(ientry)
952 n2 = this%flowbudptr%budterm(this%idxbudoutf)%id2(ientry)
953 qbnd = this%flowbudptr%budterm(this%idxbudoutf)%flow(ientry)
954 ctmp = this%xnewpak(n1)
955 if (
present(rrate)) rrate = ctmp * qbnd * this%eqnsclfac
956 if (
present(rhsval)) rhsval =
dzero
957 if (
present(hcofval)) hcofval = qbnd * this%eqnsclfac
973 call this%obs%StoreObsType(
'temperature', .false., indx)
978 call this%obs%StoreObsType(
'flow-ja-face', .true., indx)
983 call this%obs%StoreObsType(
'from-mvr', .true., indx)
988 call this%obs%StoreObsType(
'to-mvr', .true., indx)
993 call this%obs%StoreObsType(
'storage', .true., indx)
998 call this%obs%StoreObsType(
'constant', .true., indx)
1003 call this%obs%StoreObsType(
'lke', .true., indx)
1008 call this%obs%StoreObsType(
'rainfall', .true., indx)
1013 call this%obs%StoreObsType(
'evaporation', .true., indx)
1018 call this%obs%StoreObsType(
'runoff', .true., indx)
1023 call this%obs%StoreObsType(
'ext-inflow', .true., indx)
1028 call this%obs%StoreObsType(
'withdrawal', .true., indx)
1033 call this%obs%StoreObsType(
'ext-outflow', .true., indx)
1045 logical,
intent(inout) :: found
1048 select case (obsrv%ObsTypeId)
1050 call this%rp_obs_byfeature(obsrv)
1051 case (
'EVAPORATION')
1052 call this%rp_obs_byfeature(obsrv)
1054 call this%rp_obs_byfeature(obsrv)
1056 call this%rp_obs_byfeature(obsrv)
1058 call this%rp_obs_byfeature(obsrv)
1059 case (
'EXT-OUTFLOW')
1060 call this%rp_obs_byfeature(obsrv)
1062 call this%rp_obs_budterm(obsrv, &
1063 this%flowbudptr%budterm(this%idxbudtmvr))
1074 character(len=*),
intent(in) :: obstypeid
1075 real(DP),
intent(inout) :: v
1076 integer(I4B),
intent(in) :: jj
1077 logical,
intent(inout) :: found
1079 integer(I4B) :: n1, n2
1082 select case (obstypeid)
1084 if (this%iboundpak(jj) /= 0)
then
1085 call this%lke_rain_term(jj, n1, n2, v)
1087 case (
'EVAPORATION')
1088 if (this%iboundpak(jj) /= 0)
then
1089 call this%lke_evap_term(jj, n1, n2, v)
1092 if (this%iboundpak(jj) /= 0)
then
1093 call this%lke_roff_term(jj, n1, n2, v)
1096 if (this%iboundpak(jj) /= 0)
then
1097 call this%lke_iflw_term(jj, n1, n2, v)
1100 if (this%iboundpak(jj) /= 0)
then
1101 call this%lke_wdrl_term(jj, n1, n2, v)
1103 case (
'EXT-OUTFLOW')
1104 if (this%iboundpak(jj) /= 0)
then
1105 call this%lke_outf_term(jj, n1, n2, v)
1119 integer(I4B),
intent(in) :: itemno
1120 character(len=*),
intent(in) :: keyword
1121 logical,
intent(inout) :: found
1123 character(len=LINELENGTH) :: text
1124 integer(I4B) :: ierr
1126 real(DP),
pointer :: bndElem => null()
1135 select case (keyword)
1137 ierr = this%apt_check_valid(itemno)
1141 call this%parser%GetString(text)
1143 bndelem => this%temprain(itemno)
1145 this%packName,
'BND', this%tsManager, &
1146 this%iprpak,
'RAINFALL')
1147 case (
'EVAPORATION')
1148 ierr = this%apt_check_valid(itemno)
1152 call this%parser%GetString(text)
1154 bndelem => this%tempevap(itemno)
1156 this%packName,
'BND', this%tsManager, &
1157 this%iprpak,
'EVAPORATION')
1159 ierr = this%apt_check_valid(itemno)
1163 call this%parser%GetString(text)
1165 bndelem => this%temproff(itemno)
1167 this%packName,
'BND', this%tsManager, &
1168 this%iprpak,
'RUNOFF')
1170 ierr = this%apt_check_valid(itemno)
1174 call this%parser%GetString(text)
1176 bndelem => this%tempiflw(itemno)
1178 this%packName,
'BND', this%tsManager, &
1179 this%iprpak,
'EXT-INFLOW')
1198 character(len=LINELENGTH) :: text
1199 character(len=LENBOUNDNAME) :: bndName, bndNameTemp
1200 character(len=9) :: cno
1201 character(len=50),
dimension(:),
allocatable :: caux
1202 integer(I4B) :: ierr
1203 logical :: isfound, endOfBlock
1205 integer(I4B) :: ii, jj
1206 integer(I4B) :: iaux
1207 integer(I4B) :: itmp
1208 integer(I4B) :: nlak
1209 integer(I4B) :: nconn
1210 integer(I4B),
dimension(:),
pointer,
contiguous :: nboundchk
1211 real(DP),
pointer :: bndElem => null()
1217 call mem_allocate(this%strt, this%ncv,
'STRT', this%memoryPath)
1218 call mem_allocate(this%ktf, this%ncv,
'KTF', this%memoryPath)
1219 call mem_allocate(this%rfeatthk, this%ncv,
'RFEATTHK', this%memoryPath)
1220 call mem_allocate(this%lauxvar, this%naux, this%ncv,
'LAUXVAR', &
1224 if (this%imatrows == 0)
then
1225 call mem_allocate(this%iboundpak, this%ncv,
'IBOUND', this%memoryPath)
1226 call mem_allocate(this%xnewpak, this%ncv,
'XNEWPAK', this%memoryPath)
1228 call mem_allocate(this%xoldpak, this%ncv,
'XOLDPAK', this%memoryPath)
1231 allocate (this%featname(this%ncv))
1235 this%strt(n) =
dep20
1237 this%rfeatthk(n) =
dzero
1238 this%lauxvar(:, n) =
dzero
1239 this%xoldpak(n) =
dep20
1240 if (this%imatrows == 0)
then
1241 this%iboundpak(n) = 1
1242 this%xnewpak(n) =
dep20
1247 if (this%naux > 0)
then
1248 allocate (caux(this%naux))
1252 allocate (nboundchk(this%ncv))
1258 call this%parser%GetBlock(
'PACKAGEDATA', isfound, ierr, &
1259 supportopenclose=.true.)
1263 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1268 call this%parser%GetNextLine(endofblock)
1269 if (endofblock)
exit
1270 n = this%parser%GetInteger()
1272 if (n < 1 .or. n > this%ncv)
then
1273 write (
errmsg,
'(a,1x,i6)') &
1274 'Itemno must be > 0 and <= ', this%ncv
1280 nboundchk(n) = nboundchk(n) + 1
1283 this%strt(n) = this%parser%GetDouble()
1286 this%ktf(n) = this%parser%GetDouble()
1287 this%rfeatthk(n) = this%parser%GetDouble()
1288 if (this%rfeatthk(n) <=
dzero)
then
1289 write (
errmsg,
'(4x,a)') &
1290 '****ERROR. Specified thickness used for thermal &
1291 &conduction MUST BE > 0 else divide by zero error occurs'
1297 do iaux = 1, this%naux
1298 call this%parser%GetString(caux(iaux))
1302 write (cno,
'(i9.9)') n
1303 bndname =
'Feature'//cno
1306 if (this%inamedbound /= 0)
then
1307 call this%parser%GetStringCaps(bndnametemp)
1308 if (bndnametemp /=
'')
then
1309 bndname = bndnametemp
1312 this%featname(n) = bndname
1316 do jj = 1, this%naux
1319 bndelem => this%lauxvar(jj, ii)
1321 this%packName,
'AUX', &
1322 this%tsManager, this%iprpak, &
1331 if (nboundchk(n) == 0)
then
1332 write (
errmsg,
'(a,1x,i0)')
'No data specified for feature', n
1334 else if (nboundchk(n) > 1)
then
1335 write (
errmsg,
'(a,1x,i0,1x,a,1x,i0,1x,a)') &
1336 'Data for feature', n,
'specified', nboundchk(n),
'times'
1341 write (this%iout,
'(1x,a)') &
1342 'END OF '//trim(adjustl(this%text))//
' PACKAGEDATA'
1344 call store_error(
'Required packagedata block not found.')
1349 call this%parser%StoreErrorUnit()
1353 if (this%naux > 0)
then
1358 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 lke_rain_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Rain term.
subroutine lke_read_cvs(this)
Read feature information for this advanced package.
subroutine lke_iflw_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Inflow Term.
subroutine lke_roff_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Runoff term.
character(len= *), parameter ftype
subroutine lke_solve(this)
Add terms specific to lakes to the explicit lake solve.
subroutine lke_outf_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Outflow term.
subroutine lke_setup_budobj(this, idx)
Set up the budget object that stores all the lake flows.
subroutine lke_wdrl_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Specified withdrawal term.
subroutine lke_bd_obs(this, obstypeid, jj, v, found)
Calculate observation value and pass it back to APT.
subroutine lke_allocate_arrays(this)
Allocate arrays specific to the lake energy transport (LKE) package.
subroutine allocate_scalars(this)
Allocate scalars specific to the lake energy transport (LKE) package.
subroutine lke_set_stressperiod(this, itemno, keyword, found)
Sets the stress period attributes for keyword use.
subroutine lke_fill_budobj(this, idx, x, flowja, ccratin, ccratout)
Copy flow terms into thisbudobj.
subroutine, public lke_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, fmi, eqnsclfac, gwecommon, dvt, dvu, dvua)
Create a new lke package.
subroutine find_lke_package(this)
Find corresponding lke package.
subroutine lke_rp_obs(this, obsrv, found)
Process package specific obs.
subroutine lke_fc_expanded(this, rhs, ia, idxglo, matrix_sln)
Add matrix terms related to LKE.
character(len= *), parameter flowtype
subroutine lke_evap_term(this, ientry, n1, n2, rrate, rhsval, hcofval)
Evaporative term.
subroutine lke_df_obs(this)
Defined observation types.
integer(i4b) function lke_get_nbudterms(this)
Function to return the number of budget terms just for this package.
subroutine lke_da(this)
Deallocate memory.
This module defines variable data types.
This module contains the derived types ObserveType and ObsDataType.
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.