MODFLOW 6  version 6.8.0.dev0
USGS Modular Hydrologic Model
TimeSeriesManager.f90
Go to the documentation of this file.
2 
3  use kindmodule, only: dp, i4b
9  use listmodule, only: listtype
11  use tdismodule, only: delt, kper, kstp, totim, totimc, &
12  totimsav
21 
22  implicit none
23 
24  private
28 
30  integer(I4B), public :: iout = 0 ! output unit number
31  type(timeseriesfilelisttype), pointer, public :: tsfilelist => null() ! list of ts files objs
32  type(listtype), pointer, public :: boundtslinks => null() ! links to bound and aux
33  integer(I4B) :: numtsfiles = 0 ! number of ts files
34  character(len=MAXCHARLEN), allocatable, dimension(:) :: tsfiles ! list of ts files
35  logical, private :: removetslinksoncompletion = .false. ! flag indicating whether time series links should be removed in ad() once simulation time passes the end of the time series
36  logical, private :: extendtstoendofsimulation = .false. ! flag indicating whether time series should be extended to provide their final value for all times after the series end time
37  type(listtype), pointer, private :: auxvartslinks => null() ! list of aux links
38  type(hashtabletype), pointer, private :: bndtshashtable => null() ! hash of ts to tsobj
39  type(timeseriescontainertype), allocatable, dimension(:), &
40  private :: tscontainers
41 
42  contains
43 
44  ! -- Public procedures
45  procedure, public :: tsmanager_df
46  procedure, public :: ad => tsmgr_ad
47  procedure, public :: da => tsmgr_da
48  procedure, public :: add_tsfile
49  procedure, public :: countlinks
50  procedure, public :: getlink
51  procedure, public :: reset
52  procedure, public :: hashbndtimeseries
53  ! -- Private procedures
54  procedure, private :: get_time_series
55  procedure, private :: make_link
56  end type timeseriesmanagertype
57 
58 contains
59 
60  !> @brief Create the tsmanager
61  !<
62  subroutine tsmanager_cr(this, iout, removeTsLinksOnCompletion, &
63  extendTsToEndOfSimulation)
64  ! -- dummy
65  type(timeseriesmanagertype) :: this
66  integer(I4B), intent(in) :: iout
67  logical, intent(in), optional :: removetslinksoncompletion
68  logical, intent(in), optional :: extendtstoendofsimulation
69  !
70  this%iout = iout
71  if (present(removetslinksoncompletion)) then
72  this%removeTsLinksOnCompletion = removetslinksoncompletion
73  end if
74  if (present(extendtstoendofsimulation)) then
75  this%extendTsToEndOfSimulation = extendtstoendofsimulation
76  end if
77  allocate (this%boundTsLinks)
78  allocate (this%auxvarTsLinks)
79  allocate (this%tsfileList)
80  allocate (this%tsfiles(1000))
81  end subroutine tsmanager_cr
82 
83  !> @brief Define time series manager object
84  !<
85  subroutine tsmanager_df(this)
86  ! -- dummy
87  class(timeseriesmanagertype) :: this
88  !
89  if (this%numtsfiles > 0) then
90  call this%HashBndTimeSeries()
91  end if
92  end subroutine tsmanager_df
93 
94  !> @brief Add a time series file to this manager
95  !<
96  subroutine add_tsfile(this, fname, inunit)
97  ! -- modules
100  ! -- dummy
101  class(timeseriesmanagertype) :: this
102  character(len=*), intent(in) :: fname
103  integer(I4B), intent(in) :: inunit
104  ! -- local
105  integer(I4B) :: isize
106  integer(I4B) :: i
107  class(timeseriesfiletype), pointer :: tsfile => null()
108  !
109  ! -- Check for fname duplicates
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))
114  call store_error_unit(inunit)
115  end if
116  end do
117  end if
118  !
119  ! -- Save fname
120  this%numtsfiles = this%numtsfiles + 1
121  isize = size(this%tsfiles)
122  if (this%numtsfiles > isize) then
123  call expandarray(this%tsfiles, 1000)
124  end if
125  this%tsfiles(this%numtsfiles) = fname
126  !
127  ! --
128  call this%tsfileList%Add(fname, this%iout, tsfile)
129  end subroutine add_tsfile
130 
131  !> @brief Time step (or subtime step) advance. Call this each time step or
132  !! subtime step
133  !<
134  subroutine tsmgr_ad(this)
135  ! -- dummy
136  class(timeseriesmanagertype) :: this
137  ! -- local
138  type(timeserieslinktype), pointer :: tsLink => null()
139  type(timeseriestype), pointer :: timeseries => null()
140  integer(I4B) :: i, nlinks, nauxlinks
141  real(DP) :: begintime, endtime, tsendtime
142  character(len=LENPACKAGENAME + 2) :: pkgID
143  ! -- formats
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, ')')
155  !
156  ! -- Initialize time variables
157  begintime = totimc
158  endtime = begintime + delt
159  !
160  ! -- Determine number of ts links
161  nlinks = this%boundtslinks%Count()
162  nauxlinks = this%auxvartslinks%Count()
163  !
164  ! -- Iterate through auxvartslinks and replace specified
165  ! elements of auxvar with average value obtained from
166  ! appropriate time series. Need to do auxvartslinks
167  ! first because they may be a multiplier column
168  i = 1
169  do while (i <= nauxlinks)
170  tslink => gettimeserieslinkfromlist(this%auxvarTsLinks, i)
171  timeseries => tslink%timeSeries
172  !
173  ! -- Remove time series link once its end time has passed, if requested
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()
179  cycle
180  end if
181  end if
182  !
183  if (i == 1) then
184  if (tslink%Iprpak == 1) then
185  write (this%iout, fmt5) kper, kstp
186  end if
187  end if
188  tslink%BndElement = timeseries%GetValue(begintime, endtime, &
189  this%extendTsToEndOfSimulation)
190  !
191  ! -- Write time series values to output file
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), &
198  tslink%BndElement
199  else
200  write (this%iout, 15) trim(pkgid), tslink%IRow, tslink%JCol, &
201  trim(tslink%timeSeries%Name), &
202  tslink%BndElement, trim(tslink%BndName)
203  end if
204  else
205  if (tslink%BndName == '') then
206  write (this%iout, 20) trim(pkgid), tslink%IRow, trim(tslink%Text), &
207  trim(tslink%timeSeries%Name), &
208  tslink%BndElement
209  else
210  write (this%iout, 25) trim(pkgid), tslink%IRow, trim(tslink%Text), &
211  trim(tslink%timeSeries%Name), &
212  tslink%BndElement, trim(tslink%BndName)
213  end if
214  end if
215  end if
216  !
217  i = i + 1
218  end do
219  !
220  ! -- Iterate through boundtslinks and replace specified
221  ! elements of bound with average value obtained from
222  ! appropriate time series. (For list-type packages)
223  i = 1
224  do while (i <= nlinks)
225  tslink => gettimeserieslinkfromlist(this%boundTsLinks, i)
226  timeseries => tslink%timeSeries
227  !
228  ! -- Remove time series link once its end time has passed, if requested
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()
234  cycle
235  end if
236  end if
237  !
238  if (i == 1 .and. nauxlinks == 0) then
239  if (tslink%Iprpak == 1) then
240  write (this%iout, fmt5) kper, kstp
241  end if
242  end if
243  ! this part needs to be different for MAW because MAW does not use
244  ! bound array for well rate (although rate is stored in
245  ! this%bound(4,ibnd)), it uses this%mawwells(n)%rate%value
246  if (tslink%UseDefaultProc) then
247  timeseries => tslink%timeSeries
248  tslink%BndElement = timeseries%GetValue(begintime, endtime, &
249  this%extendTsToEndOfSimulation)
250  !
251  ! -- If multiplier is active and it applies to this element,
252  ! do the multiplication. This must be done after the auxlinks
253  ! have been calculated in case iauxmultcol is being used.
254  if (associated(tslink%RMultiplier)) then
255  tslink%BndElement = tslink%BndElement * tslink%RMultiplier
256  end if
257  !
258  ! -- Write time series values to output files
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), &
265  tslink%BndElement
266  else
267  write (this%iout, 15) trim(pkgid), tslink%IRow, tslink%JCol, &
268  trim(tslink%timeSeries%Name), &
269  tslink%BndElement, trim(tslink%BndName)
270  end if
271  else
272  if (tslink%BndName == '') then
273  write (this%iout, 20) trim(pkgid), tslink%IRow, trim(tslink%Text), &
274  trim(tslink%timeSeries%Name), &
275  tslink%BndElement
276  else
277  write (this%iout, 25) trim(pkgid), tslink%IRow, trim(tslink%Text), &
278  trim(tslink%timeSeries%Name), &
279  tslink%BndElement, trim(tslink%BndName)
280  end if
281  end if
282  end if
283  !
284  ! -- If conversion from flux to flow is required, multiply by cell area
285  if (tslink%ConvertFlux) then
286  tslink%BndElement = tslink%BndElement * tslink%CellArea
287  end if
288  end if
289  !
290  i = i + 1
291  end do
292  !
293  ! -- Finish with ending line
294  if (nlinks + nauxlinks > 0) then
295  if (tslink%Iprpak == 1) then
296  write (this%iout, '()')
297  end if
298  end if
299  end subroutine tsmgr_ad
300 
301  !> @brief Deallocate memory
302  !<
303  subroutine tsmgr_da(this)
304  ! -- dummy
305  class(timeseriesmanagertype) :: this
306  ! -- local
307  !
308  ! -- Deallocate time-series links in boundTsLinks
309  call this%boundTsLinks%Clear(.true.)
310  deallocate (this%boundTsLinks)
311  !
312  ! -- Deallocate time-series links in auxvarTsLinks
313  call this%auxvarTsLinks%Clear(.true.)
314  deallocate (this%auxvarTsLinks)
315  !
316  ! -- Deallocate tsfileList
317  call this%tsfileList%da()
318  deallocate (this%tsfileList)
319  !
320  ! -- Deallocate the hash table
321  if (associated(this%BndTsHashTable)) then
322  call hash_table_da(this%BndTsHashTable)
323  end if
324  !
325  deallocate (this%tsfiles)
326  end subroutine tsmgr_da
327 
328  !> @brief Call this when a new BEGIN PERIOD block is read for a new stress
329  !! period
330  !<
331  subroutine reset(this, pkgName)
332  ! -- dummy
333  class(timeseriesmanagertype) :: this
334  character(len=*), intent(in) :: pkgName
335  ! -- local
336  integer(I4B) :: i, nlinks
337  type(timeserieslinktype), pointer :: tslink
338  !
339  ! Zero out values for time-series controlled stresses.
340  ! Also deallocate all tslinks too.
341  ! Then when time series are
342  ! specified in this or another stress period,
343  ! a new tslink would be set up.
344  !
345  ! Reassign all linked elements to zero
346  nlinks = this%boundTsLinks%Count()
347  do i = 1, nlinks
348  tslink => gettimeserieslinkfromlist(this%boundTsLinks, i)
349  if (associated(tslink)) then
350  if (tslink%PackageName == pkgname) then
351  tslink%BndElement = dzero
352  end if
353  end if
354  end do
355  !
356  ! Remove links belonging to calling package
357  nlinks = this%boundTsLinks%Count()
358  do i = nlinks, 1, -1
359  tslink => gettimeserieslinkfromlist(this%boundTsLinks, i)
360  if (associated(tslink)) then
361  if (tslink%PackageName == pkgname) then
362  call this%boundTsLinks%RemoveNode(i, .true.)
363  end if
364  end if
365  end do
366  nlinks = this%auxvarTsLinks%Count()
367  do i = nlinks, 1, -1
368  tslink => gettimeserieslinkfromlist(this%auxvarTsLinks, i)
369  if (associated(tslink)) then
370  if (tslink%PackageName == pkgname) then
371  call this%auxvarTsLinks%RemoveNode(i, .true.)
372  end if
373  end if
374  end do
375  end subroutine reset
376 
377  !> @brief Make link
378  !<
379  subroutine make_link(this, timeSeries, pkgName, auxOrBnd, bndElem, &
380  irow, jcol, iprpak, tsLink, text, bndName)
381  ! -- dummy
382  class(timeseriesmanagertype), intent(inout) :: this
383  type(timeseriestype), pointer, intent(inout) :: timeSeries
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
389  type(timeserieslinktype), pointer, intent(inout) :: tsLink
390  character(len=*), intent(in) :: text
391  character(len=*), intent(in) :: bndName
392  !
393  tslink => null()
394  call constructtimeserieslink(tslink, timeseries, pkgname, &
395  auxorbnd, bndelem, irow, jcol, iprpak)
396  if (associated(tslink)) then
397  if (auxorbnd == 'BND') then
398  call addtimeserieslinktolist(this%boundTsLinks, tslink)
399  elseif (auxorbnd == 'AUX') then
400  call addtimeserieslinktolist(this%auxvarTsLinks, tslink)
401  else
402  call store_error('programmer error in make_link', terminate=.true.)
403  end if
404  tslink%Text = text
405  tslink%BndName = bndname
406  end if
407  end subroutine make_link
408 
409  !> @brief Get link
410  !<
411  function getlink(this, auxOrBnd, indx) result(tsLink)
412  ! -- dummy
413  class(timeseriesmanagertype) :: this
414  character(len=3), intent(in) :: auxorbnd
415  integer(I4B), intent(in) :: indx
416  type(timeserieslinktype), pointer :: tslink
417  ! -- local
418  type(listtype), pointer :: list
419  !
420  list => null()
421  tslink => null()
422  !
423  select case (auxorbnd)
424  case ('AUX')
425  list => this%auxvarTsLinks
426  case ('BND')
427  list => this%boundTsLinks
428  end select
429  !
430  if (associated(list)) then
431  tslink => gettimeserieslinkfromlist(list, indx)
432  end if
433  end function getlink
434 
435  !> @brief Count links
436  !<
437  function countlinks(this, auxOrBnd)
438  ! -- return
439  integer(I4B) :: countlinks
440  ! -- dummy
441  class(timeseriesmanagertype) :: this
442  character(len=3), intent(in) :: auxorbnd
443  !
444  countlinks = 0
445  if (auxorbnd == 'BND') then
446  countlinks = this%boundTsLinks%Count()
447  elseif (auxorbnd == 'AUX') then
448  countlinks = this%auxvarTsLinks%count()
449  end if
450  end function countlinks
451 
452  !> @brief Get time series
453  !<
454  function get_time_series(this, name) result(res)
455  ! -- dummy
456  class(timeseriesmanagertype) :: this
457  character(len=*), intent(in) :: name
458  ! -- result
459  type(timeseriestype), pointer :: res
460  ! -- local
461  integer(I4B) :: indx
462  !
463  ! Get index from hash table, get time series from TsContainers,
464  ! and assign result to time series contained in link.
465  res => null()
466  if (.not. associated(this%BndTsHashTable)) return
467  indx = this%BndTsHashTable%get(name)
468  if (indx > 0) then
469  res => this%TsContainers(indx)%timeSeries
470  end if
471  end function get_time_series
472 
473  !> @brief Store all boundary (stress) time series links in TsContainers
474  !! and construct hash table BndTsHashTable
475  !<
476  subroutine hashbndtimeseries(this)
477  ! -- dummy
478  class(timeseriesmanagertype), intent(inout) :: this
479  ! -- local
480  integer(I4B) :: i, j, k, numtsfiles, numts
481  character(len=LENTIMESERIESNAME) :: name
482  type(timeseriesfiletype), pointer :: tsfile => null()
483  !
484  ! Initialize the hash table
485  call hash_table_cr(this%BndTsHashTable)
486  !
487  ! Allocate the TsContainers array to accommodate all time-series links.
488  numts = this%tsfileList%CountTimeSeries()
489  allocate (this%TsContainers(numts))
490  !
491  ! Store a pointer to each time series in the TsContainers array
492  ! and put its key (time-series name) and index in the hash table.
493  numtsfiles = this%tsfileList%Counttsfiles()
494  k = 0
495  do i = 1, numtsfiles
496  tsfile => this%tsfileList%Gettsfile(i)
497  numts = tsfile%Count()
498  do j = 1, numts
499  k = k + 1
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)
504  end if
505  end do
506  end do
507  end subroutine hashbndtimeseries
508 
509  ! -- Non-type-bound procedures
510 
511  !> @brief Call this subroutine if the time-series link is available or needed
512  !!
513  !! This routine assumes that there is not an existing link for the
514  !! specified package and array row and column. For the standard
515  !! boundary package, all links are removed by calling the tsmanager%reset()
516  !! method. For advanced packages, there is a separate routine called
517  !! read_value_or_time_series_adv, which should be used instead of this one.
518  !<
519  subroutine read_value_or_time_series(textInput, ii, jj, bndElem, pkgName, &
520  auxOrBnd, tsManager, iprpak, tsLink)
521  ! dummy
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
528  type(timeseriesmanagertype), intent(inout) :: tsmanager
529  integer(I4B), intent(in) :: iprpak
530  type(timeserieslinktype), pointer, intent(inout) :: tslink
531  ! local
532  type(timeseriestype), pointer :: timeseries => null()
533  integer(I4B) :: istat
534  real(dp) :: r
535  character(len=LINELENGTH) :: errmsg
536  character(len=LENTIMESERIESNAME) :: tsnametemp
537 
538  read (textinput, *, iostat=istat) r
539  if (istat == 0) then
540  bndelem = r
541  else
542 
543  ! Check to see if this is a time series name
544  tsnametemp = textinput
545  call upcase(tsnametemp)
546  timeseries => tsmanager%get_time_series(tsnametemp)
547 
548  ! If this is a time series, then create a link between
549  ! the time series and the row and column position of
550  ! bndElem
551  if (associated(timeseries)) then
552  ! -- Assign value from time series to current
553  ! array element
554  r = timeseries%GetValue(totimsav, totim, &
555  tsmanager%extendTsToEndOfSimulation)
556  bndelem = r
557  ! Make a new link between the time series and the row and
558  ! column position in the array
559  call tsmanager%make_link(timeseries, pkgname, auxorbnd, bndelem, &
560  ii, jj, iprpak, tslink, '', '')
561  else
562  errmsg = 'Error in list input. Expected numeric value or '// &
563  "time-series name, but found '"//trim(textinput)//"'."
564  call store_error(errmsg)
565  end if
566  end if
567 
568  end subroutine read_value_or_time_series
569 
570  !> @brief Call this subroutine from advanced packages to define timeseries
571  !! link for a variable (varName).
572  !!
573  !! Arguments are as follows:
574  !! textInput : string that is either a float or a string name
575  !! ii : column number
576  !! jj : row number
577  !! bndElem : pointer to a position in an array in package pkgName
578  !! pkgName : package name
579  !! auxOrBnd : 'AUX' or 'BND' keyword
580  !! tsManager : timeseries manager object for package
581  !! iprpak : integer flag indicating if interpolated timeseries values
582  !! should be printed to package iout during TsManager%ad()
583  !! varName : variable name
584  !<
585  subroutine read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, &
586  auxOrBnd, tsManager, iprpak, varName)
587  ! -- dummy
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
594  type(timeseriesmanagertype), intent(inout) :: tsmanager
595  integer(I4B), intent(in) :: iprpak
596  character(len=*), intent(in) :: varname
597  ! -- local
598  integer(I4B) :: istat
599  real(dp) :: v
600  character(len=LINELENGTH) :: errmsg
601  character(len=LENTIMESERIESNAME) :: tsnametemp
602  logical :: found
603  type(timeseriestype), pointer :: timeseries => null()
604  type(timeserieslinktype), pointer :: tslink => null()
605  !
606  ! -- attempt to read textInput as a real value
607  read (textinput, *, iostat=istat) v
608  !
609  ! -- numeric value
610  if (istat == 0) then
611  !
612  ! -- Numeric value was successfully read.
613  bndelem = v
614  !
615  ! -- remove existing link if it exists for this boundary element
616  found = remove_existing_link(tsmanager, ii, jj, pkgname, &
617  auxorbnd, varname)
618  !
619  ! -- timeseries
620  else
621  !
622  ! -- attempt to read numeric value from textInput failed.
623  ! Text should be a time-series name.
624  tsnametemp = textinput
625  call upcase(tsnametemp)
626  !
627  ! -- if textInput is a time-series name, get average value
628  ! from time series.
629  timeseries => tsmanager%get_time_series(tsnametemp)
630  !
631  ! -- create a time series link and add it to the package
632  ! list of time series links used by the array.
633  if (associated(timeseries)) then
634  !
635  ! -- Assign average value from time series to current array element
636  v = timeseries%GetValue(totimsav, totim, &
637  tsmanager%extendTsToEndOfSimulation)
638  bndelem = v
639  !
640  ! -- remove existing link if it exists for this boundary element
641  found = remove_existing_link(tsmanager, ii, jj, &
642  pkgname, auxorbnd, varname)
643  !
644  ! -- Add link to the list.
645  call tsmanager%make_link(timeseries, pkgname, auxorbnd, bndelem, &
646  ii, jj, iprpak, tslink, varname, '')
647  !
648  ! -- not a valid timeseries name
649  else
650  errmsg = 'Error in list input. Expected numeric value or '// &
651  "time-series name, but found '"//trim(textinput)//"'."
652  call store_error(errmsg)
653  end if
654  end if
655  end subroutine read_value_or_time_series_adv
656 
657 ! -- private subroutines
658 
659  !> @brief Remove an existing timeseries link if it is defined.
660  !!
661  !! Arguments are as follows:
662  !! tsManager : timeseries manager object for package
663  !! ii : column number
664  !! jj : row number
665  !! pkgName : package name
666  !! auxOrBnd : 'AUX' or 'BND' keyword
667  !! varName : variable name
668  !<
669  function remove_existing_link(tsManager, ii, jj, &
670  pkgName, auxOrBnd, varName) result(found)
671  ! -- return
672  logical :: found
673  ! -- dummy
674  type(timeseriesmanagertype), intent(inout) :: tsmanager
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
680  ! -- local
681  integer(I4B) :: i
682  integer(I4B) :: nlinks
683  integer(I4B) :: removelink
684  type(timeserieslinktype), pointer :: tsltemp => null()
685  !
686  ! -- determine if link exists
687  nlinks = tsmanager%CountLinks(auxorbnd)
688  found = .false.
689  removelink = -1
690  csearchlinks: do i = 1, nlinks
691  tsltemp => tsmanager%GetLink(auxorbnd, i)
692  !
693  ! -- Check ii against iRow, jj against jCol, and varName
694  ! against Text member of link
695  if (tsltemp%PackageName == pkgname) then
696  !
697  ! -- This array element is already linked to a time series.
698  if (tsltemp%IRow == ii .and. tsltemp%JCol == jj .and. &
699  same_word(tsltemp%Text, varname)) then
700  found = .true.
701  removelink = i
702  exit csearchlinks
703  end if
704  end if
705  end do csearchlinks
706  !
707  ! -- remove link if it was found
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.)
713  end if
714  end if
715  end function remove_existing_link
716 
717  !> @brief Determine if a timeseries link with varName is defined.
718  !!
719  !! Arguments are as follows:
720  !! tsManager : timeseries manager object for package
721  !! pkgName : package name
722  !! varName : variable name
723  !! auxOrBnd : optional 'AUX' or 'BND' keyword
724  !<
725  function var_timeseries(tsManager, pkgName, varName, auxOrBnd) result(tsexists)
726  ! -- return
727  logical :: tsexists
728  ! -- dummy
729  type(timeseriesmanagertype), intent(inout) :: tsmanager
730  character(len=*), intent(in) :: pkgname
731  character(len=*), intent(in) :: varname
732  character(len=3), intent(in), optional :: auxorbnd
733  ! -- local
734  character(len=3) :: ctstype
735  integer(I4B) :: i
736  integer(I4B) :: nlinks
737  type(timeserieslinktype), pointer :: tsltemp => null()
738  !
739  ! -- process optional variables
740  if (present(auxorbnd)) then
741  ctstype = auxorbnd
742  else
743  ctstype = 'BND'
744  end if
745  !
746  ! -- initialize the return variable and the number of timeseries links
747  tsexists = .false.
748  nlinks = tsmanager%CountLinks(ctstype)
749  !
750  ! -- determine if link exists
751  csearchlinks: do i = 1, nlinks
752  tsltemp => tsmanager%GetLink(ctstype, i)
753  if (tsltemp%PackageName == pkgname) then
754  !
755  ! -- Check varName against Text member of link
756  if (same_word(tsltemp%Text, varname)) then
757  tsexists = .true.
758  exit csearchlinks
759  end if
760  end if
761  end do csearchlinks
762  end function var_timeseries
763 
764 end module timeseriesmanagermodule
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
integer(i4b), parameter lenpackagename
maximum length of the package name
Definition: Constants.f90:23
integer(i4b), parameter lentimeseriesname
maximum length of a time series name
Definition: Constants.f90:42
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter maxcharlen
maximum length of char string
Definition: Constants.f90:47
A chaining hash map for integers.
Definition: HashTable.f90:7
subroutine, public hash_table_cr(map)
Create a hash table.
Definition: HashTable.f90:46
subroutine, public hash_table_da(map)
Deallocate the hash table.
Definition: HashTable.f90:64
logical function, public same_word(word1, word2)
Perform a case-insensitive comparison of two words.
subroutine, public upcase(word)
Convert to upper case.
This module defines variable data types.
Definition: kind.f90:8
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
Definition: Sim.f90:168
real(dp), pointer, public totim
time relative to start of simulation
Definition: tdis.f90:35
real(dp), pointer, public totimc
simulation time at start of time step
Definition: tdis.f90:36
integer(i4b), pointer, public kstp
current time step number
Definition: tdis.f90:27
real(dp), pointer, public totimsav
saved value for totim, used for subtiming
Definition: tdis.f90:38
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:26
real(dp), pointer, public delt
length of the current time step
Definition: tdis.f90:32
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.
Definition: List.f90:14