MODFLOW 6 version 6.9.0.dev0
USGS Modular Hydrologic Model
Loading...
Searching...
No Matches
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, &
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
57
58contains
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, ':')"
14710 format(a, ' package: Boundary ', i0, ', entry ', i0, &
148 ' value from time series "', a, '" = ', g12.5)
14915 format(a, ' package: Boundary ', i0, ', entry ', i0, &
150 ' value from time series "', a, '" = ', g12.5, ' (', a, ')')
15120 format(a, ' package: Boundary ', i0, ', ', a, &
152 ' value from time series "', a, '" = ', g12.5)
15325 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 !> @brief Remove an existing timeseries link if it is defined.
658 !!
659 !! Arguments are as follows:
660 !! tsManager : timeseries manager object for package
661 !! ii : column number
662 !! jj : row number
663 !! pkgName : package name
664 !! auxOrBnd : 'AUX' or 'BND' keyword
665 !! varName : variable name
666 !<
667 function remove_existing_link(tsManager, ii, jj, &
668 pkgName, auxOrBnd, varName) result(found)
669 ! -- return
670 logical :: found
671 ! -- dummy
672 type(timeseriesmanagertype), intent(inout) :: tsmanager
673 integer(I4B), intent(in) :: ii
674 integer(I4B), intent(in) :: jj
675 character(len=*), intent(in) :: pkgname
676 character(len=3), intent(in) :: auxorbnd
677 character(len=*), intent(in) :: varname
678 ! -- local
679 integer(I4B) :: i
680 integer(I4B) :: nlinks
681 integer(I4B) :: removelink
682 type(timeserieslinktype), pointer :: tsltemp => null()
683 !
684 ! -- determine if link exists
685 nlinks = tsmanager%CountLinks(auxorbnd)
686 found = .false.
687 removelink = -1
688 csearchlinks: do i = 1, nlinks
689 tsltemp => tsmanager%GetLink(auxorbnd, i)
690 !
691 ! -- Check ii against iRow, jj against jCol, and varName
692 ! against Text member of link
693 if (tsltemp%PackageName == pkgname) then
694 !
695 ! -- This array element is already linked to a time series.
696 if (tsltemp%IRow == ii .and. tsltemp%JCol == jj .and. &
697 same_word(tsltemp%Text, varname)) then
698 found = .true.
699 removelink = i
700 exit csearchlinks
701 end if
702 end if
703 end do csearchlinks
704 !
705 ! -- remove link if it was found
706 if (removelink > 0) then
707 if (auxorbnd == 'BND') then
708 call tsmanager%boundTsLinks%RemoveNode(removelink, .true.)
709 else if (auxorbnd == 'AUX') then
710 call tsmanager%auxvarTsLinks%RemoveNode(removelink, .true.)
711 end if
712 end if
713 end function remove_existing_link
714
715 !> @brief Determine if a timeseries link with varName is defined.
716 !!
717 !! Arguments are as follows:
718 !! tsManager : timeseries manager object for package
719 !! pkgName : package name
720 !! varName : variable name
721 !! auxOrBnd : optional 'AUX' or 'BND' keyword
722 !<
723 function var_timeseries(tsManager, pkgName, varName, auxOrBnd) result(tsexists)
724 ! -- return
725 logical :: tsexists
726 ! -- dummy
727 type(timeseriesmanagertype), intent(inout) :: tsmanager
728 character(len=*), intent(in) :: pkgname
729 character(len=*), intent(in) :: varname
730 character(len=3), intent(in), optional :: auxorbnd
731 ! -- local
732 character(len=3) :: ctstype
733 integer(I4B) :: i
734 integer(I4B) :: nlinks
735 type(timeserieslinktype), pointer :: tsltemp => null()
736 !
737 ! -- process optional variables
738 if (present(auxorbnd)) then
739 ctstype = auxorbnd
740 else
741 ctstype = 'BND'
742 end if
743 !
744 ! -- initialize the return variable and the number of timeseries links
745 tsexists = .false.
746 nlinks = tsmanager%CountLinks(ctstype)
747 !
748 ! -- determine if link exists
749 csearchlinks: do i = 1, nlinks
750 tsltemp => tsmanager%GetLink(ctstype, i)
751 if (tsltemp%PackageName == pkgname) then
752 !
753 ! -- Check varName against Text member of link
754 if (same_word(tsltemp%Text, varname)) then
755 tsexists = .true.
756 exit csearchlinks
757 end if
758 end if
759 end do csearchlinks
760 end function var_timeseries
761
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
subroutine reset(this)
Reset the list's current node pointer and index.
Definition List.f90:331
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:169
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 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, public constructtimeserieslink(newtslink, timeseries, pkgname, auxorbnd, bndelem, irow, jcol, iprpak, text)
Construct time series link.
subroutine tsmgr_da(this)
Deallocate memory.
logical function, public remove_existing_link(tsmanager, ii, jj, pkgname, auxorbnd, varname)
Remove an existing timeseries link if it is defined.
subroutine make_link(this, timeseries, pkgname, auxorbnd, bndelem, irow, jcol, iprpak, tslink, text, bndname)
Make link.
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...
type(timeserieslinktype) function, pointer getlink(this, auxorbnd, indx)
Get link.
subroutine tsmgr_ad(this)
Time step (or subtime step) advance. Call this each time step or subtime step.
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.
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).
integer(i4b) function countlinks(this, auxorbnd)
Count links.
subroutine, public tsmanager_cr(this, iout, removetslinksoncompletion, extendtstoendofsimulation)
Create the tsmanager.
logical function, public var_timeseries(tsmanager, pkgname, varname, auxorbnd)
Determine if a timeseries link with varName is defined.
A generic heterogeneous doubly-linked list.
Definition List.f90:14