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))
89 if (this%numtsfiles > 0)
then
90 call this%HashBndTimeSeries()
102 character(len=*),
intent(in) :: fname
103 integer(I4B),
intent(in) :: inunit
105 integer(I4B) :: isize
110 if (this%numtsfiles > 0)
then
111 do i = 1, this%numtsfiles
112 if (this%tsfiles(i) == fname)
then
113 call store_error(
'Found duplicate time-series file name: '//trim(fname))
120 this%numtsfiles = this%numtsfiles + 1
121 isize =
size(this%tsfiles)
122 if (this%numtsfiles > isize)
then
125 this%tsfiles(this%numtsfiles) = fname
128 call this%tsfileList%Add(fname, this%iout, tsfile)
140 integer(I4B) :: i, nlinks, nauxlinks
141 real(DP) :: begintime, endtime, tsendtime
142 character(len=LENPACKAGENAME + 2) :: pkgID
144 character(len=*),
parameter :: fmt5 = &
145 "(/,'Time-series controlled values in stress period: ', i0, &
146 &', time step ', i0, ':')"
147 10
format(a,
' package: Boundary ', i0,
', entry ', i0, &
148 ' value from time series "', a,
'" = ', g12.5)
149 15
format(a,
' package: Boundary ', i0,
', entry ', i0, &
150 ' value from time series "', a,
'" = ', g12.5,
' (', a,
')')
151 20
format(a,
' package: Boundary ', i0,
', ', a, &
152 ' value from time series "', a,
'" = ', g12.5)
153 25
format(a,
' package: Boundary ', i0,
', ', a, &
154 ' value from time series "', a,
'" = ', g12.5,
' (', a,
')')
158 endtime = begintime +
delt
161 nlinks = this%boundtslinks%Count()
162 nauxlinks = this%auxvartslinks%Count()
169 do while (i <= nauxlinks)
171 timeseries => tslink%timeSeries
174 if (this%removeTsLinksOnCompletion)
then
175 tsendtime = timeseries%FindLatestTime(.true.)
176 if (tsendtime < begintime)
then
177 call this%auxvarTsLinks%RemoveNode(i, .true.)
178 nauxlinks = this%auxvartslinks%Count()
184 if (tslink%Iprpak == 1)
then
188 tslink%BndElement = timeseries%GetValue(begintime, endtime, &
189 this%extendTsToEndOfSimulation)
192 if (tslink%Iprpak == 1)
then
193 pkgid =
'"'//trim(tslink%PackageName)//
'"'
194 if (tslink%Text ==
'')
then
195 if (tslink%BndName ==
'')
then
196 write (this%iout, 10) trim(pkgid), tslink%IRow, tslink%JCol, &
197 trim(tslink%timeSeries%Name), &
200 write (this%iout, 15) trim(pkgid), tslink%IRow, tslink%JCol, &
201 trim(tslink%timeSeries%Name), &
202 tslink%BndElement, trim(tslink%BndName)
205 if (tslink%BndName ==
'')
then
206 write (this%iout, 20) trim(pkgid), tslink%IRow, trim(tslink%Text), &
207 trim(tslink%timeSeries%Name), &
210 write (this%iout, 25) trim(pkgid), tslink%IRow, trim(tslink%Text), &
211 trim(tslink%timeSeries%Name), &
212 tslink%BndElement, trim(tslink%BndName)
224 do while (i <= nlinks)
226 timeseries => tslink%timeSeries
229 if (this%removeTsLinksOnCompletion)
then
230 tsendtime = timeseries%FindLatestTime(.true.)
231 if (tsendtime < begintime)
then
232 call this%boundTsLinks%RemoveNode(i, .true.)
233 nlinks = this%boundTsLinks%Count()
238 if (i == 1 .and. nauxlinks == 0)
then
239 if (tslink%Iprpak == 1)
then
246 if (tslink%UseDefaultProc)
then
247 timeseries => tslink%timeSeries
248 tslink%BndElement = timeseries%GetValue(begintime, endtime, &
249 this%extendTsToEndOfSimulation)
254 if (
associated(tslink%RMultiplier))
then
255 tslink%BndElement = tslink%BndElement * tslink%RMultiplier
259 if (tslink%Iprpak == 1)
then
260 pkgid =
'"'//trim(tslink%PackageName)//
'"'
261 if (tslink%Text ==
'')
then
262 if (tslink%BndName ==
'')
then
263 write (this%iout, 10) trim(pkgid), tslink%IRow, tslink%JCol, &
264 trim(tslink%timeSeries%Name), &
267 write (this%iout, 15) trim(pkgid), tslink%IRow, tslink%JCol, &
268 trim(tslink%timeSeries%Name), &
269 tslink%BndElement, trim(tslink%BndName)
272 if (tslink%BndName ==
'')
then
273 write (this%iout, 20) trim(pkgid), tslink%IRow, trim(tslink%Text), &
274 trim(tslink%timeSeries%Name), &
277 write (this%iout, 25) trim(pkgid), tslink%IRow, trim(tslink%Text), &
278 trim(tslink%timeSeries%Name), &
279 tslink%BndElement, trim(tslink%BndName)
285 if (tslink%ConvertFlux)
then
286 tslink%BndElement = tslink%BndElement * tslink%CellArea
294 if (nlinks + nauxlinks > 0)
then
295 if (tslink%Iprpak == 1)
then
296 write (this%iout,
'()')
309 call this%boundTsLinks%Clear(.true.)
310 deallocate (this%boundTsLinks)
313 call this%auxvarTsLinks%Clear(.true.)
314 deallocate (this%auxvarTsLinks)
317 call this%tsfileList%da()
318 deallocate (this%tsfileList)
321 if (
associated(this%BndTsHashTable))
then
325 deallocate (this%tsfiles)
334 character(len=*),
intent(in) :: pkgName
336 integer(I4B) :: i, nlinks
346 nlinks = this%boundTsLinks%Count()
349 if (
associated(tslink))
then
350 if (tslink%PackageName == pkgname)
then
351 tslink%BndElement =
dzero
357 nlinks = this%boundTsLinks%Count()
360 if (
associated(tslink))
then
361 if (tslink%PackageName == pkgname)
then
362 call this%boundTsLinks%RemoveNode(i, .true.)
366 nlinks = this%auxvarTsLinks%Count()
369 if (
associated(tslink))
then
370 if (tslink%PackageName == pkgname)
then
371 call this%auxvarTsLinks%RemoveNode(i, .true.)
379 subroutine make_link(this, timeSeries, pkgName, auxOrBnd, bndElem, &
380 irow, jcol, iprpak, tsLink, text, bndName)
384 character(len=*),
intent(in) :: pkgName
385 character(len=3),
intent(in) :: auxOrBnd
386 real(DP),
pointer,
intent(inout) :: bndElem
387 integer(I4B),
intent(in) :: irow, jcol
388 integer(I4B),
intent(in) :: iprpak
390 character(len=*),
intent(in) :: text
391 character(len=*),
intent(in) :: bndName
395 auxorbnd, bndelem, irow, jcol, iprpak)
396 if (
associated(tslink))
then
397 if (auxorbnd ==
'BND')
then
399 elseif (auxorbnd ==
'AUX')
then
402 call store_error(
'programmer error in make_link', terminate=.true.)
405 tslink%BndName = bndname
411 function getlink(this, auxOrBnd, indx)
result(tsLink)
414 character(len=3),
intent(in) :: auxorbnd
415 integer(I4B),
intent(in) :: indx
423 select case (auxorbnd)
425 list => this%auxvarTsLinks
427 list => this%boundTsLinks
430 if (
associated(list))
then
442 character(len=3),
intent(in) :: auxorbnd
445 if (auxorbnd ==
'BND')
then
447 elseif (auxorbnd ==
'AUX')
then
457 character(len=*),
intent(in) :: name
466 if (.not.
associated(this%BndTsHashTable))
return
467 indx = this%BndTsHashTable%get(name)
469 res => this%TsContainers(indx)%timeSeries
480 integer(I4B) :: i, j, k, numtsfiles, numts
481 character(len=LENTIMESERIESNAME) :: name
488 numts = this%tsfileList%CountTimeSeries()
489 allocate (this%TsContainers(numts))
493 numtsfiles = this%tsfileList%Counttsfiles()
496 tsfile => this%tsfileList%Gettsfile(i)
497 numts = tsfile%Count()
500 this%TsContainers(k)%timeSeries => tsfile%GetTimeSeries(j)
501 if (
associated(this%TsContainers(k)%timeSeries))
then
502 name = this%TsContainers(k)%timeSeries%Name
503 call this%BndTsHashTable%add(name, k)
520 auxOrBnd, tsManager, iprpak, tsLink)
522 character(len=*),
intent(in) :: textinput
523 integer(I4B),
intent(in) :: ii
524 integer(I4B),
intent(in) :: jj
525 real(dp),
pointer,
intent(inout) :: bndelem
526 character(len=*),
intent(in) :: pkgname
527 character(len=3),
intent(in) :: auxorbnd
529 integer(I4B),
intent(in) :: iprpak
533 integer(I4B) :: istat
535 character(len=LINELENGTH) :: errmsg
536 character(len=LENTIMESERIESNAME) :: tsnametemp
538 read (textinput, *, iostat=istat) r
544 tsnametemp = textinput
546 timeseries => tsmanager%get_time_series(tsnametemp)
551 if (
associated(timeseries))
then
555 tsmanager%extendTsToEndOfSimulation)
559 call tsmanager%make_link(timeseries, pkgname, auxorbnd, bndelem, &
560 ii, jj, iprpak, tslink,
'',
'')
562 errmsg =
'Error in list input. Expected numeric value or '// &
563 "time-series name, but found '"//trim(textinput)//
"'."
586 auxOrBnd, tsManager, iprpak, varName)
588 character(len=*),
intent(in) :: textinput
589 integer(I4B),
intent(in) :: ii
590 integer(I4B),
intent(in) :: jj
591 real(dp),
pointer,
intent(inout) :: bndelem
592 character(len=*),
intent(in) :: pkgname
593 character(len=3),
intent(in) :: auxorbnd
595 integer(I4B),
intent(in) :: iprpak
596 character(len=*),
intent(in) :: varname
598 integer(I4B) :: istat
600 character(len=LINELENGTH) :: errmsg
601 character(len=LENTIMESERIESNAME) :: tsnametemp
607 read (textinput, *, iostat=istat) v
624 tsnametemp = textinput
629 timeseries => tsmanager%get_time_series(tsnametemp)
633 if (
associated(timeseries))
then
637 tsmanager%extendTsToEndOfSimulation)
642 pkgname, auxorbnd, varname)
645 call tsmanager%make_link(timeseries, pkgname, auxorbnd, bndelem, &
646 ii, jj, iprpak, tslink, varname,
'')
650 errmsg =
'Error in list input. Expected numeric value or '// &
651 "time-series name, but found '"//trim(textinput)//
"'."
670 pkgName, auxOrBnd, varName)
result(found)
675 integer(I4B),
intent(in) :: ii
676 integer(I4B),
intent(in) :: jj
677 character(len=*),
intent(in) :: pkgname
678 character(len=3),
intent(in) :: auxorbnd
679 character(len=*),
intent(in) :: varname
682 integer(I4B) :: nlinks
683 integer(I4B) :: removelink
687 nlinks = tsmanager%CountLinks(auxorbnd)
690 csearchlinks:
do i = 1, nlinks
691 tsltemp => tsmanager%GetLink(auxorbnd, i)
695 if (tsltemp%PackageName == pkgname)
then
698 if (tsltemp%IRow == ii .and. tsltemp%JCol == jj .and. &
708 if (removelink > 0)
then
709 if (auxorbnd ==
'BND')
then
710 call tsmanager%boundTsLinks%RemoveNode(removelink, .true.)
711 else if (auxorbnd ==
'AUX')
then
712 call tsmanager%auxvarTsLinks%RemoveNode(removelink, .true.)
730 character(len=*),
intent(in) :: pkgname
731 character(len=*),
intent(in) :: varname
732 character(len=3),
intent(in),
optional :: auxorbnd
734 character(len=3) :: ctstype
736 integer(I4B) :: nlinks
740 if (
present(auxorbnd))
then
748 nlinks = tsmanager%CountLinks(ctstype)
751 csearchlinks:
do i = 1, nlinks
752 tsltemp => tsmanager%GetLink(ctstype, i)
753 if (tsltemp%PackageName == pkgname)
then
756 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.