51 integer(I4B),
pointer :: inic => null()
52 integer(I4B),
pointer :: inoc => null()
53 integer(I4B),
pointer :: innpf => null()
54 integer(I4B),
pointer :: inbuy => null()
55 integer(I4B),
pointer :: invsc => null()
56 integer(I4B),
pointer :: insto => null()
57 integer(I4B),
pointer :: incsub => null()
58 integer(I4B),
pointer :: inmvr => null()
59 integer(I4B),
pointer :: inhfb => null()
60 integer(I4B),
pointer :: ingnc => null()
61 integer(I4B),
pointer :: inobs => null()
62 integer(I4B),
pointer :: iss => null()
63 integer(I4B),
pointer :: inewtonur => null()
107 character(len=LENPACKAGETYPE),
dimension(GWF_NBASEPKG) ::
gwf_basepkg
108 data gwf_basepkg/
'DIS6 ',
'DISV6',
'DISU6',
' ',
' ', &
109 &
'NPF6 ',
'BUY6 ',
'VSC6 ',
'GNC6 ',
' ', &
110 &
'HFB6 ',
'STO6 ',
'IC6 ',
' ',
' ', &
111 &
'MVR6 ',
'OC6 ',
'OBS6 ',
' ',
' ', &
120 character(len=LENPACKAGETYPE),
dimension(GWF_NMULTIPKG) ::
gwf_multipkg
121 data gwf_multipkg/
'WEL6 ',
'DRN6 ',
'RIV6 ',
'GHB6 ',
' ', &
122 &
'RCH6 ',
'EVT6 ',
'CHD6 ',
'CSUB6',
' ', &
123 &
'MAW6 ',
'SFR6 ',
'LAK6 ',
'UZF6 ',
'API6 ', &
137 subroutine gwf_cr(filename, id, modelname)
148 character(len=*),
intent(in) :: filename
149 integer(I4B),
intent(in) :: id
150 character(len=*),
intent(in) :: modelname
154 character(len=LENMEMPATH) :: input_mempath
155 character(len=LINELENGTH) :: lst_fname
165 call this%allocate_scalars(modelname)
170 this%filename = filename
171 this%name = modelname
172 this%macronym =
'GWF'
179 call mem_set_value(lst_fname,
'LIST', input_mempath, found%list)
180 call mem_set_value(this%inewton,
'NEWTON', input_mempath, found%newton)
181 call mem_set_value(this%inewtonur,
'UNDER_RELAXATION', input_mempath, &
182 found%under_relaxation)
183 call mem_set_value(this%iprpak,
'PRINT_INPUT', input_mempath, &
185 call mem_set_value(this%iprflow,
'PRINT_FLOWS', input_mempath, &
187 call mem_set_value(this%ipakcb,
'SAVE_FLOWS', input_mempath, found%save_flows)
190 call this%create_lstfile(lst_fname, filename, found%list, &
191 'GROUNDWATER FLOW MODEL (GWF)')
194 if (found%save_flows)
then
199 if (this%iout > 0)
then
200 call this%log_namfile_options(found)
207 call this%create_packages()
225 class(
bndtype),
pointer :: packobj
228 call this%dis%dis_df()
229 call this%npf%npf_df(this%dis, this%xt3d, this%ingnc, this%invsc)
231 call this%budget%budget_df(
niunit_gwf,
'VOLUME',
'L**3')
232 if (this%inbuy > 0)
call this%buy%buy_df(this%dis)
233 if (this%invsc > 0)
call this%vsc%vsc_df(this%dis)
234 if (this%ingnc > 0)
call this%gnc%gnc_df(this)
238 this%neq = this%dis%nodes
239 this%nja = this%dis%nja
240 this%ia => this%dis%con%ia
241 this%ja => this%dis%con%ja
244 call this%allocate_arrays()
247 do ip = 1, this%bndlist%Count()
249 call packobj%bnd_df(this%neq, this%dis)
253 call this%obs%obs_df(this%iout, this%name,
'GWF', this%dis)
267 class(
bndtype),
pointer :: packobj
271 call this%dis%dis_ac(this%moffset, sparse)
274 if (this%innpf > 0)
call this%npf%npf_ac(this%moffset, sparse)
277 do ip = 1, this%bndlist%Count()
279 call packobj%bnd_ac(this%moffset, sparse)
283 if (this%ingnc > 0)
call this%gnc%gnc_ac(sparse)
297 class(
bndtype),
pointer :: packobj
302 call this%dis%dis_mc(this%moffset, this%idxglo, matrix_sln)
305 if (this%innpf > 0)
call this%npf%npf_mc(this%moffset, matrix_sln)
308 do ip = 1, this%bndlist%Count()
310 call packobj%bnd_mc(this%moffset, matrix_sln)
315 if (this%ingnc > 0)
call this%gnc%gnc_mc(matrix_sln)
332 class(
bndtype),
pointer :: packobj
335 if (this%inic > 0)
call this%ic%ic_ar(this%x)
336 if (this%innpf > 0)
call this%npf%npf_ar(this%ic, this%vsc, this%ibound, &
338 if (this%invsc > 0)
call this%vsc%vsc_ar(this%ibound)
339 if (this%inbuy > 0)
call this%buy%buy_ar(this%npf, this%ibound)
340 if (this%inhfb > 0)
call this%hfb%hfb_ar(this%ibound, this%xt3d, this%dis, &
341 this%invsc, this%vsc)
342 if (this%insto > 0)
call this%sto%sto_ar(this%dis, this%ibound)
343 if (this%incsub > 0)
call this%csub%csub_ar(this%dis, this%ibound)
344 if (this%inmvr > 0)
call this%mvr%mvr_ar()
345 if (this%inobs > 0)
call this%obs%gwf_obs_ar(this%ic, this%x, this%flowja)
348 call this%dis%dis_ar(this%npf%icelltype)
351 call this%oc%oc_ar(this%x, this%dis, this%npf%hnoflo)
352 call this%budget%set_ibudcsv(this%oc%ibudcsv)
355 do ip = 1, this%bndlist%Count()
357 call packobj%set_pointers(this%dis%nodes, this%ibound, this%x, &
358 this%xold, this%flowja)
360 call packobj%bnd_ar()
361 if (this%inbuy > 0)
call this%buy%buy_ar_bnd(packobj, this%x)
362 if (this%invsc > 0)
call this%vsc%vsc_ar_bnd(packobj)
380 class(
bndtype),
pointer :: packobj
387 if (this%innpf > 0)
call this%npf%npf_rp()
388 if (this%inbuy > 0)
call this%buy%buy_rp()
389 if (this%invsc > 0)
call this%vsc%vsc_rp()
390 if (this%inhfb > 0)
call this%hfb%hfb_rp()
391 if (this%inoc > 0)
call this%oc%oc_rp()
392 if (this%insto > 0)
call this%sto%sto_rp()
393 if (this%incsub > 0)
call this%csub%csub_rp()
394 if (this%inmvr > 0)
call this%mvr%mvr_rp()
395 do ip = 1, this%bndlist%Count()
397 call packobj%bnd_rp()
398 call packobj%bnd_rp_obs()
402 call this%steady_period_check()
418 class(
bndtype),
pointer :: packobj
420 integer(I4B) :: irestore
421 integer(I4B) :: ip, n
426 if (irestore == 0)
then
429 do n = 1, this%dis%nodes
430 this%xold(n) = this%x(n)
435 do n = 1, this%dis%nodes
436 this%x(n) = this%xold(n)
441 if (this%invsc > 0)
call this%vsc%vsc_ad()
442 if (this%innpf > 0)
call this%npf%npf_ad(this%dis%nodes, this%xold, &
444 if (this%insto > 0)
call this%sto%sto_ad()
445 if (this%incsub > 0)
call this%csub%csub_ad(this%dis%nodes, this%x)
446 if (this%inbuy > 0)
call this%buy%buy_ad()
447 if (this%inmvr > 0)
call this%mvr%mvr_ad()
448 do ip = 1, this%bndlist%Count()
450 call packobj%bnd_ad()
451 if (this%invsc > 0)
call this%vsc%vsc_ad_bnd(packobj, this%x)
453 call packobj%bnd_ck()
458 call this%obs%obs_ad()
468 integer(I4B),
intent(in) :: kiter
470 class(
bndtype),
pointer :: packobj
474 if (this%innpf > 0)
call this%npf%npf_cf(kiter, this%dis%nodes, this%x)
475 if (this%inbuy > 0)
call this%buy%buy_cf(kiter)
476 do ip = 1, this%bndlist%Count()
478 call packobj%bnd_cf()
479 if (this%inbuy > 0)
call this%buy%buy_cf_bnd(packobj, this%x)
487 subroutine gwf_fc(this, kiter, matrix_sln, inwtflag)
490 integer(I4B),
intent(in) :: kiter
492 integer(I4B),
intent(in) :: inwtflag
494 class(
bndtype),
pointer :: packobj
496 integer(I4B) :: inwt, inwtsto, inwtcsub, inwtpak
500 if (inwtflag == 1) inwt = this%npf%inewton
502 if (this%insto > 0)
then
503 if (inwtflag == 1) inwtsto = this%sto%inewton
506 if (this%incsub > 0)
then
507 if (inwtflag == 1) inwtcsub = this%csub%inewton
511 if (this%innpf > 0)
call this%npf%npf_fc(kiter, matrix_sln, this%idxglo, &
513 if (this%inbuy > 0)
call this%buy%buy_fc(kiter, matrix_sln, this%idxglo, &
515 if (this%inhfb > 0)
call this%hfb%hfb_fc(kiter, matrix_sln, this%idxglo, &
517 if (this%ingnc > 0)
call this%gnc%gnc_fc(kiter, matrix_sln)
519 if (this%insto > 0)
then
520 call this%sto%sto_fc(kiter, this%xold, this%x, matrix_sln, &
521 this%idxglo, this%rhs)
524 if (this%incsub > 0)
then
525 call this%csub%csub_fc(kiter, this%xold, this%x, matrix_sln, &
526 this%idxglo, this%rhs)
528 if (this%inmvr > 0)
call this%mvr%mvr_fc()
529 do ip = 1, this%bndlist%Count()
531 call packobj%bnd_fc(this%rhs, this%ia, this%idxglo, matrix_sln)
535 if (this%innpf > 0)
then
537 call this%npf%npf_fn(kiter, matrix_sln, this%idxglo, this%rhs, this%x)
542 if (this%ingnc > 0)
then
544 call this%gnc%gnc_fn(kiter, matrix_sln, this%npf%condsat, &
545 ivarcv_opt=this%npf%ivarcv, &
546 ictm1_opt=this%npf%icelltype, &
547 ictm2_opt=this%npf%icelltype)
552 if (this%insto > 0)
then
553 if (inwtsto /= 0)
then
554 call this%sto%sto_fn(kiter, this%xold, this%x, matrix_sln, &
555 this%idxglo, this%rhs)
560 if (this%incsub > 0)
then
561 if (inwtcsub /= 0)
then
562 call this%csub%csub_fn(kiter, this%xold, this%x, matrix_sln, &
563 this%idxglo, this%rhs)
568 do ip = 1, this%bndlist%Count()
571 if (inwtflag == 1) inwtpak = packobj%inewton
572 if (inwtpak /= 0)
then
573 call packobj%bnd_fn(this%rhs, this%ia, this%idxglo, matrix_sln)
586 subroutine gwf_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
589 integer(I4B),
intent(in) :: innertot
590 integer(I4B),
intent(in) :: kiter
591 integer(I4B),
intent(in) :: iend
592 integer(I4B),
intent(in) :: icnvgmod
593 character(len=LENPAKLOC),
intent(inout) :: cpak
594 integer(I4B),
intent(inout) :: ipak
595 real(DP),
intent(inout) :: dpak
597 class(
bndtype),
pointer :: packobj
602 if (this%inmvr > 0)
then
603 call this%mvr%mvr_cc(innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
607 if (this%incsub > 0)
then
608 call this%csub%csub_cc(innertot, kiter, iend, icnvgmod, &
609 this%dis%nodes, this%x, this%xold, &
614 do ip = 1, this%bndlist%Count()
616 call packobj%bnd_cc(innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
631 integer(I4B),
intent(inout) :: iptc
637 if (this%iss > 0)
then
638 if (this%inewton > 0)
then
641 iptc = this%npf%inewton
655 subroutine gwf_ptc(this, vec_residual, iptc, ptcf)
662 integer(I4B),
intent(inout) :: iptc
663 real(DP),
intent(inout) :: ptcf
666 integer(I4B) :: iptct
669 real(DP) :: ptcdelem1
676 if (this%iss > 0)
then
677 if (this%inewton > 0)
then
680 iptct = this%npf%inewton
688 do n = 1, this%dis%nodes
689 if (this%npf%ibound(n) < 1) cycle
692 v = this%dis%get_cell_volume(n, this%dis%top(n))
695 resid = vec_residual%get_value_local(n)
699 ptcdelem1 = abs(resid) / v
704 if (ptcdelem1 > ptcf) ptcf = ptcdelem1
708 if (ptcf == dzero)
then
715 if (iptct > 0) iptc = 1
729 subroutine gwf_nur(this, neqmod, x, xtemp, dx, inewtonur, dxmax, locmax)
734 integer(I4B),
intent(in) :: neqmod
735 real(DP),
dimension(neqmod),
intent(inout) :: x
736 real(DP),
dimension(neqmod),
intent(in) :: xtemp
737 real(DP),
dimension(neqmod),
intent(inout) :: dx
738 integer(I4B),
intent(inout) :: inewtonur
739 real(DP),
intent(inout) :: dxmax
740 integer(I4B),
intent(inout) :: locmax
744 class(
bndtype),
pointer :: packobj
750 if (this%inewton /= 0 .and. this%inewtonur /= 0)
then
751 if (this%innpf > 0)
then
752 call this%npf%npf_nur(neqmod, x, xtemp, dx, inewtonur, dxmax, locmax)
756 i0 = this%dis%nodes + 1
757 do ip = 1, this%bndlist%Count()
759 if (packobj%npakeq > 0)
then
760 i1 = i0 + packobj%npakeq - 1
761 call packobj%bnd_nur(packobj%npakeq, x(i0:i1), xtemp(i0:i1), &
762 dx(i0:i1), inewtonur, dxmax, locmax)
777 subroutine gwf_cq(this, icnvg, isuppress_output)
781 integer(I4B),
intent(in) :: icnvg
782 integer(I4B),
intent(in) :: isuppress_output
786 class(
bndtype),
pointer :: packobj
794 this%flowja(i) =
dzero
796 if (this%innpf > 0)
call this%npf%npf_cq(this%x, this%flowja)
797 if (this%inbuy > 0)
call this%buy%buy_cq(this%x, this%flowja)
798 if (this%inhfb > 0)
call this%hfb%hfb_cq(this%x, this%flowja)
799 if (this%ingnc > 0)
call this%gnc%gnc_cq(this%flowja)
800 if (this%insto > 0)
call this%sto%sto_cq(this%flowja, this%x, this%xold)
801 if (this%incsub > 0)
call this%csub%csub_cq(this%dis%nodes, this%x, &
802 this%xold, isuppress_output, &
808 do ip = 1, this%bndlist%Count()
810 call packobj%bnd_cf()
811 if (this%inbuy > 0)
call this%buy%buy_cf_bnd(packobj, this%x)
812 call packobj%bnd_cq(this%x, this%flowja)
824 subroutine gwf_bd(this, icnvg, isuppress_output)
829 integer(I4B),
intent(in) :: icnvg
830 integer(I4B),
intent(in) :: isuppress_output
833 class(
bndtype),
pointer :: packobj
847 call this%budget%reset()
848 if (this%insto > 0)
call this%sto%sto_bd(isuppress_output, this%budget)
849 if (this%incsub > 0)
call this%csub%csub_bd(isuppress_output, this%budget)
850 if (this%inmvr > 0)
call this%mvr%mvr_bd()
851 do ip = 1, this%bndlist%Count()
853 call packobj%bnd_bd(this%budget)
858 if (this%innpf > 0)
then
859 if (this%npf%icalcspdis /= 0)
then
860 call this%npf%calc_spdis(this%flowja)
875 integer(I4B) :: idvsave
876 integer(I4B) :: idvprint
877 integer(I4B) :: icbcfl
878 integer(I4B) :: icbcun
879 integer(I4B) :: ibudfl
880 integer(I4B) :: ipflag
882 character(len=*),
parameter :: fmtnocnvg = &
883 "(1X,/9X,'****FAILED TO MEET SOLVER CONVERGENCE CRITERIA IN TIME STEP ', &
884 &I0,' OF STRESS PERIOD ',I0,'****')"
891 if (this%oc%oc_save(
'HEAD')) idvsave = 1
892 if (this%oc%oc_print(
'HEAD')) idvprint = 1
893 if (this%oc%oc_save(
'BUDGET')) icbcfl = 1
894 if (this%oc%oc_print(
'BUDGET')) ibudfl = 1
895 icbcun = this%oc%oc_save_unit(
'BUDGET')
899 ibudfl = this%oc%set_print_flag(
'BUDGET', this%icnvg,
endofperiod)
900 idvprint = this%oc%set_print_flag(
'HEAD', this%icnvg,
endofperiod)
903 call this%gwf_ot_obs()
906 call this%gwf_ot_flow(icbcfl, ibudfl, icbcun)
909 call this%gwf_ot_dv(idvsave, idvprint, ipflag)
912 call this%gwf_ot_bdsummary(ibudfl, ipflag)
916 if (ipflag == 1)
call tdis_ot(this%iout)
919 if (this%icnvg == 0)
then
920 write (this%iout, fmtnocnvg)
kstp,
kper
929 class(
bndtype),
pointer :: packobj
933 call this%obs%obs_bd()
934 call this%obs%obs_ot()
937 if (this%incsub > 0)
then
938 call this%csub%csub_bd_obs()
939 call this%csub%obs%obs_ot()
943 do ip = 1, this%bndlist%Count()
945 call packobj%bnd_bd_obs()
946 call packobj%bnd_ot_obs()
953 integer(I4B),
intent(in) :: icbcfl
954 integer(I4B),
intent(in) :: ibudfl
955 integer(I4B),
intent(in) :: icbcun
956 class(
bndtype),
pointer :: packobj
960 if (this%insto > 0)
then
961 call this%sto%sto_save_model_flows(icbcfl, icbcun)
963 if (this%innpf > 0)
then
964 call this%npf%npf_save_model_flows(this%flowja, icbcfl, icbcun)
966 if (this%incsub > 0)
call this%csub%csub_save_model_flows(icbcfl, icbcun)
967 do ip = 1, this%bndlist%Count()
969 call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=0, icbcun=icbcun)
973 do ip = 1, this%bndlist%Count()
975 call packobj%bnd_ot_package_flows(icbcfl=icbcfl, ibudfl=0)
977 if (this%inmvr > 0)
then
978 call this%mvr%mvr_ot_saveflow(icbcfl, ibudfl)
982 if (this%innpf > 0)
call this%npf%npf_print_model_flows(ibudfl, this%flowja)
983 if (this%ingnc > 0)
call this%gnc%gnc_ot(ibudfl)
984 do ip = 1, this%bndlist%Count()
986 call packobj%bnd_ot_model_flows(icbcfl=icbcfl, ibudfl=ibudfl, icbcun=0)
990 do ip = 1, this%bndlist%Count()
992 call packobj%bnd_ot_package_flows(icbcfl=0, ibudfl=ibudfl)
994 if (this%inmvr > 0)
then
995 call this%mvr%mvr_ot_printflow(icbcfl, ibudfl)
1002 integer(I4B),
intent(in) :: idvsave
1003 integer(I4B),
intent(in) :: idvprint
1004 integer(I4B),
intent(inout) :: ipflag
1005 class(
bndtype),
pointer :: packobj
1009 if (this%incsub > 0)
call this%csub%csub_ot_dv(idvsave, idvprint)
1012 if (this%inbuy > 0)
then
1013 call this%buy%buy_ot_dv(idvsave)
1017 if (this%invsc > 0)
then
1018 call this%vsc%vsc_ot_dv(idvsave)
1022 do ip = 1, this%bndlist%Count()
1024 call packobj%bnd_ot_dv(idvsave, idvprint)
1028 call this%oc%oc_ot(ipflag)
1037 integer(I4B),
intent(in) :: ibudfl
1038 integer(I4B),
intent(inout) :: ipflag
1039 class(
bndtype),
pointer :: packobj
1044 do ip = 1, this%bndlist%Count()
1046 call packobj%bnd_ot_bdsummary(
kstp,
kper, this%iout, ibudfl)
1050 if (this%inmvr > 0)
then
1051 call this%mvr%mvr_ot_bdsummary(ibudfl)
1055 call this%budget%finalize_step(
delt)
1056 if (ibudfl /= 0)
then
1058 call this%budget%budget_ot(
kstp,
kper, this%iout)
1062 call this%budget%writecsv(
totim)
1074 if (this%incsub > 0)
then
1075 call this%csub%csub_fp()
1091 class(
bndtype),
pointer :: packobj
1098 call this%dis%dis_da()
1099 call this%ic%ic_da()
1100 call this%npf%npf_da()
1101 call this%xt3d%xt3d_da()
1102 call this%buy%buy_da()
1103 call this%vsc%vsc_da()
1104 call this%gnc%gnc_da()
1105 call this%sto%sto_da()
1106 call this%csub%csub_da()
1107 call this%budget%budget_da()
1108 call this%hfb%hfb_da()
1109 call this%mvr%mvr_da()
1110 call this%oc%oc_da()
1111 call this%obs%obs_da()
1114 deallocate (this%dis)
1115 deallocate (this%ic)
1116 deallocate (this%npf)
1117 deallocate (this%xt3d)
1118 deallocate (this%buy)
1119 deallocate (this%vsc)
1120 deallocate (this%gnc)
1121 deallocate (this%sto)
1122 deallocate (this%csub)
1123 deallocate (this%budget)
1124 deallocate (this%hfb)
1125 deallocate (this%mvr)
1126 deallocate (this%obs)
1127 deallocate (this%oc)
1130 do ip = 1, this%bndlist%Count()
1132 call packobj%bnd_da()
1133 deallocate (packobj)
1152 call this%NumericalModelType%model_da()
1172 real(DP),
dimension(:, :),
intent(in) :: budterm
1173 character(len=LENBUDTXT),
dimension(:),
intent(in) :: budtxt
1174 character(len=*),
intent(in) :: rowlabel
1176 call this%budget%addentry(budterm,
delt, budtxt, rowlabel=rowlabel)
1188 integer(I4B) :: iasym
1190 class(
bndtype),
pointer :: packobj
1196 if (this%innpf > 0)
then
1197 if (this%npf%iasym /= 0) iasym = 1
1198 if (this%npf%ixt3d /= 0) iasym = 1
1202 if (this%ingnc > 0)
then
1203 if (this%gnc%iasym /= 0) iasym = 1
1207 do ip = 1, this%bndlist%Count()
1209 if (packobj%iasym /= 0) iasym = 1
1222 character(len=*),
intent(in) :: modelname
1225 call this%NumericalModelType%allocate_scalars(modelname)
1230 call mem_allocate(this%innpf,
'INNPF', this%memoryPath)
1231 call mem_allocate(this%inbuy,
'INBUY', this%memoryPath)
1232 call mem_allocate(this%invsc,
'INVSC', this%memoryPath)
1233 call mem_allocate(this%insto,
'INSTO', this%memoryPath)
1234 call mem_allocate(this%incsub,
'INCSUB', this%memoryPath)
1235 call mem_allocate(this%inmvr,
'INMVR', this%memoryPath)
1236 call mem_allocate(this%inhfb,
'INHFB', this%memoryPath)
1237 call mem_allocate(this%ingnc,
'INGNC', this%memoryPath)
1238 call mem_allocate(this%inobs,
'INOBS', this%memoryPath)
1240 call mem_allocate(this%inewtonur,
'INEWTONUR', this%memoryPath)
1285 character(len=*),
intent(in) :: filtyp
1286 integer(I4B),
intent(in) :: ipakid
1287 integer(I4B),
intent(in) :: ipaknum
1288 character(len=*),
intent(in) :: pakname
1289 character(len=*),
intent(in) :: mempath
1290 integer(I4B),
intent(in) :: inunit
1291 integer(I4B),
intent(in) :: iout
1293 class(
bndtype),
pointer :: packobj
1294 class(
bndtype),
pointer :: packobj2
1298 select case (filtyp)
1300 call chd_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
1303 call wel_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
1306 call drn_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
1309 call riv_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
1312 call ghb_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
1315 call rch_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
1318 call evt_create(packobj, ipakid, ipaknum, inunit, iout, this%name, &
1321 call maw_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
1323 call sfr_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
1325 call lak_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
1327 call uzf_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
1329 call api_create(packobj, ipakid, ipaknum, inunit, iout, this%name, pakname)
1331 write (
errmsg, *)
'Invalid package type: ', filtyp
1337 do ip = 1, this%bndlist%Count()
1339 if (packobj2%packName == pakname)
then
1340 write (
errmsg,
'(a,a)')
'Cannot create package. Package name '// &
1341 'already exists: ', trim(pakname)
1358 integer(I4B),
intent(in) :: indis
1362 if (this%inic == 0)
then
1364 'Initial Conditions (IC6) package not specified.'
1367 if (indis == 0)
then
1369 'Discretization (DIS6, DISV6, or DISU6) Package not specified.'
1372 if (this%innpf == 0)
then
1374 'Node Property Flow (NPF6) Package not specified.'
1379 write (
errmsg,
'(a)')
'One or more required package(s) not specified.'
1381 call store_error_filename(this%filename)
1392 class(*),
pointer,
intent(inout) :: model
1396 if (.not.
associated(model))
return
1414 integer(I4B),
dimension(:),
allocatable,
intent(inout) :: bndpkgs
1416 pointer,
intent(inout) :: pkgtypes
1418 pointer,
intent(inout) :: pkgnames
1420 pointer,
intent(inout) :: mempaths
1421 integer(I4B),
dimension(:),
contiguous, &
1422 pointer,
intent(inout) :: inunits
1424 integer(I4B) :: ipakid, ipaknum
1425 character(len=LENFTYPE) :: pkgtype, bndptype
1426 character(len=LENPACKAGENAME) :: pkgname
1427 character(len=LENMEMPATH) :: mempath
1428 integer(I4B),
pointer :: inunit
1431 if (
allocated(bndpkgs))
then
1436 do n = 1,
size(bndpkgs)
1438 pkgtype = pkgtypes(bndpkgs(n))
1439 pkgname = pkgnames(bndpkgs(n))
1440 mempath = mempaths(bndpkgs(n))
1441 inunit => inunits(bndpkgs(n))
1443 if (bndptype /= pkgtype)
then
1448 call this%package_create(pkgtype, ipakid, ipaknum, pkgname, mempath, &
1451 ipaknum = ipaknum + 1
1455 deallocate (bndpkgs)
1489 pointer :: pkgtypes => null()
1491 pointer :: pkgnames => null()
1493 pointer :: mempaths => null()
1494 integer(I4B),
dimension(:),
contiguous, &
1495 pointer :: inunits => null()
1496 character(len=LENMEMPATH) :: model_mempath
1497 character(len=LENFTYPE) :: pkgtype
1498 character(len=LENPACKAGENAME) :: pkgname
1499 character(len=LENMEMPATH) :: mempath
1500 integer(I4B),
pointer :: inunit
1501 integer(I4B),
dimension(:),
allocatable :: bndpkgs
1503 integer(I4B) :: indis = 0
1504 character(len=LENMEMPATH) :: mempathnpf =
''
1505 character(len=LENMEMPATH) :: mempathic =
''
1511 call mem_setptr(pkgtypes,
'PKGTYPES', model_mempath)
1512 call mem_setptr(pkgnames,
'PKGNAMES', model_mempath)
1513 call mem_setptr(mempaths,
'MEMPATHS', model_mempath)
1514 call mem_setptr(inunits,
'INUNITS', model_mempath)
1516 do n = 1,
size(pkgtypes)
1519 pkgtype = pkgtypes(n)
1520 pkgname = pkgnames(n)
1521 mempath = mempaths(n)
1522 inunit => inunits(n)
1525 select case (pkgtype)
1528 call dis_cr(this%dis, this%name, mempath, indis, this%iout)
1531 call disv_cr(this%dis, this%name, mempath, indis, this%iout)
1534 call disu_cr(this%dis, this%name, mempath, indis, this%iout)
1537 mempathnpf = mempath
1549 this%incsub = inunit
1559 case (
'WEL6',
'DRN6',
'RIV6',
'GHB6',
'RCH6', &
1560 'EVT6',
'API6',
'CHD6',
'MAW6',
'SFR6', &
1563 bndpkgs(
size(bndpkgs)) = n
1570 call npf_cr(this%npf, this%name, mempathnpf, this%innpf, this%iout)
1571 call xt3d_cr(this%xt3d, this%name, this%innpf, this%iout)
1572 call buy_cr(this%buy, this%name, this%inbuy, this%iout)
1573 call vsc_cr(this%vsc, this%name, this%invsc, this%iout)
1574 call gnc_cr(this%gnc, this%name, this%ingnc, this%iout)
1575 call hfb_cr(this%hfb, this%name, this%inhfb, this%iout)
1576 call sto_cr(this%sto, this%name, this%insto, this%iout)
1577 call csub_cr(this%csub, this%name, this%insto, this%sto%packName, &
1578 this%incsub, this%iout)
1579 call ic_cr(this%ic, this%name, mempathic, this%inic, this%iout, this%dis)
1580 call mvr_cr(this%mvr, this%name, this%inmvr, this%iout, this%dis)
1581 call oc_cr(this%oc, this%name, this%inoc, this%iout)
1585 call this%ftype_check(indis)
1587 call this%create_bndpkgs(bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
1600 write (this%iout,
'(1x,a)')
'NAMEFILE OPTIONS:'
1602 if (found%newton)
then
1603 write (this%iout,
'(4x,a)') &
1604 'NEWTON-RAPHSON method enabled for the model.'
1605 if (found%under_relaxation)
then
1606 write (this%iout,
'(4x,a,a)') &
1607 'NEWTON-RAPHSON UNDER-RELAXATION based on the bottom ', &
1608 'elevation of the model will be applied to the model.'
1612 if (found%print_input)
then
1613 write (this%iout,
'(4x,a)')
'STRESS PACKAGE INPUT WILL BE PRINTED '// &
1614 'FOR ALL MODEL STRESS PACKAGES'
1617 if (found%print_flows)
then
1618 write (this%iout,
'(4x,a)')
'PACKAGE FLOWS WILL BE PRINTED '// &
1619 'FOR ALL MODEL PACKAGES'
1622 if (found%save_flows)
then
1623 write (this%iout,
'(4x,a)') &
1624 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL'
1627 write (this%iout,
'(1x,a)')
'END NAMEFILE OPTIONS:'
1645 if (this%iss == 1)
then
1647 write (
warnmsg,
'(a,a,a,i0,a)') &
1648 'GWF Model (', trim(this%name),
') is steady state for period ', &
1649 kper,
' and adaptive time stepping is active. Adaptive time &
1650 &stepping may not work properly for steady-state conditions.'
logical(lgp) function, public isadaptiveperiod(kper)
@ brief Determine if period is adaptive
This module contains the API package methods.
subroutine, public api_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
@ brief Create a new package object
subroutine, public addbasemodeltolist(list, model)
This module contains the base boundary package.
subroutine, public addbndtolist(list, bnd)
Add boundary to package list.
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
This module contains the BudgetModule.
subroutine, public budget_cr(this, name_model)
@ brief Create a new budget object
subroutine, public chd_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a new constant head package.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenpackagename
maximum length of the package name
real(dp), parameter dp9
real constant 9/10
integer(i4b), parameter lenpackagetype
maximum length of a package type (DIS6, SFR6, CSUB6, etc.)
integer(i4b), parameter lenpakloc
maximum length of a package location
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
real(dp), parameter dzero
real constant zero
real(dp), parameter dten
real constant 10
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
integer(i4b), parameter lenmempath
maximum length of the memory path
real(dp), parameter done
real constant 1
subroutine, public dis_cr(dis, name_model, input_mempath, inunit, iout)
Create a new structured discretization object.
subroutine, public disu_cr(dis, name_model, input_mempath, inunit, iout)
Create a new unstructured discretization object.
subroutine, public disv_cr(dis, name_model, input_mempath, inunit, iout)
Create a new discretization by vertices object.
subroutine, public drn_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a New Drn Package and point packobj to the new package.
subroutine, public evt_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a new Evapotranspiration Segments Package and point pakobj to the new package.
subroutine, public ghb_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a New Ghb Package and point bndobj to the new package.
subroutine, public gnc_cr(gncobj, name_parent, inunit, iout)
Create new GNC exchange object.
subroutine, public buy_cr(buyobj, name_model, inunit, iout)
Create a new BUY object.
This module contains the CSUB package methods.
subroutine, public csub_cr(csubobj, name_model, istounit, stoPckName, inunit, iout)
@ brief Create a new package object
subroutine, public hfb_cr(hfbobj, name_model, inunit, iout)
Create a new hfb object.
subroutine, public ic_cr(ic, name_model, input_mempath, inunit, iout, dis)
Create a new initial conditions object.
subroutine gwf_df(this)
Define packages of the model.
subroutine, public gwf_cr(filename, id, modelname)
Create a new groundwater flow model object.
subroutine gwf_ptcchk(this, iptc)
check if pseudo-transient continuation factor should be used
subroutine log_namfile_options(this, found)
Write model namfile options to list file.
subroutine gwf_ptc(this, vec_residual, iptc, ptcf)
calculate maximum pseudo-transient continuation factor
subroutine allocate_scalars(this, modelname)
Allocate memory for non-allocatable members.
subroutine gwf_ot_flow(this, icbcfl, ibudfl, icbcun)
integer(i4b) function gwf_get_iasym(this)
return 1 if any package causes the matrix to be asymmetric. Otherwise return 0.
subroutine gwf_da(this)
Deallocate.
subroutine create_packages(this)
Source package info and begin to process.
subroutine gwf_mc(this, matrix_sln)
Map the positions of this models connections in the numerical solution coefficient matrix.
subroutine gwf_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
GroundWater Flow Model Final Convergence Check for Boundary Packages.
subroutine gwf_rp(this)
GroundWater Flow Model Read and Prepare.
subroutine steady_period_check(this)
Check for steady state period.
class(gwfmodeltype) function, pointer, public castasgwfmodel(model)
Cast to GWF model.
subroutine package_create(this, filtyp, ipakid, ipaknum, pakname, mempath, inunit, iout)
Create boundary condition packages for this model.
subroutine gwf_ot_dv(this, idvsave, idvprint, ipflag)
integer(i4b), parameter, public gwf_nmultipkg
GWF multi package array descriptors.
subroutine create_bndpkgs(this, bndpkgs, pkgtypes, pkgnames, mempaths, inunits)
Source package info and begin to process.
subroutine gwf_ot(this)
GroundWater Flow Model Output.
character(len=lenpackagetype), dimension(gwf_nmultipkg), public gwf_multipkg
subroutine gwf_cf(this, kiter)
GroundWater Flow Model calculate coefficients.
integer(i4b), parameter niunit_gwf
subroutine gwf_ot_obs(this)
subroutine gwf_fp(this)
Final processing.
subroutine gwf_ot_bdsummary(this, ibudfl, ipflag)
subroutine gwf_ac(this, sparse)
Add the internal connections of this model to the sparse matrix.
subroutine gwf_fc(this, kiter, matrix_sln, inwtflag)
GroundWater Flow Model fill coefficients.
subroutine gwf_ar(this)
GroundWater Flow Model Allocate and Read.
subroutine gwf_bdentry(this, budterm, budtxt, rowlabel)
GroundWater Flow Model Budget Entry.
subroutine gwf_nur(this, neqmod, x, xtemp, dx, inewtonur, dxmax, locmax)
under-relaxation
subroutine gwf_ad(this)
GroundWater Flow Model Time Step Advance.
subroutine gwf_cq(this, icnvg, isuppress_output)
Groundwater flow model calculate flow.
subroutine gwf_bd(this, icnvg, isuppress_output)
GroundWater Flow Model Budget.
integer(i4b), parameter, public gwf_nbasepkg
GWF base package array descriptors.
character(len=lenpackagetype), dimension(gwf_nbasepkg), public gwf_basepkg
subroutine ftype_check(this, indis)
Check to make sure required input files have been specified.
subroutine, public mvr_cr(mvrobj, name_parent, inunit, iout, dis, iexgmvr)
Create a new mvr object.
subroutine, public npf_cr(npfobj, name_model, input_mempath, inunit, iout)
Create a new NPF object. Pass a inunit value of 0 if npf data will initialized from memory.
subroutine, public gwf_obs_cr(obs, inobs)
Create a new GwfObsType object.
subroutine, public oc_cr(ocobj, name_model, inunit, iout)
@ brief Create GwfOcType
This module contains the storage package methods.
subroutine, public sto_cr(stoobj, name_model, inunit, iout)
@ brief Create a new package object
subroutine, public vsc_cr(vscobj, name_model, inunit, iout)
@ brief Create a new package object
This module defines variable data types.
subroutine, public lak_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
Create a new LAK Package and point bndobj to the new package.
type(listtype), public basemodellist
subroutine, public maw_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
Create a New Multi-Aquifer Well (MAW) Package.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
subroutine, public memorylist_remove(component, subcomponent, context)
subroutine, public rch_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a New Recharge Package.
subroutine, public riv_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
Create a New Riv Package and point packobj to the new package.
This module contains the SFR package methods.
subroutine, public sfr_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
@ brief Create a new package object
This module contains simulation methods.
subroutine, public store_warning(msg, substring)
Store warning message.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_filename(filename, terminate)
Store the erroring file name.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
character(len=linelength) idm_context
integer(i4b) isimcheck
simulation input check flag (1) to check input, (0) to ignore checks
integer(i4b) ifailedstepretry
current retry for this time step
character(len=maxcharlen) warnmsg
warning message string
subroutine csr_diagsum(ia, flowja)
logical(lgp), pointer, public endofperiod
flag indicating end of stress period
subroutine, public tdis_ot(iout)
Print simulation time.
real(dp), pointer, public totim
time relative to start of simulation
logical(lgp), pointer, public readnewdata
flag indicating time to read new data
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
subroutine, public uzf_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname)
Create a New UZF Package and point packobj to the new package.
This module contains the WEL package methods.
subroutine, public wel_create(packobj, id, ibcnum, inunit, iout, namemodel, pakname, mempath)
@ brief Create a new package object
subroutine, public xt3d_cr(xt3dobj, name_model, inunit, iout, ldispopt)
Create a new xt3d object.
Highest level model type. All models extend this parent type.
Derived type for the Budget object.
This class is used to store a single deferred-length character string. It was designed to work in an ...
@ brief Output control for GWF