28 character(len=LENTIMESERIESNAME),
public :: name =
''
30 real(dp),
private :: sfac =
done
31 logical,
public :: autodeallocate = .true.
32 type(
listtype),
pointer,
private :: list => null()
52 procedure,
private :: da =>
ts_da
63 integer(I4B),
public :: inunit = 0
64 integer(I4B),
public :: iout = 0
65 integer(I4B),
public :: ntimeseries = 0
66 logical,
public :: finishedreading = .false.
67 character(len=LINELENGTH),
public :: datafile =
''
69 pointer,
contiguous,
public :: timeseries => null()
98 allocate (newtimeseriesfile)
99 allocate (newtimeseriesfile%parser)
109 class(*),
pointer,
intent(inout) :: obj
114 if (.not.
associated(obj))
return
129 class(*),
pointer,
intent(inout) :: obj
134 if (.not.
associated(obj))
return
149 type(
listtype),
intent(inout) :: list
152 class(*),
pointer :: obj => null()
165 type(
listtype),
intent(inout) :: list
166 integer(I4B),
intent(in) :: idx
170 class(*),
pointer :: obj => null()
172 obj => list%GetItem(idx)
175 if (.not.
associated(res))
then
196 n1 = ts1%list%Count()
197 n2 = ts2%list%Count()
204 tsr1 => ts1%GetNextTimeSeriesRecord()
205 tsr2 => ts2%GetNextTimeSeriesRecord()
206 if (tsr1%tsrTime /= tsr2%tsrTime)
return
207 if (tsr1%tsrValue /= tsr2%tsrValue)
return
226 function getvalue(this, time0, time1, extendToEndOfSimulation)
231 real(dp),
intent(in) :: time0
232 real(dp),
intent(in) :: time1
233 logical,
intent(in),
optional :: extendtoendofsimulation
237 if (
present(extendtoendofsimulation))
then
238 extend = extendtoendofsimulation
243 select case (this%iMethod)
245 getvalue = this%get_average_value(time0, time1, extend)
247 getvalue = this%get_value_at_time(time1, extend)
262 character(len=*),
intent(in) :: name
263 logical,
intent(in),
optional :: autoDeallocate
265 character(len=LENTIMESERIESNAME) :: tsNameTemp
268 this%tsfile => tsfile
272 this%Name = tsnametemp
276 if (
present(autodeallocate)) this%autoDeallocate = autodeallocate
282 if (this%Name ==
'')
then
283 errmsg =
'Name not specified for time series.'
296 real(DP),
intent(in) :: time
300 real(DP) :: time0, time1
306 class(*),
pointer :: obj => null()
308 tsrecearlier => null()
311 if (
associated(this%list%firstNode))
then
312 currnode => this%list%firstNode
318 if (
associated(currnode))
then
319 if (
associated(currnode%nextNode))
then
320 obj => currnode%nextNode%GetItem()
322 if (tsr%tsrTime < time .and. .not.
is_close(tsr%tsrTime, time))
then
323 currnode => currnode%nextNode
329 if (.not. this%read_next_record())
exit
336 if (
associated(currnode))
then
340 obj => tsnode0%GetItem()
342 time0 = tsrec0%tsrTime
343 do while (time0 > time)
344 if (
associated(tsnode0%prevNode))
then
345 tsnode0 => tsnode0%prevNode
346 obj => tsnode0%GetItem()
348 time0 = tsrec0%tsrTime
356 obj => tsnode1%GetItem()
358 time1 = tsrec1%tsrTime
359 do while (time1 < time .and. .not.
is_close(time1, time))
360 if (
associated(tsnode1%nextNode))
then
361 tsnode1 => tsnode1%nextNode
362 obj => tsnode1%GetItem()
364 time1 = tsrec1%tsrTime
367 if (.not. this%read_next_record())
then
376 if (time0 < time .or.
is_close(time0, time)) tsrecearlier => tsrec0
377 if (time1 > time .or.
is_close(time1, time)) tsreclater => tsrec1
391 real(DP),
intent(in) :: time
392 type(
listnodetype),
pointer,
intent(inout) :: nodeEarlier
395 real(DP) :: time0, time1
403 class(*),
pointer :: obj => null()
405 tsrecearlier => null()
407 nodeearlier => null()
410 if (
associated(this%list%firstNode))
then
411 currnode => this%list%firstNode
417 if (
associated(currnode))
then
418 if (
associated(currnode%nextNode))
then
419 obj => currnode%nextNode%GetItem()
421 if (tsr%tsrTime < time .and. .not.
is_close(tsr%tsrTime, time))
then
422 currnode => currnode%nextNode
434 if (
associated(currnode))
then
438 obj => tsnode0%GetItem()
440 time0 = tsrec0%tsrTime
441 do while (time0 > time)
442 if (
associated(tsnode0%prevNode))
then
443 tsnode0 => tsnode0%prevNode
444 obj => tsnode0%GetItem()
446 time0 = tsrec0%tsrTime
454 obj => tsnode1%GetItem()
456 time1 = tsrec1%tsrTime
457 do while (time1 < time .and. .not.
is_close(time1, time))
458 if (
associated(tsnode1%nextNode))
then
459 tsnode1 => tsnode1%nextNode
460 obj => tsnode1%GetItem()
462 time1 = tsrec1%tsrTime
470 if (time0 < time .or.
is_close(time0, time))
then
471 tsrecearlier => tsrec0
472 nodeearlier => tsnode0
474 if (time1 > time .or.
is_close(time1, time))
then
492 if (this%tsfile%finishedReading)
then
499 this%tsfile%finishedReading = .true.
515 real(dp),
intent(in) :: time
516 logical,
intent(in) :: extendtoendofsimulation
519 real(dp) :: ratio, time0, time1, timediff, timediffi, val0, val1, &
524 10
format(
'Error getting value at time ', g10.3,
' for time series "', a,
'"')
527 call this%get_surrounding_records(time, tsrearlier, tsrlater)
528 if (
associated(tsrearlier))
then
529 if (
associated(tsrlater))
then
537 time0 = tsrearlier%tsrTime
538 time1 = tsrlater%tsrtime
539 timediff = time1 - time0
540 timediffi = time - time0
541 if (timediff > 0)
then
542 ratio = timediffi / timediff
547 val0 = tsrearlier%tsrValue
548 val1 = tsrlater%tsrValue
549 valdiff = val1 - val0
555 if (extendtoendofsimulation .or.
is_close(tsrearlier%tsrTime, time))
then
568 if (
associated(tsrlater))
then
569 if (
is_close(tsrlater%tsrTime, time))
then
583 write (
errmsg, 10) time, trim(this%Name)
601 real(dp),
intent(in) :: time0
602 real(dp),
intent(in) :: time1
603 logical,
intent(in) :: extendtoendofsimulation
605 real(dp) :: area, currtime, nexttime, ratio0, ratio1, t0, t01, t1, &
606 timediff,
value, value0, value1, valuediff, currval, nextval
607 logical :: ldone, lprocess
608 type(
listnodetype),
pointer :: tslnodepreceding => null()
609 type(
listnodetype),
pointer :: currnode => null(), nextnode => null()
612 class(*),
pointer :: currobj => null(), nextobj => null()
614 10
format(
'Error encountered while performing integration', &
615 ' for time series "', a,
'" for time interval: ', g12.5,
' to ', g12.5)
620 call this%get_latest_preceding_node(time0, tslnodepreceding)
621 if (
associated(tslnodepreceding))
then
622 currnode => tslnodepreceding
623 do while (.not. ldone)
624 currobj => currnode%GetItem()
626 currtime = currrecord%tsrTime
630 elseif (currtime < time1)
then
631 if (.not.
associated(currnode%nextNode))
then
633 if (.not. this%read_next_record())
then
634 if (.not. extendtoendofsimulation)
then
635 write (
errmsg, 10) trim(this%Name), time0, time1
641 currval = currrecord%tsrValue
643 if (
associated(currnode%nextNode))
then
644 nextnode => currnode%nextNode
645 nextobj => nextnode%GetItem()
647 nexttime = nextrecord%tsrTime
648 nextval = nextrecord%tsrValue
650 elseif (extendtoendofsimulation)
then
660 if (currtime > time0 .or.
is_close(currtime, time0))
then
665 if (nexttime < time1 .or.
is_close(nexttime, time1))
then
672 select case (this%iMethod)
679 timediff = nexttime - currtime
680 ratio0 = (t0 - currtime) / timediff
681 ratio1 = (t1 - currtime) / timediff
682 valuediff = nextval - currval
683 value0 = currval + ratio0 * valuediff
684 value1 = currval + ratio1 * valuediff
685 if (this%iMethod ==
linear)
then
686 area = 0.5d0 * t01 * (value0 + value1)
704 if (.not.
associated(currnode%nextNode))
then
706 if (.not. this%read_next_record())
then
707 write (
errmsg, 10) trim(this%Name), time0, time1
710 elseif (
associated(currnode%nextNode))
then
711 currnode => currnode%nextNode
718 if (this%autoDeallocate)
then
719 if (
associated(tslnodepreceding))
then
720 if (
associated(tslnodepreceding%prevNode))
then
721 call this%list%DeallocateBackward(tslnodepreceding%prevNode)
740 real(dp),
intent(in) :: time0
741 real(dp),
intent(in) :: time1
742 logical,
intent(in) :: extendtoendofsimulation
744 real(dp) :: timediff,
value, valueintegrated
746 timediff = time1 - time0
747 if (timediff > 0)
then
748 valueintegrated = this%get_integrated_value(time0, time1, &
749 extendtoendofsimulation)
751 value = valueintegrated
753 value = valueintegrated / timediff
757 value = this%get_value_at_time(time0, extendtoendofsimulation)
773 real(DP),
intent(in) :: time
781 class(*),
pointer :: obj => null()
784 if (
associated(this%list%firstNode))
then
785 currnode => this%list%firstNode
788 &get_latest_preceding_node', &
795 if (
associated(currnode))
then
796 if (
associated(currnode%nextNode))
then
797 obj => currnode%nextNode%GetItem()
799 if (tsr%tsrTime < time .or.
is_close(tsr%tsrTime, time))
then
800 currnode => currnode%nextNode
806 if (.not. this%read_next_record())
exit
813 if (
associated(currnode))
then
817 obj => tsnode0%GetItem()
819 time0 = tsrec0%tsrTime
820 do while (time0 > time)
821 if (
associated(tsnode0%prevNode))
then
822 tsnode0 => tsnode0%prevNode
823 obj => tsnode0%GetItem()
825 time0 = tsrec0%tsrTime
832 if (time0 < time .or.
is_close(time0, time)) tslnode => tsnode0
844 if (
associated(this%list))
then
845 call this%list%Clear(.true.)
846 deallocate (this%list)
860 class(*),
pointer :: obj => null()
863 call this%list%Add(obj)
877 class(*),
pointer :: obj => null()
881 obj => this%list%GetItem()
882 if (
associated(obj))
then
898 class(*),
pointer :: obj => null()
902 obj => this%list%GetPreviousItem()
903 if (
associated(obj))
then
919 class(*),
pointer :: obj => null()
923 obj => this%list%GetNextItem()
924 if (
associated(obj))
then
937 double precision,
intent(in) :: time
938 double precision,
intent(in) :: epsi
944 call this%list%Reset()
947 tsr => this%GetNextTimeSeriesRecord()
948 if (
associated(tsr))
then
949 if (
is_close(tsr%tsrTime, time))
then
953 if (tsr%tsrTime > time)
exit
969 call this%list%Reset()
982 double precision :: badtime, time, time0, time1
985 class(*),
pointer :: obj => null()
991 call this%get_surrounding_nodes(time, nodeearlier, nodelater)
993 if (
associated(nodeearlier))
then
994 obj => nodeearlier%GetItem()
996 if (
associated(tsrearlier))
then
997 time0 = tsrearlier%tsrTime
1001 if (
associated(nodelater))
then
1002 obj => nodelater%GetItem()
1004 if (
associated(tsrlater))
then
1005 time1 = tsrlater%tsrTime
1009 if (time0 > badtime)
then
1011 if (time1 > badtime)
then
1013 if (time > time0 .and. time < time1)
then
1016 call this%list%InsertBefore(obj, nodelater)
1020 if (time == time0 .and. tsrearlier%tsrValue ==
dnodata .and. &
1022 tsrearlier%tsrValue = tsr%tsrValue
1023 elseif (time == time1 .and. tsrlater%tsrValue ==
dnodata .and. &
1025 tsrlater%tsrValue = tsr%tsrValue
1030 call this%AddTimeSeriesRecord(tsr)
1034 if (time1 > badtime)
then
1036 if (time < time1)
then
1039 call this%list%InsertBefore(obj, nodelater)
1040 elseif (time == time1)
then
1043 if (tsrlater%tsrValue ==
dnodata .and. tsr%tsrValue /=
dnodata)
then
1044 tsrlater%tsrValue = tsr%tsrValue
1049 call this%AddTimeSeriesRecord(tsr)
1062 logical,
intent(in),
optional :: readtoend
1066 class(*),
pointer :: obj => null()
1068 double precision :: endtime
1071 if (
present(readtoend))
then
1073 do while (this%read_next_record())
1078 nrecords = this%list%Count()
1079 obj => this%list%GetItem(nrecords)
1081 endtime = tsr%tsrTime
1092 logical,
optional,
intent(in) :: destroy
1094 call this%list%Clear(destroy)
1098 end subroutine clear
1106 integer(I4B) ::
count
1110 if (
associated(this%timeSeries))
then
1111 count =
size(this%timeSeries)
1125 integer(I4B),
intent(in) :: indx
1130 if (indx > 0 .and. indx <= this%nTimeSeries)
then
1131 res => this%timeSeries(indx)
1144 character(len=*),
intent(in) :: filename
1145 integer(I4B),
intent(in) :: iout
1146 logical,
optional,
intent(in) :: autoDeallocate
1148 integer(I4B) :: iMethod, istatus, j, nwords
1149 integer(I4B) :: ierr, inunit
1150 logical :: autoDeallocateLocal = .true.
1151 logical :: continueread, found, endOfBlock
1152 logical :: methodWasSet
1153 real(DP) :: sfaclocal
1154 character(len=40) :: keyword, keyvalue
1155 character(len=:),
allocatable :: line
1156 character(len=LENTIMESERIESNAME),
allocatable,
dimension(:) :: words
1159 if (
present(autodeallocate)) autodeallocatelocal = autodeallocate
1161 methodwasset = .false.
1165 this%datafile = filename
1169 inunit = this%inunit
1170 call openfile(inunit, 0, filename,
'TS6')
1173 call this%parser%Initialize(this%inunit, this%iout)
1176 continueread = .false.
1180 call this%parser%GetBlock(
'ATTRIBUTES', found, ierr, &
1181 supportopenclose=.true.)
1184 errmsg =
'End-of-file encountered while searching for'// &
1185 ' ATTRIBUTES in time-series '// &
1186 'input file "'//trim(this%datafile)//
'"'
1188 call this%parser%StoreErrorUnit()
1189 elseif (.not. found)
then
1190 errmsg =
'ATTRIBUTES block not found in time-series '// &
1191 'tsfile input file "'//trim(this%datafile)//
'"'
1193 call this%parser%StoreErrorUnit()
1199 call this%parser%GetNextLine(endofblock)
1200 if (endofblock)
exit
1203 call this%parser%GetStringCaps(keyword)
1206 if (keyword ==
'NAMES') keyword =
'NAME'
1208 if (keyword /=
'NAME' .and. keyword /=
'METHODS' .and. &
1209 keyword /=
'SFACS')
then
1211 call this%parser%GetStringCaps(keyvalue)
1214 select case (keyword)
1217 call this%parser%GetRemainingLine(line)
1218 call parseline(line, nwords, words, this%parser%iuactive)
1219 this%nTimeSeries = nwords
1222 allocate (this%timeSeries(this%nTimeSeries))
1223 do j = 1, this%nTimeSeries
1224 call this%timeSeries(j)%initialize_time_series(this, words(j), &
1225 autodeallocatelocal)
1228 methodwasset = .true.
1229 if (this%nTimeSeries == 0)
then
1230 errmsg =
'Error: NAME attribute not provided before METHOD in file: ' &
1233 call this%parser%StoreErrorUnit()
1235 select case (keyvalue)
1243 errmsg =
'Unknown interpolation method: "'//trim(keyvalue)//
'"'
1246 do j = 1, this%nTimeSeries
1247 this%timeSeries(j)%iMethod = imethod
1250 methodwasset = .true.
1251 if (this%nTimeSeries == 0)
then
1252 errmsg =
'Error: NAME attribute not provided before METHODS in file: ' &
1255 call this%parser%StoreErrorUnit()
1257 call this%parser%GetRemainingLine(line)
1258 call parseline(line, nwords, words, this%parser%iuactive)
1259 if (nwords < this%nTimeSeries)
then
1260 errmsg =
'METHODS attribute does not list a method for'// &
1263 call this%parser%StoreErrorUnit()
1265 do j = 1, this%nTimeSeries
1267 select case (words(j))
1275 errmsg =
'Unknown interpolation method: "'//trim(words(j))//
'"'
1278 this%timeSeries(j)%iMethod = imethod
1281 if (this%nTimeSeries == 0)
then
1282 errmsg =
'NAME attribute not provided before SFAC in file: ' &
1285 call this%parser%StoreErrorUnit()
1287 read (keyvalue, *, iostat=istatus) sfaclocal
1288 if (istatus /= 0)
then
1289 errmsg =
'Error reading numeric value from: "'//trim(keyvalue)//
'"'
1292 do j = 1, this%nTimeSeries
1293 this%timeSeries(j)%sfac = sfaclocal
1296 if (this%nTimeSeries == 0)
then
1297 errmsg =
'NAME attribute not provided before SFACS in file: ' &
1300 call this%parser%StoreErrorUnit()
1302 do j = 1, this%nTimeSeries
1303 sfaclocal = this%parser%GetDouble()
1304 this%timeSeries(j)%sfac = sfaclocal
1306 case (
'AUTODEALLOCATE')
1307 do j = 1, this%nTimeSeries
1308 this%timeSeries(j)%autoDeallocate = (keyvalue ==
'TRUE')
1311 errmsg =
'Unknown option found in ATTRIBUTES block: "'// &
1314 call this%parser%StoreErrorUnit()
1319 call this%parser%GetBlock(
'TIMESERIES', found, ierr, &
1320 supportopenclose=.true.)
1323 if (.not. this%read_tsfile_line())
then
1324 errmsg =
'Error: No time-series data contained in file: '// &
1330 if (.not. methodwasset)
then
1331 errmsg =
'Interpolation method was not set. METHOD or METHODS &
1332 &must be specified in the ATTRIBUTES block for this time series file.'
1337 if (
allocated(words))
deallocate (words)
1340 call this%parser%StoreErrorUnit()
1352 real(dp) :: tsrtime, tsrvalue
1354 logical :: endofblock
1361 call this%parser%GetNextLine(endofblock)
1364 if (endofblock)
then
1369 tsrtime = this%parser%GetDouble()
1372 tsloop:
do i = 1, this%nTimeSeries
1373 tsrvalue = this%parser%GetDouble()
1374 if (tsrvalue ==
dnodata) cycle tsloop
1376 tsrvalue = tsrvalue * this%timeSeries(i)%sfac
1397 ts => this%GetTimeSeries(i)
1398 if (
associated(ts))
then
1404 deallocate (this%timeSeries)
1405 deallocate (this%parser)
This module contains block parser methods.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dnodata
real no data constant
integer(i4b), parameter lenhugeline
maximum length of a huge line
integer(i4b), parameter lentimeseriesname
maximum length of a time series name
@ linearend
linear end interpolation
@ undefined
undefined interpolation
@ linear
linear interpolation
@ stepwise
stepwise interpolation
real(dp), parameter dzero
real constant zero
real(dp), parameter done
real constant 1
This module defines variable data types.
pure logical function, public is_close(a, b, rtol, atol, symmetric)
Check if a real value is approximately equal to another.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
integer(i4b) function, public count_errors()
Return number of errors.
subroutine, public store_error_unit(iunit, terminate)
Store the file unit number.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
type(timeseriestype) function, pointer gettimeseries(this, indx)
Get time series.
type(timeseriesrecordtype) function, pointer getcurrenttimeseriesrecord(this)
Get current ts record.
subroutine get_surrounding_nodes(this, time, nodeEarlier, nodeLater)
Get surrounding nodes.
subroutine inserttsr(this, tsr)
Insert a time series record.
integer(i4b) function count(this)
Count number of time series.
subroutine initialize_time_series(this, tsfile, name, autoDeallocate)
Initialize time series.
logical function read_next_record(this)
Read next record.
type(timeseriesfiletype) function, pointer, public gettimeseriesfilefromlist(list, idx)
Get time series from list.
subroutine, public constructtimeseriesfile(newTimeSeriesFile)
Construct time series file.
subroutine get_latest_preceding_node(this, time, tslNode)
Get latest preceding node.
subroutine reset(this)
Reset.
subroutine initializetsfile(this, filename, iout, autoDeallocate)
Open time-series tsfile file and read options and first record, which may contain data to define mult...
type(timeseriesrecordtype) function, pointer gettimeseriesrecord(this, time, epsi)
Get ts record.
subroutine, public addtimeseriesfiletolist(list, tsfile)
Add time series file to list.
real(dp) function getvalue(this, time0, time1, extendToEndOfSimulation)
Get time series value.
type(timeseriesfiletype) function, pointer castastimeseriesfiletype(obj)
Cast an unlimited polymorphic object as class(TimeSeriesFileType)
type(timeseriesfiletype) function, pointer, public castastimeseriesfileclass(obj)
Cast an unlimited polymorphic object as class(TimeSeriesFileType)
real(dp) function get_integrated_value(this, time0, time1, extendToEndOfSimulation)
Get integrated value.
real(dp) function get_value_at_time(this, time, extendToEndOfSimulation)
Get value for a time.
logical function, public sametimeseries(ts1, ts2)
Compare two time series; if they are identical, return true.
type(timeseriesrecordtype) function, pointer getnexttimeseriesrecord(this)
Get next ts record.
real(dp) function get_average_value(this, time0, time1, extendToEndOfSimulation)
Get average value.
subroutine clear(this, destroy)
Clear the list of time series records.
type(timeseriesrecordtype) function, pointer getprevioustimeseriesrecord(this)
Get previous ts record.
subroutine addtimeseriesrecord(this, tsr)
Add ts record.
subroutine ts_da(this)
Deallocate.
subroutine tsf_da(this)
Deallocate memory.
subroutine get_surrounding_records(this, time, tsrecEarlier, tsrecLater)
Get surrounding records.
logical function read_tsfile_line(this)
Read time series file line.
double precision function findlatesttime(this, readToEnd)
Find latest time.
subroutine, public addtimeseriesrecordtolist(list, tsrecord)
Add time series record to list.
subroutine, public constructtimeseriesrecord(newTsRecord, time, value)
Allocate and assign members of a new TimeSeriesRecordType object.
type(timeseriesrecordtype) function, pointer, public castastimeseriesrecordtype(obj)
Cast an unlimited polymorphic object as TimeSeriesRecordType.
A generic heterogeneous doubly-linked list.