hydro/nudging/module_date_utils_nudging.F90

   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_utils_nudging
  22     use module_hydro_stop, only: HYDRO_stop
  23 contains
  24
  25 !===================================================================================================
  26 ! Subroutine Name: geth_newdate
  27 ! Author(s)/Contact(s):
  28 !   Wei Yu? or NoahMP developers?
  29 !   James L McCreight, jamesmcc><ucar><edu
  30 ! Abstract:
  31 !   Calculate a time difference from two time strings: idts=newdate-olddate
  32 ! History Log:
  33 !   7/22/15 -Header Created, JLM
  34 ! Usage:
  35 !   call geth_newdate(ndate, odate, idt)
  36 ! Parameters:
  37 !   newdate : the resulting date: odate+idt
  38 !   olddate : the start time for the sum: odate+id
  39 !   idts    : the time increment in seconds: odate+id
  40 ! Input Files:
  41 !   None.
  42 ! Output Files:
  43 !   None.
  44 ! Condition codes:
  45 !   call hydro_stop("geth_newdate") is used.
  46 ! User controllable options:
  47 !   None.
  48 ! Notes:
  49 !   This routine was copied from ../LandModel/Utility_routines/module_date_utilities.F
  50 !   There are some advantages to having a separate copy here, both compiling and
  51 !   tailored needs.
  52
  53 subroutine geth_newdate (ndate, odate, idt)
  54 implicit none
  55
  56 !  From old date ("YYYY-MM-DD HH:MM:SS.ffff" or "YYYYMMDDHHMMSSffff") and
  57 !  delta-time, compute the new date.
  58
  59 !  on entry     -  odate  -  the old hdate.
  60 !                  idt    -  the change in time
  61
  62 !  on exit      -  ndate  -  the new hdate.
  63
  64 integer, intent(in)           :: idt
  65 character (len=*), intent(out) :: ndate
  66 character (len=*), intent(in)  :: odate
  67
  68 !  Local Variables
  69
  70 !  yrold    -  indicates the year associated with "odate"
  71 !  moold    -  indicates the month associated with "odate"
  72 !  dyold    -  indicates the day associated with "odate"
  73 !  hrold    -  indicates the hour associated with "odate"
  74 !  miold    -  indicates the minute associated with "odate"
  75 !  scold    -  indicates the second associated with "odate"
  76
  77 !  yrnew    -  indicates the year associated with "ndate"
  78 !  monew    -  indicates the month associated with "ndate"
  79 !  dynew    -  indicates the day associated with "ndate"
  80 !  hrnew    -  indicates the hour associated with "ndate"
  81 !  minew    -  indicates the minute associated with "ndate"
  82 !  scnew    -  indicates the second associated with "ndate"
  83
  84 !  mday     -  a list assigning the number of days in each month
  85
  86 !  i        -  loop counter
  87 !  nday     -  the integer number of days represented by "idt"
  88 !  nhour    -  the integer number of hours in "idt" after taking out
  89 !              all the whole days
  90 !  nmin     -  the integer number of minutes in "idt" after taking out
  91 !              all the whole days and whole hours.
  92 !  nsec     -  the integer number of minutes in "idt" after taking out
  93 !              all the whole days, whole hours, and whole minutes.
  94
  95 integer :: newlen, oldlen
  96 integer :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
  97 integer :: yrold, moold, dyold, hrold, miold, scold, frold
  98 integer :: nday, nhour, nmin, nsec, nfrac, i, ifrc
  99 logical :: opass
 100 character (len=10) :: hfrc
 101 character (len=1) :: sp
 102 logical :: punct
 103 integer :: yrstart, yrend, mostart, moend, dystart, dyend
 104 integer :: hrstart, hrend, mistart, miend, scstart, scend, frstart
 105 integer :: units
 106 integer, dimension(12) :: mday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
 107
 108 ! Determine if odate is "YYYY-MM-DD_HH ... " or "YYYYMMDDHH...."
 109 if (odate(5:5) == "-") then
 110    punct = .TRUE.
 111 else
 112    punct = .FALSE.
 113 endif
 114
 115 !  Break down old hdate into parts
 116
 117 hrold = 0
 118 miold = 0
 119 scold = 0
 120 frold = 0
 121 oldlen = LEN(odate)
 122 if (punct) then
 123    yrstart = 1
 124    yrend = 4
 125    mostart = 6
 126    moend = 7
 127    dystart = 9
 128    dyend = 10
 129    hrstart = 12
 130    hrend = 13
 131    mistart = 15
 132    miend = 16
 133    scstart = 18
 134    scend = 19
 135    frstart = 21
 136    select case (oldlen)
 137    case (10)
 138       ! Days
 139       units = 1
 140    case (13)
 141       ! Hours
 142       units = 2
 143    case (16)
 144       ! Minutes
 145       units = 3
 146    case (19)
 147       ! Seconds
 148       units = 4
 149    case (21)
 150       ! Tenths
 151       units = 5
 152    case (22)
 153       ! Hundredths
 154       units = 6
 155    case (23)
 156       ! Thousandths
 157       units = 7
 158    case (24)
 159       ! Ten thousandths
 160       units = 8
 161    case default
 162
 163       write(*,*) 'FATAL ERROR: geth_newdate:  odd length: #'//trim(odate)//'#'
 164       call hydro_stop("geth_newdate")
 165
 166    end select
 167
 168    if (oldlen.ge.11) then
 169       sp = odate(11:11)
 170    else
 171       sp = ' '
 172    end if
 173
 174 else
 175
 176    yrstart = 1
 177    yrend = 4
 178    mostart = 5
 179    moend = 6
 180    dystart = 7
 181    dyend = 8
 182    hrstart = 9
 183    hrend = 10
 184    mistart = 11
 185    miend = 12
 186    scstart = 13
 187    scend = 14
 188    frstart = 15
 189
 190    select case (oldlen)
 191    case (8)
 192       ! Days
 193       units = 1
 194    case (10)
 195       ! Hours
 196       units = 2
 197    case (12)
 198       ! Minutes
 199       units = 3
 200    case (14)
 201       ! Seconds
 202       units = 4
 203    case (15)
 204       ! Tenths
 205       units = 5
 206    case (16)
 207       ! Hundredths
 208       units = 6
 209    case (17)
 210       ! Thousandths
 211       units = 7
 212    case (18)
 213       ! Ten thousandths
 214       units = 8
 215    case default
 216
 217       write(*,*) 'FATAL ERROR: geth_newdate:  odd length: #'//trim(odate)//'#'
 218       call hydro_stop("geth_newdate")
 219
 220    end select
 221 endif
 222
 223 !  Use internal READ statements to convert the CHARACTER string
 224 !  date into INTEGER components.
 225
 226 read(odate(yrstart:yrend),  '(i4)') yrold
 227 read(odate(mostart:moend),  '(i2)') moold
 228 read(odate(dystart:dyend), '(i2)') dyold
 229 if (units.ge.2) then
 230    read(odate(hrstart:hrend),'(i2)') hrold
 231    if (units.ge.3) then
 232       read(odate(mistart:miend),'(i2)') miold
 233       if (units.ge.4) then
 234          read(odate(scstart:scend),'(i2)') scold
 235          if (units.ge.5) then
 236             read(odate(frstart:oldlen),*) frold
 237          end if
 238       end if
 239    end if
 240 end if
 241
 242 !  Set the number of days in February for that year.
 243
 244 mday(2) = nfeb(yrold)
 245
 246 !  Check that ODATE makes sense.
 247
 248 opass = .TRUE.
 249
 250 !  Check that the month of ODATE makes sense.
 251
 252 if ((moold.gt.12).or.(moold.lt.1)) then
 253 #ifdef HYDRO_D
 254    write(*,*) 'GETH_NEWDATE:  Month of ODATE = ', moold
 255 #endif
 256    opass = .FALSE.
 257 end if
 258
 259 !  Check that the day of ODATE makes sense.
 260
 261 if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then
 262 #ifdef HYDRO_D
 263    write(*,*) 'GETH_NEWDATE:  Day of ODATE = ', dyold
 264 #endif
 265    opass = .FALSE.
 266 end if
 267
 268 !  Check that the hour of ODATE makes sense.
 269
 270 if ((hrold.gt.23).or.(hrold.lt.0)) then
 271 #ifdef HYDRO_D
 272    write(*,*) 'GETH_NEWDATE:  Hour of ODATE = ', hrold
 273 #endif
 274    opass = .FALSE.
 275 end if
 276
 277 !  Check that the minute of ODATE makes sense.
 278
 279 if ((miold.gt.59).or.(miold.lt.0)) then
 280 #ifdef HYDRO_D
 281    write(*,*) 'GETH_NEWDATE:  Minute of ODATE = ', miold
 282 #endif
 283    opass = .FALSE.
 284 end if
 285
 286 !  Check that the second of ODATE makes sense.
 287
 288 if ((scold.gt.59).or.(scold.lt.0)) then
 289 #ifdef HYDRO_D
 290    write(*,*) 'GETH_NEWDATE:  Second of ODATE = ', scold
 291 #endif
 292    opass = .FALSE.
 293 end if
 294
 295 !  Check that the fractional part  of ODATE makes sense.
 296
 297
 298 if (.not.opass) then
 299
 300    write(*,*) 'FATAL ERROR: Crazy ODATE: ', odate(1:oldlen), oldlen
 301    stop
 302
 303 end if
 304
 305 !  Date Checks are completed.  Continue.
 306
 307
 308 !  Compute the number of days, hours, minutes, and seconds in idt
 309
 310 if (units.ge.5) then !idt should be in fractions of seconds
 311    ifrc = oldlen-(frstart)+1
 312    ifrc = 10**ifrc
 313    nday   = abs(idt)/(86400*ifrc)
 314    nhour  = mod(abs(idt),86400*ifrc)/(3600*ifrc)
 315    nmin   = mod(abs(idt),3600*ifrc)/(60*ifrc)
 316    nsec   = mod(abs(idt),60*ifrc)/(ifrc)
 317    nfrac = mod(abs(idt), ifrc)
 318 else if (units.eq.4) then  !idt should be in seconds
 319    ifrc = 1
 320    nday   = abs(idt)/86400 ! integer number of days in delta-time
 321    nhour  = mod(abs(idt),86400)/3600
 322    nmin   = mod(abs(idt),3600)/60
 323    nsec   = mod(abs(idt),60)
 324    nfrac  = 0
 325 else if (units.eq.3) then !idt should be in minutes
 326    ifrc = 1
 327    nday   = abs(idt)/1440 ! integer number of days in delta-time
 328    nhour  = mod(abs(idt),1440)/60
 329    nmin   = mod(abs(idt),60)
 330    nsec   = 0
 331    nfrac  = 0
 332 else if (units.eq.2) then !idt should be in hours
 333    ifrc = 1
 334    nday   = abs(idt)/24 ! integer number of days in delta-time
 335    nhour  = mod(abs(idt),24)
 336    nmin   = 0
 337    nsec   = 0
 338    nfrac  = 0
 339 else if (units.eq.1) then !idt should be in days
 340    ifrc = 1
 341    nday   = abs(idt)    ! integer number of days in delta-time
 342    nhour  = 0
 343    nmin   = 0
 344    nsec   = 0
 345    nfrac  = 0
 346 else
 347
 348    write(*,'(''GETH_NEWDATE: Strange length for ODATE: '', i3)') &
 349         oldlen
 350    write(*,*) '#'//odate(1:oldlen)//'#'
 351    call hydro_stop("geth_newdate")
 352
 353 end if
 354
 355 if (idt.ge.0) then
 356
 357    frnew = frold + nfrac
 358    if (frnew.ge.ifrc) then
 359       frnew = frnew - ifrc
 360       nsec = nsec + 1
 361    end if
 362
 363    scnew = scold + nsec
 364    if (scnew .ge. 60) then
 365       scnew = scnew - 60
 366       nmin  = nmin + 1
 367    end if
 368
 369    minew = miold + nmin
 370    if (minew .ge. 60) then
 371       minew = minew - 60
 372       nhour  = nhour + 1
 373    end if
 374
 375    hrnew = hrold + nhour
 376    if (hrnew .ge. 24) then
 377       hrnew = hrnew - 24
 378       nday  = nday + 1
 379    end if
 380
 381    dynew = dyold
 382    monew = moold
 383    yrnew = yrold
 384    do i = 1, nday
 385       dynew = dynew + 1
 386       if (dynew.gt.mday(monew)) then
 387          dynew = dynew - mday(monew)
 388          monew = monew + 1
 389          if (monew .gt. 12) then
 390             monew = 1
 391             yrnew = yrnew + 1
 392             ! If the year changes, recompute the number of days in February
 393             mday(2) = nfeb(yrnew)
 394          end if
 395       end if
 396    end do
 397
 398 else if (idt.lt.0) then
 399
 400    frnew = frold - nfrac
 401    if (frnew .lt. 0) then
 402       frnew = frnew + ifrc
 403       nsec = nsec + 1
 404    end if
 405
 406    scnew = scold - nsec
 407    if (scnew .lt. 00) then
 408       scnew = scnew + 60
 409       nmin  = nmin + 1
 410    end if
 411
 412    minew = miold - nmin
 413    if (minew .lt. 00) then
 414       minew = minew + 60
 415       nhour  = nhour + 1
 416    end if
 417
 418    hrnew = hrold - nhour
 419    if (hrnew .lt. 00) then
 420       hrnew = hrnew + 24
 421       nday  = nday + 1
 422    end if
 423
 424    dynew = dyold
 425    monew = moold
 426    yrnew = yrold
 427    do i = 1, nday
 428       dynew = dynew - 1
 429       if (dynew.eq.0) then
 430          monew = monew - 1
 431          if (monew.eq.0) then
 432             monew = 12
 433             yrnew = yrnew - 1
 434             ! If the year changes, recompute the number of days in February
 435             mday(2) = nfeb(yrnew)
 436          end if
 437          dynew = mday(monew)
 438       end if
 439    end do
 440 end if
 441
 442 !  Now construct the new mdate
 443
 444 newlen = LEN(ndate)
 445
 446 if (punct) then
 447
 448    if (newlen.gt.frstart) then
 449       write(ndate(1:scend),19) yrnew, monew, dynew, hrnew, minew, scnew
 450       write(hfrc,'(i10)') frnew+1000000000
 451       ndate = ndate(1:scend)//'.'//hfrc(31-newlen:10)
 452
 453    else if (newlen.eq.scend) then
 454       write(ndate(1:scend),19) yrnew, monew, dynew, hrnew, minew, scnew
 455 19    format(i4,'-',i2.2,'-',i2.2,'_',i2.2,':',i2.2,':',i2.2)
 456
 457    else if (newlen.eq.miend) then
 458       write(ndate,16) yrnew, monew, dynew, hrnew, minew
 459 16    format(i4,'-',i2.2,'-',i2.2,'_',i2.2,':',i2.2)
 460
 461    else if (newlen.eq.hrend) then
 462       write(ndate,13) yrnew, monew, dynew, hrnew
 463 13    format(i4,'-',i2.2,'-',i2.2,'_',i2.2)
 464
 465    else if (newlen.eq.dyend) then
 466       write(ndate,10) yrnew, monew, dynew
 467 10    format(i4,'-',i2.2,'-',i2.2)
 468
 469    end if
 470
 471 else
 472
 473    if (newlen.gt.frstart) then
 474       write(ndate(1:scend),119) yrnew, monew, dynew, hrnew, minew, scnew
 475       write(hfrc,'(i10)') frnew+1000000000
 476       ndate = ndate(1:scend)//'.'//hfrc(31-newlen:10)
 477
 478    else if (newlen.eq.scend) then
 479       write(ndate(1:scend),119) yrnew, monew, dynew, hrnew, minew, scnew
 480 119   format(i4,i2.2,i2.2,i2.2,i2.2,i2.2)
 481
 482    else if (newlen.eq.miend) then
 483       write(ndate,116) yrnew, monew, dynew, hrnew, minew
 484 116   format(i4,i2.2,i2.2,i2.2,i2.2)
 485
 486    else if (newlen.eq.hrend) then
 487       write(ndate,113) yrnew, monew, dynew, hrnew
 488 113   format(i4,i2.2,i2.2,i2.2)
 489
 490    else if (newlen.eq.dyend) then
 491       write(ndate,110) yrnew, monew, dynew
 492 110   format(i4,i2.2,i2.2)
 493
 494    end if
 495
 496 endif
 497
 498 if (punct .and. (oldlen.ge.11) .and. (newlen.ge.11)) ndate(11:11) = sp
 499
 500 end subroutine geth_newdate
 501
 502
 503
 504 !===================================================================================================
 505 ! Subroutine Name: geth_idts
 506 ! Author(s)/Contact(s):
 507 !   Wei Yu? or NoahMP developers?
 508 !   James L McCreight, jamesmcc><ucar><edu
 509 ! Abstract:
 510 !   Calculate a time difference from two time strings: idts=newdate-olddate
 511 ! History Log:
 512 !   7/22/15 -Header Created, JLM
 513 ! Usage:
 514 !   call geth_idts(newdate, olddate, idt)
 515 ! Parameters:
 516 !   newdate : first date in difference  (newdate-olddate).
 517 !   olddate : second date in difference (newdate-olddate).
 518 !   idts    : difference with units dependent on input resolution.
 519 ! Input Files:
 520 !   None.
 521 ! Output Files:
 522 !   None.
 523 ! Condition codes:
 524 !   Currently incomplete error handling.
 525 ! User controllable options:
 526 !   None.
 527 ! Notes:
 528 !   This routine was copied from ../LandModel/Utility_routines/module_date_utilities.F
 529 !   There are some advantages to having a separate copy here, both compiling and
 530 !   tailored needs.
 531 subroutine geth_idts(newdate, olddate, idt)
 532
 533 implicit none
 534
 535 !  From 2 input mdates ('YYYY-MM-DD HH:MM:SS.ffff'),
 536 !  compute the time difference.
 537 !  on entry     -  newdate  -  the new hdate.
 538 !                  olddate  -  the old hdate.
 539 !  on exit      -  idt    -  the change in time.
 540 !                            Units depend on length of date strings.
 541
 542 character (len=*) , intent(in) :: newdate, olddate
 543 integer           , intent(out)   :: idt
 544
 545 !  Local Variables
 546
 547 !  yrnew    -  indicates the year associated with "ndate"
 548 !  yrold    -  indicates the year associated with "odate"
 549 !  monew    -  indicates the month associated with "ndate"
 550 !  moold    -  indicates the month associated with "odate"
 551 !  dynew    -  indicates the day associated with "ndate"
 552 !  dyold    -  indicates the day associated with "odate"
 553 !  hrnew    -  indicates the hour associated with "ndate"
 554 !  hrold    -  indicates the hour associated with "odate"
 555 !  minew    -  indicates the minute associated with "ndate"
 556 !  miold    -  indicates the minute associated with "odate"
 557 !  scnew    -  indicates the second associated with "ndate"
 558 !  scold    -  indicates the second associated with "odate"
 559 !  i        -  loop counter
 560 !  mday     -  a list assigning the number of days in each month
 561
 562 ! ndate, odate: local values of newdate and olddate
 563 character(len=24) :: ndate, odate
 564
 565 integer :: oldlen, newlen
 566 integer :: yrnew, monew, dynew, hrnew, minew, scnew, frnew
 567 integer :: yrold, moold, dyold, hrold, miold, scold, frold
 568 integer :: i, newdys, olddys
 569 logical :: npass, opass
 570 integer :: timesign
 571 integer :: ifrc
 572 integer, dimension(12) :: mday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
 573 logical :: punct
 574 integer :: yrstart, yrend, mostart, moend, dystart, dyend
 575 integer :: hrstart, hrend, mistart, miend, scstart, scend, frstart
 576 integer :: units
 577
 578 oldlen = len(olddate)
 579 newlen = len(newdate)
 580 if (newlen.ne.oldlen) then
 581 #ifdef HYDRO_D
 582    write(*,'("GETH_IDTS: NEWLEN /= OLDLEN: ", A, 3x, A)') newdate(1:newlen), olddate(1:oldlen)
 583    call hydro_stop("geth_newdate")
 584 #endif
 585 endif
 586
 587 if (olddate.gt.newdate) then
 588    timesign = -1
 589
 590    ifrc = oldlen
 591    oldlen = newlen
 592    newlen = ifrc
 593
 594    ndate = olddate
 595    odate = newdate
 596 else
 597    timesign = 1
 598    ndate = newdate
 599    odate = olddate
 600 end if
 601
 602 ! Break down old hdate into parts
 603
 604 ! Determine if olddate is punctuated or not
 605 if (odate(5:5) == "-") then
 606    punct = .TRUE.
 607    if (ndate(5:5) /= "-") then
 608
 609       write(*,'("GETH_IDTS: Dates appear to be different formats: ", A, 3x, A)') &
 610            ndate(1:newlen), odate(1:oldlen)
 611       call hydro_stop("geth_idts utils_nudging -1")
 612
 613    endif
 614 else
 615    punct = .FALSE.
 616    if (ndate(5:5) == "-") then
 617
 618       write(*,'("GETH_IDTS: Dates appear to be different formats: ", A, 3x, A)') &
 619            ndate(1:newlen), odate(1:oldlen)
 620       call hydro_stop("geth_idts utils_nudging 0")
 621
 622    endif
 623 endif
 624
 625 if (punct) then
 626    yrstart = 1
 627    yrend = 4
 628    mostart = 6
 629    moend = 7
 630    dystart = 9
 631    dyend = 10
 632    hrstart = 12
 633    hrend = 13
 634    mistart = 15
 635    miend = 16
 636    scstart = 18
 637    scend = 19
 638    frstart = 21
 639    select case (oldlen)
 640    case (10)
 641       ! Days
 642       units = 1
 643    case (13)
 644       ! Hours
 645       units = 2
 646    case (16)
 647       ! Minutes
 648       units = 3
 649    case (19)
 650       ! Seconds
 651       units = 4
 652    case (21)
 653       ! Tenths
 654       units = 5
 655    case (22)
 656       ! Hundredths
 657       units = 6
 658    case (23)
 659       ! Thousandths
 660       units = 7
 661    case (24)
 662       ! Ten thousandths
 663       units = 8
 664    case default
 665
 666       write(*,*) 'ERROR: geth_idts:  odd length: #'//trim(odate)//'#'
 667       call hydro_stop("geth_idts utils_nudging 1")
 668
 669    end select
 670 else
 671
 672    yrstart = 1
 673    yrend = 4
 674    mostart = 5
 675    moend = 6
 676    dystart = 7
 677    dyend = 8
 678    hrstart = 9
 679    hrend = 10
 680    mistart = 11
 681    miend = 12
 682    scstart = 13
 683    scend = 14
 684    frstart = 15
 685
 686    select case (oldlen)
 687    case (8)
 688       ! Days
 689       units = 1
 690    case (10)
 691       ! Hours
 692       units = 2
 693    case (12)
 694       ! Minutes
 695       units = 3
 696    case (14)
 697       ! Seconds
 698       units = 4
 699    case (15)
 700       ! Tenths
 701       units = 5
 702    case (16)
 703       ! Hundredths
 704       units = 6
 705    case (17)
 706       ! Thousandths
 707       units = 7
 708    case (18)
 709       ! Ten thousandths
 710       units = 8
 711    case default
 712
 713       write(*,*) 'ERROR: geth_idts:  odd length: #'//trim(odate)//'#'
 714       call hydro_stop("geth_idts nudging_utils 2")
 715
 716    end select
 717 endif
 718
 719
 720 hrold = 0
 721 miold = 0
 722 scold = 0
 723 frold = 0
 724
 725 read(odate(yrstart:yrend), '(i4)') yrold
 726 read(odate(mostart:moend), '(i2)') moold
 727 read(odate(dystart:dyend), '(i2)') dyold
 728 if (units.ge.2) then
 729    read(odate(hrstart:hrend),'(i2)') hrold
 730    if (units.ge.3) then
 731       read(odate(mistart:miend),'(i2)') miold
 732       if (units.ge.4) then
 733          read(odate(scstart:scend),'(i2)') scold
 734          if (units.ge.5) then
 735             read(odate(frstart:oldlen),*) frold
 736          end if
 737       end if
 738    end if
 739 end if
 740
 741 !  Break down new hdate into parts
 742
 743 hrnew = 0
 744 minew = 0
 745 scnew = 0
 746 frnew = 0
 747
 748 read(ndate(yrstart:yrend), '(i4)') yrnew
 749 read(ndate(mostart:moend), '(i2)') monew
 750 read(ndate(dystart:dyend), '(i2)') dynew
 751 if (units.ge.2) then
 752    read(ndate(hrstart:hrend),'(i2)') hrnew
 753    if (units.ge.3) then
 754       read(ndate(mistart:miend),'(i2)') minew
 755       if (units.ge.4) then
 756          read(ndate(scstart:scend),'(i2)') scnew
 757          if (units.ge.5) then
 758             read(ndate(frstart:newlen),*) frnew
 759          end if
 760       end if
 761    end if
 762 end if
 763
 764 !  Check that the dates make sense.
 765
 766 npass = .true.
 767 opass = .true.
 768
 769 !  Check that the month of NDATE makes sense.
 770
 771 if ((monew.gt.12).or.(monew.lt.1)) then
 772 #ifdef HYDRO_D
 773    write(*,*) 'GETH_IDTS:  Month of NDATE = ', monew
 774 #endif
 775    npass = .false.
 776 end if
 777
 778 !  Check that the month of ODATE makes sense.
 779
 780 if ((moold.gt.12).or.(moold.lt.1)) then
 781 #ifdef HYDRO_D
 782    print*, 'GETH_IDTS:  Month of ODATE = ', moold
 783 #endif
 784    opass = .false.
 785 end if
 786
 787 !  Check that the day of NDATE makes sense.
 788
 789 if (monew.ne.2) then
 790    ! ...... For all months but February
 791    if ((dynew.gt.mday(monew)).or.(dynew.lt.1)) then
 792 #ifdef HYDRO_D
 793       print*, 'GETH_IDTS:  Day of NDATE = ', dynew
 794 #endif
 795       npass = .false.
 796    end if
 797 else if (monew.eq.2) then
 798    ! ...... For February
 799    if ((dynew > nfeb(yrnew)).or.(dynew < 1)) then
 800 #ifdef HYDRO_D
 801       print*, 'GETH_IDTS:  Day of NDATE = ', dynew
 802 #endif
 803       npass = .false.
 804    end if
 805 endif
 806
 807 !  Check that the day of ODATE makes sense.
 808
 809 if (moold.ne.2) then
 810    ! ...... For all months but February
 811    if ((dyold.gt.mday(moold)).or.(dyold.lt.1)) then
 812 #ifdef HYDRO_D
 813       print*, 'GETH_IDTS:  Day of ODATE = ', dyold
 814 #endif
 815       opass = .false.
 816    end if
 817 else if (moold.eq.2) then
 818    ! ....... For February
 819    if ((dyold > nfeb(yrold)).or.(dyold < 1)) then
 820 #ifdef HYDRO_D
 821       print*, 'GETH_IDTS:  Day of ODATE = ', dyold
 822 #endif
 823       opass = .false.
 824    end if
 825 end if
 826
 827 !  Check that the hour of NDATE makes sense.
 828
 829 if ((hrnew.gt.23).or.(hrnew.lt.0)) then
 830 #ifdef HYDRO_D
 831    print*, 'GETH_IDTS:  Hour of NDATE = ', hrnew
 832 #endif
 833    npass = .false.
 834 end if
 835
 836 !  Check that the hour of ODATE makes sense.
 837
 838 if ((hrold.gt.23).or.(hrold.lt.0)) then
 839 #ifdef HYDRO_D
 840    print*, 'GETH_IDTS:  Hour of ODATE = ', hrold
 841 #endif
 842    opass = .false.
 843 end if
 844
 845 !  Check that the minute of NDATE makes sense.
 846
 847 if ((minew.gt.59).or.(minew.lt.0)) then
 848 #ifdef HYDRO_D
 849    print*, 'GETH_IDTS:  Minute of NDATE = ', minew
 850 #endif
 851    npass = .false.
 852 end if
 853
 854 !  Check that the minute of ODATE makes sense.
 855
 856 if ((miold.gt.59).or.(miold.lt.0)) then
 857 #ifdef HYDRO_D
 858    print*, 'GETH_IDTS:  Minute of ODATE = ', miold
 859 #endif
 860    opass = .false.
 861 end if
 862
 863 !  Check that the second of NDATE makes sense.
 864
 865 if ((scnew.gt.59).or.(scnew.lt.0)) then
 866 #ifdef HYDRO_D
 867    print*, 'GETH_IDTS:  SECOND of NDATE = ', scnew
 868 #endif
 869    npass = .false.
 870 end if
 871
 872 !  Check that the second of ODATE makes sense.
 873
 874 if ((scold.gt.59).or.(scold.lt.0)) then
 875 #ifdef HYDRO_D
 876    print*, 'GETH_IDTS:  Second of ODATE = ', scold
 877 #endif
 878    opass = .false.
 879 end if
 880
 881 if (.not. npass) then
 882 #ifdef HYDRO_D
 883    print*, 'Screwy NDATE: ', ndate(1:newlen)
 884    call hydro_stop("geth_idts nudging_utils 3")
 885 #endif
 886 end if
 887
 888 if (.not. opass) then
 889 #ifdef HYDRO_D
 890    print*, 'FATAL ERROR: Screwy ODATE: ', odate(1:oldlen)
 891    call hydro_stop("geth_idts nudging_utils 4")
 892 #endif
 893 end if
 894
 895 !  Date Checks are completed.  Continue.
 896
 897 !  Compute number of days from 1 January ODATE, 00:00:00 until ndate
 898 !  Compute number of hours from 1 January ODATE, 00:00:00 until ndate
 899 !  Compute number of minutes from 1 January ODATE, 00:00:00 until ndate
 900
 901 newdys = 0
 902 do i = yrold, yrnew - 1
 903    newdys = newdys + 337 + nfeb(i)
 904 end do
 905
 906 if (monew .gt. 1) then
 907    mday(2) = nfeb(yrnew)
 908    do i = 1, monew - 1
 909       newdys = newdys + mday(i)
 910    end do
 911    mday(2) = 28
 912 end if
 913
 914 newdys = newdys + dynew - 1
 915
 916 !  Compute number of hours from 1 January ODATE, 00:00:00 until odate
 917 !  Compute number of minutes from 1 January ODATE, 00:00:00 until odate
 918
 919 olddys = 0
 920
 921 if (moold .gt. 1) then
 922    mday(2) = nfeb(yrold)
 923    do i = 1, moold - 1
 924       olddys = olddys + mday(i)
 925    end do
 926    mday(2) = 28
 927 end if
 928
 929 olddys = olddys + dyold -1
 930
 931 !  Determine the time difference
 932
 933 idt = (newdys - olddys)
 934 if (units.ge.2) then
 935    idt = idt*24 + (hrnew - hrold)
 936    if (units.ge.3) then
 937       idt = idt*60 + (minew - miold)
 938       if (units.ge.4) then
 939          idt = idt*60 + (scnew - scold)
 940          if (units.ge.5) then
 941             ifrc = oldlen-(frstart-1)
 942             ifrc = 10**ifrc
 943             idt = idt * ifrc + (frnew-frold)
 944          endif
 945       endif
 946    endif
 947 endif
 948
 949 if (timesign .eq. -1) then
 950    idt = idt * timesign
 951 end if
 952
 953 end subroutine geth_idts
 954
 955
 956 !===================================================================================================
 957 ! Function Name: get_idts_elemental
 958 ! Author(s)/Contact(s):
 959 !   James L McCreight, jamesmcc><ucar><edu
 960 ! Abstract:
 961 !   get_idts on a vector.
 962 !
 963 ! History Log:
 964 !   10/11/16 -Header Created, JLM
 965 ! Usage:
 966 !
 967 ! Parameters:
 968 !
 969 ! Input Files:
 970 !   None.
 971 ! Output Files:
 972 !   None.
 973 ! Condition codes:
 974 !
 975 ! User controllable options:
 976 !   None.
 977 ! Notes:
 978 !elemental subroutine geth_idts_elemental(newdate, olddate, idt)
 979 !end
 980
 981
 982
 983 !===================================================================================================
 984 ! Function Name: nfeb
 985 ! Author(s)/Contact(s):
 986 !   Wei Yu? or NoahMP developers?
 987 !   James L McCreight, jamesmcc><ucar><edu
 988 ! Abstract:
 989 !
 990 ! History Log:
 991 !   7/22/15 -Header Created, JLM
 992 ! Usage:
 993 !
 994 ! Parameters:
 995 !
 996 ! Input Files:
 997 !   None.
 998 ! Output Files:
 999 !   None.
