3 ! This module is able to perform three date and time functions:
5 ! 1. geth_idts (ndate, odate, idts)
6 ! Get the time period between two dates.
8 ! 2. geth_newdate ( ndate, odate, idts)
9 ! Get the new date based on the old date and a time difference.
11 ! 3. split_date_char ( date , century_year , month , day , hour , minute , second )
12 ! Given the date, return the integer components.
18 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
20 SUBROUTINE geth_idts (ndate, odate, idts)
24 ! From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'),
25 ! compute the time difference.
27 ! on entry - ndate - the new hdate.
28 ! odate - the old hdate.
30 ! on exit - idts - the change in time in seconds.
32 CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
33 INTEGER , INTENT(OUT) :: idts
37 ! yrnew - indicates the year associated with "ndate"
38 ! yrold - indicates the year associated with "odate"
39 ! monew - indicates the month associated with "ndate"
40 ! moold - indicates the month associated with "odate"
41 ! dynew - indicates the day associated with "ndate"
42 ! dyold - indicates the day associated with "odate"
43 ! hrnew - indicates the hour associated with "ndate"
44 ! hrold - indicates the hour associated with "odate"
45 ! minew - indicates the minute associated with "ndate"
46 ! miold - indicates the minute associated with "odate"
47 ! scnew - indicates the second associated with "ndate"
48 ! scold - indicates the second associated with "odate"
50 ! mday - a list assigning the number of days in each month
52 CHARACTER (LEN=24) :: tdate
54 INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew
55 INTEGER :: yrold, moold, dyold, hrold, miold, scold
56 INTEGER :: mday(12), i, newdys, olddys
57 LOGICAL :: npass, opass
60 IF (odate.GT.ndate) THEN
69 ! Assign the number of days in a months
84 ! Break down old hdate into parts
91 READ(odate(1:4), '(I4)') yrold
92 READ(odate(6:7), '(I2)') moold
93 READ(odate(9:10), '(I2)') dyold
95 READ(odate(12:13),'(I2)') hrold
97 READ(odate(15:16),'(I2)') miold
99 READ(odate(18:19),'(I2)') scold
104 ! Break down new hdate into parts
111 READ(ndate(1:4), '(I4)') yrnew
112 READ(ndate(6:7), '(I2)') monew
113 READ(ndate(9:10), '(I2)') dynew
115 READ(ndate(12:13),'(I2)') hrnew
117 READ(ndate(15:16),'(I2)') minew
119 READ(ndate(18:19),'(I2)') scnew
124 ! Check that the dates make sense.
129 ! Check that the month of NDATE makes sense.
131 IF ((monew.GT.12).or.(monew.LT.1)) THEN
132 PRINT*, 'GETH_IDTS: Month of NDATE = ', monew
136 ! Check that the month of ODATE makes sense.
138 IF ((moold.GT.12).or.(moold.LT.1)) THEN
139 PRINT*, 'GETH_IDTS: Month of ODATE = ', moold
143 ! Check that the day of NDATE makes sense.
146 ! ...... For all months but February
147 IF ((dynew.GT.mday(monew)).or.(dynew.LT.1)) THEN
148 PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
151 ELSE IF (monew.eq.2) THEN
152 ! ...... For February
153 IF ((dynew.GT.nfeb(yrnew)).OR.(dynew.LT.1)) THEN
154 PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
159 ! Check that the day of ODATE makes sense.
162 ! ...... For all months but February
163 IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
164 PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
167 ELSE IF (moold.eq.2) THEN
168 ! ....... For February
169 IF ((dyold.GT.nfeb(yrold)).or.(dyold.LT.1)) THEN
170 PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
175 ! Check that the hour of NDATE makes sense.
177 IF ((hrnew.GT.23).or.(hrnew.LT.0)) THEN
178 PRINT*, 'GETH_IDTS: Hour of NDATE = ', hrnew
182 ! Check that the hour of ODATE makes sense.
184 IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
185 PRINT*, 'GETH_IDTS: Hour of ODATE = ', hrold
189 ! Check that the minute of NDATE makes sense.
191 IF ((minew.GT.59).or.(minew.LT.0)) THEN
192 PRINT*, 'GETH_IDTS: Minute of NDATE = ', minew
196 ! Check that the minute of ODATE makes sense.
198 IF ((miold.GT.59).or.(miold.LT.0)) THEN
199 PRINT*, 'GETH_IDTS: Minute of ODATE = ', miold
203 ! Check that the second of NDATE makes sense.
205 IF ((scnew.GT.59).or.(scnew.LT.0)) THEN
206 PRINT*, 'GETH_IDTS: SECOND of NDATE = ', scnew
210 ! Check that the second of ODATE makes sense.
212 IF ((scold.GT.59).or.(scold.LT.0)) THEN
213 PRINT*, 'GETH_IDTS: Second of ODATE = ', scold
217 IF (.not. npass) THEN
218 call mprintf(.true.,ERROR,'Screwy NDATE: %s',s1=ndate(1:nlen))
221 IF (.not. opass) THEN
222 call mprintf(.true.,ERROR,'Screwy ODATE: %s',s1=odate(1:olen))
225 ! Date Checks are completed. Continue.
227 ! Compute number of days from 1 January ODATE, 00:00:00 until ndate
228 ! Compute number of hours from 1 January ODATE, 00:00:00 until ndate
229 ! Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
232 DO i = yrold, yrnew - 1
233 newdys = newdys + (365 + (nfeb(i)-28))
236 IF (monew .GT. 1) THEN
237 mday(2) = nfeb(yrnew)
239 newdys = newdys + mday(i)
244 newdys = newdys + dynew-1
246 ! Compute number of hours from 1 January ODATE, 00:00:00 until odate
247 ! Compute number of minutes from 1 January ODATE, 00:00:00 until odate
251 IF (moold .GT. 1) THEN
252 mday(2) = nfeb(yrold)
254 olddys = olddys + mday(i)
259 olddys = olddys + dyold-1
261 ! Determine the time difference in seconds
263 idts = (newdys - olddys) * 86400
264 idts = idts + (hrnew - hrold) * 3600
265 idts = idts + (minew - miold) * 60
266 idts = idts + (scnew - scold)
268 IF (isign .eq. -1) THEN
275 END SUBROUTINE geth_idts
277 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
279 SUBROUTINE geth_newdate (ndate, odate, idt)
283 ! From old date ('YYYY-MM-DD HH:MM:SS.ffff') and
284 ! delta-time, compute the new date.
286 ! on entry - odate - the old hdate.
287 ! idt - the change in time
289 ! on exit - ndate - the new hdate.
291 INTEGER , INTENT(IN) :: idt
292 CHARACTER (LEN=*) , INTENT(OUT) :: ndate
293 CHARACTER (LEN=*) , INTENT(IN) :: odate
298 ! yrold - indicates the year associated with "odate"
299 ! moold - indicates the month associated with "odate"
300 ! dyold - indicates the day associated with "odate"
301 ! hrold - indicates the hour associated with "odate"
302 ! miold - indicates the minute associated with "odate"
303 ! scold - indicates the second associated with "odate"
305 ! yrnew - indicates the year associated with "ndate"
306 ! monew - indicates the month associated with "ndate"
307 ! dynew - indicates the day associated with "ndate"
308 ! hrnew - indicates the hour associated with "ndate"
309 ! minew - indicates the minute associated with "ndate"
310 ! scnew - indicates the second associated with "ndate"
312 ! mday - a list assigning the number of days in each month
315 ! nday - the integer number of days represented by "idt"
316 ! nhour - the integer number of hours in "idt" after taking out
318 ! nmin - the integer number of minutes in "idt" after taking out
319 ! all the whole days and whole hours.
320 ! nsec - the integer number of minutes in "idt" after taking out
321 ! all the whole days, whole hours, and whole minutes.
323 INTEGER :: nlen, olen
324 INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
325 INTEGER :: yrold, moold, dyold, hrold, miold, scold, frold
326 INTEGER :: mday(12), nday, nhour, nmin, nsec, nfrac, i, ifrc
328 CHARACTER (LEN=10) :: hfrc
329 CHARACTER (LEN=1) :: sp
330 ! INTEGER, EXTERNAL :: nfeb ! in the same module now
332 ! Assign the number of days in a months
347 ! Break down old hdate into parts
360 ! Use internal READ statements to convert the CHARACTER string
361 ! date into INTEGER components.
363 READ(odate(1:4), '(I4)') yrold
364 READ(odate(6:7), '(I2)') moold
365 READ(odate(9:10), '(I2)') dyold
367 READ(odate(12:13),'(I2)') hrold
369 READ(odate(15:16),'(I2)') miold
371 READ(odate(18:19),'(I2)') scold
373 READ(odate(21:olen),'(I2)') frold
379 ! Set the number of days in February for that year.
381 mday(2) = nfeb(yrold)
383 ! Check that ODATE makes sense.
387 ! Check that the month of ODATE makes sense.
389 IF ((moold.GT.12).or.(moold.LT.1)) THEN
390 WRITE(*,*) 'GETH_NEWDATE: Month of ODATE = ', moold
394 ! Check that the day of ODATE makes sense.
396 IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
397 WRITE(*,*) 'GETH_NEWDATE: Day of ODATE = ', dyold
401 ! Check that the hour of ODATE makes sense.
403 IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
404 WRITE(*,*) 'GETH_NEWDATE: Hour of ODATE = ', hrold
408 ! Check that the minute of ODATE makes sense.
410 IF ((miold.GT.59).or.(miold.LT.0)) THEN
411 WRITE(*,*) 'GETH_NEWDATE: Minute of ODATE = ', miold
415 ! Check that the second of ODATE makes sense.
417 IF ((scold.GT.59).or.(scold.LT.0)) THEN
418 WRITE(*,*) 'GETH_NEWDATE: Second of ODATE = ', scold
422 ! Check that the fractional part of ODATE makes sense.
426 call mprintf(.true.,ERROR,'GETH_NEWDATE: Crazy ODATE: %s %i',s1=odate(1:olen),i1=olen)
429 ! Date Checks are completed. Continue.
432 ! Compute the number of days, hours, minutes, and seconds in idt
434 IF (olen.GT.20) THEN !idt should be in fractions of seconds
437 nday = ABS(idt)/(86400*ifrc)
438 nhour = MOD(ABS(idt),86400*ifrc)/(3600*ifrc)
439 nmin = MOD(ABS(idt),3600*ifrc)/(60*ifrc)
440 nsec = MOD(ABS(idt),60*ifrc)/(ifrc)
441 nfrac = MOD(ABS(idt), ifrc)
442 ELSE IF (olen.eq.19) THEN !idt should be in seconds
444 nday = ABS(idt)/86400 ! Integer number of days in delta-time
445 nhour = MOD(ABS(idt),86400)/3600
446 nmin = MOD(ABS(idt),3600)/60
447 nsec = MOD(ABS(idt),60)
449 ELSE IF (olen.eq.16) THEN !idt should be in minutes
451 nday = ABS(idt)/1440 ! Integer number of days in delta-time
452 nhour = MOD(ABS(idt),1440)/60
453 nmin = MOD(ABS(idt),60)
456 ELSE IF (olen.eq.13) THEN !idt should be in hours
458 nday = ABS(idt)/24 ! Integer number of days in delta-time
459 nhour = MOD(ABS(idt),24)
463 ELSE IF (olen.eq.10) THEN !idt should be in days
465 nday = ABS(idt)/24 ! Integer number of days in delta-time
471 call mprintf(.true.,ERROR,'GETH_NEWDATE: Strange length for ODATE: %i',i1=olen)
476 frnew = frold + nfrac
477 IF (frnew.GE.ifrc) THEN
483 IF (scnew .GE. 60) THEN
489 IF (minew .GE. 60) THEN
494 hrnew = hrold + nhour
495 IF (hrnew .GE. 24) THEN
505 IF (dynew.GT.mday(monew)) THEN
506 dynew = dynew - mday(monew)
508 IF (monew .GT. 12) THEN
511 ! If the year changes, recompute the number of days in February
512 mday(2) = nfeb(yrnew)
517 ELSE IF (idt.LT.0) THEN
519 frnew = frold - nfrac
520 IF (frnew .LT. 0) THEN
526 IF (scnew .LT. 00) THEN
532 IF (minew .LT. 00) THEN
537 hrnew = hrold - nhour
538 IF (hrnew .LT. 00) THEN
553 ! If the year changes, recompute the number of days in February
554 mday(2) = nfeb(yrnew)
561 ! Now construct the new mdate
566 WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
567 WRITE(hfrc,'(I10)') frnew+1000000000
568 ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
570 ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
571 WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
572 19 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
573 IF (nlen.eq.20) ndate = ndate(1:19)//'.'
575 ELSE IF (nlen.eq.16) THEN
576 WRITE(ndate,16) yrnew, monew, dynew, hrnew, minew
577 16 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
579 ELSE IF (nlen.eq.13) THEN
580 WRITE(ndate,13) yrnew, monew, dynew, hrnew
581 13 format(I4,'-',I2.2,'-',I2.2,'_',I2.2)
583 ELSE IF (nlen.eq.10) THEN
584 WRITE(ndate,10) yrnew, monew, dynew
585 10 format(I4,'-',I2.2,'-',I2.2)
589 IF (olen.GE.11) ndate(11:11) = sp
591 END SUBROUTINE geth_newdate
593 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
595 FUNCTION nfeb ( year ) RESULT (num_days)
597 ! Compute the number of days in February for the given year
604 #ifdef NO_LEAP_CALENDAR
605 num_days = 28 ! February always has 28 days for No Leap Calendar ...
607 num_days = 28 ! By default, February has 28 days ...
608 IF (MOD(year,4).eq.0) THEN
609 num_days = 29 ! But every four years, it has 29 days ...
610 IF (MOD(year,100).eq.0) THEN
611 num_days = 28 ! Except every 100 years, when it has 28 days ...
612 IF (MOD(year,400).eq.0) THEN
613 num_days = 29 ! Except every 400 years, when it has 29 days.
621 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
622 SUBROUTINE split_date_char ( date , century_year , month , day , hour , minute , second )
628 CHARACTER(LEN=19) , INTENT(IN) :: date
632 INTEGER , INTENT(OUT) :: century_year , month , day , hour , minute , second
634 READ(date,FMT='( I4.4)') century_year
635 READ(date,FMT='( 5X,I2.2)') month
636 READ(date,FMT='( 8X,I2.2)') day
637 READ(date,FMT='(11X,I2.2)') hour
638 READ(date,FMT='(14X,I2.2)') minute
639 READ(date,FMT='(17X,I2.2)') second
641 END SUBROUTINE split_date_char