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