hydro/Routing/module_date_utilities_rt.F

   1 !  Program Name:
   2 !  Author(s)/Contact(s):
   3 !  Abstract:
   4 !  History Log:
   5 !
   6 !  Usage:
   7 !  Parameters: <Specify typical arguments passed>
   8 !  Input Files:
   9 !        <list file names and briefly describe the data they include>
  10 !  Output Files:
  11 !        <list file names and briefly describe the information they include>
  12 !
  13 !  Condition codes:
  14 !        <list exit condition or error codes returned >
  15 !        If appropriate, descriptive troubleshooting instructions or
  16 !        likely causes for failures could be mentioned here with the
  17 !        appropriate error code
  18 !
  19 !  User controllable options: <if applicable>
  20
  21 module Module_Date_utilities_rt
  22     use module_hydro_stop, only: HYDRO_stop
  23 contains
  24   subroutine geth_newdate (ndate, odate, idt)
  25     implicit none
  26
  27     !  From old date ("YYYY-MM-DD HH:MM:SS.ffff" or "YYYYMMDDHHMMSSffff") and
  28     !  delta-time, compute the new date.
  29
  30     !  on entry     -  odate  -  the old hdate.
  31     !                  idt    -  the change in time
  32
  33     !  on exit      -  ndate  -  the new hdate.
  34
  35     integer, intent(in)           :: idt
  36     character (len=*), intent(out) :: ndate
  37     character (len=*), intent(in)  :: odate
  38
  39     !  Local Variables
  40
  41     !  yrold    -  indicates the year associated with "odate"
  42     !  moold    -  indicates the month associated with "odate"
  43     !  dyold    -  indicates the day associated with "odate"
  44     !  hrold    -  indicates the hour associated with "odate"
  45     !  miold    -  indicates the minute associated with "odate"
  46     !  scold    -  indicates the second associated with "odate"
  47
  48     !  yrnew    -  indicates the year associated with "ndate"
  49     !  monew    -  indicates the month associated with "ndate"
  50     !  dynew    -  indicates the day associated with "ndate"
  51     !  hrnew    -  indicates the hour associated with "ndate"
  52     !  minew    -  indicates the minute associated with "ndate"
  53     !  scnew    -  indicates the second associated with "ndate"
  54
  55     !  mday     -  a list assigning the number of days in each month
  56
  57     !  i        -  loop counter
  58     !  nday     -  the integer number of days represented by "idt"
  59     !  nhour    -  the integer number of hours in "idt" after taking out
  60     !              all the whole days
  61     !  nmin     -  the integer number of minutes in "idt" after taking out
  62     !              all the whole days and whole hours.
  63     !  nsec     -  the integer number of minutes in "idt" after taking out
  64     !              all the whole days, whole hours, and whole minutes.
  65
  66     integer :: newlen, oldlen
  67     integer :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
  68     integer :: yrold, moold, dyold, hrold, miold, scold, frold
  69     integer :: nday, nhour, nmin, nsec, nfrac, i, ifrc
  70     logical :: opass
  71     character (len=10) :: hfrc
  72     character (len=1) :: sp
  73     logical :: punct
  74     integer :: yrstart, yrend, mostart, moend, dystart, dyend
  75     integer :: hrstart, hrend, mistart, miend, scstart, scend, frstart
  76     integer :: units
  77     integer, dimension(12) :: mday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
  78
  79     ! Determine if odate is "YYYY-MM-DD_HH ... " or "YYYYMMDDHH...."
  80     if (odate(5:5) == "-") then
  81        punct = .TRUE.
  82     else
  83        punct = .FALSE.
  84     endif
  85
  86     !  Break down old hdate into parts
  87
  88     hrold = 0
  89     miold = 0
  90     scold = 0
  91     frold = 0
  92     oldlen = LEN(odate)
  93     if (punct) then
  94        yrstart = 1
  95        yrend = 4
  96        mostart = 6
  97        moend = 7
  98        dystart = 9
  99        dyend = 10
 100        hrstart = 12
 101        hrend = 13
 102        mistart = 15
 103        miend = 16
 104        scstart = 18
 105        scend = 19
 106        frstart = 21
 107        select case (oldlen)
 108        case (10)
 109           ! Days
 110           units = 1
 111        case (13)
 112           ! Hours
 113           units = 2
 114        case (16)
 115           ! Minutes
 116           units = 3
 117        case (19)
 118           ! Seconds
 119           units = 4
 120        case (21)
 121           ! Tenths
 122           units = 5
 123        case (22)
 124           ! Hundredths
 125           units = 6
 126        case (23)
 127           ! Thousandths
 128           units = 7
 129        case (24)
 130           ! Ten thousandths
 131           units = 8
 132        case default
 133           write(*,*) 'ERROR: geth_newdate:  odd length: #'//trim(odate)//'#'
 134           call hydro_stop("In geth_newdate() odd length")
 135        end select
 136
 137        if (oldlen.ge.11) then
 138           sp = odate(11:11)
 139        else
 140           sp = ' '
 141        end if
 142
 143     else
 144
 145        yrstart = 1
 146        yrend = 4
 147        mostart = 5
 148        moend = 6
 149        dystart = 7
 150        dyend = 8
 151        hrstart = 9
 152        hrend = 10
 153        mistart = 11
 154        miend = 12
 155        scstart = 13
 156        scend = 14
 157        frstart = 15
 158
 159        select case (oldlen)
 160        case (8)
 161           ! Days
 162           units = 1
 163        case (10)
 164           ! Hours
 165           units = 2
 166        case (12)
 167           ! Minutes
 168           units = 3
 169        case (14)
 170           ! Seconds
 171           units = 4
 172        case (15)
 173           ! Tenths
 174           units = 5
 175        case (16)
 176           ! Hundredths
 177           units = 6
 178        case (17)
 179           ! Thousandths
 180           units = 7
 181        case (18)
 182           ! Ten thousandths
 183           units = 8
 184        case default
 185           write(*,*) 'ERROR: geth_newdate:  odd length: #'//trim(odate)//'#'
 186           call hydro_stop("In geth_newdate() - odd length")
 187        end select
 188     endif
 189
 190     !  Use internal READ statements to convert the CHARACTER string
 191     !  date into INTEGER components.
 192
 193     read(odate(yrstart:yrend),  '(i4)') yrold
 194     read(odate(mostart:moend),  '(i2)') moold
 195     read(odate(dystart:dyend), '(i2)') dyold
 196     if (units.ge.2) then
 197        read(odate(hrstart:hrend),'(i2)') hrold
 198        if (units.ge.3) then
 199           read(odate(mistart:miend),'(i2)') miold
 200           if (units.ge.4) then
 201              read(odate(scstart:scend),'(i2)') scold
 202              if (units.ge.5) then
 203                 read(odate(frstart:oldlen),*) frold
 204              end if
 205           end if
 206        end if
 207     end if
 208
 209     !  Set the number of days in February for that year.
 210
 211     mday(2) = nfeb(yrold)
 212
 213     !  Check that ODATE makes sense.
 214
 215     opass = .TRUE.
 216
 217     !  Check that the month of ODATE makes sense.
 218
 219     if ((moold.gt.12).or.(moold.lt.1)) then
 220 #ifdef HYDRO_D
 221        write(*,*) 'GETH_NEWDATE:  Month of ODATE = ', moold
 222 #endif
 223        opass = .FALSE.
 224     end if
 225
 226     !  Check that the day of ODATE makes sense.
 227
 228     if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then
 229 #ifdef HYDRO_D
 230        write(*,*) 'GETH_NEWDATE:  Day of ODATE = ', dyold
 231 #endif
 232        opass = .FALSE.
 233     end if
 234
 235     !  Check that the hour of ODATE makes sense.
 236
 237     if ((hrold.gt.23).or.(hrold.lt.0)) then
 238 #ifdef HYDRO_D
 239        write(*,*) 'GETH_NEWDATE:  Hour of ODATE = ', hrold
 240 #endif
 241        opass = .FALSE.
 242     end if
 243
 244     !  Check that the minute of ODATE makes sense.
 245
 246     if ((miold.gt.59).or.(miold.lt.0)) then
 247 #ifdef HYDRO_D
 248        write(*,*) 'GETH_NEWDATE:  Minute of ODATE = ', miold
 249 #endif
 250        opass = .FALSE.
 251     end if
 252
 253     !  Check that the second of ODATE makes sense.
 254
 255     if ((scold.gt.59).or.(scold.lt.0)) then
 256 #ifdef HYDRO_D
 257        write(*,*) 'GETH_NEWDATE:  Second of ODATE = ', scold
 258 #endif
 259        opass = .FALSE.
 260     end if
 261
 262     !  Check that the fractional part  of ODATE makes sense.
 263
 264
 265     if (.not.opass) then
 266 #ifdef HYDRO_D
 267        write(*,*) 'Crazy ODATE: ', odate(1:oldlen), oldlen
 268        call hydro_stop("In geth_newdate() - Crazy ODATE")
 269 #endif
 270     end if
 271
 272     !  Date Checks are completed.  Continue.
 273
 274
 275     !  Compute the number of days, hours, minutes, and seconds in idt
 276
 277     if (units.ge.5) then !idt should be in fractions of seconds
 278        ifrc = oldlen-(frstart)+1
 279        ifrc = 10**ifrc
 280        nday   = abs(idt)/(86400*ifrc)
 281        nhour  = mod(abs(idt),86400*ifrc)/(3600*ifrc)
 282        nmin   = mod(abs(idt),3600*ifrc)/(60*ifrc)
 283        nsec   = mod(abs(idt),60*ifrc)/(ifrc)
 284        nfrac = mod(abs(idt), ifrc)
 285     else if (units.eq.4) then  !idt should be in seconds
 286        ifrc = 1
 287        nday   = abs(idt)/86400 ! integer number of days in delta-time
 288        nhour  = mod(abs(idt),86400)/3600
 289        nmin   = mod(abs(idt),3600)/60
 290        nsec   = mod(abs(idt),60)
 291        nfrac  = 0
 292     else if (units.eq.3) then !idt should be in minutes
 293        ifrc = 1
 294        nday   = abs(idt)/1440 ! integer number of days in delta-time
 295        nhour  = mod(abs(idt),1440)/60
 296        nmin   = mod(abs(idt),60)
 297        nsec   = 0
 298        nfrac  = 0
 299     else if (units.eq.2) then !idt should be in hours
 300        ifrc = 1
 301        nday   = abs(idt)/24 ! integer number of days in delta-time
 302        nhour  = mod(abs(idt),24)
 303        nmin   = 0
 304        nsec   = 0
 305        nfrac  = 0
 306     else if (units.eq.1) then !idt should be in days
 307        ifrc = 1
 308        nday   = abs(idt)    ! integer number of days in delta-time
 309        nhour  = 0
 310        nmin   = 0
 311        nsec   = 0
 312        nfrac  = 0
 313     else
 314        write(*,'(''GETH_NEWDATE: Strange length for ODATE: '', i3)') &
 315             oldlen
 316        write(*,*) '#'//odate(1:oldlen)//'#'
 317        call hydro_stop("In geth_newdate()")
 318     end if
 319
 320     if (idt.ge.0) then
 321
 322        frnew = frold + nfrac
 323        if (frnew.ge.ifrc) then
 324           frnew = frnew - ifrc
 325           nsec = nsec + 1
 326        end if
 327
 328        scnew = scold + nsec
 329        if (scnew .ge. 60) then
 330           scnew = scnew - 60
 331           nmin  = nmin + 1
 332        end if
 333
 334        minew = miold + nmin
 335        if (minew .ge. 60) then
 336           minew = minew - 60
 337           nhour  = nhour + 1
 338        end if
 339
 340        hrnew = hrold + nhour
 341        if (hrnew .ge. 24) then
 342           hrnew = hrnew - 24
 343           nday  = nday + 1
 344        end if
 345
 346        dynew = dyold
 347        monew = moold
 348        yrnew = yrold
 349        do i = 1, nday
 350           dynew = dynew + 1
 351           if (dynew.gt.mday(monew)) then
 352              dynew = dynew - mday(monew)
 353              monew = monew + 1
 354              if (monew .gt. 12) then
 355                 monew = 1
 356                 yrnew = yrnew + 1
 357                 ! If the year changes, recompute the number of days in February
 358                 mday(2) = nfeb(yrnew)
 359              end if
 360           end if
 361        end do
 362
 363     else if (idt.lt.0) then
 364
 365        frnew = frold - nfrac
 366        if (frnew .lt. 0) then
 367           frnew = frnew + ifrc
 368           nsec = nsec + 1
 369        end if
 370
 371        scnew = scold - nsec
 372        if (scnew .lt. 00) then
 373           scnew = scnew + 60
 374           nmin  = nmin + 1
 375        end if
 376
 377        minew = miold - nmin
 378        if (minew .lt. 00) then
 379           minew = minew + 60
 380           nhour  = nhour + 1
 381        end if
 382
 383        hrnew = hrold - nhour
 384        if (hrnew .lt. 00) then
 385           hrnew = hrnew + 24
 386           nday  = nday + 1
 387        end if
 388
 389        dynew = dyold
 390        monew = moold
 391        yrnew = yrold
 392        do i = 1, nday
 393           dynew = dynew - 1
 394           if (dynew.eq.0) then
 395              monew = monew - 1
 396              if (monew.eq.0) then
 397                 monew = 12
 398                 yrnew = yrnew - 1
 399                 ! If the year changes, recompute the number of days in February
 400                 mday(2) = nfeb(yrnew)
 401              end if
 402              dynew = mday(monew)
 403           end if
 404        end do
 405     end if
 406
 407     !  Now construct the new mdate
 408
 409     newlen = LEN(ndate)
 410
 411     if (punct) then
 412
 413        if (newlen.gt.frstart) then
 414           write(ndate(1:scend),19) yrnew, monew, dynew, hrnew, minew, scnew
 415           write(hfrc,'(i10)') frnew+1000000000
 416           ndate = ndate(1:scend)//'.'//hfrc(31-newlen:10)
 417
 418        else if (newlen.eq.scend) then
 419           write(ndate(1:scend),19) yrnew, monew, dynew, hrnew, minew, scnew
 420 19        format(i4,'-',i2.2,'-',i2.2,'_',i2.2,':',i2.2,':',i2.2)
 421
 422        else if (newlen.eq.miend) then
 423           write(ndate,16) yrnew, monew, dynew, hrnew, minew
 424 16        format(i4,'-',i2.2,'-',i2.2,'_',i2.2,':',i2.2)
 425
 426        else if (newlen.eq.hrend) then
 427           write(ndate,13) yrnew, monew, dynew, hrnew
 428 13        format(i4,'-',i2.2,'-',i2.2,'_',i2.2)
 429
 430        else if (newlen.eq.dyend) then
 431           write(ndate,10) yrnew, monew, dynew
 432 10        format(i4,'-',i2.2,'-',i2.2)
 433
 434        end if
 435
 436     else
 437
 438        if (newlen.gt.frstart) then
 439           write(ndate(1:scend),119) yrnew, monew, dynew, hrnew, minew, scnew
 440           write(hfrc,'(i10)') frnew+1000000000
 441           ndate = ndate(1:scend)//'.'//hfrc(31-newlen:10)
 442
 443        else if (newlen.eq.scend) then
 444           write(ndate(1:scend),119) yrnew, monew, dynew, hrnew, minew, scnew
 445 119       format(i4,i2.2,i2.2,i2.2,i2.2,i2.2)
 446
 447        else if (newlen.eq.miend) then
 448           write(ndate,116) yrnew, monew, dynew, hrnew, minew
 449 116       format(i4,i2.2,i2.2,i2.2,i2.2)
 450
 451        else if (newlen.eq.hrend) then
 452           write(ndate,113) yrnew, monew, dynew, hrnew
 453 113       format(i4,i2.2,i2.2,i2.2)
 454
 455        else if (newlen.eq.dyend) then
 456           write(ndate,110) yrnew, monew, dynew
 457 110       format(i4,i2.2,i2.2)
 458
 459        end if
 460
 461     endif
 462
 463     if (punct .and. (oldlen.ge.11) .and. (newlen.ge.11)) ndate(11:11) = sp
 464
 465   end subroutine geth_newdate
 466
 467   subroutine geth_idts (newdate, olddate, idt)
 468     implicit none
 469
 470     !  From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'),
 471     !  compute the time difference.
 472
 473     !  on entry     -  newdate  -  the new hdate.
 474     !                  olddate  -  the old hdate.
 475
 476     !  on exit      -  idt    -  the change in time.
 477     !                            Units depend on length of date strings.
 478
 479     character (len=*) , intent(in) :: newdate, olddate
 480     integer           , intent(out)   :: idt
 481
 482
 483     !  Local Variables
 484
 485     !  yrnew    -  indicates the year associated with "ndate"
 486     !  yrold    -  indicates the year associated with "odate"
 487     !  monew    -  indicates the month associated with "ndate"
 488     !  moold    -  indicates the month associated with "odate"
 489     !  dynew    -  indicates the day associated with "ndate"
 490     !  dyold    -  indicates the day associated with "odate"
 491     !  hrnew    -  indicates the hour associated with "ndate"
 492     !  hrold    -  indicates the hour associated with "odate"
 493     !  minew    -  indicates the minute associated with "ndate"
 494     !  miold    -  indicates the minute associated with "odate"
 495     !  scnew    -  indicates the second associated with "ndate"
 496     !  scold    -  indicates the second associated with "odate"
 497     !  i        -  loop counter
 498     !  mday     -  a list assigning the number of days in each month
 499
 500     ! ndate, odate: local values of newdate and olddate
 501     character(len=24) :: ndate, odate
 502
 503     integer :: oldlen, newlen
 504     integer :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
 505     integer :: yrold, moold, dyold, hrold, miold, scold, frold
 506     integer :: i, newdys, olddys
 507     logical :: npass, opass
 508     integer :: timesign
 509     integer :: ifrc
 510     integer, dimension(12) :: mday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
 511     logical :: punct
 512     integer :: yrstart, yrend, mostart, moend, dystart, dyend
 513     integer :: hrstart, hrend, mistart, miend, scstart, scend, frstart
 514     integer :: units
 515
 516     oldlen = len(olddate)
 517     newlen = len(newdate)
 518     if (newlen.ne.oldlen) then
 519        write(*,'("GETH_IDTS: NEWLEN /= OLDLEN: ", A, 3x, A)') newdate(1:newlen), olddate(1:oldlen)
 520        call hydro_stop("In geth_idts() - NEWLEN /= OLDLEN")
 521     endif
 522
 523     if (olddate.gt.newdate) then
 524        timesign = -1
 525
 526        ifrc = oldlen
 527        oldlen = newlen
 528        newlen = ifrc
 529
 530        ndate = olddate
 531        odate = newdate
 532     else
 533        timesign = 1
 534        ndate = newdate
 535        odate = olddate
 536     end if
 537
 538     ! Break down old hdate into parts
 539
 540     ! Determine if olddate is punctuated or not
 541     if (odate(5:5) == "-") then
 542        punct = .TRUE.
 543        if (ndate(5:5) /= "-") then
 544           write(*,'("GETH_IDTS: Dates appear to be different formats: ", A, 3x, A)') &
 545                ndate(1:newlen), odate(1:oldlen)
 546           call hydro_stop("In geth_idts() - Dates appear to be different formats")
 547        endif
 548     else
 549        punct = .FALSE.
 550        if (ndate(5:5) == "-") then
 551           write(*,'("GETH_IDTS: Dates appear to be different formats: ", A, 3x, A)') &
 552                ndate(1:newlen), odate(1:oldlen)
 553           call hydro_stop("In geth_idts() - Dates appear to be different formats")
 554        endif
 555     endif
 556
 557     if (punct) then
 558        yrstart = 1
 559        yrend = 4
 560        mostart = 6
 561        moend = 7
 562        dystart = 9
 563        dyend = 10
 564        hrstart = 12
 565        hrend = 13
 566        mistart = 15
 567        miend = 16
 568        scstart = 18
 569        scend = 19
 570        frstart = 21
 571        select case (oldlen)
 572        case (10)
 573           ! Days
 574           units = 1
 575        case (13)
 576           ! Hours
 577           units = 2
 578        case (16)
 579           ! Minutes
 580           units = 3
 581        case (19)
 582           ! Seconds
 583           units = 4
 584        case (21)
 585           ! Tenths
 586           units = 5
 587        case (22)
 588           ! Hundredths
 589           units = 6
 590        case (23)
 591           ! Thousandths
 592           units = 7
 593        case (24)
 594           ! Ten thousandths
 595           units = 8
 596        case default
 597           write(*,*) 'ERROR: geth_idts:  odd length: #'//trim(odate)//'#'
 598           call hydro_stop("In geth_idts() - odd length")
 599        end select
 600     else
 601
 602        yrstart = 1
 603        yrend = 4
 604        mostart = 5
 605        moend = 6
 606        dystart = 7
 607        dyend = 8
 608        hrstart = 9
 609        hrend = 10
 610        mistart = 11
 611        miend = 12
 612        scstart = 13
 613        scend = 14
 614        frstart = 15
 615
 616        select case (oldlen)
 617        case (8)
 618           ! Days
 619           units = 1
 620        case (10)
 621           ! Hours
 622           units = 2
 623        case (12)
 624           ! Minutes
 625           units = 3
 626        case (14)
 627           ! Seconds
 628           units = 4
 629        case (15)
 630           ! Tenths
 631           units = 5
 632        case (16)
 633           ! Hundredths
 634           units = 6
 635        case (17)
 636           ! Thousandths
 637           units = 7
 638        case (18)
 639           ! Ten thousandths
 640           units = 8
 641        case default
 642           write(*,*) 'ERROR: geth_idts:  odd length: #'//trim(odate)//'#'
 643           call hydro_stop("In geth_idts() - odd length")
 644        end select
 645     endif
 646
 647
 648     hrold = 0
 649     miold = 0
 650     scold = 0
 651     frold = 0
 652
 653     read(odate(yrstart:yrend), '(i4)') yrold
 654     read(odate(mostart:moend), '(i2)') moold
 655     read(odate(dystart:dyend), '(i2)') dyold
 656     if (units.ge.2) then
 657        read(odate(hrstart:hrend),'(i2)') hrold
 658        if (units.ge.3) then
 659           read(odate(mistart:miend),'(i2)') miold
 660           if (units.ge.4) then
 661              read(odate(scstart:scend),'(i2)') scold
 662              if (units.ge.5) then
 663                 read(odate(frstart:oldlen),*) frold
 664              end if
 665           end if
 666        end if
 667     end if
 668
 669     !  Break down new hdate into parts
 670
 671     hrnew = 0
 672     minew = 0
 673     scnew = 0
 674     frnew = 0
 675
 676     read(ndate(yrstart:yrend), '(i4)') yrnew
 677     read(ndate(mostart:moend), '(i2)') monew
 678     read(ndate(dystart:dyend), '(i2)') dynew
 679     if (units.ge.2) then
 680        read(ndate(hrstart:hrend),'(i2)') hrnew
 681        if (units.ge.3) then
 682           read(ndate(mistart:miend),'(i2)') minew
 683           if (units.ge.4) then
 684              read(ndate(scstart:scend),'(i2)') scnew
 685              if (units.ge.5) then
 686                 read(ndate(frstart:newlen),*) frnew
 687              end if
 688           end if
 689        end if
 690     end if
 691
 692     !  Check that the dates make sense.
 693
 694     npass = .true.
 695     opass = .true.
 696
 697     !  Check that the month of NDATE makes sense.
 698
 699     if ((monew.gt.12).or.(monew.lt.1)) then
 700 #ifdef HYDRO_D
 701        write(*,*) 'GETH_IDTS:  Month of NDATE = ', monew
 702 #endif
 703        npass = .false.
 704     end if
 705
 706     !  Check that the month of ODATE makes sense.
 707
 708     if ((moold.gt.12).or.(moold.lt.1)) then
 709 #ifdef HYDRO_D
 710        print*, 'GETH_IDTS:  Month of ODATE = ', moold
 711 #endif
 712        opass = .false.
 713     end if
 714
 715     !  Check that the day of NDATE makes sense.
 716
 717     if (monew.ne.2) then
 718        ! ...... For all months but February
 719        if ((dynew.gt.mday(monew)).or.(dynew.lt.1)) then
 720 #ifdef HYDRO_D
 721           print*, 'GETH_IDTS:  Day of NDATE = ', dynew
 722 #endif
 723           npass = .false.
 724        end if
 725     else if (monew.eq.2) then
 726        ! ...... For February
 727        if ((dynew > nfeb(yrnew)).or.(dynew < 1)) then
 728 #ifdef HYDRO_D
 729           print*, 'GETH_IDTS:  Day of NDATE = ', dynew
 730 #endif
 731           npass = .false.
 732        end if
 733     endif
 734
 735     !  Check that the day of ODATE makes sense.
 736
 737     if (moold.ne.2) then
 738        ! ...... For all months but February
 739        if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then
 740 #ifdef HYDRO_D
 741           print*, 'GETH_IDTS:  Day of ODATE = ', dyold
 742 #endif
 743           opass = .false.
 744        end if
 745     else if (moold.eq.2) then
 746        ! ....... For February
 747        if ((dyold > nfeb(yrold)).or.(dyold < 1)) then
 748 #ifdef HYDRO_D
 749           print*, 'GETH_IDTS:  Day of ODATE = ', dyold
 750 #endif
 751           opass = .false.
 752        end if
 753     end if
 754
 755     !  Check that the hour of NDATE makes sense.
 756
 757     if ((hrnew.gt.23).or.(hrnew.lt.0)) then
 758 #ifdef HYDRO_D
 759        print*, 'GETH_IDTS:  Hour of NDATE = ', hrnew
 760 #endif
 761        npass = .false.
 762     end if
 763
 764     !  Check that the hour of ODATE makes sense.
 765
 766     if ((hrold.gt.23).or.(hrold.lt.0)) then
 767 #ifdef HYDRO_D
 768        print*, 'GETH_IDTS:  Hour of ODATE = ', hrold
 769 #endif
 770        opass = .false.
 771     end if
 772
 773     !  Check that the minute of NDATE makes sense.
 774
 775     if ((minew.gt.59).or.(minew.lt.0)) then
 776 #ifdef HYDRO_D
 777        print*, 'GETH_IDTS:  Minute of NDATE = ', minew
 778 #endif
 779        npass = .false.
 780     end if
 781
 782     !  Check that the minute of ODATE makes sense.
 783
 784     if ((miold.gt.59).or.(miold.lt.0)) then
 785 #ifdef HYDRO_D
 786        print*, 'GETH_IDTS:  Minute of ODATE = ', miold
 787 #endif
 788        opass = .false.
 789     end if
 790
 791     !  Check that the second of NDATE makes sense.
 792
 793     if ((scnew.gt.59).or.(scnew.lt.0)) then
 794 #ifdef HYDRO_D
 795        print*, 'GETH_IDTS:  SECOND of NDATE = ', scnew
 796 #endif
 797        npass = .false.
 798     end if
 799
 800     !  Check that the second of ODATE makes sense.
 801
 802     if ((scold.gt.59).or.(scold.lt.0)) then
 803 #ifdef HYDRO_D
 804        print*, 'GETH_IDTS:  Second of ODATE = ', scold
 805 #endif
 806        opass = .false.
 807     end if
 808
 809     if (.not. npass) then
 810        print*, 'Screwy NDATE: ', ndate(1:newlen)
 811        call hydro_stop("In geth_idts() - Screwy NDATE ")
 812     end if
 813
 814     if (.not. opass) then
 815        print*, 'Screwy ODATE: ', odate(1:oldlen)
 816        call hydro_stop("In geth_idts() - Screwy ODATE ")
 817     end if
 818
 819     !  Date Checks are completed.  Continue.
 820
 821     !  Compute number of days from 1 January ODATE, 00:00:00 until ndate
 822     !  Compute number of hours from 1 January ODATE, 00:00:00 until ndate
 823     !  Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
 824
 825     newdys = 0
 826     do i = yrold, yrnew - 1
 827        newdys = newdys + 337 + nfeb(i)
 828     end do
 829
 830     if (monew .gt. 1) then
 831        mday(2) = nfeb(yrnew)
 832        do i = 1, monew - 1
 833           newdys = newdys + mday(i)
 834        end do
 835        mday(2) = 28
 836     end if
 837
 838     newdys = newdys + dynew - 1
 839
 840     !  Compute number of hours from 1 January ODATE, 00:00:00 until odate
 841     !  Compute number of minutes from 1 January ODATE, 00:00:00 until odate
 842
 843     olddys = 0
 844
 845     if (moold .gt. 1) then
 846        mday(2) = nfeb(yrold)
 847        do i = 1, moold - 1
 848           olddys = olddys + mday(i)
 849        end do
 850        mday(2) = 28
 851     end if
 852
 853     olddys = olddys + dyold -1
 854
 855     !  Determine the time difference
 856
 857     idt = (newdys - olddys)
 858     if (units.ge.2) then
 859        idt = idt*24 + (hrnew - hrold)
 860        if (units.ge.3) then
 861           idt = idt*60 + (minew - miold)
 862           if (units.ge.4) then
 863              idt = idt*60 + (scnew - scold)
 864              if (units.ge.5) then
 865                 ifrc = oldlen-(frstart-1)
 866                 ifrc = 10**ifrc
 867                 idt = idt * ifrc + (frnew-frold)
 868              endif
 869           endif
 870        endif
 871     endif
 872
 873     if (timesign .eq. -1) then
 874        idt = idt * timesign
 875     end if
 876
 877   end subroutine geth_idts
 878
 879
 880   integer function nfeb(year)
 881     !
 882     ! Compute the number of days in February for the given year.
 883     !
 884     implicit none
 885     integer, intent(in) :: year ! Four-digit year
 886
 887     nfeb = 28 ! By default, February has 28 days ...
 888     if (mod(year,4).eq.0) then
 889        nfeb = 29  ! But every four years, it has 29 days ...
 890        if (mod(year,100).eq.0) then
 891           nfeb = 28  ! Except every 100 years, when it has 28 days ...
 892           if (mod(year,400).eq.0) then
 893              nfeb = 29  ! Except every 400 years, when it has 29 days ...
 894              if (mod(year,3600).eq.0) then
 895                 nfeb = 28  ! Except every 3600 years, when it has 28 days.
 896              endif
 897           endif
 898        endif
 899     endif
 900   end function nfeb
 901
 902   integer function nmdays(hdate)
 903     !
 904     ! Compute the number of days in the month of given date hdate.
 905     !
 906     implicit none
 907     character(len=*), intent(in) :: hdate
 908
 909     integer :: year, month
 910     integer, dimension(12), parameter :: ndays = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
 911
 912     read(hdate(1:7), '(I4,1x,I2)') year, month
 913
 914     if (month == 2) then
 915        nmdays = nfeb(year)
 916     else
 917        nmdays = ndays(month)
 918     endif
 919   end function nmdays
 920
 921   function monthabbr_to_mm(mon) result(mm)
 922     implicit none
 923
 924     character(len=3), intent(in) :: mon
 925
 926     integer :: mm
 927
 928     if (mon == "Jan") then
 929        mm = 1
 930     elseif (mon == "Feb") then
 931        mm = 2
 932     elseif (mon == "Mar") then
 933        mm = 3
 934     elseif (mon == "Apr") then
 935        mm = 4
 936     elseif (mon == "May") then
 937        mm = 5
 938     elseif (mon == "Jun") then
 939        mm = 6
 940     elseif (mon == "Jul") then
 941        mm = 7
 942     elseif (mon == "Aug") then
 943        mm = 8
 944     elseif (mon == "Sep") then
 945        mm = 9
 946     elseif (mon == "Oct") then
 947        mm = 10
 948     elseif (mon == "Nov") then
 949        mm = 11
 950     elseif (mon == "Dec") then
 951        mm = 12
 952     else
 953        write(*, '("Function monthabbr_to_mm:  mon = <",A,">")') mon
 954        print*,  "Function monthabbr_to_mm:  Unrecognized mon"
 955        call hydro_stop("In monthabbr_to_mm() - Unrecognized mon")
 956     endif
 957   end function monthabbr_to_mm
 958
 959   subroutine swap_date_format(indate, outdate)
 960     implicit none
 961     character(len=*), intent(in)  :: indate
 962     character(len=*), intent(out) :: outdate
 963     integer :: inlen
 964
 965     inlen = len(indate)
 966     if (indate(5:5) == "-") then
 967        select case (inlen)
 968        case (10)
 969           ! YYYY-MM-DD
 970           outdate = indate(1:4)//indate(6:7)//indate(9:10)
 971        case (13)
 972           ! YYYY-MM-DD_HH
 973           outdate = indate(1:4)//indate(6:7)//indate(9:10)//indate(12:13)
 974        case (16)
 975           ! YYYY-MM-DD_HH:mm
 976           outdate = indate(1:4)//indate(6:7)//indate(9:10)//indate(12:13)//indate(15:16)
 977        case (19)
 978           ! YYYY-MM-DD_HH:mm:ss
 979           outdate = indate(1:4)//indate(6:7)//indate(9:10)//indate(12:13)//indate(15:16)//&
 980                indate(18:19)
 981        case (21,22,23,24)
 982           ! YYYY-MM-DD_HH:mm:ss.f[f[f[f]]]
 983           outdate = indate(1:4)//indate(6:7)//indate(9:10)//indate(12:13)//indate(15:16)//&
 984                indate(18:19)//indate(21:inlen)
 985        case default
 986           write(*,'("Unrecognized length: <", A,">")') indate
 987          call hydro_stop("In swap_date_format() - Unrecognized length")
 988        end select
 989     else
 990        select case (inlen)
 991        case (8)
 992           ! YYYYMMDD
 993           outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)
 994        case (10)
 995           ! YYYYMMDDHH
 996           outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)//"_"//&
 997                indate(9:10)
 998        case (12)
 999           ! YYYYMMDDHHmm
