WPS/metgrid/src/module_date_pack.F

   1 MODULE date_pack
   2
   3 !  This module is able to perform three date and time functions:
   4
   5 !  1.  geth_idts (ndate, odate, idts)
   6 !  Get the time period between two dates.
   7
   8 !  2. geth_newdate ( ndate, odate, idts)
   9 !  Get the new date based on the old date and a time difference.
  10
  11 !  3. split_date_char ( date , century_year , month , day , hour , minute , second )
  12 !  Given the date, return the integer components.
  13
  14 use module_debug
  15
  16 CONTAINS
  17
  18 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  19
  20    SUBROUTINE geth_idts (ndate, odate, idts)
  21
  22       IMPLICIT NONE
  23
  24       !  From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'),
  25       !  compute the time difference.
  26
  27       !  on entry     -  ndate  -  the new hdate.
  28       !                  odate  -  the old hdate.
  29
  30       !  on exit      -  idts    -  the change in time in seconds.
  31
  32       CHARACTER (LEN=*) , INTENT(INOUT) :: ndate, odate
  33       INTEGER           , INTENT(OUT)   :: idts
  34
  35       !  Local Variables
  36
  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"
  49       !  i        -  loop counter
  50       !  mday     -  a list assigning the number of days in each month
  51
  52       CHARACTER (LEN=24) :: tdate
  53       INTEGER :: olen, nlen
  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
  58       INTEGER :: isign
  59
  60       IF (odate.GT.ndate) THEN
  61          isign = -1
  62          tdate=ndate
  63          ndate=odate
  64          odate=tdate
  65       ELSE
  66          isign = 1
  67       END IF
  68
  69       !  Assign the number of days in a months
  70
  71       mday( 1) = 31
  72       mday( 2) = 28
  73       mday( 3) = 31
  74       mday( 4) = 30
  75       mday( 5) = 31
  76       mday( 6) = 30
  77       mday( 7) = 31
  78       mday( 8) = 31
  79       mday( 9) = 30
  80       mday(10) = 31
  81       mday(11) = 30
  82       mday(12) = 31
  83
  84       !  Break down old hdate into parts
  85
  86       hrold = 0
  87       miold = 0
  88       scold = 0
  89       olen = LEN(odate)
  90
  91       READ(odate(1:4),  '(I4)') yrold
  92       READ(odate(6:7),  '(I2)') moold
  93       READ(odate(9:10), '(I2)') dyold
  94       IF (olen.GE.13) THEN
  95          READ(odate(12:13),'(I2)') hrold
  96          IF (olen.GE.16) THEN
  97             READ(odate(15:16),'(I2)') miold
  98             IF (olen.GE.19) THEN
  99                READ(odate(18:19),'(I2)') scold
 100             END IF
 101          END IF
 102       END IF
 103
 104       !  Break down new hdate into parts
 105
 106       hrnew = 0
 107       minew = 0
 108       scnew = 0
 109       nlen = LEN(ndate)
 110
 111       READ(ndate(1:4),  '(I4)') yrnew
 112       READ(ndate(6:7),  '(I2)') monew
 113       READ(ndate(9:10), '(I2)') dynew
 114       IF (nlen.GE.13) THEN
 115          READ(ndate(12:13),'(I2)') hrnew
 116          IF (nlen.GE.16) THEN
 117             READ(ndate(15:16),'(I2)') minew
 118             IF (nlen.GE.19) THEN
 119                READ(ndate(18:19),'(I2)') scnew
 120             END IF
 121          END IF
 122       END IF
 123
 124       !  Check that the dates make sense.
 125
 126       npass = .true.
 127       opass = .true.
 128
 129       !  Check that the month of NDATE makes sense.
 130
 131       IF ((monew.GT.12).or.(monew.LT.1)) THEN
 132          PRINT*, 'GETH_IDTS:  Month of NDATE = ', monew
 133          npass = .false.
 134       END IF
 135
 136       !  Check that the month of ODATE makes sense.
 137
 138       IF ((moold.GT.12).or.(moold.LT.1)) THEN
 139          PRINT*, 'GETH_IDTS:  Month of ODATE = ', moold
 140          opass = .false.
 141       END IF
 142
 143       !  Check that the day of NDATE makes sense.
 144
 145       IF (monew.ne.2) THEN
 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
 149             npass = .false.
 150          END IF
 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
 155             npass = .false.
 156          END IF
 157       END IF
 158
 159       !  Check that the day of ODATE makes sense.
 160
 161       IF (moold.ne.2) THEN
 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
 165             opass = .false.
 166          END IF
 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
 171             opass = .false.
 172          END IF
 173       END IF
 174
 175       !  Check that the hour of NDATE makes sense.
 176
 177       IF ((hrnew.GT.23).or.(hrnew.LT.0)) THEN
 178          PRINT*, 'GETH_IDTS:  Hour of NDATE = ', hrnew
 179          npass = .false.
 180       END IF
 181
 182       !  Check that the hour of ODATE makes sense.
 183
 184       IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
 185          PRINT*, 'GETH_IDTS:  Hour of ODATE = ', hrold
 186          opass = .false.
 187       END IF
 188
 189       !  Check that the minute of NDATE makes sense.
 190
 191       IF ((minew.GT.59).or.(minew.LT.0)) THEN
 192          PRINT*, 'GETH_IDTS:  Minute of NDATE = ', minew
 193          npass = .false.
 194       END IF
 195
 196       !  Check that the minute of ODATE makes sense.
 197
 198       IF ((miold.GT.59).or.(miold.LT.0)) THEN
 199          PRINT*, 'GETH_IDTS:  Minute of ODATE = ', miold
 200          opass = .false.
 201       END IF
 202
 203       !  Check that the second of NDATE makes sense.
 204
 205       IF ((scnew.GT.59).or.(scnew.LT.0)) THEN
 206          PRINT*, 'GETH_IDTS:  SECOND of NDATE = ', scnew
 207          npass = .false.
 208       END IF
 209
 210       !  Check that the second of ODATE makes sense.
 211
 212       IF ((scold.GT.59).or.(scold.LT.0)) THEN
 213          PRINT*, 'GETH_IDTS:  Second of ODATE = ', scold
 214          opass = .false.
 215       END IF
 216
 217       IF (.not. npass) THEN
 218          call mprintf(.true.,ERROR,'Screwy NDATE: %s',s1=ndate(1:nlen))
 219       END IF
 220
 221       IF (.not. opass) THEN
 222          call mprintf(.true.,ERROR,'Screwy ODATE: %s',s1=odate(1:olen))
 223       END IF
 224
 225       !  Date Checks are completed.  Continue.
 226
 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
 230
 231       newdys = 0
 232       DO i = yrold, yrnew - 1
 233          newdys = newdys + (365 + (nfeb(i)-28))
 234       END DO
 235
 236       IF (monew .GT. 1) THEN
 237          mday(2) = nfeb(yrnew)
 238          DO i = 1, monew - 1
 239             newdys = newdys + mday(i)
 240          END DO
 241          mday(2) = 28
 242       END IF
 243
 244       newdys = newdys + dynew-1
 245
 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
 248
 249       olddys = 0
 250
 251       IF (moold .GT. 1) THEN
 252          mday(2) = nfeb(yrold)
 253          DO i = 1, moold - 1
 254             olddys = olddys + mday(i)
 255          END DO
 256          mday(2) = 28
 257       END IF
 258
 259       olddys = olddys + dyold-1
 260
 261       !  Determine the time difference in seconds
 262
 263       idts = (newdys - olddys) * 86400
 264       idts = idts + (hrnew - hrold) * 3600
 265       idts = idts + (minew - miold) * 60
 266       idts = idts + (scnew - scold)
 267
 268       IF (isign .eq. -1) THEN
 269          tdate=ndate
 270          ndate=odate
 271          odate=tdate
 272          idts = idts * isign
 273       END IF
 274
 275    END SUBROUTINE geth_idts
 276
 277 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 278
 279    SUBROUTINE geth_newdate (ndate, odate, idt)
 280
 281       IMPLICIT NONE
 282
 283       !  From old date ('YYYY-MM-DD HH:MM:SS.ffff') and
 284       !  delta-time, compute the new date.
 285
 286       !  on entry     -  odate  -  the old hdate.
 287       !                  idt    -  the change in time
 288
 289       !  on exit      -  ndate  -  the new hdate.
 290
 291       INTEGER , INTENT(IN)           :: idt
 292       CHARACTER (LEN=*) , INTENT(OUT) :: ndate
 293       CHARACTER (LEN=*) , INTENT(IN)  :: odate
 294
 295
 296       !  Local Variables
 297
 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"
 304
 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"
 311
 312       !  mday     -  a list assigning the number of days in each month
 313
 314       !  i        -  loop counter
 315       !  nday     -  the integer number of days represented by "idt"
 316       !  nhour    -  the integer number of hours in "idt" after taking out
 317       !              all the whole days
 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.
 322
 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
 327       LOGICAL :: opass
 328       CHARACTER (LEN=10) :: hfrc
 329       CHARACTER (LEN=1) :: sp
 330       ! INTEGER, EXTERNAL :: nfeb  ! in the same module now
 331
 332       !  Assign the number of days in a months
 333
 334       mday( 1) = 31
 335       mday( 2) = 28
 336       mday( 3) = 31
 337       mday( 4) = 30
 338       mday( 5) = 31
 339       mday( 6) = 30
 340       mday( 7) = 31
 341       mday( 8) = 31
 342       mday( 9) = 30
 343       mday(10) = 31
 344       mday(11) = 30
 345       mday(12) = 31
 346
 347       !  Break down old hdate into parts
 348
 349       hrold = 0
 350       miold = 0
 351       scold = 0
 352       frold = 0
 353       olen = LEN(odate)
 354       IF (olen.GE.11) THEN
 355          sp = odate(11:11)
 356       else
 357          sp = ' '
 358       END IF
 359
 360       !  Use internal READ statements to convert the CHARACTER string
 361       !  date into INTEGER components.
 362
 363       READ(odate(1:4),  '(I4)') yrold
 364       READ(odate(6:7),  '(I2)') moold
 365       READ(odate(9:10), '(I2)') dyold
 366       IF (olen.GE.13) THEN
 367          READ(odate(12:13),'(I2)') hrold
 368          IF (olen.GE.16) THEN
 369             READ(odate(15:16),'(I2)') miold
 370             IF (olen.GE.19) THEN
 371                READ(odate(18:19),'(I2)') scold
 372                IF (olen.GT.20) THEN
 373                   READ(odate(21:olen),'(I2)') frold
 374                END IF
 375             END IF
 376          END IF
 377       END IF
 378
 379       !  Set the number of days in February for that year.
 380
 381       mday(2) = nfeb(yrold)
 382
 383       !  Check that ODATE makes sense.
 384
 385       opass = .TRUE.
 386
 387       !  Check that the month of ODATE makes sense.
 388
 389       IF ((moold.GT.12).or.(moold.LT.1)) THEN
 390          WRITE(*,*) 'GETH_NEWDATE:  Month of ODATE = ', moold
 391          opass = .FALSE.
 392       END IF
 393
 394       !  Check that the day of ODATE makes sense.
 395
 396       IF ((dyold.GT.mday(moold)).or.(dyold.LT.1)) THEN
 397          WRITE(*,*) 'GETH_NEWDATE:  Day of ODATE = ', dyold
 398          opass = .FALSE.
 399       END IF
 400
 401       !  Check that the hour of ODATE makes sense.
 402
 403       IF ((hrold.GT.23).or.(hrold.LT.0)) THEN
 404          WRITE(*,*) 'GETH_NEWDATE:  Hour of ODATE = ', hrold
 405          opass = .FALSE.
 406       END IF
 407
 408       !  Check that the minute of ODATE makes sense.
 409
 410       IF ((miold.GT.59).or.(miold.LT.0)) THEN
 411          WRITE(*,*) 'GETH_NEWDATE:  Minute of ODATE = ', miold
 412          opass = .FALSE.
 413       END IF
 414
 415       !  Check that the second of ODATE makes sense.
 416
 417       IF ((scold.GT.59).or.(scold.LT.0)) THEN
 418          WRITE(*,*) 'GETH_NEWDATE:  Second of ODATE = ', scold
 419          opass = .FALSE.
 420       END IF
 421
 422       !  Check that the fractional part  of ODATE makes sense.
 423
 424
 425       IF (.not.opass) THEN
 426          call mprintf(.true.,ERROR,'GETH_NEWDATE: Crazy ODATE: %s %i',s1=odate(1:olen),i1=olen)
 427       END IF
 428
 429       !  Date Checks are completed.  Continue.
 430
 431
 432       !  Compute the number of days, hours, minutes, and seconds in idt
 433
 434       IF (olen.GT.20) THEN !idt should be in fractions of seconds
 435          ifrc = olen-20
 436          ifrc = 10**ifrc
 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
 443          ifrc = 1
 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)
 448          nfrac  = 0
 449       ELSE IF (olen.eq.16) THEN !idt should be in minutes
 450          ifrc = 1
 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)
 454          nsec   = 0
 455          nfrac  = 0
 456       ELSE IF (olen.eq.13) THEN !idt should be in hours
 457          ifrc = 1
 458          nday   = ABS(idt)/24 ! Integer number of days in delta-time
 459          nhour  = MOD(ABS(idt),24)
 460          nmin   = 0
 461          nsec   = 0
 462          nfrac  = 0
 463       ELSE IF (olen.eq.10) THEN !idt should be in days
 464          ifrc = 1
 465          nday   = ABS(idt)/24 ! Integer number of days in delta-time
 466          nhour  = 0
 467          nmin   = 0
 468          nsec   = 0
 469          nfrac  = 0
 470       ELSE
 471          call mprintf(.true.,ERROR,'GETH_NEWDATE: Strange length for ODATE: %i',i1=olen)
 472       END IF
 473
 474       IF (idt.GE.0) THEN
 475
 476          frnew = frold + nfrac
 477          IF (frnew.GE.ifrc) THEN
 478             frnew = frnew - ifrc
 479             nsec = nsec + 1
 480          END IF
 481
 482          scnew = scold + nsec
 483          IF (scnew .GE. 60) THEN
 484             scnew = scnew - 60
 485             nmin  = nmin + 1
 486          END IF
 487
 488          minew = miold + nmin
 489          IF (minew .GE. 60) THEN
 490             minew = minew - 60
 491             nhour  = nhour + 1
 492          END IF
 493
 494          hrnew = hrold + nhour
 495          IF (hrnew .GE. 24) THEN
 496             hrnew = hrnew - 24
 497             nday  = nday + 1
 498          END IF
 499
 500          dynew = dyold
 501          monew = moold
 502          yrnew = yrold
 503          DO i = 1, nday
 504             dynew = dynew + 1
 505             IF (dynew.GT.mday(monew)) THEN
 506                dynew = dynew - mday(monew)
 507                monew = monew + 1
 508                IF (monew .GT. 12) THEN
 509                   monew = 1
 510                   yrnew = yrnew + 1
 511                   ! If the year changes, recompute the number of days in February
 512                   mday(2) = nfeb(yrnew)
 513                END IF
 514             END IF
 515          END DO
 516
 517       ELSE IF (idt.LT.0) THEN
 518
 519          frnew = frold - nfrac
 520          IF (frnew .LT. 0) THEN
 521             frnew = frnew + ifrc
 522             nsec = nsec - 1
 523          END IF
 524
 525          scnew = scold - nsec
 526          IF (scnew .LT. 00) THEN
 527             scnew = scnew + 60
 528             nmin  = nmin + 1
 529          END IF
 530
 531          minew = miold - nmin
 532          IF (minew .LT. 00) THEN
 533             minew = minew + 60
 534             nhour  = nhour + 1
 535          END IF
 536
 537          hrnew = hrold - nhour
 538          IF (hrnew .LT. 00) THEN
 539             hrnew = hrnew + 24
 540             nday  = nday + 1
 541          END IF
 542
 543          dynew = dyold
 544          monew = moold
 545          yrnew = yrold
 546          DO i = 1, nday
 547             dynew = dynew - 1
 548             IF (dynew.eq.0) THEN
 549                monew = monew - 1
 550                IF (monew.eq.0) THEN
 551                   monew = 12
 552                   yrnew = yrnew - 1
 553                   ! If the year changes, recompute the number of days in February
 554                   mday(2) = nfeb(yrnew)
 555                END IF
 556                dynew = mday(monew)
 557             END IF
 558          END DO
 559       END IF
 560
 561       !  Now construct the new mdate
 562
 563       nlen = LEN(ndate)
 564
 565       IF (nlen.GT.20) THEN
 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)
 569
 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)//'.'
 574
 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)
 578
 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)
 582
 583       ELSE IF (nlen.eq.10) THEN
 584          WRITE(ndate,10) yrnew, monew, dynew
 585       10   format(I4,'-',I2.2,'-',I2.2)
 586
 587       END IF
 588
 589       IF (olen.GE.11) ndate(11:11) = sp
 590
 591    END SUBROUTINE geth_newdate
 592
 593 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 594
 595    FUNCTION nfeb ( year ) RESULT (num_days)
 596
 597       ! Compute the number of days in February for the given year
 598
 599       IMPLICIT NONE
 600
 601       INTEGER :: year
 602       INTEGER :: num_days
 603
 604       num_days = 28 ! By default, February has 28 days ...
 605       IF (MOD(year,4).eq.0) THEN
 606          num_days = 29  ! But every four years, it has 29 days ...
 607          IF (MOD(year,100).eq.0) THEN
 608             num_days = 28  ! Except every 100 years, when it has 28 days ...
 609             IF (MOD(year,400).eq.0) THEN
 610                num_days = 29  ! Except every 400 years, when it has 29 days.
 611             END IF
 612          END IF
 613       END IF
 614
 615    END FUNCTION nfeb
 616
 617 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 618    SUBROUTINE split_date_char ( date , century_year , month , day , hour , minute , second )
 619
 620       IMPLICIT NONE
 621
 622       !  Input data.
 623
 624       CHARACTER(LEN=19) , INTENT(IN) :: date
 625
 626       !  Output data.
 627
 628       INTEGER , INTENT(OUT) :: century_year , month , day , hour , minute , second
 629
 630       READ(date,FMT='(    I4.4)') century_year
 631       READ(date,FMT='( 5X,I2.2)') month
 632       READ(date,FMT='( 8X,I2.2)') day
 633       READ(date,FMT='(11X,I2.2)') hour
 634       READ(date,FMT='(14X,I2.2)') minute
 635       READ(date,FMT='(17X,I2.2)') second
 636
 637    END SUBROUTINE split_date_char
 638
 639 END MODULE date_pack