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()
245 class(
bndtype),
intent(inout) :: this
246 integer(I4B),
intent(in) :: moffset
260 subroutine bnd_mc(this, moffset, matrix_sln)
262 class(
bndtype),
intent(inout) :: this
263 integer(I4B),
intent(in) :: moffset
281 class(
bndtype),
intent(inout) :: this
284 call this%obs%obs_ar()
287 call this%allocate_arrays()
290 call this%read_initial_attr()
293 if (this%imover == 1)
then
294 allocate (this%pakmvrobj)
295 call this%pakmvrobj%ar(this%maxbound, 0, this%memoryPath)
313 class(
bndtype),
intent(inout) :: this
316 integer(I4B) :: nlist
317 logical(LGP) :: isfound
318 character(len=LINELENGTH) :: line
320 character(len=*),
parameter :: fmtblkerr = &
321 &
"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
322 character(len=*),
parameter :: fmtlsp = &
323 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
324 character(len=*),
parameter :: fmtnbd = &
325 "(1X,/1X,'THE NUMBER OF ACTIVE ',A,'S (',I6, &
326 &') IS GREATER THAN MAXIMUM(',I6,')')"
330 if (this%inunit == 0)
return
333 if (this%ionper <
kper)
then
336 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
337 supportopenclose=.true., &
338 blockrequired=.false.)
342 call this%read_check_ionper()
348 this%ionper =
nper + 1
351 call this%parser%GetCurrentLine(line)
352 write (
errmsg, fmtblkerr) adjustl(trim(line))
354 call this%parser%StoreErrorUnit()
360 if (this%ionper ==
kper)
then
364 call this%TsManager%Reset(this%packName)
365 call this%TasManager%Reset(this%packName)
368 call this%dis%read_list(this%parser%line_reader, &
369 this%parser%iuactive, this%iout, &
370 this%iprpak, nlist, this%inamedbound, &
371 this%iauxmultcol, this%nodelist, &
372 this%bound, this%auxvar, this%auxname, &
373 this%boundname, this%listlabel, &
374 this%packName, this%tsManager, this%iscloc)
378 if (this%ivsc == 1)
then
379 call this%bnd_store_user_cond(nlist, this%bound, this%condinput)
386 call this%bnd_rp_ts()
389 call this%parser%terminateblock()
392 call this%copy_boundname()
395 write (this%iout, fmtlsp) trim(this%filtyp)
414 real(DP) :: begintime, endtime
418 endtime = begintime +
delt
421 call this%TsManager%ad()
422 call this%TasManager%ad()
427 call this%obs%obs_ad()
440 class(
bndtype),
intent(inout) :: this
454 if (this%imover == 1)
then
455 call this%pakmvrobj%reset()
486 subroutine bnd_fc(this, rhs, ia, idxglo, matrix_sln)
489 real(DP),
dimension(:),
intent(inout) :: rhs
490 integer(I4B),
dimension(:),
intent(in) :: ia
491 integer(I4B),
dimension(:),
intent(in) :: idxglo
499 do i = 1, this%nbound
501 rhs(n) = rhs(n) + this%rhs(i)
503 call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
518 subroutine bnd_fn(this, rhs, ia, idxglo, matrix_sln)
521 real(DP),
dimension(:),
intent(inout) :: rhs
522 integer(I4B),
dimension(:),
intent(in) :: ia
523 integer(I4B),
dimension(:),
intent(in) :: idxglo
542 subroutine bnd_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
544 class(
bndtype),
intent(inout) :: this
545 integer(I4B),
intent(in) :: neqpak
546 real(DP),
dimension(neqpak),
intent(inout) :: x
547 real(DP),
dimension(neqpak),
intent(in) :: xtemp
548 real(DP),
dimension(neqpak),
intent(inout) :: dx
549 integer(I4B),
intent(inout) :: inewtonur
550 real(DP),
intent(inout) :: dxmax
551 integer(I4B),
intent(inout) :: locmax
571 subroutine bnd_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
573 class(
bndtype),
intent(inout) :: this
574 integer(I4B),
intent(in) :: innertot
575 integer(I4B),
intent(in) :: kiter
576 integer(I4B),
intent(in) :: iend
577 integer(I4B),
intent(in) :: icnvgmod
578 character(len=LENPAKLOC),
intent(inout) :: cpak
579 integer(I4B),
intent(inout) :: ipak
580 real(DP),
intent(inout) :: dpak
596 class(
bndtype),
intent(inout) :: this
597 real(DP),
dimension(:),
intent(in) :: x
598 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
599 integer(I4B),
optional,
intent(in) :: iadv
601 integer(I4B) :: imover
606 if (
present(iadv))
then
621 call this%bnd_cq_simrate(x, flowja, imover)
622 if (imover == 1)
then
623 call this%bnd_cq_simtomvr(flowja)
640 real(DP),
dimension(:),
intent(in) :: hnew
641 real(DP),
dimension(:),
intent(inout) :: flowja
642 integer(I4B),
intent(in) :: imover
646 integer(I4B) :: idiag
652 if (this%nbound > 0)
then
655 do i = 1, this%nbound
656 node = this%nodelist(i)
661 idiag = this%dis%con%ia(node)
662 if (this%ibound(node) > 0)
then
665 rrate = this%hcof(i) * hnew(node) - this%rhs(i)
667 flowja(idiag) = flowja(idiag) + rrate
671 this%simvals(i) = rrate
690 real(DP),
dimension(:),
intent(inout) :: flowja
699 if (this%nbound > 0)
then
702 do i = 1, this%nbound
703 node = this%nodelist(i)
708 if (this%ibound(node) > 0)
then
714 rrate = this%pakmvrobj%get_qtomvr(i)
723 if (fact >
done)
then
733 if (rrate >
dzero)
then
741 this%simtomvr(i) = rrate
763 type(
budgettype),
intent(inout) :: model_budget
765 character(len=LENPACKAGENAME) :: text
768 integer(I4B) :: isuppress_output
775 call model_budget%addentry(ratin, ratout,
delt, this%text, &
776 isuppress_output, this%packName)
777 if (this%imover == 1 .and. this%isadvpak == 0)
then
778 text = trim(adjustl(this%text))//
'-TO-MVR'
781 call model_budget%addentry(ratin, ratout,
delt, text, &
782 isuppress_output, this%packName)
799 integer(I4B),
intent(in) :: icbcfl
800 integer(I4B),
intent(in) :: ibudfl
818 integer(I4B),
intent(in) :: idvsave
819 integer(I4B),
intent(in) :: idvprint
837 integer(I4B),
intent(in) :: kstp
838 integer(I4B),
intent(in) :: kper
839 integer(I4B),
intent(in) :: iout
840 integer(I4B),
intent(in) :: ibudfl
858 integer(I4B),
intent(in) :: icbcfl
859 integer(I4B),
intent(in) :: ibudfl
860 integer(I4B),
intent(in) :: icbcun
861 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
863 character(len=LINELENGTH) :: title
864 character(len=LENPACKAGENAME) :: text
865 integer(I4B) :: imover
868 title = trim(adjustl(this%text))//
' PACKAGE ('//trim(this%packName)// &
870 if (
present(imap))
then
872 this%outputtab, this%nbound, this%nodelist, &
873 this%simvals, this%ibound, title, this%text, &
874 this%ipakcb, this%dis, this%naux, &
875 this%name_model, this%name_model, &
876 this%name_model, this%packName, &
877 this%auxname, this%auxvar, this%iout, &
878 this%inamedbound, this%boundname, imap)
881 this%outputtab, this%nbound, this%nodelist, &
882 this%simvals, this%ibound, title, this%text, &
883 this%ipakcb, this%dis, this%naux, &
884 this%name_model, this%name_model, &
885 this%name_model, this%packName, &
886 this%auxname, this%auxvar, this%iout, &
887 this%inamedbound, this%boundname)
895 if (this%isadvpak /= 0) imover = 0
896 if (imover == 1)
then
897 text = trim(adjustl(this%text))//
'-TO-MVR'
899 title = trim(adjustl(this%text))//
' PACKAGE ('// &
900 trim(this%packName)//
') FLOW RATES TO-MVR'
902 this%outputtab, this%nbound, this%nodelist, &
903 this%simtomvr, this%ibound, title, text, &
904 this%ipakcb, this%dis, this%naux, &
905 this%name_model, this%name_model, &
906 this%name_model, this%packName, &
907 this%auxname, this%auxvar, this%iout, &
908 this%inamedbound, this%boundname)
930 call mem_deallocate(this%noupdateauxvar,
'NOUPDATEAUXVAR', this%memoryPath)
939 call mem_deallocate(this%boundname_cst,
'BOUNDNAME_CST', this%memoryPath)
941 call mem_deallocate(this%auxname_cst,
'AUXNAME_CST', this%memoryPath)
942 nullify (this%icelltype)
945 if (this%imover /= 0)
then
946 call this%pakmvrobj%da()
947 deallocate (this%pakmvrobj)
948 nullify (this%pakmvrobj)
952 if (
associated(this%inputtab))
then
953 call this%inputtab%table_da()
954 deallocate (this%inputtab)
955 nullify (this%inputtab)
959 if (
associated(this%outputtab))
then
960 call this%outputtab%table_da()
961 deallocate (this%outputtab)
962 nullify (this%outputtab)
966 if (
associated(this%errortab))
then
967 call this%errortab%table_da()
968 deallocate (this%errortab)
969 nullify (this%errortab)
992 call this%obs%obs_da()
993 call this%TsManager%da()
994 call this%TasManager%da()
997 deallocate (this%obs)
998 deallocate (this%TsManager)
999 deallocate (this%TasManager)
1000 nullify (this%TsManager)
1001 nullify (this%TasManager)
1004 call this%NumericalPackageType%da()
1024 integer(I4B),
pointer :: imodelnewton => null()
1027 call this%NumericalPackageType%allocate_scalars()
1034 call mem_allocate(this%isadvpak,
'ISADVPAK', this%memoryPath)
1035 call mem_allocate(this%ibcnum,
'IBCNUM', this%memoryPath)
1036 call mem_allocate(this%maxbound,
'MAXBOUND', this%memoryPath)
1037 call mem_allocate(this%nbound,
'NBOUND', this%memoryPath)
1038 call mem_allocate(this%ncolbnd,
'NCOLBND', this%memoryPath)
1039 call mem_allocate(this%iscloc,
'ISCLOC', this%memoryPath)
1041 call mem_allocate(this%inamedbound,
'INAMEDBOUND', this%memoryPath)
1042 call mem_allocate(this%iauxmultcol,
'IAUXMULTCOL', this%memoryPath)
1043 call mem_allocate(this%inobspkg,
'INOBSPKG', this%memoryPath)
1046 call mem_allocate(this%imover,
'IMOVER', this%memoryPath)
1052 call mem_allocate(this%npakeq,
'NPAKEQ', this%memoryPath)
1053 call mem_allocate(this%ioffset,
'IOFFSET', this%memoryPath)
1056 allocate (this%TsManager)
1057 allocate (this%TasManager)
1072 this%inamedbound = 0
1073 this%iauxmultcol = 0
1082 this%inewton = imodelnewton
1083 imodelnewton => null()
1101 integer(I4B),
dimension(:),
pointer,
contiguous,
optional :: nodelist
1102 real(DP),
dimension(:, :),
pointer,
contiguous,
optional :: auxvar
1108 if (
present(nodelist))
then
1109 this%nodelist => nodelist
1111 call mem_allocate(this%nodelist, this%maxbound,
'NODELIST', &
1113 do j = 1, this%maxbound
1114 this%nodelist(j) = 0
1120 call mem_allocate(this%noupdateauxvar, this%naux,
'NOUPDATEAUXVAR', &
1122 this%noupdateauxvar(:) = 0
1125 call mem_allocate(this%bound, this%ncolbnd, this%maxbound,
'BOUND', &
1130 call mem_allocate(this%condinput, 0,
'CONDINPUT', this%memoryPath)
1133 call mem_allocate(this%hcof, this%maxbound,
'HCOF', this%memoryPath)
1134 call mem_allocate(this%rhs, this%maxbound,
'RHS', this%memoryPath)
1137 call mem_allocate(this%simvals, this%maxbound,
'SIMVALS', this%memoryPath)
1138 if (this%imover == 1)
then
1139 call mem_allocate(this%simtomvr, this%maxbound,
'SIMTOMVR', &
1141 do i = 1, this%maxbound
1142 this%simtomvr(i) =
dzero
1145 call mem_allocate(this%simtomvr, 0,
'SIMTOMVR', this%memoryPath)
1149 if (
present(auxvar))
then
1150 this%auxvar => auxvar
1152 call mem_allocate(this%auxvar, this%naux, this%maxbound,
'AUXVAR', &
1154 do i = 1, this%maxbound
1156 this%auxvar(j, i) =
dzero
1162 if (this%inamedbound /= 0)
then
1164 'BOUNDNAME', this%memoryPath)
1166 'BOUNDNAME_CST', this%memoryPath)
1169 'BOUNDNAME', this%memoryPath)
1171 'BOUNDNAME_CST', this%memoryPath)
1177 if (this%ictMemPath /=
'')
then
1178 call mem_setptr(this%icelltype,
'ICELLTYPE', this%ictMemPath)
1182 do j = 1, this%maxbound
1183 do i = 1, this%ncolbnd
1184 this%bound(i, j) =
dzero
1187 do i = 1, this%maxbound
1188 this%hcof(i) =
dzero
1193 call this%pak_setup_outputtab()
1223 integer(I4B),
pointer :: neq
1224 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
1225 real(DP),
dimension(:),
pointer,
contiguous :: xnew
1226 real(DP),
dimension(:),
pointer,
contiguous :: xold
1227 real(DP),
dimension(:),
pointer,
contiguous :: flowja
1231 this%ibound => ibound
1234 this%flowja => flowja
1249 class(
bndtype),
intent(inout) :: this
1251 character(len=:),
allocatable :: line
1252 character(len=LINELENGTH) :: fname
1253 character(len=LINELENGTH) :: keyword
1254 character(len=LENAUXNAME) :: sfacauxname
1255 character(len=LENAUXNAME),
dimension(:),
allocatable :: caux
1256 integer(I4B) :: lloc
1257 integer(I4B) :: istart
1258 integer(I4B) :: istop
1260 integer(I4B) :: ierr
1261 integer(I4B) :: inobs
1262 logical(LGP) :: isfound
1263 logical(LGP) :: endOfBlock
1264 logical(LGP) :: foundchildclassoption
1266 character(len=*),
parameter :: fmtflow = &
1267 &
"(4x, 'FLOWS WILL BE SAVED TO FILE: ', a, /4x, 'OPENED ON UNIT: ', I7)"
1268 character(len=*),
parameter :: fmtflow2 = &
1269 &
"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')"
1270 character(len=*),
parameter :: fmttas = &
1271 &
"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)"
1272 character(len=*),
parameter :: fmtts = &
1273 &
"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
1274 character(len=*),
parameter :: fmtnme = &
1280 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, &
1281 supportopenclose=.true., blockrequired=.false.)
1285 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text)) &
1288 call this%parser%GetNextLine(endofblock)
1289 if (endofblock)
then
1292 call this%parser%GetStringCaps(keyword)
1293 select case (keyword)
1294 case (
'AUX',
'AUXILIARY')
1295 call this%parser%GetRemainingLine(line)
1297 call urdaux(this%naux, this%parser%iuactive, this%iout, lloc, &
1298 istart, istop, caux, line, this%text)
1300 'AUXNAME', this%memoryPath)
1302 'AUXNAME_CST', this%memoryPath)
1304 this%auxname(n) = caux(n)
1305 this%auxname_cst(n) = caux(n)
1310 write (this%iout, fmtflow2)
1311 case (
'PRINT_INPUT')
1313 write (this%iout,
'(4x,a)') &
1314 'LISTS OF '//trim(adjustl(this%text))//
' CELLS WILL BE PRINTED.'
1315 case (
'PRINT_FLOWS')
1317 write (this%iout,
'(4x,a)') trim(adjustl(this%text))// &
1318 ' FLOWS WILL BE PRINTED TO LISTING FILE.'
1320 this%inamedbound = 1
1321 write (this%iout,
'(4x,a)') trim(adjustl(this%text))// &
1322 ' BOUNDARIES HAVE NAMES IN LAST COLUMN.'
1324 call this%parser%GetStringCaps(keyword)
1325 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1326 errmsg =
'TS6 keyword must be followed by "FILEIN" '// &
1330 call this%parser%GetString(fname)
1331 write (this%iout, fmtts) trim(fname)
1332 call this%TsManager%add_tsfile(fname, this%inunit)
1334 if (this%AllowTimeArraySeries)
then
1335 if (.not. this%dis%supports_layers())
then
1336 errmsg =
'TAS6 FILE cannot be used '// &
1337 'with selected discretization type.'
1341 errmsg =
'The '//trim(this%filtyp)// &
1342 ' package does not support TIMEARRAYSERIESFILE'
1344 call this%parser%StoreErrorUnit()
1346 call this%parser%GetStringCaps(keyword)
1347 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1348 errmsg =
'TAS6 keyword must be followed by "FILEIN" '// &
1351 call this%parser%StoreErrorUnit()
1353 call this%parser%GetString(fname)
1354 write (this%iout, fmttas) trim(fname)
1355 call this%TasManager%add_tasfile(fname)
1356 case (
'AUXMULTNAME')
1357 call this%parser%GetStringCaps(sfacauxname)
1358 this%iauxmultcol = -1
1359 write (this%iout,
'(4x,a,a)') &
1360 'AUXILIARY MULTIPLIER NAME: ', sfacauxname
1362 call this%parser%GetStringCaps(keyword)
1363 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1364 errmsg =
'OBS6 keyword must be followed by "FILEIN" '// &
1367 call this%parser%StoreErrorUnit()
1369 if (this%obs%active)
then
1370 errmsg =
'Multiple OBS6 keywords detected in OPTIONS block. '// &
1371 'Only one OBS6 entry allowed for a package.'
1374 this%obs%active = .true.
1375 call this%parser%GetString(this%obs%inputFilename)
1377 call openfile(inobs, this%iout, this%obs%inputFilename,
'OBS')
1378 this%obs%inUnitObs = inobs
1384 case (
'DEV_NO_NEWTON')
1385 call this%parser%DevOpt()
1387 write (this%iout,
'(4x,a)') &
1388 'NEWTON-RAPHSON method disabled for unconfined cells'
1392 call this%bnd_options(keyword, foundchildclassoption)
1395 if (.not. foundchildclassoption)
then
1396 write (
errmsg,
'(a,3(1x,a))') &
1397 'UNKNOWN', trim(adjustl(this%text)),
'OPTION:', trim(keyword)
1402 write (this%iout,
'(1x,a)') &
1403 'END OF '//trim(adjustl(this%text))//
' OPTIONS'
1405 write (this%iout,
'(1x,a)')
'NO '//trim(adjustl(this%text))// &
1406 ' OPTION BLOCK DETECTED.'
1410 if (this%iauxmultcol < 0)
then
1413 if (this%naux == 0)
then
1414 write (
errmsg,
'(a,2(1x,a))') &
1415 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
1416 'but no AUX variables specified.'
1421 this%iauxmultcol = 0
1423 if (sfacauxname == this%auxname(n))
then
1424 this%iauxmultcol = n
1430 if (this%iauxmultcol == 0)
then
1431 write (
errmsg,
'(a,2(1x,a))') &
1432 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
1433 'but no AUX variable found with this name.'
1440 call this%parser%StoreErrorUnit()
1456 class(
bndtype),
intent(inout) :: this
1458 character(len=LINELENGTH) :: keyword
1459 logical(LGP) :: isfound
1460 logical(LGP) :: endOfBlock
1461 integer(I4B) :: ierr
1464 call this%parser%GetBlock(
'DIMENSIONS', isfound, ierr, &
1465 supportopenclose=.true.)
1469 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1472 call this%parser%GetNextLine(endofblock)
1473 if (endofblock)
exit
1474 call this%parser%GetStringCaps(keyword)
1475 select case (keyword)
1477 this%maxbound = this%parser%GetInteger()
1478 write (this%iout,
'(4x,a,i7)')
'MAXBOUND = ', this%maxbound
1480 write (
errmsg,
'(a,3(1x,a))') &
1481 'Unknown', trim(this%text),
'dimension:', trim(keyword)
1486 write (this%iout,
'(1x,a)') &
1487 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
1489 call store_error(
'Required DIMENSIONS block not found.')
1490 call this%parser%StoreErrorUnit()
1494 if (this%maxbound <= 0)
then
1495 write (
errmsg,
'(a)')
'MAXBOUND must be an integer greater than zero.'
1501 call this%parser%StoreErrorUnit()
1506 call this%define_listlabel()
1525 class(
bndtype),
intent(inout) :: this
1526 integer(I4B),
intent(in) :: nlist
1527 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(in) :: rlist
1528 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: condinput
1534 condinput(l) = rlist(2, l)
1550 class(
bndtype),
intent(inout) :: this
1565 class(
bndtype),
intent(inout) :: this
1566 character(len=*),
intent(inout) :: option
1567 logical(LGP),
intent(inout) :: found
1584 class(
bndtype),
intent(inout) :: this
1589 if (this%inamedbound /= 0)
then
1590 do i = 1,
size(this%boundname)
1591 this%boundname_cst(i) = this%boundname(i)
1607 class(
bndtype),
intent(inout) :: this
1609 character(len=LINELENGTH) :: title
1610 character(len=LINELENGTH) :: text
1611 integer(I4B) :: ntabcol
1614 if (this%iprflow /= 0)
then
1618 if (this%inamedbound > 0)
then
1619 ntabcol = ntabcol + 1
1623 title = trim(adjustl(this%text))//
' PACKAGE ('//trim(this%packName)// &
1625 call table_cr(this%outputtab, this%packName, title)
1626 call this%outputtab%table_df(this%maxbound, ntabcol, this%iout, &
1629 call this%outputtab%initialize_column(text, 10, alignment=
tabcenter)
1631 call this%outputtab%initialize_column(text, 20, alignment=
tableft)
1633 call this%outputtab%initialize_column(text, 15, alignment=
tabcenter)
1634 if (this%inamedbound > 0)
then
1636 call this%outputtab%initialize_column(text,
lenboundname, &
1653 class(
bndtype),
intent(inout) :: this
1672 logical(LGP) :: supported
1710 class(
bndtype),
intent(inout) :: this
1715 character(len=LENBOUNDNAME) :: bname
1716 logical(LGP) :: jfound
1718 if (.not. this%bnd_obs_supported())
return
1720 do i = 1, this%obs%npakobs
1721 obsrv => this%obs%pakobs(i)%obsrv
1725 call obsrv%ResetObsIndex()
1726 obsrv%BndFound = .false.
1728 bname = obsrv%FeatureName
1729 if (bname /=
'')
then
1735 do j = 1, this%nbound
1736 if (this%boundname(j) == bname)
then
1738 obsrv%BndFound = .true.
1739 obsrv%CurrentTimeStepEndValue =
dzero
1740 call obsrv%AddObsIndex(j)
1747 jloop:
do j = 1, this%nbound
1748 if (this%nodelist(j) == obsrv%NodeNumber)
then
1750 obsrv%BndFound = .true.
1751 obsrv%CurrentTimeStepEndValue =
dzero
1752 call obsrv%AddObsIndex(j)
1783 call this%obs%obs_bd_clear()
1786 do i = 1, this%obs%npakobs
1787 obsrv => this%obs%pakobs(i)%obsrv
1788 if (obsrv%BndFound)
then
1789 do n = 1, obsrv%indxbnds_count
1790 if (obsrv%ObsTypeId ==
'TO-MVR')
then
1791 if (this%imover == 1)
then
1792 v = this%pakmvrobj%get_qtomvr(obsrv%indxbnds(n))
1800 v = this%simvals(obsrv%indxbnds(n))
1802 call this%obs%SaveOneSimval(obsrv, v)
1805 call this%obs%SaveOneSimval(obsrv,
dnodata)
1824 call this%obs%obs_ot()
1841 class(
bndtype),
intent(inout) :: this
1855 class(*),
pointer,
intent(inout) :: obj
1856 class(
bndtype),
pointer :: res
1862 if (.not.
associated(obj))
return
1881 type(
listtype),
intent(inout) :: list
1882 class(
bndtype),
pointer,
intent(inout) :: bnd
1884 class(*),
pointer :: obj
1902 type(
listtype),
intent(inout) :: list
1903 integer(I4B),
intent(in) :: idx
1904 class(
bndtype),
pointer :: res
1906 class(*),
pointer :: obj
1909 obj => list%GetItem(idx)
1923 outputtab, nbound, nodelist, flow, ibound, &
1924 title, text, ipakcb, dis, naux, textmodel, &
1925 textpackage, dstmodel, dstpackage, &
1926 auxname, auxvar, iout, inamedbound, &
1931 integer(I4B),
intent(in) :: icbcfl
1932 integer(I4B),
intent(in) :: ibudfl
1933 integer(I4B),
intent(in) :: icbcun
1934 integer(I4B),
intent(in) :: iprflow
1935 type(
tabletype),
pointer,
intent(inout) :: outputtab
1936 integer(I4B),
intent(in) :: nbound
1937 integer(I4B),
dimension(:),
contiguous,
intent(in) :: nodelist
1938 real(dp),
dimension(:),
contiguous,
intent(in) :: flow
1939 integer(I4B),
dimension(:),
contiguous,
intent(in) :: ibound
1940 character(len=*),
intent(in) :: title
1941 character(len=*),
intent(in) :: text
1942 integer(I4B),
intent(in) :: ipakcb
1944 integer(I4B),
intent(in) :: naux
1945 character(len=*),
intent(in) :: textmodel
1946 character(len=*),
intent(in) :: textpackage
1947 character(len=*),
intent(in) :: dstmodel
1948 character(len=*),
intent(in) :: dstpackage
1949 character(len=*),
dimension(:),
intent(in) :: auxname
1950 real(dp),
dimension(:, :),
intent(in) :: auxvar
1951 integer(I4B),
intent(in) :: iout
1952 integer(I4B),
intent(in) :: inamedbound
1953 character(len=LENBOUNDNAME),
dimension(:),
contiguous :: boundname
1954 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
1956 character(len=20) :: nodestr
1957 integer(I4B) :: nodeu
1958 integer(I4B) :: maxrows
1960 integer(I4B) :: node
1962 integer(I4B) :: ibinun
1963 integer(I4B) :: nboundcount
1966 character(len=LENBOUNDNAME) :: bname
1969 if (iprflow /= 0)
then
1970 call outputtab%set_kstpkper(
kstp,
kper)
1975 if (ibudfl /= 0 .and. iprflow /= 0)
then
1979 maxrows = maxrows + 1
1982 if (maxrows > 0)
then
1983 call outputtab%set_maxbound(maxrows)
1985 call outputtab%set_title(title)
1989 if (ipakcb < 0)
then
1991 else if (ipakcb == 0)
then
1996 if (icbcfl == 0)
then
2001 if (ibinun /= 0)
then
2009 if (node > 0) nboundcount = nboundcount + 1
2011 call dis%record_srcdst_list_header(text, textmodel, textpackage, &
2012 dstmodel, dstpackage, naux, &
2013 auxname, ibinun, nboundcount, iout)
2017 if (nbound > 0)
then
2023 if (inamedbound > 0)
then
2024 bname = boundname(i)
2039 if (ibudfl /= 0)
then
2040 if (iprflow /= 0)
then
2043 nodeu = dis%get_nodeuser(node)
2044 call dis%nodeu_to_string(nodeu, nodestr)
2045 call outputtab%print_list_entry(i, trim(adjustl(nodestr)), &
2051 if (ibinun /= 0)
then
2053 if (
present(imap)) n2 = imap(i)
2054 call dis%record_mf6_list_entry(ibinun, node, n2, rrate, naux, &
2055 auxvar(:, i), olconv2=.false.)
2060 if (ibudfl /= 0)
then
2061 if (iprflow /= 0)
then
2062 write (iout,
'(1x)')
2082 class(
bndtype),
intent(inout) :: this
2091 call mem_reallocate(this%condinput, this%maxbound,
'CONDINPUT', &
2093 do i = 1, this%maxbound
2094 this%condinput(i) =
dzero
2099 write (this%iout,
'(/1x,a,a)')
'VISCOSITY ACTIVE IN ', &
2100 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.