module_date_time.F
References to this file elsewhere.
1 !WRF:MODEL_LAYER:UTIL
2 !
3 MODULE module_date_time
4
5 USE module_wrf_error
6 USE module_configure
7 USE module_model_constants
8
9 CHARACTER* 24 :: start_date = ' '
10 CHARACTER* 24 :: current_date
11 INTEGER , PARAMETER :: len_current_date = 24
12 REAL , PRIVATE :: xtime
13
14 ! 1. geth_idts (ndate, odate, idts)
15 ! Get the time period between two dates.
16
17 ! 2. geth_newdate ( ndate, odate, idts)
18 ! Get the new date based on the old date and a time difference.
19
20 ! 3. split_date_char ( date , century_year , month , day , hour , minute , second , ten_thousandth)
21 ! Given the date, return the integer components.
22
23 CONTAINS
24
25 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
26
27 SUBROUTINE get_julgmt(date_str,julyr,julday,gmt)
28 IMPLICIT NONE
29 ! Arguments
30 CHARACTER (LEN=24) , INTENT(IN) :: date_str
31 INTEGER, INTENT(OUT ) :: julyr
32 INTEGER, INTENT(OUT ) :: julday
33 REAL , INTENT(OUT ) :: gmt
34 ! Local
35 INTEGER :: ny , nm , nd , nh , ni , ns , nt
36 INTEGER :: my1, my2, my3, monss
37 INTEGER, DIMENSION(12) :: mmd
38 DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
39 CALL split_date_char ( date_str , ny , nm , nd , nh , ni , ns , nt )
40 #ifdef PLANET
41 GMT=nh+FLOAT(ni)/60.+(FLOAT(ns)+FLOAT(nt)/1.e6)/3600.
42 JULDAY=nd
43 JULYR=ny
44 #else
45 GMT=nh+FLOAT(ni)/60.+FLOAT(ns)/3600.
46 MY1=MOD(ny,4)
47 MY2=MOD(ny,100)
48 MY3=MOD(ny,400)
49 IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
50 JULDAY=nd
51 JULYR=ny
52 DO MONSS=1,nm-1
53 JULDAY=JULDAY+MMD(MONSS)
54 ENDDO
55 #endif
56 END SUBROUTINE get_julgmt
57
58
59 SUBROUTINE geth_julgmt(julyr,julday, gmt)
60 IMPLICIT NONE
61 ! Arguments
62 INTEGER, INTENT(OUT ) :: julyr
63 INTEGER, INTENT(OUT ) :: julday
64 REAL , INTENT(OUT ) :: gmt
65 ! Local
66 INTEGER :: ny , nm , nd , nh , ni , ns , nt
67 INTEGER :: my1, my2, my3, monss
68 INTEGER, DIMENSION(12) :: mmd
69 DATA MMD/31,28,31,30,31,30,31,31,30,31,30,31/
70 CALL split_date_char ( current_date , ny , nm , nd , nh , ni , ns , nt )
71 #ifdef PLANET
72 GMT=nh+FLOAT(ni)/60.+(FLOAT(ns)+FLOAT(nt)/1.e6)/3600.
73 JULDAY=nd
74 JULYR=ny
75 #else
76 GMT=nh+FLOAT(ni)/60.+FLOAT(ns)/3600.
77 MY1=MOD(ny,4)
78 MY2=MOD(ny,100)
79 MY3=MOD(ny,400)
80 IF(MY1.EQ.0.AND.MY2.NE.0.OR.MY3.EQ.0)MMD(2)=29
81 JULDAY=nd
82 JULYR=ny
83 DO MONSS=1,nm-1
84 JULDAY=JULDAY+MMD(MONSS)
85 ENDDO
86 #endif
87 END SUBROUTINE geth_julgmt
88
89 SUBROUTINE calc_current_date (id, time)
90 ! This subroutines calculates current_date and xtime
91 IMPLICIT NONE
92 ! Arguments
93 INTEGER, INTENT(IN ) :: id ! grid id
94 REAL, INTENT(IN ) :: time ! time in seconds since start time
95 ! Local
96 INTEGER :: julyr, julday, idt
97 CHARACTER*19 new_date
98 CHARACTER*24 base_date
99 CHARACTER*128 mess
100 REAL :: gmt
101
102 xtime = time/60.
103 CALL nl_get_gmt (id, gmt)
104 CALL nl_get_julyr (id, julyr)
105 CALL nl_get_julday (id, julday)
106 idt = 86400*(julday-1)+nint(3600*gmt)
107 write (mess,*) 'calc_current_date called: time = ',time,' idt = ',idt
108 CALL wrf_debug(300,TRIM(mess))
109 write (mess,*) 'calc_current_date called: gmt = ',gmt
110 CALL wrf_debug(300,TRIM(mess))
111 write (mess,*) 'calc_current_date called: julyr = ',julyr
112 CALL wrf_debug(300,TRIM(mess))
113 write (mess,*) 'calc_current_date called: julday = ',julday
114 CALL wrf_debug(300,TRIM(mess))
115 #ifdef PLANET
116 base_date = '0000-00001_00:00:00.0000'
117 #else
118 base_date = '0000-01-01_00:00:00.0000'
119 #endif
120 write(base_date(1:4),'(I4.4)')julyr
121 CALL geth_newdate (start_date(1:19), base_date(1:19), idt)
122 CALL geth_newdate (new_date, start_date(1:19), nint(time))
123 write (current_date(1:24),fmt=340)new_date
124 340 format(a19, '.0000')
125 write (mess,*) current_date,gmt,julday,julyr,'=current_date,gmt,julday,julyr: calc_current_date'
126 CALL wrf_debug(300,TRIM(mess))
127 END SUBROUTINE calc_current_date
128
129 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
130
131 SUBROUTINE geth_idts (ndate, odate, idts)
132
133 IMPLICIT NONE
134
135 ! From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'),
136 ! or ('YYYY-DDDDD HH:MM:SS.ffff'),
137 ! compute the time difference.
138
139 ! on entry - ndate - the new hdate.
140 ! odate - the old hdate.
141
142 ! on exit - idts - the change in time in seconds.
143
144 CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
145 INTEGER , INTENT(OUT) :: idts
146
147 ! Local Variables
148
149 ! yrnew - indicates the year associated with "ndate"
150 ! yrold - indicates the year associated with "odate"
151 ! monew - indicates the month associated with "ndate"
152 ! moold - indicates the month associated with "odate"
153 ! dynew - indicates the day associated with "ndate"
154 ! dyold - indicates the day associated with "odate"
155 ! hrnew - indicates the hour associated with "ndate"
156 ! hrold - indicates the hour associated with "odate"
157 ! minew - indicates the minute associated with "ndate"
158 ! miold - indicates the minute associated with "odate"
159 ! scnew - indicates the second associated with "ndate"
160 ! scold - indicates the second associated with "odate"
161 ! i - loop counter
162 ! mday - a list assigning the number of days in each month
163
164 CHARACTER (LEN=24) :: tdate
165 INTEGER :: olen, nlen
166 INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew
167 INTEGER :: yrold, moold, dyold, hrold, miold, scold
168 INTEGER :: mday(12), i, newdys, olddys
169 LOGICAL :: npass, opass
170 INTEGER :: isign
171
172 IF (odate.GT.ndate) THEN
173 isign = -1
174 tdate=ndate
175 ndate=odate
176 odate=tdate
177 ELSE
178 isign = 1
179 END IF
180
181 ! Assign the number of days in a months
182
183 mday( 1) = 31
184 mday( 2) = 28
185 mday( 3) = 31
186 mday( 4) = 30
187 mday( 5) = 31
188 mday( 6) = 30
189 mday( 7) = 31
190 mday( 8) = 31
191 mday( 9) = 30
192 mday(10) = 31
193 mday(11) = 30
194 mday(12) = 31
195
196 ! Break down old hdate into parts
197
198 hrold = 0
199 miold = 0
200 scold = 0
201 olen = LEN(odate)
202
203 READ(odate(1:4), '(I4)') yrold
204 #ifdef PLANET
205 READ(odate(6:10), '(I5)') dyold
206 moold=0.
207 #else
208 READ(odate(6:7), '(I2)') moold
209 READ(odate(9:10), '(I2)') dyold
210 #endif
211 IF (olen.GE.13) THEN
212 READ(odate(12:13),'(I2)') hrold
213 IF (olen.GE.16) THEN
214 READ(odate(15:16),'(I2)') miold
215 IF (olen.GE.19) THEN
216 READ(odate(18:19),'(I2)') scold
217 END IF
218 END IF
219 END IF
220
221 ! Break down new hdate into parts
222
223 hrnew = 0
224 minew = 0
225 scnew = 0
226 nlen = LEN(ndate)
227
228 READ(ndate(1:4), '(I4)') yrnew
229 #ifdef PLANET
230 READ(ndate(6:10), '(I5)') dynew
231 monew=0.
232 #else
233 READ(ndate(6:7), '(I2)') monew
234 READ(ndate(9:10), '(I2)') dynew
235 #endif
236 IF (nlen.GE.13) THEN
237 READ(ndate(12:13),'(I2)') hrnew
238 IF (nlen.GE.16) THEN
239 READ(ndate(15:16),'(I2)') minew
240 IF (nlen.GE.19) THEN
241 READ(ndate(18:19),'(I2)') scnew
242 END IF
243 END IF
244 END IF
245
246 ! Check that the dates make sense.
247
248 npass = .true.
249 opass = .true.
250
251 #ifdef PLANET
252 ! Check that the day of NDATE makes sense.
253
254 IF ((dynew > PLANET_YEAR).or.(dynew < 1)) THEN
255 PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
256 npass = .false.
257 END IF
258
259 ! Check that the day of ODATE makes sense.
260
261 IF ((dyold > PLANET_YEAR).or.(dyold < 1)) THEN
262 PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
263 opass = .false.
264 END IF
265
266 #else
267 ! Check that the month of NDATE makes sense.
268
269 IF ((monew.GT.12).or.(monew.LT.1)) THEN
270 PRINT*, 'GETH_IDTS: Month of NDATE = ', monew
271 npass = .false.
272 END IF
273
274 ! Check that the month of ODATE makes sense.
275
276 IF ((moold.GT.12).or.(moold.LT.1)) THEN
277 PRINT*, 'GETH_IDTS: Month of ODATE = ', moold
278 opass = .false.
279 END IF
280
281 ! Check that the day of NDATE makes sense.
282
283 IF (monew.ne.2) THEN
284 ! ...... For all months but February
285 IF ((dynew.GT.mday(monew)).or.(dynew.LT.1)) THEN
286 PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
287 npass = .false.
288 END IF
289 ELSE IF (monew.eq.2) THEN
290 ! ...... For February
291 IF ((dynew.GT.nfeb(yrnew)).OR.(dynew.LT.1)) THEN
292 PRINT*, 'GETH_IDTS: Day of NDATE = ', dynew
293 npass = .false.
294 END IF
295 END IF
296
297 ! Check that the day of ODATE makes sense.
298
299 IF (moold.ne.2) THEN
300 ! ...... For all months but February
301 IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
302 PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
303 opass = .false.
304 END IF
305 ELSE IF (moold.eq.2) THEN
306 ! ....... For February
307 IF ((dyold.GT.nfeb(yrold)).or.(dyold.LT.1)) THEN
308 PRINT*, 'GETH_IDTS: Day of ODATE = ', dyold
309 opass = .false.
310 END IF
311 END IF
312 #endif
313 ! Check that the hour of NDATE makes sense.
314
315 IF ((hrnew.GT.23).or.(hrnew.LT.0)) THEN
316 PRINT*, 'GETH_IDTS: Hour of NDATE = ', hrnew
317 npass = .false.
318 END IF
319
320 ! Check that the hour of ODATE makes sense.
321
322 IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
323 PRINT*, 'GETH_IDTS: Hour of ODATE = ', hrold
324 opass = .false.
325 END IF
326
327 ! Check that the minute of NDATE makes sense.
328
329 IF ((minew.GT.59).or.(minew.LT.0)) THEN
330 PRINT*, 'GETH_IDTS: Minute of NDATE = ', minew
331 npass = .false.
332 END IF
333
334 ! Check that the minute of ODATE makes sense.
335
336 IF ((miold.GT.59).or.(miold.LT.0)) THEN
337 PRINT*, 'GETH_IDTS: Minute of ODATE = ', miold
338 opass = .false.
339 END IF
340
341 ! Check that the second of NDATE makes sense.
342
343 IF ((scnew.GT.59).or.(scnew.LT.0)) THEN
344 PRINT*, 'GETH_IDTS: SECOND of NDATE = ', scnew
345 npass = .false.
346 END IF
347
348 ! Check that the second of ODATE makes sense.
349
350 IF ((scold.GT.59).or.(scold.LT.0)) THEN
351 PRINT*, 'GETH_IDTS: Second of ODATE = ', scold
352 opass = .false.
353 END IF
354
355 IF (.not. npass) THEN
356 WRITE( wrf_err_message , * ) 'module_date_time: geth_idts: Bad NDATE: ', ndate(1:nlen)
357 CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
358 END IF
359
360 IF (.not. opass) THEN
361 WRITE( wrf_err_message , * ) 'module_date_time: geth_idts: Bad ODATE: ', odate(1:olen)
362 CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
363 END IF
364
365 ! Date Checks are completed. Continue.
366
367 ! Compute number of days from 1 January ODATE, 00:00:00 until ndate
368 ! Compute number of hours from 1 January ODATE, 00:00:00 until ndate
369 ! Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
370
371 newdys = 0
372 #ifdef PLANET
373 DO i = yrold, yrnew - 1
374 newdys = newdys + PLANET_YEAR
375 END DO
376 #else
377 DO i = yrold, yrnew - 1
378 newdys = newdys + (365 + (nfeb(i)-28))
379 END DO
380
381 IF (monew .GT. 1) THEN
382 mday(2) = nfeb(yrnew)
383 DO i = 1, monew - 1
384 newdys = newdys + mday(i)
385 END DO
386 mday(2) = 28
387 END IF
388 #endif
389
390 newdys = newdys + dynew-1
391
392 ! Compute number of hours from 1 January ODATE, 00:00:00 until odate
393 ! Compute number of minutes from 1 January ODATE, 00:00:00 until odate
394
395 olddys = 0
396
397 #ifndef PLANET
398 IF (moold .GT. 1) THEN
399 mday(2) = nfeb(yrold)
400 DO i = 1, moold - 1
401 olddys = olddys + mday(i)
402 END DO
403 mday(2) = 28
404 END IF
405 #endif
406
407 olddys = olddys + dyold-1
408
409 ! Determine the time difference in seconds
410
411 idts = (newdys - olddys) * 86400
412 idts = idts + (hrnew - hrold) * 3600
413 idts = idts + (minew - miold) * 60
414 idts = idts + (scnew - scold)
415
416 IF (isign .eq. -1) THEN
417 tdate=ndate
418 ndate=odate
419 odate=tdate
420 idts = idts * isign
421 END IF
422
423 END SUBROUTINE geth_idts
424
425 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
426
427 SUBROUTINE geth_newdate (ndate, odate, idt)
428
429 IMPLICIT NONE
430
431 ! From old date ('YYYY-MM-DD HH:MM:SS.ffff') and
432 ! [or ('YYYY-DDDDD HH:MM:SS.ffff')]
433 ! delta-time, compute the new date.
434
435 ! on entry - odate - the old hdate.
436 ! idt - the change in time
437
438 ! on exit - ndate - the new hdate.
439
440 INTEGER , INTENT(IN) :: idt
441 CHARACTER (LEN=*) , INTENT(OUT) :: ndate
442 CHARACTER (LEN=*) , INTENT(IN) :: odate
443
444
445 ! Local Variables
446
447 ! yrold - indicates the year associated with "odate"
448 ! moold - indicates the month associated with "odate"
449 ! dyold - indicates the day associated with "odate"
450 ! hrold - indicates the hour associated with "odate"
451 ! miold - indicates the minute associated with "odate"
452 ! scold - indicates the second associated with "odate"
453
454 ! yrnew - indicates the year associated with "ndate"
455 ! monew - indicates the month associated with "ndate"
456 ! dynew - indicates the day associated with "ndate"
457 ! hrnew - indicates the hour associated with "ndate"
458 ! minew - indicates the minute associated with "ndate"
459 ! scnew - indicates the second associated with "ndate"
460
461 ! mday - a list assigning the number of days in each month
462
463 ! i - loop counter
464 ! nday - the integer number of days represented by "idt"
465 ! nhour - the integer number of hours in "idt" after taking out
466 ! all the whole days
467 ! nmin - the integer number of minutes in "idt" after taking out
468 ! all the whole days and whole hours.
469 ! nsec - the integer number of minutes in "idt" after taking out
470 ! all the whole days, whole hours, and whole minutes.
471
472 INTEGER :: nlen, olen
473 INTEGER :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
474 INTEGER :: yrold, moold, dyold, hrold, miold, scold, frold
475 INTEGER :: mday(12), nday, nhour, nmin, nsec, nfrac, i, ifrc
476 LOGICAL :: opass
477 CHARACTER (LEN=10) :: hfrc
478 CHARACTER (LEN=1) :: sp
479 ! INTEGER, EXTERNAL :: nfeb ! in the same module now
480
481 ! Assign the number of days in a months
482
483 mday( 1) = 31
484 mday( 2) = 28
485 mday( 3) = 31
486 mday( 4) = 30
487 mday( 5) = 31
488 mday( 6) = 30
489 mday( 7) = 31
490 mday( 8) = 31
491 mday( 9) = 30
492 mday(10) = 31
493 mday(11) = 30
494 mday(12) = 31
495
496 ! Break down old hdate into parts
497
498 hrold = 0
499 miold = 0
500 scold = 0
501 frold = 0
502 olen = LEN(odate)
503 IF (olen.GE.11) THEN
504 sp = odate(11:11)
505 else
506 sp = ' '
507 END IF
508
509 ! Use internal READ statements to convert the CHARACTER string
510 ! date into INTEGER components.
511
512 READ(odate(1:4), '(I4)') yrold
513 #ifdef PLANET
514 READ(odate(6:10), '(I5)') dyold
515 moold=0.
516 #else
517 READ(odate(6:7), '(I2)') moold
518 READ(odate(9:10), '(I2)') dyold
519 #endif
520 IF (olen.GE.13) THEN
521 READ(odate(12:13),'(I2)') hrold
522 IF (olen.GE.16) THEN
523 READ(odate(15:16),'(I2)') miold
524 IF (olen.GE.19) THEN
525 READ(odate(18:19),'(I2)') scold
526 IF (olen.GT.20) THEN
527 READ(odate(21:olen),'(I2)') frold
528 END IF
529 END IF
530 END IF
531 END IF
532
533 ! Set the number of days in February for that year.
534
535 mday(2) = nfeb(yrold)
536
537 ! Check that ODATE makes sense.
538
539 opass = .TRUE.
540
541 #ifdef PLANET
542 ! Check that the day of ODATE makes sense.
543 IF ((dyold.GT.PLANET_YEAR).or.(dyold.LT.1)) THEN
544 WRITE(*,*) 'GETH_NEWDATE: Day of ODATE = ', dyold
545 opass = .FALSE.
546 END IF
547 #else
548 ! Check that the month of ODATE makes sense.
549
550 IF ((moold.GT.12).or.(moold.LT.1)) THEN
551 WRITE(*,*) 'GETH_NEWDATE: Month of ODATE = ', moold
552 opass = .FALSE.
553 END IF
554
555 ! Check that the day of ODATE makes sense.
556
557 IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
558 WRITE(*,*) 'GETH_NEWDATE: Day of ODATE = ', dyold
559 opass = .FALSE.
560 END IF
561 #endif
562 ! Check that the hour of ODATE makes sense.
563
564 IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
565 WRITE(*,*) 'GETH_NEWDATE: Hour of ODATE = ', hrold
566 opass = .FALSE.
567 END IF
568
569 ! Check that the minute of ODATE makes sense.
570
571 IF ((miold.GT.59).or.(miold.LT.0)) THEN
572 WRITE(*,*) 'GETH_NEWDATE: Minute of ODATE = ', miold
573 opass = .FALSE.
574 END IF
575
576 ! Check that the second of ODATE makes sense.
577
578 IF ((scold.GT.59).or.(scold.LT.0)) THEN
579 WRITE(*,*) 'GETH_NEWDATE: Second of ODATE = ', scold
580 opass = .FALSE.
581 END IF
582
583 ! Check that the fractional part of ODATE makes sense.
584
585
586 IF (.not.opass) THEN
587 WRITE( wrf_err_message , * ) 'module_date_time: GETH_NEWDATE: Bad ODATE: ', odate(1:olen), olen
588 CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
589 END IF
590
591 ! Date Checks are completed. Continue.
592
593
594 ! Compute the number of days, hours, minutes, and seconds in idt
595
596 IF (olen.GT.20) THEN !idt should be in fractions of seconds
597 ifrc = olen-20
598 ifrc = 10**ifrc
599 nday = ABS(idt)/(86400*ifrc)
600 nhour = MOD(ABS(idt),86400*ifrc)/(3600*ifrc)
601 nmin = MOD(ABS(idt),3600*ifrc)/(60*ifrc)
602 nsec = MOD(ABS(idt),60*ifrc)/(ifrc)
603 nfrac = MOD(ABS(idt), ifrc)
604 ELSE IF (olen.eq.19) THEN !idt should be in seconds
605 ifrc = 1
606 nday = ABS(idt)/86400 ! Integer number of days in delta-time
607 nhour = MOD(ABS(idt),86400)/3600
608 nmin = MOD(ABS(idt),3600)/60
609 nsec = MOD(ABS(idt),60)
610 nfrac = 0
611 ELSE IF (olen.eq.16) THEN !idt should be in minutes
612 ifrc = 1
613 nday = ABS(idt)/1440 ! Integer number of days in delta-time
614 nhour = MOD(ABS(idt),1440)/60
615 nmin = MOD(ABS(idt),60)
616 nsec = 0
617 nfrac = 0
618 ELSE IF (olen.eq.13) THEN !idt should be in hours
619 ifrc = 1
620 nday = ABS(idt)/24 ! Integer number of days in delta-time
621 nhour = MOD(ABS(idt),24)
622 nmin = 0
623 nsec = 0
624 nfrac = 0
625 ELSE IF (olen.eq.10) THEN !idt should be in days
626 ifrc = 1
627 nday = ABS(idt)/24 ! Integer number of days in delta-time
628 nhour = 0
629 nmin = 0
630 nsec = 0
631 nfrac = 0
632 ELSE
633 WRITE( wrf_err_message , * ) 'module_date_time: GETH_NEWDATE: Strange length for ODATE: ',olen
634 CALL wrf_error_fatal ( TRIM ( wrf_err_message ) )
635 END IF
636
637 IF (idt.GE.0) THEN
638
639 frnew = frold + nfrac
640 IF (frnew.GE.ifrc) THEN
641 frnew = frnew - ifrc
642 nsec = nsec + 1
643 END IF
644
645 scnew = scold + nsec
646 IF (scnew .GE. 60) THEN
647 scnew = scnew - 60
648 nmin = nmin + 1
649 END IF
650
651 minew = miold + nmin
652 IF (minew .GE. 60) THEN
653 minew = minew - 60
654 nhour = nhour + 1
655 END IF
656
657 hrnew = hrold + nhour
658 IF (hrnew .GE. 24) THEN
659 hrnew = hrnew - 24
660 nday = nday + 1
661 END IF
662
663 dynew = dyold
664 monew = moold
665 yrnew = yrold
666 DO i = 1, nday
667 dynew = dynew + 1
668 #ifdef PLANET
669 IF (dynew .GT. PLANET_YEAR) THEN
670 dynew = dynew - PLANET_YEAR
671 yrnew = yrnew + 1
672 END IF
673 #else
674 IF (dynew.GT.mday(monew)) THEN
675 dynew = dynew - mday(monew)
676 monew = monew + 1
677 IF (monew .GT. 12) THEN
678 monew = 1
679 yrnew = yrnew + 1
680 ! If the year changes, recompute the number of days in February
681 mday(2) = nfeb(yrnew)
682 END IF
683 END IF
684 #endif
685 END DO
686
687 ELSE IF (idt.LT.0) THEN
688
689 frnew = frold - nfrac
690 IF (frnew .LT. 0) THEN
691 frnew = frnew + ifrc
692 nsec = nsec - 1
693 END IF
694
695 scnew = scold - nsec
696 IF (scnew .LT. 00) THEN
697 scnew = scnew + 60
698 nmin = nmin + 1
699 END IF
700
701 minew = miold - nmin
702 IF (minew .LT. 00) THEN
703 minew = minew + 60
704 nhour = nhour + 1
705 END IF
706
707 hrnew = hrold - nhour
708 IF (hrnew .LT. 00) THEN
709 hrnew = hrnew + 24
710 nday = nday + 1
711 END IF
712
713 dynew = dyold
714 monew = moold
715 yrnew = yrold
716 DO i = 1, nday
717 dynew = dynew - 1
718 #ifdef PLANET
719 IF (dynew.eq.0) THEN
720 dynew = PLANET_YEAR
721 yrnew = yrnew - 1
722 END IF
723 #else
724 IF (dynew.eq.0) THEN
725 monew = monew - 1
726 IF (monew.eq.0) THEN
727 monew = 12
728 yrnew = yrnew - 1
729 ! If the year changes, recompute the number of days in February
730 mday(2) = nfeb(yrnew)
731 END IF
732 dynew = mday(monew)
733 END IF
734 #endif
735 END DO
736 END IF
737
738 ! Now construct the new mdate
739
740 nlen = LEN(ndate)
741
742 #ifdef PLANET
743 IF (nlen.GT.20) THEN
744 WRITE(ndate(1:19),19) yrnew, dynew, hrnew, minew, scnew
745 WRITE(hfrc,'(I10)') frnew+1000000000
746 ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
747
748 ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
749 WRITE(ndate(1:19),19) yrnew, dynew, hrnew, minew, scnew
750 19 format(I4.4,'-',I5.5,'_',I2.2,':',I2.2,':',I2.2)
751 IF (nlen.eq.20) ndate = ndate(1:19)//'.'
752
753 ELSE IF (nlen.eq.16) THEN
754 WRITE(ndate,16) yrnew, dynew, hrnew, minew
755 16 format(I4.4,'-',I5.5,'_',I2.2,':',I2.2)
756
757 ELSE IF (nlen.eq.13) THEN
758 WRITE(ndate,13) yrnew, dynew, hrnew
759 13 format(I4.4,'-',I5.5,'_',I2.2)
760
761 ELSE IF (nlen.eq.10) THEN
762 WRITE(ndate,10) yrnew, dynew
763 10 format(I4.4,'-',I5.5)
764
765 END IF
766
767 IF (olen.GE.11) ndate(11:11) = sp
768 #else
769 IF (nlen.GT.20) THEN
770 WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
771 WRITE(hfrc,'(I10)') frnew+1000000000
772 ndate = ndate(1:19)//'.'//hfrc(31-nlen:10)
773
774 ELSE IF (nlen.eq.19.or.nlen.eq.20) THEN
775 WRITE(ndate(1:19),19) yrnew, monew, dynew, hrnew, minew, scnew
776 19 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2,':',I2.2)
777 IF (nlen.eq.20) ndate = ndate(1:19)//'.'
778
779 ELSE IF (nlen.eq.16) THEN
780 WRITE(ndate,16) yrnew, monew, dynew, hrnew, minew
781 16 format(I4,'-',I2.2,'-',I2.2,'_',I2.2,':',I2.2)
782
783 ELSE IF (nlen.eq.13) THEN
784 WRITE(ndate,13) yrnew, monew, dynew, hrnew
785 13 format(I4,'-',I2.2,'-',I2.2,'_',I2.2)
786
787 ELSE IF (nlen.eq.10) THEN
788 WRITE(ndate,10) yrnew, monew, dynew
789 10 format(I4,'-',I2.2,'-',I2.2)
790
791 END IF
792
793 IF (olen.GE.11) ndate(11:11) = sp
794 #endif
795 END SUBROUTINE geth_newdate
796
797 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
798
799 FUNCTION nfeb ( year ) RESULT (num_days)
800
801 ! Compute the number of days in February for the given year
802
803 IMPLICIT NONE
804
805 INTEGER :: year
806 INTEGER :: num_days
807
808 num_days = 28 ! By default, February has 28 days ...
809 IF (MOD(year,4).eq.0) THEN
810 num_days = 29 ! But every four years, it has 29 days ...
811 IF (MOD(year,100).eq.0) THEN
812 num_days = 28 ! Except every 100 years, when it has 28 days ...
813 IF (MOD(year,400).eq.0) THEN
814 num_days = 29 ! Except every 400 years, when it has 29 days.
815 END IF
816 END IF
817 END IF
818
819 END FUNCTION nfeb
820
821 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
822 SUBROUTINE split_date_char ( date , century_year , month , day , hour , minute , second , ten_thousandth)
823
824 IMPLICIT NONE
825
826 ! Input data.
827
828 CHARACTER(LEN=24) , INTENT(IN) :: date
829
830 ! Output data.
831
832 INTEGER , INTENT(OUT) :: century_year , month , day , hour , minute , second , ten_thousandth
833
834 READ(date,FMT='( I4)') century_year
835 #ifdef PLANET
836 month = 0
837 READ(date,FMT='( 5X,I5)') day
838 #else
839 READ(date,FMT='( 5X,I2)') month
840 READ(date,FMT='( 8X,I2)') day
841 #endif
842 READ(date,FMT='(11X,I2)') hour
843 READ(date,FMT='(14X,I2)') minute
844 READ(date,FMT='(17X,I2)') second
845 READ(date,FMT='(20X,I4)') ten_thousandth
846
847 END SUBROUTINE split_date_char
848
849 SUBROUTINE init_module_date_time
850 END SUBROUTINE init_module_date_time
851
852 END MODULE module_date_time
853
854
855 ! TBH: NOTE:
856 ! TBH: Linkers whine if these routines are placed inside the module. Not
857 ! TBH: sure if these should live here or inside an external package. They
858 ! TBH: have dependencies both on WRF (for the format of the WRF date-time
859 ! TBH: strings) and on the time manager. Currently, the format of the WRF
860 ! TBH: date-time strings is a slight variant on ISO 8601 (ISO is
861 ! TBH: "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss"). If we
862 ! TBH: change the WRF format to match the standard, then we remove the
863 ! TBH: WRF dependence...
864
865 ! Converts WRF date-time string into an WRFU_Time object.
866 ! The format of the WRF date-time strings is a slight variant on ISO 8601:
867 ! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".
868 SUBROUTINE wrf_atotime ( str, time )
869 USE module_utility
870 CHARACTER (LEN=*), INTENT( IN) :: str
871 TYPE(WRFU_Time), INTENT(OUT) :: time
872 INTEGER yr, mm, dd, h, m, s, ms
873 INTEGER rc
874 IF ( LEN( str ) .GE. 20 ) THEN
875 IF ( str(20:20) .EQ. '.' ) THEN
876 #ifdef PLANET
877 READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2,1x,I4.4)') yr,dd,h,m,s,ms
878 mm = 1
879 #else
880 READ(str,34) yr,mm,dd,h,m,s,ms
881 #endif
882 ! last four digits are ten-thousandths of a sec, convert to ms
883 ms=nint(real(ms)/10)
884 ELSE
885 #ifdef PLANET
886 READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2)') yr,dd,h,m,s
887 mm = 1
888 #else
889 READ(str,33) yr,mm,dd,h,m,s
890 #endif
891 ms = 0
892 ENDIF
893 ELSE
894 #ifdef PLANET
895 READ(str,'(I4.4,1x,I5.5,1x,I2.2,1x,I2.2,1x,I2.2)') yr,dd,h,m,s
896 mm = 1
897 #else
898 READ(str,33) yr,mm,dd,h,m,s
899 #endif
900 ms = 0
901 ENDIF
902 CALL WRFU_TimeSet( time, YY=yr, MM=mm, DD=dd, H=h, M=m, S=s, MS=ms, rc=rc )
903 CALL wrf_check_error( WRFU_SUCCESS, rc, &
904 'WRFU_TimeSet() in wrf_atotime() FAILED', &
905 __FILE__ , &
906 __LINE__ )
907 33 FORMAT (I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2)
908 34 FORMAT (I4.4,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I2.2,1x,I4.4)
909 RETURN
910 END SUBROUTINE wrf_atotime
911
912
913
914 ! Converts an WRFU_Time object into a WRF date-time string.
915 ! The format of the WRF date-time strings is a slight variant on ISO 8601:
916 ! ISO is "YYYY-MM-DDThh:mm:ss" while WRF is "YYYY-MM-DD_hh:mm:ss".
917 SUBROUTINE wrf_timetoa ( time, str )
918 USE module_utility
919 TYPE(WRFU_Time), INTENT( IN) :: time
920 CHARACTER (LEN=*), INTENT(OUT) :: str
921 INTEGER strlen, rc
922 CHARACTER (LEN=256) :: mess, tmpstr
923 ! Assertion
924 IF ( LEN(str) < 19 ) THEN
925 CALL wrf_error_fatal( 'wrf_timetoa: str is too short' )
926 ENDIF
927 tmpstr = ''
928 CALL WRFU_TimeGet( time, timeString=tmpstr, rc=rc )
929 CALL wrf_check_error( WRFU_SUCCESS, rc, &
930 'WRFU_TimeGet() in wrf_timetoa() FAILED', &
931 __FILE__ , &
932 __LINE__ )
933 ! change ISO 8601 'T' to WRF '_' and hack off fraction if str is not
934 ! big enough to hold it
935 strlen = MIN( LEN(str), LEN_TRIM(tmpstr) )
936 str = ''
937 str(1:strlen) = tmpstr(1:strlen)
938 str(11:11) = '_'
939 WRITE (mess,*) 'DEBUG wrf_timetoa(): returning with str = [',TRIM(str),']'
940 CALL wrf_debug ( 150 , TRIM(mess) )
941 RETURN
942 END SUBROUTINE wrf_timetoa
943
944
945
946 ! Converts an WRFU_TimeInterval object into a time-interval string.
947 SUBROUTINE wrf_timeinttoa ( timeinterval, str )
948 USE module_utility
949 TYPE(WRFU_TimeInterval), INTENT( IN) :: timeinterval
950 CHARACTER (LEN=*), INTENT(OUT) :: str
951 INTEGER rc
952 CHARACTER (LEN=256) :: mess
953 CALL WRFU_TimeIntervalGet( timeinterval, timeString=str, rc=rc )
954 CALL wrf_check_error( WRFU_SUCCESS, rc, &
955 'WRFU_TimeIntervalGet() in wrf_timeinttoa() FAILED', &
956 __FILE__ , &
957 __LINE__ )
958 WRITE (mess,*) 'DEBUG wrf_timeinttoa(): returning with str = [',TRIM(str),']'
959 CALL wrf_debug ( 150 , TRIM(mess) )
960 RETURN
961 END SUBROUTINE wrf_timeinttoa
962
963
964
965 ! Debug routine to print key clock information.
966 ! Every printed line begins with pre_str.
967 SUBROUTINE wrf_clockprint ( level, clock, pre_str )
968 USE module_utility
969 INTEGER, INTENT( IN) :: level
970 TYPE(WRFU_Clock), INTENT( IN) :: clock
971 CHARACTER (LEN=*), INTENT( IN) :: pre_str
972 INTEGER rc
973 INTEGER :: debug_level
974 TYPE(WRFU_Time) :: currTime, startTime, stopTime
975 TYPE(WRFU_TimeInterval) :: timeStep
976 CHARACTER (LEN=64) :: currTime_str, startTime_str, stopTime_str
977 CHARACTER (LEN=64) :: timeStep_str
978 CHARACTER (LEN=256) :: mess
979 CALL get_wrf_debug_level( debug_level )
980 IF ( level .LE. debug_level ) THEN
981 CALL WRFU_ClockGet( clock, CurrTime=currTime, StartTime=startTime, &
982 StopTime=stopTime, TimeStep=timeStep, rc=rc )
983 CALL wrf_check_error( WRFU_SUCCESS, rc, &
984 'wrf_clockprint: WRFU_ClockGet() FAILED', &
985 __FILE__ , &
986 __LINE__ )
987 CALL wrf_timetoa( currTime, currTime_str )
988 CALL wrf_timetoa( startTime, startTime_str )
989 CALL wrf_timetoa( stopTime, stopTime_str )
990 CALL wrf_timeinttoa( timeStep, timeStep_str )
991 WRITE (mess,*) TRIM(pre_str),' clock start time = ',TRIM(startTime_str)
992 CALL wrf_message(TRIM(mess))
993 WRITE (mess,*) TRIM(pre_str),' clock current time = ',TRIM(currTime_str)
994 CALL wrf_message(TRIM(mess))
995 WRITE (mess,*) TRIM(pre_str),' clock stop time = ',TRIM(stopTime_str)
996 CALL wrf_message(TRIM(mess))
997 WRITE (mess,*) TRIM(pre_str),' clock time step = ',TRIM(timeStep_str)
998 CALL wrf_message(TRIM(mess))
999 ENDIF
1000 RETURN
1001 END SUBROUTINE wrf_clockprint
1002