50 character(len=LENLISTLABEL),
pointer :: listlabel => null()
51 character(len=LENPACKAGENAME) :: text =
''
52 character(len=LENAUXNAME),
dimension(:),
pointer, &
53 contiguous :: auxname => null()
55 contiguous :: auxname_cst => null()
56 character(len=LENBOUNDNAME),
dimension(:),
pointer, &
57 contiguous :: boundname => null()
59 contiguous :: boundname_cst => null()
62 integer(I4B),
pointer :: isadvpak => null()
63 integer(I4B),
pointer :: ibcnum => null()
64 integer(I4B),
pointer :: maxbound => null()
65 integer(I4B),
pointer :: nbound => null()
66 integer(I4B),
pointer :: ncolbnd => null()
67 integer(I4B),
pointer :: iscloc => null()
68 integer(I4B),
pointer :: naux => null()
69 integer(I4B),
pointer :: inamedbound => null()
70 integer(I4B),
pointer :: iauxmultcol => null()
71 integer(I4B),
pointer :: npakeq => null()
72 integer(I4B),
pointer :: ioffset => null()
74 integer(I4B),
dimension(:),
pointer,
contiguous :: nodelist => null()
75 integer(I4B),
dimension(:),
pointer,
contiguous :: noupdateauxvar => null()
76 real(dp),
dimension(:, :),
pointer,
contiguous :: bound => null()
77 real(dp),
dimension(:),
pointer,
contiguous :: hcof => null()
78 real(dp),
dimension(:),
pointer,
contiguous :: rhs => null()
79 real(dp),
dimension(:, :),
pointer,
contiguous :: auxvar => null()
80 real(dp),
dimension(:),
pointer,
contiguous :: simvals => null()
81 real(dp),
dimension(:),
pointer,
contiguous :: simtomvr => null()
84 integer(I4B),
pointer :: imover => null()
88 integer(I4B),
pointer :: ivsc => null()
89 real(dp),
dimension(:),
pointer,
contiguous :: condinput => null()
94 integer(I4B) :: indxconvertflux = 0
95 logical(LGP) :: allowtimearrayseries = .false.
98 integer(I4B),
pointer :: inobspkg => null()
102 integer(I4B),
pointer :: neq
103 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound => null()
104 real(dp),
dimension(:),
pointer,
contiguous :: xnew => null()
105 real(dp),
dimension(:),
pointer,
contiguous :: xold => null()
106 real(dp),
dimension(:),
pointer,
contiguous :: flowja => null()
107 integer(I4B),
dimension(:),
pointer,
contiguous :: icelltype => null()
108 character(len=LENMEMPATH) :: ictmempath =
''
182 class(
bndtype),
intent(inout) :: this
183 integer(I4B),
intent(inout) :: neq
191 call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout)
194 call obs_cr(this%obs, this%inobspkg)
197 write (this%iout, 1) this%filtyp, trim(adjustl(this%text)), this%inunit
198 1
format(1x, /1x, a,
' -- ', a,
' PACKAGE, VERSION 8, 2/22/2014', &
199 ' INPUT READ FROM UNIT ', i0)
202 call this%parser%Initialize(this%inunit, this%iout)
205 call this%read_options()
209 call this%tsmanager%tsmanager_df()
210 call this%tasmanager%tasmanager_df()
213 call this%read_dimensions()
216 if (this%npakeq > 0)
then
217 this%ioffset = neq - this%dis%nodes
221 neq = neq + this%npakeq
224 if (this%bnd_obs_supported())
then
225 call this%obs%obs_df(this%iout, this%packName, this%filtyp, this%dis)
226 call this%bnd_df_obs()
242 class(
bndtype),
intent(inout) :: this
243 integer(I4B),
intent(in) :: moffset
254 subroutine bnd_mc(this, moffset, matrix_sln)
256 class(
bndtype),
intent(inout) :: this
257 integer(I4B),
intent(in) :: moffset
272 class(
bndtype),
intent(inout) :: this
275 call this%obs%obs_ar()
278 call this%allocate_arrays()
281 call this%read_initial_attr()
284 if (this%imover == 1)
then
285 allocate (this%pakmvrobj)
286 call this%pakmvrobj%ar(this%maxbound, 0, this%memoryPath)
301 class(
bndtype),
intent(inout) :: this
304 integer(I4B) :: nlist
305 logical(LGP) :: isfound
306 character(len=LINELENGTH) :: line
308 character(len=*),
parameter :: fmtblkerr = &
309 &
"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
310 character(len=*),
parameter :: fmtlsp = &
311 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
312 character(len=*),
parameter :: fmtnbd = &
313 "(1X,/1X,'THE NUMBER OF ACTIVE ',A,'S (',I6, &
314 &') IS GREATER THAN MAXIMUM(',I6,')')"
318 if (this%inunit == 0)
return
321 if (this%ionper <
kper)
then
324 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
325 supportopenclose=.true., &
326 blockrequired=.false.)
330 call this%read_check_ionper()
336 this%ionper =
nper + 1
339 call this%parser%GetCurrentLine(line)
340 write (
errmsg, fmtblkerr) adjustl(trim(line))
342 call this%parser%StoreErrorUnit()
348 if (this%ionper ==
kper)
then
352 call this%TsManager%Reset(this%packName)
353 call this%TasManager%Reset(this%packName)
356 call this%dis%read_list(this%parser%line_reader, &
357 this%parser%iuactive, this%iout, &
358 this%iprpak, nlist, this%inamedbound, &
359 this%iauxmultcol, this%nodelist, &
360 this%bound, this%auxvar, this%auxname, &
361 this%boundname, this%listlabel, &
362 this%packName, this%tsManager, this%iscloc)
366 if (this%ivsc == 1)
then
367 call this%bnd_store_user_cond(nlist, this%bound, this%condinput)
374 call this%bnd_rp_ts()
377 call this%parser%terminateblock()
380 call this%copy_boundname()
383 write (this%iout, fmtlsp) trim(this%filtyp)
399 real(DP) :: begintime, endtime
403 endtime = begintime +
delt
406 call this%TsManager%ad()
407 call this%TasManager%ad()
412 call this%obs%obs_ad()
423 class(
bndtype),
intent(inout) :: this
434 if (this%imover == 1)
then
435 call this%pakmvrobj%reset()
463 subroutine bnd_fc(this, rhs, ia, idxglo, matrix_sln)
466 real(DP),
dimension(:),
intent(inout) :: rhs
467 integer(I4B),
dimension(:),
intent(in) :: ia
468 integer(I4B),
dimension(:),
intent(in) :: idxglo
476 do i = 1, this%nbound
478 rhs(n) = rhs(n) + this%rhs(i)
480 call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
492 subroutine bnd_fn(this, rhs, ia, idxglo, matrix_sln)
495 real(DP),
dimension(:),
intent(inout) :: rhs
496 integer(I4B),
dimension(:),
intent(in) :: ia
497 integer(I4B),
dimension(:),
intent(in) :: idxglo
513 subroutine bnd_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
515 class(
bndtype),
intent(inout) :: this
516 integer(I4B),
intent(in) :: neqpak
517 real(DP),
dimension(neqpak),
intent(inout) :: x
518 real(DP),
dimension(neqpak),
intent(in) :: xtemp
519 real(DP),
dimension(neqpak),
intent(inout) :: dx
520 integer(I4B),
intent(inout) :: inewtonur
521 real(DP),
intent(inout) :: dxmax
522 integer(I4B),
intent(inout) :: locmax
539 subroutine bnd_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
541 class(
bndtype),
intent(inout) :: this
542 integer(I4B),
intent(in) :: innertot
543 integer(I4B),
intent(in) :: kiter
544 integer(I4B),
intent(in) :: iend
545 integer(I4B),
intent(in) :: icnvgmod
546 character(len=LENPAKLOC),
intent(inout) :: cpak
547 integer(I4B),
intent(inout) :: ipak
548 real(DP),
intent(inout) :: dpak
561 class(
bndtype),
intent(inout) :: this
562 real(DP),
dimension(:),
intent(in) :: x
563 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
564 integer(I4B),
optional,
intent(in) :: iadv
566 integer(I4B) :: imover
570 if (
present(iadv))
then
585 call this%bnd_cq_simrate(x, flowja, imover)
586 if (imover == 1)
then
587 call this%bnd_cq_simtomvr(flowja)
601 real(DP),
dimension(:),
intent(in) :: hnew
602 real(DP),
dimension(:),
intent(inout) :: flowja
603 integer(I4B),
intent(in) :: imover
607 integer(I4B) :: idiag
611 if (this%nbound > 0)
then
614 do i = 1, this%nbound
615 node = this%nodelist(i)
620 idiag = this%dis%con%ia(node)
621 if (this%ibound(node) > 0)
then
624 rrate = this%hcof(i) * hnew(node) - this%rhs(i)
626 flowja(idiag) = flowja(idiag) + rrate
630 this%simvals(i) = rrate
646 real(DP),
dimension(:),
intent(inout) :: flowja
655 if (this%nbound > 0)
then
658 do i = 1, this%nbound
659 node = this%nodelist(i)
664 if (this%ibound(node) > 0)
then
670 rrate = this%pakmvrobj%get_qtomvr(i)
679 if (fact >
done)
then
689 if (rrate >
dzero)
then
697 this%simtomvr(i) = rrate
716 type(
budgettype),
intent(inout) :: model_budget
718 character(len=LENPACKAGENAME) :: text
721 integer(I4B) :: isuppress_output
728 call model_budget%addentry(ratin, ratout,
delt, this%text, &
729 isuppress_output, this%packName)
730 if (this%imover == 1 .and. this%isadvpak == 0)
then
731 text = trim(adjustl(this%text))//
'-TO-MVR'
734 call model_budget%addentry(ratin, ratout,
delt, text, &
735 isuppress_output, this%packName)
749 integer(I4B),
intent(in) :: icbcfl
750 integer(I4B),
intent(in) :: ibudfl
765 integer(I4B),
intent(in) :: idvsave
766 integer(I4B),
intent(in) :: idvprint
781 integer(I4B),
intent(in) :: kstp
782 integer(I4B),
intent(in) :: kper
783 integer(I4B),
intent(in) :: iout
784 integer(I4B),
intent(in) :: ibudfl
799 integer(I4B),
intent(in) :: icbcfl
800 integer(I4B),
intent(in) :: ibudfl
801 integer(I4B),
intent(in) :: icbcun
802 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
804 character(len=LINELENGTH) :: title
805 character(len=LENPACKAGENAME) :: text
806 integer(I4B) :: imover
809 title = trim(adjustl(this%text))//
' PACKAGE ('//trim(this%packName)// &
811 if (
present(imap))
then
813 this%outputtab, this%nbound, this%nodelist, &
814 this%simvals, this%ibound, title, this%text, &
815 this%ipakcb, this%dis, this%naux, &
816 this%name_model, this%name_model, &
817 this%name_model, this%packName, &
818 this%auxname, this%auxvar, this%iout, &
819 this%inamedbound, this%boundname, imap)
822 this%outputtab, this%nbound, this%nodelist, &
823 this%simvals, this%ibound, title, this%text, &
824 this%ipakcb, this%dis, this%naux, &
825 this%name_model, this%name_model, &
826 this%name_model, this%packName, &
827 this%auxname, this%auxvar, this%iout, &
828 this%inamedbound, this%boundname)
836 if (this%isadvpak /= 0) imover = 0
837 if (imover == 1)
then
838 text = trim(adjustl(this%text))//
'-TO-MVR'
840 title = trim(adjustl(this%text))//
' PACKAGE ('// &
841 trim(this%packName)//
') FLOW RATES TO-MVR'
843 this%outputtab, this%nbound, this%nodelist, &
844 this%simtomvr, this%ibound, title, text, &
845 this%ipakcb, this%dis, this%naux, &
846 this%name_model, this%name_model, &
847 this%name_model, this%packName, &
848 this%auxname, this%auxvar, this%iout, &
849 this%inamedbound, this%boundname)
868 call mem_deallocate(this%noupdateauxvar,
'NOUPDATEAUXVAR', this%memoryPath)
877 call mem_deallocate(this%boundname_cst,
'BOUNDNAME_CST', this%memoryPath)
879 call mem_deallocate(this%auxname_cst,
'AUXNAME_CST', this%memoryPath)
880 nullify (this%icelltype)
883 if (this%imover /= 0)
then
884 call this%pakmvrobj%da()
885 deallocate (this%pakmvrobj)
886 nullify (this%pakmvrobj)
890 if (
associated(this%inputtab))
then
891 call this%inputtab%table_da()
892 deallocate (this%inputtab)
893 nullify (this%inputtab)
897 if (
associated(this%outputtab))
then
898 call this%outputtab%table_da()
899 deallocate (this%outputtab)
900 nullify (this%outputtab)
904 if (
associated(this%errortab))
then
905 call this%errortab%table_da()
906 deallocate (this%errortab)
907 nullify (this%errortab)
930 call this%obs%obs_da()
931 call this%TsManager%da()
932 call this%TasManager%da()
935 deallocate (this%obs)
936 deallocate (this%TsManager)
937 deallocate (this%TasManager)
938 nullify (this%TsManager)
939 nullify (this%TasManager)
942 call this%NumericalPackageType%da()
959 integer(I4B),
pointer :: imodelnewton => null()
962 call this%NumericalPackageType%allocate_scalars()
969 call mem_allocate(this%isadvpak,
'ISADVPAK', this%memoryPath)
970 call mem_allocate(this%ibcnum,
'IBCNUM', this%memoryPath)
971 call mem_allocate(this%maxbound,
'MAXBOUND', this%memoryPath)
972 call mem_allocate(this%nbound,
'NBOUND', this%memoryPath)
973 call mem_allocate(this%ncolbnd,
'NCOLBND', this%memoryPath)
974 call mem_allocate(this%iscloc,
'ISCLOC', this%memoryPath)
976 call mem_allocate(this%inamedbound,
'INAMEDBOUND', this%memoryPath)
977 call mem_allocate(this%iauxmultcol,
'IAUXMULTCOL', this%memoryPath)
978 call mem_allocate(this%inobspkg,
'INOBSPKG', this%memoryPath)
981 call mem_allocate(this%imover,
'IMOVER', this%memoryPath)
987 call mem_allocate(this%npakeq,
'NPAKEQ', this%memoryPath)
988 call mem_allocate(this%ioffset,
'IOFFSET', this%memoryPath)
991 allocate (this%TsManager)
992 allocate (this%TasManager)
1007 this%inamedbound = 0
1008 this%iauxmultcol = 0
1017 this%inewton = imodelnewton
1018 imodelnewton => null()
1033 integer(I4B),
dimension(:),
pointer,
contiguous,
optional :: nodelist
1034 real(DP),
dimension(:, :),
pointer,
contiguous,
optional :: auxvar
1040 if (
present(nodelist))
then
1041 this%nodelist => nodelist
1043 call mem_allocate(this%nodelist, this%maxbound,
'NODELIST', &
1045 do j = 1, this%maxbound
1046 this%nodelist(j) = 0
1052 call mem_allocate(this%noupdateauxvar, this%naux,
'NOUPDATEAUXVAR', &
1054 this%noupdateauxvar(:) = 0
1057 call mem_allocate(this%bound, this%ncolbnd, this%maxbound,
'BOUND', &
1062 call mem_allocate(this%condinput, 0,
'CONDINPUT', this%memoryPath)
1065 call mem_allocate(this%hcof, this%maxbound,
'HCOF', this%memoryPath)
1066 call mem_allocate(this%rhs, this%maxbound,
'RHS', this%memoryPath)
1069 call mem_allocate(this%simvals, this%maxbound,
'SIMVALS', this%memoryPath)
1070 if (this%imover == 1)
then
1071 call mem_allocate(this%simtomvr, this%maxbound,
'SIMTOMVR', &
1073 do i = 1, this%maxbound
1074 this%simtomvr(i) =
dzero
1077 call mem_allocate(this%simtomvr, 0,
'SIMTOMVR', this%memoryPath)
1081 if (
present(auxvar))
then
1082 this%auxvar => auxvar
1084 call mem_allocate(this%auxvar, this%naux, this%maxbound,
'AUXVAR', &
1086 do i = 1, this%maxbound
1088 this%auxvar(j, i) =
dzero
1094 if (this%inamedbound /= 0)
then
1096 'BOUNDNAME', this%memoryPath)
1098 'BOUNDNAME_CST', this%memoryPath)
1101 'BOUNDNAME', this%memoryPath)
1103 'BOUNDNAME_CST', this%memoryPath)
1109 if (this%ictMemPath /=
'')
then
1110 call mem_setptr(this%icelltype,
'ICELLTYPE', this%ictMemPath)
1114 do j = 1, this%maxbound
1115 do i = 1, this%ncolbnd
1116 this%bound(i, j) =
dzero
1119 do i = 1, this%maxbound
1120 this%hcof(i) =
dzero
1125 call this%pak_setup_outputtab()
1149 integer(I4B),
pointer :: neq
1150 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
1151 real(DP),
dimension(:),
pointer,
contiguous :: xnew
1152 real(DP),
dimension(:),
pointer,
contiguous :: xold
1153 real(DP),
dimension(:),
pointer,
contiguous :: flowja
1157 this%ibound => ibound
1160 this%flowja => flowja
1173 class(
bndtype),
intent(inout) :: this
1175 character(len=:),
allocatable :: line
1176 character(len=LINELENGTH) :: fname
1177 character(len=LINELENGTH) :: keyword
1178 character(len=LENAUXNAME) :: sfacauxname
1179 character(len=LENAUXNAME),
dimension(:),
allocatable :: caux
1180 integer(I4B) :: lloc
1181 integer(I4B) :: istart
1182 integer(I4B) :: istop
1184 integer(I4B) :: ierr
1185 integer(I4B) :: inobs
1186 logical(LGP) :: isfound
1187 logical(LGP) :: endOfBlock
1188 logical(LGP) :: foundchildclassoption
1190 character(len=*),
parameter :: fmtflow = &
1191 &
"(4x, 'FLOWS WILL BE SAVED TO FILE: ', a, /4x, 'OPENED ON UNIT: ', I7)"
1192 character(len=*),
parameter :: fmtflow2 = &
1193 &
"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')"
1194 character(len=*),
parameter :: fmttas = &
1195 &
"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)"
1196 character(len=*),
parameter :: fmtts = &
1197 &
"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
1198 character(len=*),
parameter :: fmtnme = &
1204 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, &
1205 supportopenclose=.true., blockrequired=.false.)
1209 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text)) &
1212 call this%parser%GetNextLine(endofblock)
1213 if (endofblock)
then
1216 call this%parser%GetStringCaps(keyword)
1217 select case (keyword)
1218 case (
'AUX',
'AUXILIARY')
1219 call this%parser%GetRemainingLine(line)
1221 call urdaux(this%naux, this%parser%iuactive, this%iout, lloc, &
1222 istart, istop, caux, line, this%text)
1224 'AUXNAME', this%memoryPath)
1226 'AUXNAME_CST', this%memoryPath)
1228 this%auxname(n) = caux(n)
1229 this%auxname_cst(n) = caux(n)
1234 write (this%iout, fmtflow2)
1235 case (
'PRINT_INPUT')
1237 write (this%iout,
'(4x,a)') &
1238 'LISTS OF '//trim(adjustl(this%text))//
' CELLS WILL BE PRINTED.'
1239 case (
'PRINT_FLOWS')
1241 write (this%iout,
'(4x,a)') trim(adjustl(this%text))// &
1242 ' FLOWS WILL BE PRINTED TO LISTING FILE.'
1244 this%inamedbound = 1
1245 write (this%iout,
'(4x,a)') trim(adjustl(this%text))// &
1246 ' BOUNDARIES HAVE NAMES IN LAST COLUMN.'
1248 call this%parser%GetStringCaps(keyword)
1249 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1250 errmsg =
'TS6 keyword must be followed by "FILEIN" '// &
1254 call this%parser%GetString(fname)
1255 write (this%iout, fmtts) trim(fname)
1256 call this%TsManager%add_tsfile(fname, this%inunit)
1258 if (this%AllowTimeArraySeries)
then
1259 if (.not. this%dis%supports_layers())
then
1260 errmsg =
'TAS6 FILE cannot be used '// &
1261 'with selected discretization type.'
1265 errmsg =
'The '//trim(this%filtyp)// &
1266 ' package does not support TIMEARRAYSERIESFILE'
1268 call this%parser%StoreErrorUnit()
1270 call this%parser%GetStringCaps(keyword)
1271 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1272 errmsg =
'TAS6 keyword must be followed by "FILEIN" '// &
1275 call this%parser%StoreErrorUnit()
1277 call this%parser%GetString(fname)
1278 write (this%iout, fmttas) trim(fname)
1279 call this%TasManager%add_tasfile(fname)
1280 case (
'AUXMULTNAME')
1281 call this%parser%GetStringCaps(sfacauxname)
1282 this%iauxmultcol = -1
1283 write (this%iout,
'(4x,a,a)') &
1284 'AUXILIARY MULTIPLIER NAME: ', sfacauxname
1286 call this%parser%GetStringCaps(keyword)
1287 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1288 errmsg =
'OBS6 keyword must be followed by "FILEIN" '// &
1291 call this%parser%StoreErrorUnit()
1293 if (this%obs%active)
then
1294 errmsg =
'Multiple OBS6 keywords detected in OPTIONS block. '// &
1295 'Only one OBS6 entry allowed for a package.'
1298 this%obs%active = .true.
1299 call this%parser%GetString(this%obs%inputFilename)
1301 call openfile(inobs, this%iout, this%obs%inputFilename,
'OBS')
1302 this%obs%inUnitObs = inobs
1308 case (
'DEV_NO_NEWTON')
1309 call this%parser%DevOpt()
1311 write (this%iout,
'(4x,a)') &
1312 'NEWTON-RAPHSON method disabled for unconfined cells'
1316 call this%bnd_options(keyword, foundchildclassoption)
1319 if (.not. foundchildclassoption)
then
1320 write (
errmsg,
'(a,3(1x,a))') &
1321 'UNKNOWN', trim(adjustl(this%text)),
'OPTION:', trim(keyword)
1326 write (this%iout,
'(1x,a)') &
1327 'END OF '//trim(adjustl(this%text))//
' OPTIONS'
1329 write (this%iout,
'(1x,a)')
'NO '//trim(adjustl(this%text))// &
1330 ' OPTION BLOCK DETECTED.'
1334 if (this%iauxmultcol < 0)
then
1337 if (this%naux == 0)
then
1338 write (
errmsg,
'(a,2(1x,a))') &
1339 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
1340 'but no AUX variables specified.'
1345 this%iauxmultcol = 0
1347 if (sfacauxname == this%auxname(n))
then
1348 this%iauxmultcol = n
1354 if (this%iauxmultcol == 0)
then
1355 write (
errmsg,
'(a,2(1x,a))') &
1356 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
1357 'but no AUX variable found with this name.'
1364 call this%parser%StoreErrorUnit()
1377 class(
bndtype),
intent(inout) :: this
1379 character(len=LINELENGTH) :: keyword
1380 logical(LGP) :: isfound
1381 logical(LGP) :: endOfBlock
1382 integer(I4B) :: ierr
1385 call this%parser%GetBlock(
'DIMENSIONS', isfound, ierr, &
1386 supportopenclose=.true.)
1390 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1393 call this%parser%GetNextLine(endofblock)
1394 if (endofblock)
exit
1395 call this%parser%GetStringCaps(keyword)
1396 select case (keyword)
1398 this%maxbound = this%parser%GetInteger()
1399 write (this%iout,
'(4x,a,i7)')
'MAXBOUND = ', this%maxbound
1401 write (
errmsg,
'(a,3(1x,a))') &
1402 'Unknown', trim(this%text),
'dimension:', trim(keyword)
1407 write (this%iout,
'(1x,a)') &
1408 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
1410 call store_error(
'Required DIMENSIONS block not found.')
1411 call this%parser%StoreErrorUnit()
1415 if (this%maxbound <= 0)
then
1416 write (
errmsg,
'(a)')
'MAXBOUND must be an integer greater than zero.'
1422 call this%parser%StoreErrorUnit()
1427 call this%define_listlabel()
1443 class(
bndtype),
intent(inout) :: this
1444 integer(I4B),
intent(in) :: nlist
1445 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(in) :: rlist
1446 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: condinput
1452 condinput(l) = rlist(2, l)
1465 class(
bndtype),
intent(inout) :: this
1477 class(
bndtype),
intent(inout) :: this
1478 character(len=*),
intent(inout) :: option
1479 logical(LGP),
intent(inout) :: found
1493 class(
bndtype),
intent(inout) :: this
1499 if (this%inamedbound /= 0)
then
1500 do i = 1,
size(this%boundname)
1501 this%boundname_cst(i) = this%boundname(i)
1514 class(
bndtype),
intent(inout) :: this
1516 character(len=LINELENGTH) :: title
1517 character(len=LINELENGTH) :: text
1518 integer(I4B) :: ntabcol
1521 if (this%iprflow /= 0)
then
1525 if (this%inamedbound > 0)
then
1526 ntabcol = ntabcol + 1
1530 title = trim(adjustl(this%text))//
' PACKAGE ('//trim(this%packName)// &
1532 call table_cr(this%outputtab, this%packName, title)
1533 call this%outputtab%table_df(this%maxbound, ntabcol, this%iout, &
1536 call this%outputtab%initialize_column(text, 10, alignment=
tabcenter)
1538 call this%outputtab%initialize_column(text, 20, alignment=
tableft)
1540 call this%outputtab%initialize_column(text, 15, alignment=
tabcenter)
1541 if (this%inamedbound > 0)
then
1543 call this%outputtab%initialize_column(text,
lenboundname, &
1557 class(
bndtype),
intent(inout) :: this
1573 logical(LGP) :: supported
1605 class(
bndtype),
intent(inout) :: this
1610 character(len=LENBOUNDNAME) :: bname
1611 logical(LGP) :: jfound
1613 if (.not. this%bnd_obs_supported())
return
1615 do i = 1, this%obs%npakobs
1616 obsrv => this%obs%pakobs(i)%obsrv
1620 call obsrv%ResetObsIndex()
1621 obsrv%BndFound = .false.
1623 bname = obsrv%FeatureName
1624 if (bname /=
'')
then
1630 do j = 1, this%nbound
1631 if (this%boundname(j) == bname)
then
1633 obsrv%BndFound = .true.
1634 obsrv%CurrentTimeStepEndValue =
dzero
1635 call obsrv%AddObsIndex(j)
1642 jloop:
do j = 1, this%nbound
1643 if (this%nodelist(j) == obsrv%NodeNumber)
then
1645 obsrv%BndFound = .true.
1646 obsrv%CurrentTimeStepEndValue =
dzero
1647 call obsrv%AddObsIndex(j)
1676 call this%obs%obs_bd_clear()
1679 do i = 1, this%obs%npakobs
1680 obsrv => this%obs%pakobs(i)%obsrv
1681 if (obsrv%BndFound)
then
1682 do n = 1, obsrv%indxbnds_count
1683 if (obsrv%ObsTypeId ==
'TO-MVR')
then
1684 if (this%imover == 1)
then
1685 v = this%pakmvrobj%get_qtomvr(obsrv%indxbnds(n))
1693 v = this%simvals(obsrv%indxbnds(n))
1695 call this%obs%SaveOneSimval(obsrv, v)
1698 call this%obs%SaveOneSimval(obsrv,
dnodata)
1714 call this%obs%obs_ot()
1728 class(
bndtype),
intent(inout) :: this
1739 class(*),
pointer,
intent(inout) :: obj
1740 class(
bndtype),
pointer :: res
1746 if (.not.
associated(obj))
return
1762 type(
listtype),
intent(inout) :: list
1763 class(
bndtype),
pointer,
intent(inout) :: bnd
1765 class(*),
pointer :: obj
1780 type(
listtype),
intent(inout) :: list
1781 integer(I4B),
intent(in) :: idx
1782 class(
bndtype),
pointer :: res
1784 class(*),
pointer :: obj
1787 obj => list%GetItem(idx)
1798 outputtab, nbound, nodelist, flow, ibound, &
1799 title, text, ipakcb, dis, naux, textmodel, &
1800 textpackage, dstmodel, dstpackage, &
1801 auxname, auxvar, iout, inamedbound, &
1806 integer(I4B),
intent(in) :: icbcfl
1807 integer(I4B),
intent(in) :: ibudfl
1808 integer(I4B),
intent(in) :: icbcun
1809 integer(I4B),
intent(in) :: iprflow
1810 type(
tabletype),
pointer,
intent(inout) :: outputtab
1811 integer(I4B),
intent(in) :: nbound
1812 integer(I4B),
dimension(:),
contiguous,
intent(in) :: nodelist
1813 real(dp),
dimension(:),
contiguous,
intent(in) :: flow
1814 integer(I4B),
dimension(:),
contiguous,
intent(in) :: ibound
1815 character(len=*),
intent(in) :: title
1816 character(len=*),
intent(in) :: text
1817 integer(I4B),
intent(in) :: ipakcb
1819 integer(I4B),
intent(in) :: naux
1820 character(len=*),
intent(in) :: textmodel
1821 character(len=*),
intent(in) :: textpackage
1822 character(len=*),
intent(in) :: dstmodel
1823 character(len=*),
intent(in) :: dstpackage
1824 character(len=*),
dimension(:),
intent(in) :: auxname
1825 real(dp),
dimension(:, :),
intent(in) :: auxvar
1826 integer(I4B),
intent(in) :: iout
1827 integer(I4B),
intent(in) :: inamedbound
1828 character(len=LENBOUNDNAME),
dimension(:),
contiguous :: boundname
1829 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
1831 character(len=20) :: nodestr
1832 integer(I4B) :: nodeu
1833 integer(I4B) :: maxrows
1835 integer(I4B) :: node
1837 integer(I4B) :: ibinun
1838 integer(I4B) :: nboundcount
1840 real(dp),
dimension(naux) :: auxrow
1842 character(len=LENBOUNDNAME) :: bname
1845 if (iprflow /= 0)
then
1846 call outputtab%set_kstpkper(
kstp,
kper)
1851 if (ibudfl /= 0 .and. iprflow /= 0)
then
1855 maxrows = maxrows + 1
1858 if (maxrows > 0)
then
1859 call outputtab%set_maxbound(maxrows)
1861 call outputtab%set_title(title)
1865 if (ipakcb < 0)
then
1867 else if (ipakcb == 0)
then
1872 if (icbcfl == 0)
then
1877 if (ibinun /= 0)
then
1885 if (node > 0) nboundcount = nboundcount + 1
1887 call dis%record_srcdst_list_header(text, textmodel, textpackage, &
1888 dstmodel, dstpackage, naux, &
1889 auxname, ibinun, nboundcount, iout)
1893 if (nbound > 0)
then
1899 if (inamedbound > 0)
then
1900 bname = boundname(i)
1915 if (ibudfl /= 0)
then
1916 if (iprflow /= 0)
then
1919 nodeu = dis%get_nodeuser(node)
1920 call dis%nodeu_to_string(nodeu, nodestr)
1921 call outputtab%print_list_entry(i, trim(adjustl(nodestr)), &
1927 if (ibinun /= 0)
then
1929 if (
present(imap)) n2 = imap(i)
1931 auxrow(:) = auxvar(:, i)
1933 call dis%record_mf6_list_entry(ibinun, node, n2, rrate, naux, &
1934 auxrow, olconv2=.false.)
1939 if (ibudfl /= 0)
then
1940 if (iprflow /= 0)
then
1941 write (iout,
'(1x)')
1958 class(
bndtype),
intent(inout) :: this
1967 call mem_reallocate(this%condinput, this%maxbound,
'CONDINPUT', &
1969 do i = 1, this%maxbound
1970 this%condinput(i) =
dzero
1975 write (this%iout,
'(/1x,a,a)')
'VISCOSITY ACTIVE IN ', &
1976 trim(this%filtyp)//
' PACKAGE CALCULATIONS: '//trim(adjustl(this%packName))
This module contains block parser methods.
This module contains the base boundary package.
subroutine bnd_read_dimensions(this)
@ brief Read dimensions for package
logical(lgp) function bnd_obs_supported(this)
Determine if observations are supported.
subroutine bnd_ar(this)
@ brief Allocate and read method for boundary package
subroutine bnd_rp(this)
@ brief Allocate and read method for package
subroutine allocate_scalars(this)
@ brief Allocate package scalars
subroutine bnd_ot_dv(this, idvsave, idvprint)
@ brief Output advanced package dependent-variable terms.
subroutine bnd_store_user_cond(this, nlist, rlist, condinput)
@ brief Store user-specified conductances when vsc is active
subroutine bnd_ot_obs(this)
Output observations for the package.
subroutine bnd_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
@ brief Apply Newton-Raphson under-relaxation for package.
subroutine bnd_ot_package_flows(this, icbcfl, ibudfl)
@ brief Output advanced package flow terms.
subroutine bnd_read_options(this)
@ brief Read additional options for package
subroutine bnd_ot_model_flows(this, icbcfl, ibudfl, icbcun, imap)
@ brief Output package flow terms.
subroutine bnd_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
@ brief Convergence check for package.
subroutine bnd_rp_ts(this)
Assign time series links for the package.
subroutine bnd_bd_obs(this)
Save observations for the package.
subroutine bnd_options(this, option, found)
@ brief Read additional options for package
subroutine bnd_da(this)
@ brief Deallocate package memory
subroutine bnd_bd(this, model_budget)
@ brief Add package flows to model budget.
subroutine, public addbndtolist(list, bnd)
Add boundary to package list.
subroutine bnd_cq_simrate(this, hnew, flowja, imover)
@ brief Calculate simrate.
subroutine bnd_mc(this, moffset, matrix_sln)
@ brief Map boundary package connection to matrix
class(bndtype) function, pointer, public getbndfromlist(list, idx)
Get boundary from package list.
subroutine bnd_fc(this, rhs, ia, idxglo, matrix_sln)
@ brief Copy hcof and rhs terms into solution.
subroutine allocate_arrays(this, nodelist, auxvar)
@ brief Allocate package arrays
subroutine bnd_ck(this)
@ brief Check boundary package period data
subroutine pak_setup_outputtab(this)
@ brief Setup output table for package
subroutine bnd_ac(this, moffset, sparse)
@ brief Add boundary package connection to matrix
subroutine bnd_ot_bdsummary(this, kstp, kper, iout, ibudfl)
@ brief Output advanced package budget summary.
subroutine copy_boundname(this)
@ brief Copy boundnames into boundnames_cst
subroutine bnd_df_obs(this)
Define the observation types available in the package.
subroutine bnd_reset(this)
@ brief Reset bnd package before formulating
subroutine bnd_activate_viscosity(this)
Activate viscosity terms.
subroutine bnd_cq_simtomvr(this, flowja)
@ brief Calculate flow to the mover.
subroutine bnd_read_initial_attr(this)
@ brief Read initial parameters for package
subroutine, public save_print_model_flows(icbcfl, ibudfl, icbcun, iprflow, outputtab, nbound, nodelist, flow, ibound, title, text, ipakcb, dis, naux, textmodel, textpackage, dstmodel, dstpackage, auxname, auxvar, iout, inamedbound, boundname, imap)
Save and/or print flows for a package.
subroutine set_pointers(this, neq, ibound, xnew, xold, flowja)
@ brief Set pointers to model variables
subroutine bnd_rp_obs(this)
Read and prepare observations for a package.
subroutine bnd_cf(this)
@ brief Formulate the package hcof and rhs terms.
subroutine bnd_fn(this, rhs, ia, idxglo, matrix_sln)
@ brief Add Newton-Raphson terms for package into solution.
subroutine bnd_ad(this)
@ brief Advance the boundary package
class(bndtype) function, pointer, private castasbndclass(obj)
Cast as a boundary type.
subroutine bnd_cq(this, x, flowja, iadv)
@ brief Calculate advanced package flows.
subroutine define_listlabel(this)
@ brief Define the list label for the package
subroutine pack_initialize(this)
@ brief Allocate and initialize select package members
subroutine bnd_df(this, neq, dis)
@ brief Define boundary package options and dimensions
This module contains the BudgetModule.
subroutine, public rate_accumulator(flow, rin, rout)
@ brief Rate accumulator subroutine
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ tabcenter
centered table column
@ tableft
left justified table column
integer(i4b), parameter lenmodelname
maximum length of the model name
integer(i4b), parameter lenpackagename
maximum length of the package name
real(dp), parameter dnodata
real no data constant
integer(i4b), parameter lenlistlabel
maximum length of a llist label
integer(i4b), parameter lenpakloc
maximum length of a package location
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
integer(i4b), parameter lenauxname
maximum length of a aux variable
integer(i4b), parameter lenboundname
maximum length of a bound name
real(dp), parameter dzero
real constant zero
integer(i4b), parameter maxcharlen
maximum length of char string
integer(i4b), parameter lenmempath
maximum length of the memory path
real(dp), parameter done
real constant 1
This module defines variable data types.
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains the base numerical package type.
This module contains the derived types ObserveType and ObsDataType.
This module contains the derived type ObsType.
subroutine, public obs_cr(obs, inobs)
@ brief Create a new ObsType object
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.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
subroutine, public table_cr(this, name, title)
real(dp), pointer, public totimc
simulation time at start of time step
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
integer(i4b), pointer, public nper
number of stress period
subroutine, public tasmanager_cr(this, dis, modelname, iout)
Create the time-array series manager.
subroutine, public tsmanager_cr(this, iout, removeTsLinksOnCompletion, extendTsToEndOfSimulation)
Create the tsmanager.
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 ...
A generic heterogeneous doubly-linked list.