30 integer(I4B),
public :: iout = 0
32 type(
listtype),
pointer,
public :: boundtslinks => null()
33 integer(I4B) :: numtsfiles = 0
34 character(len=MAXCHARLEN),
allocatable,
dimension(:) :: tsfiles
35 logical,
private :: removetslinksoncompletion = .false.
36 logical,
private :: extendtstoendofsimulation = .false.
37 type(
listtype),
pointer,
private :: auxvartslinks => null()
40 private :: tscontainers
63 extendTsToEndOfSimulation)
66 integer(I4B),
intent(in) :: iout
67 logical,
intent(in),
optional :: removetslinksoncompletion
68 logical,
intent(in),
optional :: extendtstoendofsimulation
71 if (
present(removetslinksoncompletion))
then
72 this%removeTsLinksOnCompletion = removetslinksoncompletion
74 if (
present(extendtstoendofsimulation))
then
75 this%extendTsToEndOfSimulation = extendtstoendofsimulation
77 allocate (this%boundTsLinks)
78 allocate (this%auxvarTsLinks)
79 allocate (this%tsfileList)
80 allocate (this%tsfiles(1000))
92 if (this%numtsfiles > 0)
then
93 call this%HashBndTimeSeries()
108 character(len=*),
intent(in) :: fname
109 integer(I4B),
intent(in) :: inunit
111 integer(I4B) :: isize
116 if (this%numtsfiles > 0)
then
117 do i = 1, this%numtsfiles
118 if (this%tsfiles(i) == fname)
then
119 call store_error(
'Found duplicate time-series file name: '//trim(fname))
126 this%numtsfiles = this%numtsfiles + 1
127 isize =
size(this%tsfiles)
128 if (this%numtsfiles > isize)
then
131 this%tsfiles(this%numtsfiles) = fname
134 call this%tsfileList%Add(fname, this%iout, tsfile)
149 integer(I4B) :: i, nlinks, nauxlinks
150 real(DP) :: begintime, endtime, tsendtime
151 character(len=LENPACKAGENAME + 2) :: pkgID
153 character(len=*),
parameter :: fmt5 = &
154 "(/,'Time-series controlled values in stress period: ', i0, &
155 &', time step ', i0, ':')"
156 10
format(a,
' package: Boundary ', i0,
', entry ', i0, &
157 ' value from time series "', a,
'" = ', g12.5)
158 15
format(a,
' package: Boundary ', i0,
', entry ', i0, &
159 ' value from time series "', a,
'" = ', g12.5,
' (', a,
')')
160 20
format(a,
' package: Boundary ', i0,
', ', a, &
161 ' value from time series "', a,
'" = ', g12.5)
162 25
format(a,
' package: Boundary ', i0,
', ', a, &
163 ' value from time series "', a,
'" = ', g12.5,
' (', a,
')')
167 endtime = begintime +
delt
170 nlinks = this%boundtslinks%Count()
171 nauxlinks = this%auxvartslinks%Count()
178 do while (i <= nauxlinks)
180 timeseries => tslink%timeSeries
183 if (this%removeTsLinksOnCompletion)
then
184 tsendtime = timeseries%FindLatestTime(.true.)
185 if (tsendtime < begintime)
then
186 call this%auxvarTsLinks%RemoveNode(i, .true.)
187 nauxlinks = this%auxvartslinks%Count()
193 if (tslink%Iprpak == 1)
then
197 tslink%BndElement = timeseries%GetValue(begintime, endtime, &
198 this%extendTsToEndOfSimulation)
201 if (tslink%Iprpak == 1)
then
202 pkgid =
'"'//trim(tslink%PackageName)//
'"'
203 if (tslink%Text ==
'')
then
204 if (tslink%BndName ==
'')
then
205 write (this%iout, 10) trim(pkgid), tslink%IRow, tslink%JCol, &
206 trim(tslink%timeSeries%Name), &
209 write (this%iout, 15) trim(pkgid), tslink%IRow, tslink%JCol, &
210 trim(tslink%timeSeries%Name), &
211 tslink%BndElement, trim(tslink%BndName)
214 if (tslink%BndName ==
'')
then
215 write (this%iout, 20) trim(pkgid), tslink%IRow, trim(tslink%Text), &
216 trim(tslink%timeSeries%Name), &
219 write (this%iout, 25) trim(pkgid), tslink%IRow, trim(tslink%Text), &
220 trim(tslink%timeSeries%Name), &
221 tslink%BndElement, trim(tslink%BndName)
233 do while (i <= nlinks)
235 timeseries => tslink%timeSeries
238 if (this%removeTsLinksOnCompletion)
then
239 tsendtime = timeseries%FindLatestTime(.true.)
240 if (tsendtime < begintime)
then
241 call this%boundTsLinks%RemoveNode(i, .true.)
242 nlinks = this%boundTsLinks%Count()
247 if (i == 1 .and. nauxlinks == 0)
then
248 if (tslink%Iprpak == 1)
then
255 if (tslink%UseDefaultProc)
then
256 timeseries => tslink%timeSeries
257 tslink%BndElement = timeseries%GetValue(begintime, endtime, &
258 this%extendTsToEndOfSimulation)
263 if (
associated(tslink%RMultiplier))
then
264 tslink%BndElement = tslink%BndElement * tslink%RMultiplier
268 if (tslink%Iprpak == 1)
then
269 pkgid =
'"'//trim(tslink%PackageName)//
'"'
270 if (tslink%Text ==
'')
then
271 if (tslink%BndName ==
'')
then
272 write (this%iout, 10) trim(pkgid), tslink%IRow, tslink%JCol, &
273 trim(tslink%timeSeries%Name), &
276 write (this%iout, 15) trim(pkgid), tslink%IRow, tslink%JCol, &
277 trim(tslink%timeSeries%Name), &
278 tslink%BndElement, trim(tslink%BndName)
281 if (tslink%BndName ==
'')
then
282 write (this%iout, 20) trim(pkgid), tslink%IRow, trim(tslink%Text), &
283 trim(tslink%timeSeries%Name), &
286 write (this%iout, 25) trim(pkgid), tslink%IRow, trim(tslink%Text), &
287 trim(tslink%timeSeries%Name), &
288 tslink%BndElement, trim(tslink%BndName)
294 if (tslink%ConvertFlux)
then
295 tslink%BndElement = tslink%BndElement * tslink%CellArea
303 if (nlinks + nauxlinks > 0)
then
304 if (tslink%Iprpak == 1)
then
305 write (this%iout,
'()')
321 call this%boundTsLinks%Clear(.true.)
322 deallocate (this%boundTsLinks)
325 call this%auxvarTsLinks%Clear(.true.)
326 deallocate (this%auxvarTsLinks)
329 call this%tsfileList%da()
330 deallocate (this%tsfileList)
333 if (
associated(this%BndTsHashTable))
then
337 deallocate (this%tsfiles)
349 character(len=*),
intent(in) :: pkgName
351 integer(I4B) :: i, nlinks
361 nlinks = this%boundTsLinks%Count()
364 if (
associated(tslink))
then
365 if (tslink%PackageName == pkgname)
then
366 tslink%BndElement =
dzero
372 nlinks = this%boundTsLinks%Count()
375 if (
associated(tslink))
then
376 if (tslink%PackageName == pkgname)
then
377 call this%boundTsLinks%RemoveNode(i, .true.)
381 nlinks = this%auxvarTsLinks%Count()
384 if (
associated(tslink))
then
385 if (tslink%PackageName == pkgname)
then
386 call this%auxvarTsLinks%RemoveNode(i, .true.)
397 subroutine make_link(this, timeSeries, pkgName, auxOrBnd, bndElem, &
398 irow, jcol, iprpak, tsLink, text, bndName)
402 character(len=*),
intent(in) :: pkgName
403 character(len=3),
intent(in) :: auxOrBnd
404 real(DP),
pointer,
intent(inout) :: bndElem
405 integer(I4B),
intent(in) :: irow, jcol
406 integer(I4B),
intent(in) :: iprpak
408 character(len=*),
intent(in) :: text
409 character(len=*),
intent(in) :: bndName
413 auxorbnd, bndelem, irow, jcol, iprpak)
414 if (
associated(tslink))
then
415 if (auxorbnd ==
'BND')
then
417 elseif (auxorbnd ==
'AUX')
then
420 call store_error(
'programmer error in make_link', terminate=.true.)
423 tslink%BndName = bndname
432 function getlink(this, auxOrBnd, indx)
result(tsLink)
435 character(len=3),
intent(in) :: auxorbnd
436 integer(I4B),
intent(in) :: indx
444 select case (auxorbnd)
446 list => this%auxvarTsLinks
448 list => this%boundTsLinks
451 if (
associated(list))
then
466 character(len=3),
intent(in) :: auxorbnd
469 if (auxorbnd ==
'BND')
then
471 elseif (auxorbnd ==
'AUX')
then
484 character(len=*),
intent(in) :: name
493 indx = this%BndTsHashTable%get(name)
495 res => this%TsContainers(indx)%timeSeries
509 integer(I4B) :: i, j, k, numtsfiles, numts
510 character(len=LENTIMESERIESNAME) :: name
517 numts = this%tsfileList%CountTimeSeries()
518 allocate (this%TsContainers(numts))
522 numtsfiles = this%tsfileList%Counttsfiles()
525 tsfile => this%tsfileList%Gettsfile(i)
526 numts = tsfile%Count()
529 this%TsContainers(k)%timeSeries => tsfile%GetTimeSeries(j)
530 if (
associated(this%TsContainers(k)%timeSeries))
then
531 name = this%TsContainers(k)%timeSeries%Name
532 call this%BndTsHashTable%add(name, k)
552 auxOrBnd, tsManager, iprpak, tsLink)
554 character(len=*),
intent(in) :: textinput
555 integer(I4B),
intent(in) :: ii
556 integer(I4B),
intent(in) :: jj
557 real(dp),
pointer,
intent(inout) :: bndelem
558 character(len=*),
intent(in) :: pkgname
559 character(len=3),
intent(in) :: auxorbnd
561 integer(I4B),
intent(in) :: iprpak
565 integer(I4B) :: istat
567 character(len=LINELENGTH) :: errmsg
568 character(len=LENTIMESERIESNAME) :: tsnametemp
570 read (textinput, *, iostat=istat) r
576 tsnametemp = textinput
578 timeseries => tsmanager%get_time_series(tsnametemp)
583 if (
associated(timeseries))
then
587 tsmanager%extendTsToEndOfSimulation)
591 call tsmanager%make_link(timeseries, pkgname, auxorbnd, bndelem, &
592 ii, jj, iprpak, tslink,
'',
'')
594 errmsg =
'Error in list input. Expected numeric value or '// &
595 "time-series name, but found '"//trim(textinput)//
"'."
618 auxOrBnd, tsManager, iprpak, varName)
620 character(len=*),
intent(in) :: textinput
621 integer(I4B),
intent(in) :: ii
622 integer(I4B),
intent(in) :: jj
623 real(dp),
pointer,
intent(inout) :: bndelem
624 character(len=*),
intent(in) :: pkgname
625 character(len=3),
intent(in) :: auxorbnd
627 integer(I4B),
intent(in) :: iprpak
628 character(len=*),
intent(in) :: varname
630 integer(I4B) :: istat
632 character(len=LINELENGTH) :: errmsg
633 character(len=LENTIMESERIESNAME) :: tsnametemp
639 read (textinput, *, iostat=istat) v
656 tsnametemp = textinput
661 timeseries => tsmanager%get_time_series(tsnametemp)
665 if (
associated(timeseries))
then
669 tsmanager%extendTsToEndOfSimulation)
674 pkgname, auxorbnd, varname)
677 call tsmanager%make_link(timeseries, pkgname, auxorbnd, bndelem, &
678 ii, jj, iprpak, tslink, varname,
'')
682 errmsg =
'Error in list input. Expected numeric value or '// &
683 "time-series name, but found '"//trim(textinput)//
"'."
705 pkgName, auxOrBnd, varName)
result(found)
710 integer(I4B),
intent(in) :: ii
711 integer(I4B),
intent(in) :: jj
712 character(len=*),
intent(in) :: pkgname
713 character(len=3),
intent(in) :: auxorbnd
714 character(len=*),
intent(in) :: varname
717 integer(I4B) :: nlinks
718 integer(I4B) :: removelink
722 nlinks = tsmanager%CountLinks(auxorbnd)
725 csearchlinks:
do i = 1, nlinks
726 tsltemp => tsmanager%GetLink(auxorbnd, i)
730 if (tsltemp%PackageName == pkgname)
then
733 if (tsltemp%IRow == ii .and. tsltemp%JCol == jj .and. &
743 if (removelink > 0)
then
744 if (auxorbnd ==
'BND')
then
745 call tsmanager%boundTsLinks%RemoveNode(removelink, .true.)
746 else if (auxorbnd ==
'AUX')
then
747 call tsmanager%auxvarTsLinks%RemoveNode(removelink, .true.)
768 character(len=*),
intent(in) :: pkgname
769 character(len=*),
intent(in) :: varname
770 character(len=3),
intent(in),
optional :: auxorbnd
772 character(len=3) :: ctstype
774 integer(I4B) :: nlinks
778 if (
present(auxorbnd))
then
786 nlinks = tsmanager%CountLinks(ctstype)
789 csearchlinks:
do i = 1, nlinks
790 tsltemp => tsmanager%GetLink(ctstype, i)
791 if (tsltemp%PackageName == pkgname)
then
794 if (
same_word(tsltemp%Text, varname))
then
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
integer(i4b), parameter lenpackagename
maximum length of the package name
integer(i4b), parameter lentimeseriesname
maximum length of a time series name
real(dp), parameter dzero
real constant zero
integer(i4b), parameter maxcharlen
maximum length of char string
A chaining hash map for integers.
subroutine, public hash_table_cr(map)
Create a hash table.
subroutine, public hash_table_da(map)
Deallocate the hash table.
This module defines variable data types.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
real(dp), pointer, public totim
time relative to start of simulation
real(dp), pointer, public totimc
simulation time at start of time step
integer(i4b), pointer, public kstp
current time step number
real(dp), pointer, public totimsav
saved value for totim, used for subtiming
integer(i4b), pointer, public kper
current stress period number
real(dp), pointer, public delt
length of the current time step
subroutine, public constructtimeserieslink(newTsLink, timeSeries, pkgName, auxOrBnd, bndElem, iRow, jCol, iprpak, text)
Construct time series link.
subroutine, public addtimeserieslinktolist(list, tslink)
Add time series link to a list.
type(timeserieslinktype) function, pointer, public gettimeserieslinkfromlist(list, indx)
Get time series link from a list.
subroutine reset(this, pkgName)
Call this when a new BEGIN PERIOD block is read for a new stress period.
subroutine make_link(this, timeSeries, pkgName, auxOrBnd, bndElem, irow, jcol, iprpak, tsLink, text, bndName)
Make link.
subroutine, public read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, auxOrBnd, tsManager, iprpak, varName)
Call this subroutine from advanced packages to define timeseries link for a variable (varName).
subroutine tsmgr_da(this)
Deallocate memory.
integer(i4b) function countlinks(this, auxOrBnd)
Count links.
type(timeserieslinktype) function, pointer getlink(this, auxOrBnd, indx)
Get link.
logical function, public var_timeseries(tsManager, pkgName, varName, auxOrBnd)
Determine if a timeseries link with varName is defined.
subroutine add_tsfile(this, fname, inunit)
Add a time series file to this manager.
subroutine tsmanager_df(this)
Define time series manager object.
subroutine hashbndtimeseries(this)
Store all boundary (stress) time series links in TsContainers and construct hash table BndTsHashTable...
subroutine tsmgr_ad(this)
Time step (or subtime step) advance. Call this each time step or subtime step.
subroutine, public tsmanager_cr(this, iout, removeTsLinksOnCompletion, extendTsToEndOfSimulation)
Create the tsmanager.
subroutine, public read_value_or_time_series(textInput, ii, jj, bndElem, pkgName, auxOrBnd, tsManager, iprpak, tsLink)
Call this subroutine if the time-series link is available or needed.
type(timeseriestype) function, pointer get_time_series(this, name)
Get time series.
logical function remove_existing_link(tsManager, ii, jj, pkgName, auxOrBnd, varName)
Remove an existing timeseries link if it is defined.
A generic heterogeneous doubly-linked list.