49 character(len=LENLISTLABEL),
pointer :: listlabel => null()
50 character(len=LENPACKAGENAME) :: text =
''
51 character(len=LENAUXNAME),
dimension(:),
pointer, &
52 contiguous :: auxname => null()
54 contiguous :: auxname_cst => null()
55 character(len=LENBOUNDNAME),
dimension(:),
pointer, &
56 contiguous :: boundname => null()
58 contiguous :: boundname_cst => null()
61 integer(I4B),
pointer :: isadvpak => null()
62 integer(I4B),
pointer :: ibcnum => null()
63 integer(I4B),
pointer :: maxbound => null()
64 integer(I4B),
pointer :: nbound => null()
65 integer(I4B),
pointer :: ncolbnd => null()
66 integer(I4B),
pointer :: iscloc => null()
67 integer(I4B),
pointer :: naux => null()
68 integer(I4B),
pointer :: inamedbound => null()
69 integer(I4B),
pointer :: iauxmultcol => null()
70 integer(I4B),
pointer :: npakeq => null()
71 integer(I4B),
pointer :: ioffset => null()
73 integer(I4B),
dimension(:),
pointer,
contiguous :: nodelist => null()
74 integer(I4B),
dimension(:),
pointer,
contiguous :: noupdateauxvar => null()
75 real(dp),
dimension(:, :),
pointer,
contiguous :: bound => null()
76 real(dp),
dimension(:),
pointer,
contiguous :: hcof => null()
77 real(dp),
dimension(:),
pointer,
contiguous :: rhs => null()
78 real(dp),
dimension(:, :),
pointer,
contiguous :: auxvar => null()
79 real(dp),
dimension(:),
pointer,
contiguous :: simvals => null()
80 real(dp),
dimension(:),
pointer,
contiguous :: simtomvr => null()
83 integer(I4B),
pointer :: imover => null()
87 integer(I4B),
pointer :: ivsc => null()
88 real(dp),
dimension(:),
pointer,
contiguous :: condinput => null()
93 integer(I4B) :: indxconvertflux = 0
94 logical(LGP) :: allowtimearrayseries = .false.
97 integer(I4B),
pointer :: inobspkg => null()
101 integer(I4B),
pointer :: neq
102 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound => null()
103 real(dp),
dimension(:),
pointer,
contiguous :: xnew => null()
104 real(dp),
dimension(:),
pointer,
contiguous :: xold => null()
105 real(dp),
dimension(:),
pointer,
contiguous :: flowja => null()
106 integer(I4B),
dimension(:),
pointer,
contiguous :: icelltype => null()
107 character(len=LENMEMPATH) :: ictmempath =
''
183 class(
bndtype),
intent(inout) :: this
184 integer(I4B),
intent(inout) :: neq
192 call tasmanager_cr(this%TasManager, dis, this%name_model, this%iout)
195 call obs_cr(this%obs, this%inobspkg)
198 write (this%iout, 1) this%filtyp, trim(adjustl(this%text)), this%inunit
199 1
format(1x, /1x, a,
' -- ', a,
' PACKAGE, VERSION 8, 2/22/2014', &
200 ' INPUT READ FROM UNIT ', i0)
203 call this%parser%Initialize(this%inunit, this%iout)
206 call this%read_options()
210 call this%tsmanager%tsmanager_df()
211 call this%tasmanager%tasmanager_df()
214 call this%read_dimensions()
217 if (this%npakeq > 0)
then
218 this%ioffset = neq - this%dis%nodes
222 neq = neq + this%npakeq
225 if (this%bnd_obs_supported())
then
226 call this%obs%obs_df(this%iout, this%packName, this%filtyp, this%dis)
227 call this%bnd_df_obs()
242 class(
bndtype),
intent(inout) :: this
243 integer(I4B),
intent(in) :: moffset
253 subroutine bnd_mc(this, moffset, matrix_sln)
255 class(
bndtype),
intent(inout) :: this
256 integer(I4B),
intent(in) :: moffset
270 class(
bndtype),
intent(inout) :: this
273 call this%obs%obs_ar()
276 call this%allocate_arrays()
279 call this%read_initial_attr()
282 if (this%imover == 1)
then
283 allocate (this%pakmvrobj)
284 call this%pakmvrobj%ar(this%maxbound, 0, this%memoryPath)
298 class(
bndtype),
intent(inout) :: this
301 integer(I4B) :: nlist
302 logical(LGP) :: isfound
303 character(len=LINELENGTH) :: line
305 character(len=*),
parameter :: fmtblkerr = &
306 &
"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
307 character(len=*),
parameter :: fmtlsp = &
308 &
"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
309 character(len=*),
parameter :: fmtnbd = &
310 "(1X,/1X,'THE NUMBER OF ACTIVE ',A,'S (',I6, &
311 &') IS GREATER THAN MAXIMUM(',I6,')')"
315 if (this%inunit == 0)
return
318 if (this%ionper <
kper)
then
321 call this%parser%GetBlock(
'PERIOD', isfound, ierr, &
322 supportopenclose=.true., &
323 blockrequired=.false.)
327 call this%read_check_ionper()
333 this%ionper =
nper + 1
336 call this%parser%GetCurrentLine(line)
337 write (
errmsg, fmtblkerr) adjustl(trim(line))
339 call this%parser%StoreErrorUnit()
345 if (this%ionper ==
kper)
then
349 call this%TsManager%Reset(this%packName)
350 call this%TasManager%Reset(this%packName)
353 call this%dis%read_list(this%parser%line_reader, &
354 this%parser%iuactive, this%iout, &
355 this%iprpak, nlist, this%inamedbound, &
356 this%iauxmultcol, this%nodelist, &
357 this%bound, this%auxvar, this%auxname, &
358 this%boundname, this%listlabel, &
359 this%packName, this%tsManager, this%iscloc)
363 if (this%ivsc == 1)
then
364 call this%bnd_store_user_cond(nlist, this%bound, this%condinput)
371 call this%bnd_rp_ts()
374 call this%parser%terminateblock()
377 call this%copy_boundname()
380 write (this%iout, fmtlsp) trim(this%filtyp)
395 real(DP) :: begintime, endtime
399 endtime = begintime +
delt
402 call this%TsManager%ad()
403 call this%TasManager%ad()
408 call this%obs%obs_ad()
418 class(
bndtype),
intent(inout) :: this
429 if (this%imover == 1)
then
430 call this%pakmvrobj%reset()
456 subroutine bnd_fc(this, rhs, ia, idxglo, matrix_sln)
459 real(DP),
dimension(:),
intent(inout) :: rhs
460 integer(I4B),
dimension(:),
intent(in) :: ia
461 integer(I4B),
dimension(:),
intent(in) :: idxglo
469 do i = 1, this%nbound
471 rhs(n) = rhs(n) + this%rhs(i)
473 call matrix_sln%add_value_pos(idxglo(ipos), this%hcof(i))
484 subroutine bnd_fn(this, rhs, ia, idxglo, matrix_sln)
487 real(DP),
dimension(:),
intent(inout) :: rhs
488 integer(I4B),
dimension(:),
intent(in) :: ia
489 integer(I4B),
dimension(:),
intent(in) :: idxglo
504 subroutine bnd_nur(this, neqpak, x, xtemp, dx, inewtonur, dxmax, locmax)
506 class(
bndtype),
intent(inout) :: this
507 integer(I4B),
intent(in) :: neqpak
508 real(DP),
dimension(neqpak),
intent(inout) :: x
509 real(DP),
dimension(neqpak),
intent(in) :: xtemp
510 real(DP),
dimension(neqpak),
intent(inout) :: dx
511 integer(I4B),
intent(inout) :: inewtonur
512 real(DP),
intent(inout) :: dxmax
513 integer(I4B),
intent(inout) :: locmax
529 subroutine bnd_cc(this, innertot, kiter, iend, icnvgmod, cpak, ipak, dpak)
531 class(
bndtype),
intent(inout) :: this
532 integer(I4B),
intent(in) :: innertot
533 integer(I4B),
intent(in) :: kiter
534 integer(I4B),
intent(in) :: iend
535 integer(I4B),
intent(in) :: icnvgmod
536 character(len=LENPAKLOC),
intent(inout) :: cpak
537 integer(I4B),
intent(inout) :: ipak
538 real(DP),
intent(inout) :: dpak
550 class(
bndtype),
intent(inout) :: this
551 real(DP),
dimension(:),
intent(in) :: x
552 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
553 integer(I4B),
optional,
intent(in) :: iadv
555 integer(I4B) :: imover
559 if (
present(iadv))
then
574 call this%bnd_cq_simrate(x, flowja, imover)
575 if (imover == 1)
then
576 call this%bnd_cq_simtomvr(flowja)
589 real(DP),
dimension(:),
intent(in) :: hnew
590 real(DP),
dimension(:),
intent(inout) :: flowja
591 integer(I4B),
intent(in) :: imover
595 integer(I4B) :: idiag
599 if (this%nbound > 0)
then
602 do i = 1, this%nbound
603 node = this%nodelist(i)
608 idiag = this%dis%con%ia(node)
609 if (this%ibound(node) > 0)
then
612 rrate = this%hcof(i) * hnew(node) - this%rhs(i)
614 flowja(idiag) = flowja(idiag) + rrate
618 this%simvals(i) = rrate
633 real(DP),
dimension(:),
intent(inout) :: flowja
642 if (this%nbound > 0)
then
645 do i = 1, this%nbound
646 node = this%nodelist(i)
651 if (this%ibound(node) > 0)
then
657 rrate = this%pakmvrobj%get_qtomvr(i)
666 if (fact >
done)
then
676 if (rrate >
dzero)
then
684 this%simtomvr(i) = rrate
702 type(
budgettype),
intent(inout) :: model_budget
704 character(len=LENPACKAGENAME) :: text
707 integer(I4B) :: isuppress_output
714 call model_budget%addentry(ratin, ratout,
delt, this%text, &
715 isuppress_output, this%packName)
716 if (this%imover == 1 .and. this%isadvpak == 0)
then
717 text = trim(adjustl(this%text))//
'-TO-MVR'
720 call model_budget%addentry(ratin, ratout,
delt, text, &
721 isuppress_output, this%packName)
734 integer(I4B),
intent(in) :: icbcfl
735 integer(I4B),
intent(in) :: ibudfl
749 integer(I4B),
intent(in) :: idvsave
750 integer(I4B),
intent(in) :: idvprint
764 integer(I4B),
intent(in) :: kstp
765 integer(I4B),
intent(in) :: kper
766 integer(I4B),
intent(in) :: iout
767 integer(I4B),
intent(in) :: ibudfl
781 integer(I4B),
intent(in) :: icbcfl
782 integer(I4B),
intent(in) :: ibudfl
783 integer(I4B),
intent(in) :: icbcun
784 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
786 character(len=LINELENGTH) :: title
787 character(len=LENPACKAGENAME) :: text
788 integer(I4B) :: imover
791 title = trim(adjustl(this%text))//
' PACKAGE ('//trim(this%packName)// &
793 if (
present(imap))
then
795 this%outputtab, this%nbound, this%nodelist, &
796 this%simvals, this%ibound, title, this%text, &
797 this%ipakcb, this%dis, this%naux, &
798 this%name_model, this%name_model, &
799 this%name_model, this%packName, &
800 this%auxname, this%auxvar, this%iout, &
801 this%inamedbound, this%boundname, imap)
804 this%outputtab, this%nbound, this%nodelist, &
805 this%simvals, this%ibound, title, this%text, &
806 this%ipakcb, this%dis, this%naux, &
807 this%name_model, this%name_model, &
808 this%name_model, this%packName, &
809 this%auxname, this%auxvar, this%iout, &
810 this%inamedbound, this%boundname)
818 if (this%isadvpak /= 0) imover = 0
819 if (imover == 1)
then
820 text = trim(adjustl(this%text))//
'-TO-MVR'
822 title = trim(adjustl(this%text))//
' PACKAGE ('// &
823 trim(this%packName)//
') FLOW RATES TO-MVR'
825 this%outputtab, this%nbound, this%nodelist, &
826 this%simtomvr, this%ibound, title, text, &
827 this%ipakcb, this%dis, this%naux, &
828 this%name_model, this%name_model, &
829 this%name_model, this%packName, &
830 this%auxname, this%auxvar, this%iout, &
831 this%inamedbound, this%boundname)
863 call mem_deallocate(this%noupdateauxvar,
'NOUPDATEAUXVAR', this%memoryPath)
872 call mem_deallocate(this%boundname_cst,
'BOUNDNAME_CST', this%memoryPath)
874 call mem_deallocate(this%auxname_cst,
'AUXNAME_CST', this%memoryPath)
875 nullify (this%icelltype)
878 if (this%imover /= 0)
then
879 call this%pakmvrobj%da()
880 deallocate (this%pakmvrobj)
881 nullify (this%pakmvrobj)
885 if (
associated(this%inputtab))
then
886 call this%inputtab%table_da()
887 deallocate (this%inputtab)
888 nullify (this%inputtab)
892 if (
associated(this%outputtab))
then
893 call this%outputtab%table_da()
894 deallocate (this%outputtab)
895 nullify (this%outputtab)
899 if (
associated(this%errortab))
then
900 call this%errortab%table_da()
901 deallocate (this%errortab)
902 nullify (this%errortab)
925 call this%obs%obs_da()
926 call this%TsManager%da()
927 call this%TasManager%da()
930 deallocate (this%obs)
931 deallocate (this%TsManager)
932 deallocate (this%TasManager)
933 nullify (this%TsManager)
934 nullify (this%TasManager)
937 call this%NumericalPackageType%da()
953 integer(I4B),
pointer :: imodelnewton => null()
956 call this%NumericalPackageType%allocate_scalars()
963 call mem_allocate(this%isadvpak,
'ISADVPAK', this%memoryPath)
964 call mem_allocate(this%ibcnum,
'IBCNUM', this%memoryPath)
965 call mem_allocate(this%maxbound,
'MAXBOUND', this%memoryPath)
966 call mem_allocate(this%nbound,
'NBOUND', this%memoryPath)
967 call mem_allocate(this%ncolbnd,
'NCOLBND', this%memoryPath)
968 call mem_allocate(this%iscloc,
'ISCLOC', this%memoryPath)
970 call mem_allocate(this%inamedbound,
'INAMEDBOUND', this%memoryPath)
971 call mem_allocate(this%iauxmultcol,
'IAUXMULTCOL', this%memoryPath)
972 call mem_allocate(this%inobspkg,
'INOBSPKG', this%memoryPath)
975 call mem_allocate(this%imover,
'IMOVER', this%memoryPath)
981 call mem_allocate(this%npakeq,
'NPAKEQ', this%memoryPath)
982 call mem_allocate(this%ioffset,
'IOFFSET', this%memoryPath)
985 allocate (this%TsManager)
986 allocate (this%TasManager)
1001 this%inamedbound = 0
1002 this%iauxmultcol = 0
1011 this%inewton = imodelnewton
1012 imodelnewton => null()
1026 integer(I4B),
dimension(:),
pointer,
contiguous,
optional :: nodelist
1027 real(DP),
dimension(:, :),
pointer,
contiguous,
optional :: auxvar
1033 if (
present(nodelist))
then
1034 this%nodelist => nodelist
1036 call mem_allocate(this%nodelist, this%maxbound,
'NODELIST', &
1038 do j = 1, this%maxbound
1039 this%nodelist(j) = 0
1045 call mem_allocate(this%noupdateauxvar, this%naux,
'NOUPDATEAUXVAR', &
1047 this%noupdateauxvar(:) = 0
1050 call mem_allocate(this%bound, this%ncolbnd, this%maxbound,
'BOUND', &
1055 call mem_allocate(this%condinput, 0,
'CONDINPUT', this%memoryPath)
1058 call mem_allocate(this%hcof, this%maxbound,
'HCOF', this%memoryPath)
1059 call mem_allocate(this%rhs, this%maxbound,
'RHS', this%memoryPath)
1062 call mem_allocate(this%simvals, this%maxbound,
'SIMVALS', this%memoryPath)
1063 if (this%imover == 1)
then
1064 call mem_allocate(this%simtomvr, this%maxbound,
'SIMTOMVR', &
1066 do i = 1, this%maxbound
1067 this%simtomvr(i) =
dzero
1070 call mem_allocate(this%simtomvr, 0,
'SIMTOMVR', this%memoryPath)
1074 if (
present(auxvar))
then
1075 this%auxvar => auxvar
1077 call mem_allocate(this%auxvar, this%naux, this%maxbound,
'AUXVAR', &
1079 do i = 1, this%maxbound
1081 this%auxvar(j, i) =
dzero
1087 if (this%inamedbound /= 0)
then
1089 'BOUNDNAME', this%memoryPath)
1091 'BOUNDNAME_CST', this%memoryPath)
1094 'BOUNDNAME', this%memoryPath)
1096 'BOUNDNAME_CST', this%memoryPath)
1102 if (this%ictMemPath /=
'')
then
1103 call mem_setptr(this%icelltype,
'ICELLTYPE', this%ictMemPath)
1107 do j = 1, this%maxbound
1108 do i = 1, this%ncolbnd
1109 this%bound(i, j) =
dzero
1112 do i = 1, this%maxbound
1113 this%hcof(i) =
dzero
1118 call this%pak_setup_outputtab()
1140 integer(I4B),
pointer :: neq
1141 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
1142 real(DP),
dimension(:),
pointer,
contiguous :: xnew
1143 real(DP),
dimension(:),
pointer,
contiguous :: xold
1144 real(DP),
dimension(:),
pointer,
contiguous :: flowja
1148 this%ibound => ibound
1151 this%flowja => flowja
1163 class(
bndtype),
intent(inout) :: this
1165 character(len=:),
allocatable :: line
1166 character(len=LINELENGTH) :: fname
1167 character(len=LINELENGTH) :: keyword
1168 character(len=LENAUXNAME) :: sfacauxname
1169 character(len=LENAUXNAME),
dimension(:),
allocatable :: caux
1170 integer(I4B) :: lloc
1171 integer(I4B) :: istart
1172 integer(I4B) :: istop
1174 integer(I4B) :: ierr
1175 integer(I4B) :: inobs
1176 logical(LGP) :: isfound
1177 logical(LGP) :: endOfBlock
1178 logical(LGP) :: foundchildclassoption
1180 character(len=*),
parameter :: fmtflow = &
1181 &
"(4x, 'FLOWS WILL BE SAVED TO FILE: ', a, /4x, 'OPENED ON UNIT: ', I7)"
1182 character(len=*),
parameter :: fmtflow2 = &
1183 &
"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE SPECIFIED IN OUTPUT CONTROL')"
1184 character(len=*),
parameter :: fmttas = &
1185 &
"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)"
1186 character(len=*),
parameter :: fmtts = &
1187 &
"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
1188 character(len=*),
parameter :: fmtnme = &
1194 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, &
1195 supportopenclose=.true., blockrequired=.false.)
1199 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text)) &
1202 call this%parser%GetNextLine(endofblock)
1203 if (endofblock)
then
1206 call this%parser%GetStringCaps(keyword)
1207 select case (keyword)
1208 case (
'AUX',
'AUXILIARY')
1209 call this%parser%GetRemainingLine(line)
1211 call urdaux(this%naux, this%parser%iuactive, this%iout, lloc, &
1212 istart, istop, caux, line, this%text)
1214 'AUXNAME', this%memoryPath)
1216 'AUXNAME_CST', this%memoryPath)
1218 this%auxname(n) = caux(n)
1219 this%auxname_cst(n) = caux(n)
1224 write (this%iout, fmtflow2)
1225 case (
'PRINT_INPUT')
1227 write (this%iout,
'(4x,a)') &
1228 'LISTS OF '//trim(adjustl(this%text))//
' CELLS WILL BE PRINTED.'
1229 case (
'PRINT_FLOWS')
1231 write (this%iout,
'(4x,a)') trim(adjustl(this%text))// &
1232 ' FLOWS WILL BE PRINTED TO LISTING FILE.'
1234 this%inamedbound = 1
1235 write (this%iout,
'(4x,a)') trim(adjustl(this%text))// &
1236 ' BOUNDARIES HAVE NAMES IN LAST COLUMN.'
1238 call this%parser%GetStringCaps(keyword)
1239 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1240 errmsg =
'TS6 keyword must be followed by "FILEIN" '// &
1244 call this%parser%GetString(fname)
1245 write (this%iout, fmtts) trim(fname)
1246 call this%TsManager%add_tsfile(fname, this%inunit)
1248 if (this%AllowTimeArraySeries)
then
1249 if (.not. this%dis%supports_layers())
then
1250 errmsg =
'TAS6 FILE cannot be used '// &
1251 'with selected discretization type.'
1255 errmsg =
'The '//trim(this%filtyp)// &
1256 ' package does not support TIMEARRAYSERIESFILE'
1258 call this%parser%StoreErrorUnit()
1260 call this%parser%GetStringCaps(keyword)
1261 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1262 errmsg =
'TAS6 keyword must be followed by "FILEIN" '// &
1265 call this%parser%StoreErrorUnit()
1267 call this%parser%GetString(fname)
1268 write (this%iout, fmttas) trim(fname)
1269 call this%TasManager%add_tasfile(fname)
1270 case (
'AUXMULTNAME')
1271 call this%parser%GetStringCaps(sfacauxname)
1272 this%iauxmultcol = -1
1273 write (this%iout,
'(4x,a,a)') &
1274 'AUXILIARY MULTIPLIER NAME: ', sfacauxname
1276 call this%parser%GetStringCaps(keyword)
1277 if (trim(adjustl(keyword)) /=
'FILEIN')
then
1278 errmsg =
'OBS6 keyword must be followed by "FILEIN" '// &
1281 call this%parser%StoreErrorUnit()
1283 if (this%obs%active)
then
1284 errmsg =
'Multiple OBS6 keywords detected in OPTIONS block. '// &
1285 'Only one OBS6 entry allowed for a package.'
1288 this%obs%active = .true.
1289 call this%parser%GetString(this%obs%inputFilename)
1291 call openfile(inobs, this%iout, this%obs%inputFilename,
'OBS')
1292 this%obs%inUnitObs = inobs
1298 case (
'DEV_NO_NEWTON')
1299 call this%parser%DevOpt()
1301 write (this%iout,
'(4x,a)') &
1302 'NEWTON-RAPHSON method disabled for unconfined cells'
1306 call this%bnd_options(keyword, foundchildclassoption)
1309 if (.not. foundchildclassoption)
then
1310 write (
errmsg,
'(a,3(1x,a))') &
1311 'UNKNOWN', trim(adjustl(this%text)),
'OPTION:', trim(keyword)
1316 write (this%iout,
'(1x,a)') &
1317 'END OF '//trim(adjustl(this%text))//
' OPTIONS'
1319 write (this%iout,
'(1x,a)')
'NO '//trim(adjustl(this%text))// &
1320 ' OPTION BLOCK DETECTED.'
1324 if (this%iauxmultcol < 0)
then
1327 if (this%naux == 0)
then
1328 write (
errmsg,
'(a,2(1x,a))') &
1329 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
1330 'but no AUX variables specified.'
1335 this%iauxmultcol = 0
1337 if (sfacauxname == this%auxname(n))
then
1338 this%iauxmultcol = n
1344 if (this%iauxmultcol == 0)
then
1345 write (
errmsg,
'(a,2(1x,a))') &
1346 'AUXMULTNAME was specified as', trim(adjustl(sfacauxname)), &
1347 'but no AUX variable found with this name.'
1354 call this%parser%StoreErrorUnit()
1366 class(
bndtype),
intent(inout) :: this
1368 character(len=LINELENGTH) :: keyword
1369 logical(LGP) :: isfound
1370 logical(LGP) :: endOfBlock
1371 integer(I4B) :: ierr
1374 call this%parser%GetBlock(
'DIMENSIONS', isfound, ierr, &
1375 supportopenclose=.true.)
1379 write (this%iout,
'(/1x,a)')
'PROCESSING '//trim(adjustl(this%text))// &
1382 call this%parser%GetNextLine(endofblock)
1383 if (endofblock)
exit
1384 call this%parser%GetStringCaps(keyword)
1385 select case (keyword)
1387 this%maxbound = this%parser%GetInteger()
1388 write (this%iout,
'(4x,a,i7)')
'MAXBOUND = ', this%maxbound
1390 write (
errmsg,
'(a,3(1x,a))') &
1391 'Unknown', trim(this%text),
'dimension:', trim(keyword)
1396 write (this%iout,
'(1x,a)') &
1397 'END OF '//trim(adjustl(this%text))//
' DIMENSIONS'
1399 call store_error(
'Required DIMENSIONS block not found.')
1400 call this%parser%StoreErrorUnit()
1404 if (this%maxbound <= 0)
then
1405 write (
errmsg,
'(a)')
'MAXBOUND must be an integer greater than zero.'
1411 call this%parser%StoreErrorUnit()
1416 call this%define_listlabel()
1431 class(
bndtype),
intent(inout) :: this
1432 integer(I4B),
intent(in) :: nlist
1433 real(DP),
dimension(:, :),
pointer,
contiguous,
intent(in) :: rlist
1434 real(DP),
dimension(:),
pointer,
contiguous,
intent(inout) :: condinput
1440 condinput(l) = rlist(2, l)
1452 class(
bndtype),
intent(inout) :: this
1463 class(
bndtype),
intent(inout) :: this
1464 character(len=*),
intent(inout) :: option
1465 logical(LGP),
intent(inout) :: found
1478 class(
bndtype),
intent(inout) :: this
1484 if (this%inamedbound /= 0)
then
1485 do i = 1,
size(this%boundname)
1486 this%boundname_cst(i) = this%boundname(i)
1498 class(
bndtype),
intent(inout) :: this
1500 character(len=LINELENGTH) :: title
1501 character(len=LINELENGTH) :: text
1502 integer(I4B) :: ntabcol
1505 if (this%iprflow /= 0)
then
1509 if (this%inamedbound > 0)
then
1510 ntabcol = ntabcol + 1
1514 title = trim(adjustl(this%text))//
' PACKAGE ('//trim(this%packName)// &
1516 call table_cr(this%outputtab, this%packName, title)
1517 call this%outputtab%table_df(this%maxbound, ntabcol, this%iout, &
1520 call this%outputtab%initialize_column(text, 10, alignment=
tabcenter)
1522 call this%outputtab%initialize_column(text, 20, alignment=
tableft)
1524 call this%outputtab%initialize_column(text, 15, alignment=
tabcenter)
1525 if (this%inamedbound > 0)
then
1527 call this%outputtab%initialize_column(text,
lenboundname, &
1540 class(
bndtype),
intent(inout) :: this
1555 logical(LGP) :: supported
1585 class(
bndtype),
intent(inout) :: this
1590 character(len=LENBOUNDNAME) :: bname
1591 logical(LGP) :: jfound
1593 if (.not. this%bnd_obs_supported())
return
1595 do i = 1, this%obs%npakobs
1596 obsrv => this%obs%pakobs(i)%obsrv
1600 call obsrv%ResetObsIndex()
1601 obsrv%BndFound = .false.
1603 bname = obsrv%FeatureName
1604 if (bname /=
'')
then
1610 do j = 1, this%nbound
1611 if (this%boundname(j) == bname)
then
1613 obsrv%BndFound = .true.
1614 obsrv%CurrentTimeStepEndValue =
dzero
1615 call obsrv%AddObsIndex(j)
1622 jloop:
do j = 1, this%nbound
1623 if (this%nodelist(j) == obsrv%NodeNumber)
then
1625 obsrv%BndFound = .true.
1626 obsrv%CurrentTimeStepEndValue =
dzero
1627 call obsrv%AddObsIndex(j)
1655 call this%obs%obs_bd_clear()
1658 do i = 1, this%obs%npakobs
1659 obsrv => this%obs%pakobs(i)%obsrv
1660 if (obsrv%BndFound)
then
1661 do n = 1, obsrv%indxbnds_count
1662 if (obsrv%ObsTypeId ==
'TO-MVR')
then
1663 if (this%imover == 1)
then
1664 v = this%pakmvrobj%get_qtomvr(obsrv%indxbnds(n))
1672 v = this%simvals(obsrv%indxbnds(n))
1674 call this%obs%SaveOneSimval(obsrv, v)
1677 call this%obs%SaveOneSimval(obsrv,
dnodata)
1692 call this%obs%obs_ot()
1705 class(
bndtype),
intent(inout) :: this
1715 class(
bndtype),
intent(inout) :: this
1725 class(*),
pointer,
intent(inout) :: obj
1726 class(
bndtype),
pointer :: res
1732 if (.not.
associated(obj))
return
1747 type(
listtype),
intent(inout) :: list
1748 class(
bndtype),
pointer,
intent(inout) :: bnd
1750 class(*),
pointer :: obj
1764 type(
listtype),
intent(inout) :: list
1765 integer(I4B),
intent(in) :: idx
1766 class(
bndtype),
pointer :: res
1768 class(*),
pointer :: obj
1771 obj => list%GetItem(idx)
1781 outputtab, nbound, nodelist, flow, ibound, &
1782 title, text, ipakcb, dis, naux, textmodel, &
1783 textpackage, dstmodel, dstpackage, &
1784 auxname, auxvar, iout, inamedbound, &
1789 integer(I4B),
intent(in) :: icbcfl
1790 integer(I4B),
intent(in) :: ibudfl
1791 integer(I4B),
intent(in) :: icbcun
1792 integer(I4B),
intent(in) :: iprflow
1793 type(
tabletype),
pointer,
intent(inout) :: outputtab
1794 integer(I4B),
intent(in) :: nbound
1795 integer(I4B),
dimension(:),
contiguous,
intent(in) :: nodelist
1796 real(dp),
dimension(:),
contiguous,
intent(in) :: flow
1797 integer(I4B),
dimension(:),
contiguous,
intent(in) :: ibound
1798 character(len=*),
intent(in) :: title
1799 character(len=*),
intent(in) :: text
1800 integer(I4B),
intent(in) :: ipakcb
1802 integer(I4B),
intent(in) :: naux
1803 character(len=*),
intent(in) :: textmodel
1804 character(len=*),
intent(in) :: textpackage
1805 character(len=*),
intent(in) :: dstmodel
1806 character(len=*),
intent(in) :: dstpackage
1807 character(len=*),
dimension(:),
intent(in) :: auxname
1808 real(dp),
dimension(:, :),
intent(in) :: auxvar
1809 integer(I4B),
intent(in) :: iout
1810 integer(I4B),
intent(in) :: inamedbound
1811 character(len=LENBOUNDNAME),
dimension(:),
contiguous :: boundname
1812 integer(I4B),
dimension(:),
optional,
intent(in) :: imap
1814 character(len=20) :: nodestr
1815 integer(I4B) :: nodeu
1816 integer(I4B) :: maxrows
1818 integer(I4B) :: node
1820 integer(I4B) :: ibinun
1821 integer(I4B) :: nboundcount
1823 real(dp),
dimension(naux) :: auxrow
1825 character(len=LENBOUNDNAME) :: bname
1828 if (iprflow /= 0)
then
1829 call outputtab%set_kstpkper(
kstp,
kper)
1834 if (ibudfl /= 0 .and. iprflow /= 0)
then
1838 maxrows = maxrows + 1
1841 if (maxrows > 0)
then
1842 call outputtab%set_maxbound(maxrows)
1844 call outputtab%set_title(title)
1848 if (ipakcb < 0)
then
1850 else if (ipakcb == 0)
then
1855 if (icbcfl == 0)
then
1860 if (ibinun /= 0)
then
1868 if (node > 0) nboundcount = nboundcount + 1
1870 call dis%record_srcdst_list_header(text, textmodel, textpackage, &
1871 dstmodel, dstpackage, naux, &
1872 auxname, ibinun, nboundcount, iout)
1876 if (nbound > 0)
then
1882 if (inamedbound > 0)
then
1883 bname = boundname(i)
1898 if (ibudfl /= 0)
then
1899 if (iprflow /= 0)
then
1902 nodeu = dis%get_nodeuser(node)
1903 call dis%nodeu_to_string(nodeu, nodestr)
1904 call outputtab%print_list_entry(i, trim(adjustl(nodestr)), &
1910 if (ibinun /= 0)
then
1912 if (
present(imap)) n2 = imap(i)
1914 auxrow(:) = auxvar(:, i)
1916 call dis%record_mf6_list_entry(ibinun, node, n2, rrate, naux, &
1917 auxrow, olconv2=.false.)
1922 if (ibudfl /= 0)
then
1923 if (iprflow /= 0)
then
1924 write (iout,
'(1x)')
1940 class(
bndtype),
intent(inout) :: this
1949 call mem_reallocate(this%condinput, this%maxbound,
'CONDINPUT', &
1951 do i = 1, this%maxbound
1952 this%condinput(i) =
dzero
1957 write (this%iout,
'(/1x,a,a)')
'VISCOSITY ACTIVE IN ', &
1958 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 bnd_fp(this)
Final processing at end of simulation (no-op by default)
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_log(this)
Log period input for a boundary package.
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
subroutine bnd_dt(this)
Submit an ATS time step request (no-op by default)
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.