1000 ! Condition codes:
1001 !
1002 ! User controllable options:
1003 !   None.
1004 ! Notes:
1005 !   This routine was copied from ../LandModel/Utility_routines/module_date_utilities.F
1006 !   There are some advantages to having a separate copy here, both compiling and
1007 !   tailored needs.
1008
1009 integer function nfeb(year)
1010 !
1011 ! Compute the number of days in February for the given year.
1012 !
1013 implicit none
1014 integer, intent(in) :: year ! Four-digit year
1015
1016 nfeb = 28 ! By default, February has 28 days ...
1017 if (mod(year,4).eq.0) then
1018    nfeb = 29  ! But every four years, it has 29 days ...
1019    if (mod(year,100).eq.0) then
1020       nfeb = 28  ! Except every 100 years, when it has 28 days ...
1021       if (mod(year,400).eq.0) then
1022          nfeb = 29  ! Except every 400 years, when it has 29 days ...
1023          if (mod(year,3600).eq.0) then
1024             nfeb = 28  ! Except every 3600 years, when it has 28 days.
1025          endif
1026       endif
1027    endif
1028 endif
1029 end function nfeb
1030
1031 !===================================================================================================
1032 ! Function Name: nmdays
1033 ! Author(s)/Contact(s):
1034 !   Wei Yu? or NoahMP developers?
1035 !   James L McCreight, jamesmcc><ucar><edu
1036 ! Abstract:
1037 !
1038 ! History Log:
1039 !   7/22/15 -Header Created, JLM
1040 ! Usage:
1041 !
1042 ! Parameters:
1043 !
1044 ! Input Files:
1045 !   None.
1046 ! Output Files:
1047 !   None.
1048 ! Condition codes:
1049 !
1050 ! User controllable options:
1051 !   None.
1052 ! Notes:
1053 !   This routine was copied from ../LandModel/Utility_routines/module_date_utilities.F
1054 !   There are some advantages to having a separate copy here, both compiling and
1055 !   tailored needs.
1056
1057 integer function nmdays(hdate)
1058 !
1059 ! Compute the number of days in the month of given date hdate.
1060 !
1061 implicit none
1062 character(len=*), intent(in) :: hdate
1063
1064 integer :: year, month
1065 integer, dimension(12), parameter :: ndays = (/ 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 /)
1066
1067 read(hdate(1:7), '(I4,1x,I2)') year, month
1068
1069 if (month == 2) then
1070    nmdays = nfeb(year)
1071 else
1072    nmdays = ndays(month)
1073 endif
1074 end function nmdays
1075
1076 !===================================================================================================
1077 ! Function Name: monthabbr_to_mm
1078 ! Author(s)/Contact(s):
1079 !   Wei Yu? or NoahMP developers?
1080 !   James L McCreight, jamesmcc><ucar><edu
1081 ! Abstract:
1082 !
1083 ! History Log:
1084 !   7/22/15 -Header Created, JLM
1085 ! Usage:
1086 !
1087 ! Parameters:
1088 !
1089 ! Input Files:
1090 !   None.
1091 ! Output Files:
1092 !   None.
1093 ! Condition codes:
1094 !
1095 ! User controllable options:
1096 !   None.
1097 ! Notes:
1098 !   This routine was copied from ../LandModel/Utility_routines/module_date_utilities.F
1099 !   There are some advantages to having a separate copy here, both compiling and
1100 !   tailored needs.
1101
1102 function monthabbr_to_mm(mon) result(mm)
1103 implicit none
1104
1105 character(len=3), intent(in) :: mon
1106
1107 integer :: mm
1108
1109 if (mon == "Jan") then
1110    mm = 1
1111 elseif (mon == "Feb") then
1112    mm = 2
1113 elseif (mon == "Mar") then
1114    mm = 3
1115 elseif (mon == "Apr") then
1116    mm = 4
1117 elseif (mon == "May") then
1118    mm = 5
1119 elseif (mon == "Jun") then
1120    mm = 6
1121 elseif (mon == "Jul") then
1122    mm = 7
1123 elseif (mon == "Aug") then
1124    mm = 8
1125 elseif (mon == "Sep") then
1126    mm = 9
1127 elseif (mon == "Oct") then
1128    mm = 10
1129 elseif (mon == "Nov") then
1130    mm = 11
1131 elseif (mon == "Dec") then
1132    mm = 12
1133 else
1134
1135    write(*, '("Function monthabbr_to_mm:  mon = <",A,">")') mon
1136    print*,  "FATAL ERROR: Function monthabbr_to_mm:  Unrecognized mon"
1137    call hydro_stop("monthabbr_to_mm")
1138
1139 endif
1140 end function monthabbr_to_mm
1141
1142 !===================================================================================================
1143 ! Subroutine Name: swap_date_format
1144 ! Author(s)/Contact(s):
1145 !   Wei Yu? or NoahMP developers?
1146 !   James L McCreight, jamesmcc><ucar><edu
1147 ! Abstract:
1148 !
1149 ! History Log:
1150 !   7/22/15 -Header Created, JLM
1151 ! Usage:
1152 !
1153 ! Parameters:
1154 !
1155 ! Input Files:
1156 !   None.
1157 ! Output Files:
1158 !   None.
1159 ! Condition codes:
1160 !
1161 ! User controllable options:
1162 !   None.
1163 ! Notes:
1164 !   This routine was copied from ../LandModel/Utility_routines/module_date_utilities.F
1165 !   There are some advantages to having a separate copy here, both compiling and
1166 !   tailored needs.
1167
1168 subroutine swap_date_format(indate, outdate)
1169 implicit none
1170 character(len=*), intent(in)  :: indate
1171 character(len=*), intent(out) :: outdate
1172 integer :: inlen
1173
1174 inlen = len(indate)
1175 if (indate(5:5) == "-") then
1176    select case (inlen)
1177    case (10)
1178       ! YYYY-MM-DD
1179       outdate = indate(1:4)//indate(6:7)//indate(9:10)
1180    case (13)
1181       ! YYYY-MM-DD_HH
1182       outdate = indate(1:4)//indate(6:7)//indate(9:10)//indate(12:13)
1183    case (16)
1184       ! YYYY-MM-DD_HH:mm
1185       outdate = indate(1:4)//indate(6:7)//indate(9:10)//indate(12:13)//indate(15:16)
1186    case (19)
1187       ! YYYY-MM-DD_HH:mm:ss
1188       outdate = indate(1:4)//indate(6:7)//indate(9:10)//indate(12:13)//indate(15:16)//&
1189            indate(18:19)
1190    case (21,22,23,24)
1191       ! YYYY-MM-DD_HH:mm:ss.f[f[f[f]]]
1192       outdate = indate(1:4)//indate(6:7)//indate(9:10)//indate(12:13)//indate(15:16)//&
1193            indate(18:19)//indate(21:inlen)
1194    case default
1195 #ifdef HYDRO_D
1196       write(*,'("Unrecognized length: <", A,">")') indate
1197       call hydro_stop("swap_date_format")
1198 #endif
1199    end select
1200 else
1201    select case (inlen)
1202    case (8)
1203       ! YYYYMMDD
1204       outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)
1205    case (10)
1206       ! YYYYMMDDHH
1207       outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)//"_"//&
1208            indate(9:10)
1209    case (12)
1210       ! YYYYMMDDHHmm
1211       outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)//"_"//&
1212            indate(9:10)//":"//indate(11:12)
1213    case (14)
1214       ! YYYYMMDDHHmmss
1215       outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)//"_"//&
1216            indate(9:10)//":"//indate(11:12)//":"//indate(13:14)
1217    case (15,16,17,18)
1218       ! YYYYMMDDHHmmssf[f[f[f]]]
1219       outdate = indate(1:4)//"-"//indate(5:6)//"-"//indate(7:8)//"_"//&
1220            indate(9:10)//":"//indate(11:12)//":"//indate(13:14)//"."//indate(15:inlen)
1221    case default
1222
1223       write(*,'("FATAL ERROR: Unrecognized length: <", A,">")') indate
1224       call hydro_stop("swap_date_format")
1225
1226    end select
1227 endif
1228
1229 end subroutine swap_date_format
1230
1231 !===================================================================================================
1232 ! Function Name: mm_to_monthabbr
1233 ! Author(s)/Contact(s):
1234 !   Wei Yu? or NoahMP developers?
1235 !   James L McCreight, jamesmcc><ucar><edu
1236 ! Abstract:
1237 !
1238 ! History Log:
1239 !   7/22/15 -Header Created, JLM
1240 ! Usage:
1241 !
1242 ! Parameters:
1243 !
1244 ! Input Files:
1245 !   None.
1246 ! Output Files:
1247 !   None.
1248 ! Condition codes:
1249 !
1250 ! User controllable options:
1251 !   None.
1252 ! Notes:
1253 !   This routine was copied from ../LandModel/Utility_routines/module_date_utilities.F
1254 !   There are some advantages to having a separate copy here, both compiling and
1255 !   tailored needs.
1256
1257 character(len=3) function mm_to_monthabbr(ii) result(mon)
1258 implicit none
1259 integer, intent(in) :: ii
1260 character(len=3), parameter, dimension(12) :: month = (/ &
1261      "Jan", "Feb", "Mar", "Apr", "May", "Jun", &
1262      "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" /)
1263 if (ii > 0 .and. ii < 13 ) then
1264    mon = month(ii)
1265 else
1266
1267    print*, "FATAL ERROR: mm_to_monthabbr"
1268    call hydro_stop("mm_to_monthabbr")
1269
1270 endif
1271 end function mm_to_monthabbr
1272
1273 !===================================================================================================
1274 ! Function Name: round_resolution_minute
1275 ! Author(s)/Contact(s):
1276 !   James L McCreight, jamesmcc><ucar><edu
1277 ! Abstract: Round a time to some time resolution specified in minutes:
1278 !           1) the resolution evenly divides 60
1279 !           2) the first time chunk in a hour is centered on 0 minutes and
1280 !              subesquent chunks are centered on N*resoluton (mod 60).
1281 ! History Log:
1282 !   7/29/15 -Header Created, JLM
1283 ! Usage:
1284 !
1285 ! Parameters:
1286 !
1287 ! Input Files:
1288 !   None.
1289 ! Output Files:
1290 !   None.
1291 ! Condition codes:
1292 !   None.
1293 ! User controllable options:
1294 !   None.
1295 ! Notes: Some tests:
1296 ! print*,round_resolution_minute('2003-02-01_01:00:00', 5)
1297 ! print*,round_resolution_minute('2003-02-01_01:02:29', 5)
1298 ! print*,round_resolution_minute('2003-02-01_01:02:30', 5)
1299 ! print*,round_resolution_minute('2003-02-01_01:57:29', 5)
1300 ! print*,round_resolution_minute('2003-02-01_01:57:30', 5)
1301 ! print*,''
1302 ! print*,round_resolution_minute('2003-02-01_01:00:00', 15)
1303 ! print*,round_resolution_minute('2003-02-01_01:07:29', 15)
1304 ! print*,round_resolution_minute('2003-02-01_01:07:30', 15)
1305 ! print*,round_resolution_minute('2003-02-01_01:52:29', 15)
1306 ! print*,round_resolution_minute('2003-02-01_01:52:30', 15)
1307
1308 function round_resolution_minute(time, resolution)
1309 implicit none
1310 character(len=19)             :: round_resolution_minute ! return value
1311 character(len=19), intent(in) :: time         ! time to round
1312 integer                       :: resolution   ! the time resolution in minutes
1313
1314 integer :: diffMin
1315 real    :: resolutionInv, theMinute, theSecond, resMin
1316 character(len=19) :: roundTime, timeCopy
1317
1318 ! nearest defines a time resolution
1319 resolutionInv = 1./resolution
1320 !1234567890123456789
1321 !YYYY-MM-DD_HH:mm:ss
1322 read(time(15:16),*) theMinute
1323 read(time(18:19),*) theSecond
1324 theMinute = theMinute + (theSecond/60.)
1325 ! What fraction of the time resolution is the current time?
1326 resMin = (theMinute * resolutionInv)
1327 ! Round to the time resolution.
1328 ! nint doesnt document its rounding rule on gfortran! boo.
1329 if(resMin - floor(resMin) .ge. .5) resMin=ceiling(resMin)
1330 if(resMin - floor(resMin) .lt. .5) resMin=floor(resMin)
1331 ! Convert back to regular minutes.
1332 resMin = resMin / resolutionInv
1333 ! To get the exact right time, some floor/ceil operations are helpful.
1334 timeCopy = time
1335 timeCopy(18:19) = '00' ! Floor of theMinute in string form
1336 ! nint is needed b/c resMin is real and often slightly off integer,
1337 ! and this is exacerbated by *60
1338 diffMin = (nint(resMin) - floor(theMinute))*60
1339 !print*, nint(resMin), floor(theMinute), timeCopy, diffMin
1340 call geth_newdate(round_resolution_minute, timeCopy, diffMin)
1341
1342 end function round_resolution_minute
1343
1344
1345
1346 end module module_date_utils_nudging