wrfv2_fire/share/module_date_time.F

   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(INOUT) :: 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(INOUT) :: 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(INOUT) :: 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