1000           outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)//"_"//&
1001                indate(9:10)//":"//indate(11:12)
1002        case (14)
1003           ! YYYYMMDDHHmmss
1004           outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)//"_"//&
1005                indate(9:10)//":"//indate(11:12)//":"//indate(13:14)
1006        case (15,16,17,18)
1007           ! YYYYMMDDHHmmssf[f[f[f]]]
1008           outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)//"_"//&
1009                indate(9:10)//":"//indate(11:12)//":"//indate(13:14)//"."//indate(15:inlen)
1010        case default
1011           write(*,'("Unrecognized length: <", A,">")') indate
1012           call hydro_stop("In swap_date_format() - Unrecognized length")
1013        end select
1014     endif
1015
1016   end subroutine swap_date_format
1017
1018   character(len=3) function mm_to_monthabbr(ii) result(mon)
1019     implicit none
1020     integer, intent(in) :: ii
1021     character(len=3), parameter, dimension(12) :: month = (/ &
1022          "Jan", "Feb", "Mar", "Apr", "May", "Jun", &
1023          "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" /)
1024     if (ii > 0 .and. ii < 13 ) then
1025        mon = month(ii)
1026     else
1027 !       print*, "mm_to_monthabbr"
1028        call hydro_stop("In mm_to_monthabbr() - mm_to_monthabbr")
1029     endif
1030   end function mm_to_monthabbr
1031
1032 end module Module_Date_utilities_rt