28 character(len=LENFTYPE) ::
ftype =
'SSM'
29 character(len=LENPACKAGENAME) ::
text =
' SOURCE-SINK MIX'
39 integer(I4B),
pointer :: nbound
40 integer(I4B),
dimension(:),
pointer,
contiguous :: isrctype => null()
41 integer(I4B),
dimension(:),
pointer,
contiguous :: iauxpak => null()
42 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound => null()
43 real(dp),
dimension(:),
pointer,
contiguous :: cnew => null()
46 type(
gwtspctype),
dimension(:),
pointer :: ssmivec => null()
47 real(dp),
pointer :: eqnsclfac => null()
48 character(len=LENVARNAME) :: depvartype =
''
82 subroutine ssm_cr(ssmobj, name_model, inunit, iout, fmi, eqnsclfac, &
86 character(len=*),
intent(in) :: name_model
87 integer(I4B),
intent(in) :: inunit
88 integer(I4B),
intent(in) :: iout
90 real(dp),
intent(in),
pointer :: eqnsclfac
91 character(len=LENVARNAME),
intent(in) :: depvartype
97 call ssmobj%set_names(1, name_model,
'SSM',
'SSM')
100 call ssmobj%allocate_scalars()
103 ssmobj%inunit = inunit
106 ssmobj%eqnsclfac => eqnsclfac
109 call ssmobj%parser%Initialize(ssmobj%inunit, ssmobj%iout)
113 ssmobj%depvartype = depvartype
142 subroutine ssm_ar(this, dis, ibound, cnew)
148 integer(I4B),
dimension(:),
pointer,
contiguous :: ibound
149 real(DP),
dimension(:),
pointer,
contiguous :: cnew
152 character(len=*),
parameter :: fmtssm = &
153 "(1x,/1x,'SSM -- SOURCE-SINK MIXING PACKAGE, VERSION 1, 8/25/2017', &
154 &' INPUT READ FROM UNIT ', i0, //)"
157 write (this%iout, fmtssm) this%inunit
161 this%ibound => ibound
165 if (this%fmi%nflowpack == 0)
then
166 write (
errmsg,
'(a)')
'SSM package does not detect any boundary flows &
167 &that require SSM terms. Activate GWF-GWT &
168 &exchange or activate FMI package and provide a &
169 &budget file that contains boundary flows. If no &
170 &boundary flows are present in corresponding GWF &
171 &model then this SSM package should be removed.'
173 call this%parser%StoreErrorUnit()
177 call this%allocate_arrays()
180 call this%read_options()
183 call this%read_data()
186 call this%pak_setup_outputtab()
209 do ip = 1, this%fmi%nflowpack
210 if (this%fmi%iatp(ip) /= 0) cycle
211 if (this%isrctype(ip) == 3 .or. this%isrctype(ip) == 4)
then
212 ssmiptr => this%ssmivec(ip)
213 call ssmiptr%spc_rp()
244 do ip = 1, this%fmi%nflowpack
245 if (this%fmi%iatp(ip) /= 0) cycle
246 do i = 1, this%fmi%gwfpackages(ip)%nbound
247 node = this%fmi%gwfpackages(ip)%nodelist(i)
249 this%nbound = this%nbound + 1
256 do ip = 1, this%fmi%nflowpack
257 if (this%fmi%iatp(ip) /= 0) cycle
258 if (this%isrctype(ip) == 3 .or. this%isrctype(ip) == 4)
then
259 ssmiptr => this%ssmivec(ip)
260 call ssmiptr%spc_ad(this%fmi%gwfpackages(ip)%nbound, &
261 this%fmi%gwfpackages(ip)%budtxt)
276 subroutine ssm_term(this, ipackage, ientry, rrate, rhsval, hcofval, &
280 integer(I4B),
intent(in) :: ipackage
281 integer(I4B),
intent(in) :: ientry
282 real(DP),
intent(out),
optional :: rrate
283 real(DP),
intent(out),
optional :: rhsval
284 real(DP),
intent(out),
optional :: hcofval
285 real(DP),
intent(out),
optional :: cssm
286 real(DP),
intent(out),
optional :: qssm
288 logical(LGP) :: lauxmixed
290 integer(I4B) :: nbound_flow
302 nbound_flow = this%fmi%gwfpackages(ipackage)%nbound
303 n = this%fmi%gwfpackages(ipackage)%nodelist(ientry)
306 if (this%ibound(n) > 0)
then
309 qbnd = this%fmi%gwfpackages(ipackage)%get_flow(ientry)
310 call this%get_ssm_conc(ipackage, ientry, nbound_flow, ctmp, lauxmixed)
314 if (.not. lauxmixed)
then
319 if (qbnd >=
dzero)
then
324 if (ctmp <
dzero)
then
335 if (qbnd >=
dzero)
then
338 if (ctmp < this%cnew(n))
then
348 if (qbnd <=
dzero)
then
349 hcoftmp = qbnd * omega * this%eqnsclfac
351 rhstmp = -qbnd * ctmp * (
done - omega) * this%eqnsclfac
358 if (
present(hcofval)) hcofval = hcoftmp
359 if (
present(rhsval)) rhsval = rhstmp
360 if (
present(rrate)) rrate = hcoftmp * ctmp - rhstmp
361 if (
present(cssm)) cssm = ctmp
362 if (
present(qssm)) qssm = qbnd
381 integer(I4B),
intent(in) :: ipackage
382 integer(I4B),
intent(in) :: ientry
383 integer(I4B),
intent(in) :: nbound_flow
384 real(DP),
intent(out) :: conc
385 logical(LGP),
intent(out) :: lauxmixed
387 integer(I4B) :: isrctype
388 integer(I4B) :: iauxpos
392 isrctype = this%isrctype(ipackage)
394 select case (isrctype)
396 iauxpos = this%iauxpak(ipackage)
397 conc = this%fmi%gwfpackages(ipackage)%auxvar(iauxpos, ientry)
398 if (isrctype == 2) lauxmixed = .true.
400 conc = this%ssmivec(ipackage)%get_value(ientry, nbound_flow)
401 if (isrctype == 4) lauxmixed = .true.
413 subroutine ssm_fc(this, matrix_sln, idxglo, rhs)
418 integer(I4B),
intent(in),
dimension(:) :: idxglo
419 real(DP),
intent(inout),
dimension(:) :: rhs
424 integer(I4B) :: idiag
425 integer(I4B) :: nflowpack
426 integer(I4B) :: nbound
431 nflowpack = this%fmi%nflowpack
433 if (this%fmi%iatp(ip) /= 0) cycle
436 nbound = this%fmi%gwfpackages(ip)%nbound
438 n = this%fmi%gwfpackages(ip)%nodelist(i)
440 call this%ssm_term(ip, i, rhsval=rhsval, hcofval=hcofval)
441 idiag = idxglo(this%dis%con%ia(n))
442 call matrix_sln%add_value_pos(idiag, hcofval)
443 rhs(n) = rhs(n) + rhsval
463 real(DP),
dimension(:),
contiguous,
intent(inout) :: flowja
468 integer(I4B) :: idiag
472 do ip = 1, this%fmi%nflowpack
475 if (this%fmi%iatp(ip) /= 0) cycle
478 do i = 1, this%fmi%gwfpackages(ip)%nbound
479 n = this%fmi%gwfpackages(ip)%nodelist(i)
481 call this%ssm_term(ip, i, rrate=rate)
482 idiag = this%dis%con%ia(n)
483 flowja(idiag) = flowja(idiag) + rate
498 subroutine ssm_bd(this, isuppress_output, model_budget)
504 integer(I4B),
intent(in) :: isuppress_output
505 type(
budgettype),
intent(inout) :: model_budget
507 character(len=LENBUDROWLABEL) :: rowlabel
517 do ip = 1, this%fmi%nflowpack
520 if (this%fmi%iatp(ip) /= 0) cycle
527 do i = 1, this%fmi%gwfpackages(ip)%nbound
528 n = this%fmi%gwfpackages(ip)%nodelist(i)
530 call this%ssm_term(ip, i, rrate=rate)
531 if (rate <
dzero)
then
539 rowlabel =
'SSM_'//adjustl(trim(this%fmi%flowpacknamearray(ip)))
540 call model_budget%addentry(rin, rout,
delt, &
541 this%fmi%gwfpackages(ip)%budtxt, &
542 isuppress_output, rowlabel=rowlabel)
561 integer(I4B),
intent(in) :: icbcfl
562 integer(I4B),
intent(in) :: ibudfl
563 integer(I4B),
intent(in) :: icbcun
565 character(len=LINELENGTH) :: title
566 integer(I4B) :: node, nodeu
567 character(len=20) :: nodestr
568 integer(I4B) :: maxrows
570 integer(I4B) :: i, n2, ibinun
575 real(DP),
dimension(0, 0) :: auxvar
576 character(len=LENAUXNAME),
dimension(0) :: auxname
578 character(len=LENBOUNDNAME) :: bname
580 character(len=*),
parameter :: fmttkk = &
581 &
"(1X,/1X,A,' PERIOD ',I0,' STEP ',I0)"
585 if (ibudfl /= 0 .and. this%iprflow /= 0)
then
586 call this%outputtab%set_kstpkper(
kstp,
kper)
587 do ip = 1, this%fmi%nflowpack
588 if (this%fmi%iatp(ip) /= 0) cycle
591 do i = 1, this%fmi%gwfpackages(ip)%nbound
592 node = this%fmi%gwfpackages(ip)%nodelist(i)
594 maxrows = maxrows + 1
598 if (maxrows > 0)
then
599 call this%outputtab%set_maxbound(maxrows)
601 title =
'SSM PACKAGE ('//trim(this%packName)// &
603 call this%outputtab%set_title(title)
607 if (this%ipakcb < 0)
then
609 else if (this%ipakcb == 0)
then
614 if (icbcfl == 0) ibinun = 0
617 if (ibinun /= 0)
then
619 call this%dis%record_srcdst_list_header(
text, this%name_model, &
620 this%name_model, this%name_model, &
621 this%packName, naux, auxname, &
622 ibinun, this%nbound, this%iout)
626 if (this%nbound > 0)
then
629 do ip = 1, this%fmi%nflowpack
630 if (this%fmi%iatp(ip) /= 0) cycle
633 do i = 1, this%fmi%gwfpackages(ip)%nbound
636 node = this%fmi%gwfpackages(ip)%nodelist(i)
638 call this%ssm_term(ip, i, rrate=rrate, qssm=qssm, cssm=cssm)
642 if (ibudfl /= 0)
then
643 if (this%iprflow /= 0)
then
646 nodeu = this%dis%get_nodeuser(node)
647 call this%dis%nodeu_to_string(nodeu, nodestr)
648 bname = this%fmi%gwfpackages(ip)%name
649 call this%outputtab%add_term(i)
650 call this%outputtab%add_term(trim(adjustl(nodestr)))
651 call this%outputtab%add_term(qssm)
652 call this%outputtab%add_term(cssm)
653 call this%outputtab%add_term(rrate)
654 call this%outputtab%add_term(bname)
659 if (ibinun /= 0)
then
661 call this%dis%record_mf6_list_entry(ibinun, node, n2, rrate, &
662 naux, auxvar(:, i), &
670 if (ibudfl /= 0)
then
671 if (this%iprflow /= 0)
then
672 write (this%iout,
'(1x)')
694 if (this%inunit > 0)
then
695 do ip = 1,
size(this%ssmivec)
696 if (this%isrctype(ip) == 3 .or. this%isrctype(ip) == 4)
then
697 ssmiptr => this%ssmivec(ip)
698 call ssmiptr%spc_da()
701 deallocate (this%ssmivec)
705 if (this%inunit > 0)
then
708 this%ibound => null()
713 if (
associated(this%outputtab))
then
714 call this%outputtab%table_da()
715 deallocate (this%outputtab)
716 nullify (this%outputtab)
723 call this%NumericalPackageType%da()
741 call this%NumericalPackageType%allocate_scalars()
744 call mem_allocate(this%nbound,
'NBOUND', this%memoryPath)
763 integer(I4B) :: nflowpack
767 nflowpack = this%fmi%nflowpack
768 call mem_allocate(this%iauxpak, nflowpack,
'IAUXPAK', this%memoryPath)
769 call mem_allocate(this%isrctype, nflowpack,
'ISRCTYPE', this%memoryPath)
778 allocate (this%ssmivec(nflowpack))
793 character(len=LINELENGTH) :: keyword
795 logical :: isfound, endOfBlock
797 character(len=*),
parameter :: fmtiprflow = &
798 "(4x,'SSM FLOW INFORMATION WILL BE PRINTED TO LISTING FILE &
799 &WHENEVER ICBCFL IS NOT ZERO.')"
800 character(len=*),
parameter :: fmtisvflow = &
801 "(4x,'CELL-BY-CELL FLOW INFORMATION WILL BE SAVED TO BINARY FILE &
802 &WHENEVER ICBCFL IS NOT ZERO.')"
805 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, blockrequired=.false., &
806 supportopenclose=.true.)
810 write (this%iout,
'(1x,a)')
'PROCESSING SSM OPTIONS'
812 call this%parser%GetNextLine(endofblock)
814 call this%parser%GetStringCaps(keyword)
815 select case (keyword)
818 write (this%iout, fmtiprflow)
821 write (this%iout, fmtisvflow)
823 write (
errmsg,
'(a,a)')
'Unknown SSM option: ', trim(keyword)
825 call this%parser%StoreErrorUnit()
828 write (this%iout,
'(1x,a)')
'END OF SSM OPTIONS'
844 call this%read_sources_aux()
847 call this%read_sources_fileinput()
862 character(len=LINELENGTH) :: keyword
863 character(len=20) :: srctype
866 integer(I4B) :: nflowpack
867 integer(I4B) :: isrctype
868 logical :: isfound, endOfBlock
877 nflowpack = this%fmi%nflowpack
880 call this%parser%GetBlock(
'SOURCES', isfound, ierr, &
881 supportopenclose=.true., &
882 blockrequired=.true.)
884 write (this%iout,
'(1x,a)')
'PROCESSING SOURCES'
886 call this%parser%GetNextLine(endofblock)
890 call this%parser%GetStringCaps(keyword)
893 if (trim(adjustl(this%fmi%gwfpackages(ip)%name)) == keyword)
then
898 if (.not. pakfound)
then
899 write (
errmsg,
'(a,a)')
'Flow package cannot be found: ', &
902 call this%parser%StoreErrorUnit()
906 if (this%isrctype(ip) /= 0)
then
907 write (
errmsg,
'(a, a)') &
908 'A package cannot be specified more than once in the SSM SOURCES &
909 &block. The following package was specified more than once: ', &
912 call this%parser%StoreErrorUnit()
916 call this%parser%GetStringCaps(srctype)
917 select case (srctype)
919 write (this%iout,
'(1x,a)')
'AUX SOURCE DETECTED.'
922 write (this%iout,
'(1x,a)')
'AUXMIXED SOURCE DETECTED.'
926 write (
errmsg,
'(a, a)') &
927 'SRCTYPE must be AUX or AUXMIXED. Found: ', trim(srctype)
929 call this%parser%StoreErrorUnit()
933 this%isrctype(ip) = isrctype
936 call this%set_iauxpak(ip, trim(keyword))
939 write (this%iout,
'(1x,a)')
'END PROCESSING SOURCES'
941 write (
errmsg,
'(a)')
'Required SOURCES block not found.'
943 call this%parser%StoreErrorUnit()
948 call this%parser%StoreErrorUnit()
964 character(len=LINELENGTH) :: keyword
965 character(len=LINELENGTH) :: keyword2
966 character(len=20) :: srctype
969 integer(I4B) :: nflowpack
970 integer(I4B) :: isrctype
971 logical :: isfound, endOfBlock
980 nflowpack = this%fmi%nflowpack
983 call this%parser%GetBlock(
'FILEINPUT', isfound, ierr, &
984 supportopenclose=.true., &
985 blockrequired=.false.)
987 write (this%iout,
'(1x,a)')
'PROCESSING FILEINPUT'
989 call this%parser%GetNextLine(endofblock)
993 call this%parser%GetStringCaps(keyword)
996 if (trim(adjustl(this%fmi%gwfpackages(ip)%name)) == keyword)
then
1001 if (.not. pakfound)
then
1002 write (
errmsg,
'(a,a)')
'Flow package cannot be found: ', &
1005 call this%parser%StoreErrorUnit()
1009 if (this%isrctype(ip) /= 0)
then
1010 write (
errmsg,
'(a, a)') &
1011 'A package cannot be specified more than once in the SSM SOURCES &
1012 &and SOURCES_FILES blocks. The following package was specified &
1013 &more than once: ', &
1016 call this%parser%StoreErrorUnit()
1020 call this%parser%GetStringCaps(srctype)
1021 select case (srctype)
1023 write (this%iout,
'(1x,a)')
'SPC6 SOURCE DETECTED.'
1027 call this%parser%GetStringCaps(keyword2)
1028 if (trim(adjustl(keyword2)) /=
'FILEIN')
then
1029 errmsg =
'SPC6 keyword must be followed by "FILEIN" '// &
1030 'then by filename and optionally by <MIXED>.'
1032 call this%parser%StoreErrorUnit()
1037 call this%set_ssmivec(ip, trim(keyword))
1040 call this%parser%GetStringCaps(keyword2)
1041 if (trim(keyword2) ==
'MIXED')
then
1043 write (this%iout,
'(1x,a,a)')
'ASSIGNED MIXED SSM TYPE TO PACKAGE ', &
1047 write (
errmsg,
'(a,a)') &
1048 'SRCTYPE must be SPC6. Found: ', trim(srctype)
1050 call this%parser%StoreErrorUnit()
1054 this%isrctype(ip) = isrctype
1057 write (this%iout,
'(1x,a)')
'END PROCESSING FILEINPUT'
1059 write (this%iout,
'(1x,a)') &
1060 'OPTIONAL FILEINPUT BLOCK NOT FOUND. CONTINUING.'
1065 call this%parser%StoreErrorUnit()
1083 integer(I4B),
intent(in) :: ip
1084 character(len=*),
intent(in) :: packname
1086 character(len=LENAUXNAME) :: auxname
1088 integer(I4B) :: iaux
1091 call this%parser%GetStringCaps(auxname)
1093 do iaux = 1, this%fmi%gwfpackages(ip)%naux
1094 if (trim(this%fmi%gwfpackages(ip)%auxname(iaux)) == &
1100 if (.not. auxfound)
then
1101 write (
errmsg,
'(a, a)') &
1102 'Auxiliary name cannot be found: ', trim(auxname)
1104 call this%parser%StoreErrorUnit()
1108 this%iauxpak(ip) = iaux
1109 write (this%iout,
'(4x, a, i0, a, a)')
'USING AUX COLUMN ', &
1110 iaux,
' IN PACKAGE ', trim(packname)
1127 integer(I4B),
intent(in) :: ip
1128 character(len=*),
intent(in) :: packname
1130 character(len=LINELENGTH) :: filename
1132 integer(I4B) :: inunit
1135 call this%parser%GetString(filename)
1137 call openfile(inunit, this%iout, filename,
'SPC', filstat_opt=
'OLD')
1140 ssmiptr => this%ssmivec(ip)
1141 call ssmiptr%initialize(this%dis, ip, inunit, this%iout, this%name_model, &
1144 write (this%iout,
'(4x, a, a, a, a, a)')
'USING SPC INPUT FILE ', &
1145 trim(filename),
' TO SET ', trim(this%depvartype), &
1146 'S FOR PACKAGE ', trim(packname)
1160 character(len=LINELENGTH) :: title
1161 character(len=LINELENGTH) :: text
1162 integer(I4B) :: ntabcol
1165 if (this%iprflow /= 0)
then
1174 title =
'SSM PACKAGE ('//trim(this%packName)// &
1176 call table_cr(this%outputtab, this%packName, title)
1177 call this%outputtab%table_df(1, ntabcol, this%iout, transient=.true.)
1179 call this%outputtab%initialize_column(text, 10, alignment=
tabcenter)
1181 call this%outputtab%initialize_column(text, 20, alignment=
tableft)
1183 call this%outputtab%initialize_column(text, 15, alignment=
tabcenter)
1185 call this%outputtab%initialize_column(text, 15, alignment=
tabcenter)
1187 call this%outputtab%initialize_column(text, 15, alignment=
tabcenter)
1188 text =
'PACKAGE NAME'
1189 call this%outputtab%initialize_column(text, 16, alignment=
tabcenter)
This module contains the BudgetModule.
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 lenpackagename
maximum length of the package name
integer(i4b), parameter lenbudrowlabel
maximum length of the rowlabel string used in the budget table
integer(i4b), parameter lenvarname
maximum length of a variable name
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
real(dp), parameter done
real constant 1
This module contains the GwtSpc Module.
This module defines variable data types.
This module contains the base numerical package type.
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)
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
This module contains the TspSsm Module.
subroutine ssm_fc(this, matrix_sln, idxglo, rhs)
@ brief Fill coefficients
subroutine ssm_ot_flow(this, icbcfl, ibudfl, icbcun)
@ brief Output flows
subroutine ssm_term(this, ipackage, ientry, rrate, rhsval, hcofval, cssm, qssm)
@ brief Calculate the SSM mass flow rate and hcof and rhs values
subroutine allocate_scalars(this)
@ brief Allocate scalars
subroutine ssm_cq(this, flowja)
@ brief Calculate flow
subroutine ssm_bd(this, isuppress_output, model_budget)
@ brief Calculate the global SSM budget terms
subroutine pak_setup_outputtab(this)
@ brief Setup the output table
subroutine ssm_df(this)
@ brief Define SSM Package
subroutine set_ssmivec(this, ip, packname)
@ brief Set ssmivec array value for package ip
subroutine set_iauxpak(this, ip, packname)
@ brief Set iauxpak array value for package ip
subroutine get_ssm_conc(this, ipackage, ientry, nbound_flow, conc, lauxmixed)
@ brief Provide bound concentration (or temperature) and mixed flag
subroutine ssm_rp(this)
@ brief Read and prepare this SSM Package
subroutine read_sources_fileinput(this)
@ brief Read FILEINPUT block
character(len=lenpackagename) text
subroutine ssm_ar(this, dis, ibound, cnew)
@ brief Allocate and read SSM Package
subroutine read_sources_aux(this)
@ brief Read SOURCES block
subroutine, public ssm_cr(ssmobj, name_model, inunit, iout, fmi, eqnsclfac, depvartype)
@ brief Create a new SSM package
subroutine allocate_arrays(this)
@ brief Allocate arrays
character(len=lenftype) ftype
subroutine ssm_ad(this)
@ brief Advance the SSM Package
subroutine read_options(this)
@ brief Read package options
subroutine ssm_da(this)
@ brief Deallocate
subroutine read_data(this)
@ brief Read package data
Derived type for the Budget object.
Derived type for managing SPC input.
Derived type for the SSM Package.