28 character(len=LENMODELNAME) :: gwfmodelname1 =
''
29 character(len=LENMODELNAME) :: gwfmodelname2 =
''
30 integer(I4B),
pointer :: maxpackages
31 integer(I4B),
pointer :: ibudgetout => null()
32 integer(I4B),
pointer :: ibudcsv => null()
33 real(dp),
pointer :: eqnsclfac => null()
39 character(len=LENPACKAGENAME), &
40 dimension(:),
pointer,
contiguous :: paknames => null()
41 character(len=LENVARNAME) :: depvartype =
''
73 subroutine mvt_cr(mvt, name_model, inunit, iout, fmi1, eqnsclfac, &
74 depvartype, gwfmodelname1, gwfmodelname2, fmi2)
77 character(len=*),
intent(in) :: name_model
78 integer(I4B),
intent(in) :: inunit
79 integer(I4B),
intent(in) :: iout
81 real(dp),
intent(in),
pointer :: eqnsclfac
82 character(len=LENVARNAME),
intent(in) :: depvartype
83 character(len=*),
intent(in),
optional :: gwfmodelname1
84 character(len=*),
intent(in),
optional :: gwfmodelname2
85 type(
tspfmitype),
intent(in),
target,
optional :: fmi2
91 call mvt%set_names(1, name_model,
'MVT',
'MVT')
94 call mvt%allocate_scalars()
104 if (
present(fmi2))
then
109 if (
present(gwfmodelname1))
then
110 mvt%gwfmodelname1 = gwfmodelname1
112 if (
present(gwfmodelname2))
then
113 mvt%gwfmodelname2 = gwfmodelname2
120 mvt%eqnsclfac => eqnsclfac
124 mvt%depvartype = depvartype
137 character(len=*),
parameter :: fmtmvt = &
138 "(1x,/1x,'MVT -- MOVER TRANSPORT PACKAGE, VERSION 1, 4/15/2020', &
139 &' INPUT READ FROM UNIT ', i0, //)"
145 write (this%iout, fmtmvt) this%inunit
148 call this%parser%Initialize(this%inunit, this%iout)
151 call budget_cr(this%budget, this%memoryPath)
154 call this%read_options()
169 this%mvrbudobj => mvrbudobj
179 call this%mvt_setup_outputtab()
198 if (
associated(this%fmi1, this%fmi2))
then
199 call this%set_pointer_mvrbudobj(this%fmi1%mvrbudobj)
203 call this%mvt_scan_mvrbudobj()
204 call this%mvt_setup_budobj()
207 call this%budget%budget_df(this%maxpackages,
'TRANSPORT MOVER', bddim=
'M')
208 call this%budget%set_ibudcsv(this%ibudcsv)
226 real(DP),
intent(in),
dimension(:),
contiguous,
target :: cnew1
227 real(DP),
intent(in),
dimension(:),
contiguous,
target :: cnew2
230 integer(I4B) :: id1, id2, nlist
231 integer(I4B) :: ipr, irc
232 integer(I4B) :: igwtnode
233 integer(I4B) :: nbudterm
235 real(DP),
dimension(:),
pointer :: concpak
236 real(DP),
dimension(:),
contiguous,
pointer :: cnew
241 nbudterm = this%mvrbudobj%nbudterm
243 nlist = this%mvrbudobj%budterm(i)%nlist
247 call this%set_fmi_pr_rc(i, fmi_pr, fmi_rc)
252 if (
associated(fmi_pr, this%fmi2))
then
257 call fmi_pr%get_package_index(this%mvrbudobj%budterm(i)%text2id1, ipr)
260 call fmi_rc%get_package_index(this%mvrbudobj%budterm(i)%text2id2, irc)
263 if (fmi_pr%iatp(ipr) /= 0)
then
264 concpak => fmi_pr%datp(ipr)%concpack
271 id1 = this%mvrbudobj%budterm(i)%id1(n)
272 id2 = this%mvrbudobj%budterm(i)%id2(n)
275 q = this%mvrbudobj%budterm(i)%flow(n)
279 if (fmi_pr%iatp(ipr) /= 0)
then
290 igwtnode = fmi_pr%gwfpackages(ipr)%nodelist(id1)
298 if (fmi_rc%iatp(irc) /= 0)
then
299 fmi_rc%datp(irc)%qmfrommvr(id2) = fmi_rc%datp(irc)%qmfrommvr(id2) - &
300 q * cp * this%eqnsclfac
322 integer(I4B),
intent(in) :: ibudterm
328 if (this%gwfmodelname1 ==
'' .and. this%gwfmodelname2 ==
'')
then
333 if (this%mvrbudobj%budterm(ibudterm)%text1id1 == this%gwfmodelname1)
then
336 else if (this%mvrbudobj%budterm(ibudterm)%text1id1 == &
337 this%gwfmodelname2)
then
343 print *, this%mvrbudobj%budterm(ibudterm)%text1id1
344 print *, this%gwfmodelname1
345 print *, this%gwfmodelname2
346 stop
"error in set_fmi_pr_rc"
350 if (this%mvrbudobj%budterm(ibudterm)%text1id2 == this%gwfmodelname1)
then
353 else if (this%mvrbudobj%budterm(ibudterm)%text1id2 == &
354 this%gwfmodelname2)
then
360 print *, this%mvrbudobj%budterm(ibudterm)%text1id2
361 print *, this%gwfmodelname1
362 print *, this%gwfmodelname2
363 stop
"error in set_fmi_pr_rc"
367 if (.not.
associated(fmi_pr))
then
368 print *,
'Could not find FMI Package...'
369 stop
"error in set_fmi_pr_rc"
371 if (.not.
associated(fmi_rc))
then
372 print *,
'Could not find FMI Package...'
373 stop
"error in set_fmi_pr_rc"
382 subroutine mvt_cc(this, kiter, iend, icnvgmod, cpak, dpak)
385 integer(I4B),
intent(in) :: kiter
386 integer(I4B),
intent(in) :: iend
387 integer(I4B),
intent(in) :: icnvgmod
388 character(len=LENPAKLOC),
intent(inout) :: cpak
389 real(DP),
intent(inout) :: dpak
391 character(len=*),
parameter :: fmtmvrcnvg = &
392 "(/,1x,'MOVER PACKAGE REQUIRES AT LEAST TWO OUTER ITERATIONS. CONVERGE &
393 &FLAG HAS BEEN RESET TO FALSE.')"
396 if (
associated(this%mvrbudobj))
then
397 if (icnvgmod == 1 .and. kiter == 1)
then
399 cpak = trim(this%packName)
400 write (this%iout, fmtmvrcnvg)
413 real(DP),
dimension(:),
contiguous,
intent(in) :: cnew1
414 real(DP),
dimension(:),
contiguous,
intent(in) :: cnew2
417 call this%mvt_fill_budobj(cnew1, cnew2)
430 integer(I4B),
intent(in) :: icbcfl
431 integer(I4B),
intent(in) :: ibudfl
433 integer(I4B) :: ibinun
437 if (this%ibudgetout /= 0)
then
438 ibinun = this%ibudgetout
440 if (icbcfl == 0) ibinun = 0
442 call this%budobj%save_flows(this%dis, ibinun,
kstp,
kper,
delt, &
455 integer(I4B),
intent(in) :: icbcfl
456 integer(I4B),
intent(in) :: ibudfl
459 if (ibudfl /= 0 .and. this%iprflow /= 0)
then
460 call this%mvt_print_outputtab()
474 integer(I4B),
intent(in) :: ibudfl
476 integer(I4B) :: i, j, n
477 real(DP),
allocatable,
dimension(:) :: ratin, ratout
480 allocate (ratin(this%maxpackages), ratout(this%maxpackages))
481 do j = 1, this%maxpackages
487 do i = 1, this%maxpackages
488 do j = 1, this%budobj%nbudterm
489 do n = 1, this%budobj%budterm(j)%nlist
492 if (this%paknames(i) == this%budobj%budterm(j)%text2id1)
then
493 ratin(i) = ratin(i) + this%budobj%budterm(j)%flow(n)
497 if (this%paknames(i) == this%budobj%budterm(j)%text2id2)
then
498 ratout(i) = ratout(i) + this%budobj%budterm(j)%flow(n)
505 call this%budget%reset()
506 do j = 1, this%maxpackages
507 call this%budget%addentry(ratin(j), ratout(j),
delt, this%paknames(j))
511 call this%budget%finalize_step(
delt)
512 if (ibudfl /= 0)
then
513 call this%budget%budget_ot(
kstp,
kper, this%iout)
517 call this%budget%writecsv(
totim)
520 deallocate (ratin, ratout)
543 if (this%inunit > 0)
then
546 deallocate (this%paknames)
549 call this%budget%budget_da()
550 deallocate (this%budget)
553 call this%budobj%budgetobject_da()
554 deallocate (this%budobj)
555 nullify (this%budobj)
558 if (
associated(this%outputtab))
then
559 call this%outputtab%table_da()
560 deallocate (this%outputtab)
561 nullify (this%outputtab)
568 this%mvrbudobj => null()
574 call this%NumericalPackageType%da()
591 call this%NumericalPackageType%allocate_scalars()
594 call mem_allocate(this%maxpackages,
'MAXPACKAGES', this%memoryPath)
595 call mem_allocate(this%ibudgetout,
'IBUDGETOUT', this%memoryPath)
596 call mem_allocate(this%ibudcsv,
'IBUDCSV', this%memoryPath)
616 character(len=LINELENGTH) :: errmsg, keyword
617 character(len=MAXCHARLEN) :: fname
619 logical :: isfound, endOfBlock
621 character(len=*),
parameter :: fmtflow = &
622 "(4x, a, 1x, a, 1x, ' WILL BE SAVED TO FILE: ', a, &
623 &/4x, 'OPENED ON UNIT: ', I0)"
624 character(len=*),
parameter :: fmtflow2 = &
625 &
"(4x, 'FLOWS WILL BE SAVED TO BUDGET FILE')"
628 call this%parser%GetBlock(
'OPTIONS', isfound, ierr, blockrequired=.false., &
629 supportopenclose=.true.)
633 write (this%iout,
'(1x,a)')
'PROCESSING MVT OPTIONS'
635 call this%parser%GetNextLine(endofblock)
637 call this%parser%GetStringCaps(keyword)
638 select case (keyword)
641 write (this%iout, fmtflow2)
644 write (this%iout,
'(4x,a)')
'MVT INPUT WILL BE PRINTED.'
647 write (this%iout,
'(4x,a)') &
648 'MVT FLOWS WILL BE PRINTED TO LISTING FILE.'
650 call this%parser%GetStringCaps(keyword)
651 if (keyword ==
'FILEOUT')
then
652 call this%parser%GetString(fname)
654 call openfile(this%ibudgetout, this%iout, fname,
'DATA(BINARY)', &
656 write (this%iout, fmtflow)
'MVT',
'BUDGET', trim(adjustl(fname)), &
660 &be followed by FILEOUT')
663 call this%parser%GetStringCaps(keyword)
664 if (keyword ==
'FILEOUT')
then
665 call this%parser%GetString(fname)
667 call openfile(this%ibudcsv, this%iout, fname,
'CSV', &
668 filstat_opt=
'REPLACE')
669 write (this%iout, fmtflow)
'MVT',
'BUDGET CSV', &
670 trim(adjustl(fname)), this%ibudcsv
672 call store_error(
'Optional BUDGETCSV keyword must be followed by &
676 write (errmsg,
'(a,a)')
'Unknown MVT option: ', &
679 call this%parser%StoreErrorUnit()
682 write (this%iout,
'(1x,a)')
'END OF MVT OPTIONS'
697 integer(I4B) :: nbudterm
699 integer(I4B) :: maxlist
702 character(len=LENMODELNAME) :: modelname1, modelname2
703 character(len=LENPACKAGENAME) :: packagename1, packagename2
704 character(len=LENBUDTXT) :: text
707 nbudterm = this%mvrbudobj%nbudterm
710 if (this%depvartype ==
'CONCENTRATION')
then
717 call this%budobj%budgetobject_df(ncv, nbudterm, 0, 0, bddim_opt=
'M')
722 modelname1 = this%mvrbudobj%budterm(i)%text1id1
723 packagename1 = this%mvrbudobj%budterm(i)%text2id1
724 modelname2 = this%mvrbudobj%budterm(i)%text1id2
725 packagename2 = this%mvrbudobj%budterm(i)%text2id2
726 maxlist = this%mvrbudobj%budterm(i)%maxlist
727 call this%budobj%budterm(i)%initialize(text, &
732 maxlist, .false., .false., &
745 real(DP),
intent(in),
dimension(:),
contiguous,
target :: cnew1
746 real(DP),
intent(in),
dimension(:),
contiguous,
target :: cnew2
750 real(DP),
dimension(:),
contiguous,
pointer :: cnew
751 integer(I4B) :: nbudterm
752 integer(I4B) :: nlist
757 integer(I4B) :: n1, n2
758 integer(I4B) :: igwtnode
765 nbudterm = this%mvrbudobj%nbudterm
767 nlist = this%mvrbudobj%budterm(i)%nlist
768 call this%set_fmi_pr_rc(i, fmi_pr, fmi_rc)
770 if (
associated(fmi_pr, this%fmi2))
then
773 call fmi_pr%get_package_index(this%mvrbudobj%budterm(i)%text2id1, ipr)
774 call fmi_rc%get_package_index(this%mvrbudobj%budterm(i)%text2id2, irc)
775 call this%budobj%budterm(i)%reset(nlist)
777 n1 = this%mvrbudobj%budterm(i)%id1(j)
778 n2 = this%mvrbudobj%budterm(i)%id2(j)
779 q = this%mvrbudobj%budterm(i)%flow(j)
781 if (fmi_pr%iatp(ipr) /= 0)
then
782 cp = fmi_pr%datp(ipr)%concpack(n1)
785 igwtnode = fmi_pr%gwfpackages(ipr)%nodelist(n1)
792 if (fmi_rc%iatp(irc) /= 0)
then
793 rate = -q * cp * this%eqnsclfac
797 call this%budobj%budterm(i)%update_term(n1, n2, rate)
802 call this%budobj%accumulate_terms()
815 integer(I4B) :: nbudterm
816 integer(I4B) :: maxpackages
822 nbudterm = this%mvrbudobj%nbudterm
824 if (i * i == nbudterm)
then
829 this%maxpackages = maxpackages
832 allocate (this%paknames(this%maxpackages))
833 do i = 1, this%maxpackages
834 this%paknames(i) =
''
842 if (this%mvrbudobj%budterm(i)%text2id1 == this%paknames(j))
then
847 if (.not. found)
then
848 this%paknames(ipos) = this%mvrbudobj%budterm(i)%text2id1
863 character(len=LINELENGTH) :: title
864 character(len=LINELENGTH) :: text
865 integer(I4B) :: ntabcol
866 integer(I4B) :: maxrow
870 if (this%iprflow /= 0)
then
877 title =
'TRANSPORT MOVER PACKAGE ('//trim(this%packName)// &
879 call table_cr(this%outputtab, this%packName, title)
880 call this%outputtab%table_df(maxrow, ntabcol, this%iout, &
883 call this%outputtab%initialize_column(text, 10, alignment=
tabcenter)
884 text =
'PROVIDER LOCATION'
886 call this%outputtab%initialize_column(text, ilen)
888 call this%outputtab%initialize_column(text, 10)
889 text =
'PROVIDER FLOW RATE'
890 call this%outputtab%initialize_column(text, 10)
891 text =
'PROVIDER TRANSPORT RATE'
892 call this%outputtab%initialize_column(text, 10)
893 text =
'RECEIVER LOCATION'
895 call this%outputtab%initialize_column(text, ilen)
897 call this%outputtab%initialize_column(text, 10)
913 character(len=LINELENGTH) :: title
914 character(len=LENMODELNAME + LENPACKAGENAME + 1) :: cloc1, cloc2
918 integer(I4B) :: ntabrows
919 integer(I4B) :: nlist
923 do i = 1, this%budobj%nbudterm
924 nlist = this%budobj%budterm(i)%nlist
925 ntabrows = ntabrows + nlist
929 call this%outputtab%set_kstpkper(
kstp,
kper)
932 title =
'TRANSPORT MOVER PACKAGE ('//trim(this%packName)// &
934 call this%outputtab%set_title(title)
935 call this%outputtab%set_maxbound(ntabrows)
939 do i = 1, this%budobj%nbudterm
940 nlist = this%budobj%budterm(i)%nlist
942 cloc1 = trim(adjustl(this%budobj%budterm(i)%text1id1))//
' '// &
943 trim(adjustl(this%budobj%budterm(i)%text2id1))
944 cloc2 = trim(adjustl(this%budobj%budterm(i)%text1id2))//
' '// &
945 trim(adjustl(this%budobj%budterm(i)%text2id2))
946 call this%outputtab%add_term(inum)
947 call this%outputtab%add_term(cloc1)
948 call this%outputtab%add_term(this%budobj%budterm(i)%id1(n))
949 call this%outputtab%add_term(-this%mvrbudobj%budterm(i)%flow(n))
950 call this%outputtab%add_term(this%budobj%budterm(i)%flow(n))
951 call this%outputtab%add_term(cloc2)
952 call this%outputtab%add_term(this%budobj%budterm(i)%id2(n))
This module contains the BudgetModule.
subroutine, public budget_cr(this, name_model)
@ brief Create a new budget object
subroutine, public budgetobject_cr(this, name)
Create a new budget object.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
@ tabcenter
centered 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 lenpakloc
maximum length of a package location
integer(i4b), parameter lenvarname
maximum length of a variable name
real(dp), parameter dzero
real constant zero
integer(i4b), parameter maxcharlen
maximum length of char string
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
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.
subroutine, public table_cr(this, name, title)
real(dp), pointer, public pertim
time relative to start of stress period
real(dp), pointer, public totim
time relative to start of simulation
integer(i4b), pointer, public kstp
current time step number
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
subroutine mvt_setup_outputtab(this)
Set up the mover-for-transport output table.
subroutine mvt_scan_mvrbudobj(this)
Determine max number of packages in use.
subroutine set_fmi_pr_rc(this, ibudterm, fmi_pr, fmi_rc)
@ brief Set the fmi_pr and fmi_rc pointers
subroutine set_pointer_mvrbudobj(this, mvrbudobj)
@ brief Set pointer to mvrbudobj
subroutine, public mvt_cr(mvt, name_model, inunit, iout, fmi1, eqnsclfac, depvartype, gwfmodelname1, gwfmodelname2, fmi2)
Create a new mover transport object.
subroutine mvt_ot_saveflow(this, icbcfl, ibudfl)
Write mover budget terms.
subroutine mvt_ot_bdsummary(this, ibudfl)
Write mover budget to listing file.
subroutine mvt_rp(this)
Read and prepare mover transport object.
subroutine mvt_cc(this, kiter, iend, icnvgmod, cpak, dpak)
Extra convergence check for mover.
subroutine read_options(this)
Read mover-for-transport options block.
subroutine mvt_setup_budobj(this)
Set up the budget object that stores all the mvr flows.
subroutine mvt_print_outputtab(this)
Set up mover-for-transport output table.
subroutine mvt_fill_budobj(this, cnew1, cnew2)
Copy mover-for-transport flow terms into thisbudobj.
subroutine mvt_df(this, dis)
Define mover transport object.
subroutine mvt_ar(this)
Allocate and read mover-for-transport information.
subroutine mvt_fc(this, cnew1, cnew2)
Calculate coefficients and fill amat and rhs.
subroutine mvt_da(this)
@ brief Deallocate memory
subroutine mvt_ot_printflow(this, icbcfl, ibudfl)
Print mover flow table.
subroutine mvt_bd(this, cnew1, cnew2)
Write mover terms to listing file.
subroutine allocate_scalars(this)
@ brief Allocate scalar variables for package
Derived type for the Budget object.