var/da/da_util/da_advance_time.f90

   1 program da_advance_time
   2
   3    !   modified from da_advance_cymdh,
   4    !   - has accuracy down to second,
   5    !   - can use day/hour/minute/second (with/without +/- sign) to advance time,
   6    !   - can digest various input date format if it still has the right order (ie. cc yy mm dd hh nn ss)
   7    !   - can digest flexible time increment
   8    !   - can output in wrf date format (ccyy-mm-dd_hh:nn:ss)
   9    !   - can specify output date format
  10    !   - can output Julian day
  11    !   - can output Gregorian days and seconds (since year 1601)
  12    !
  13    !   eg.: da_advance_time 20070730      12             # advance 12 h
  14    !        da_advance_time 2007073012   -1d2h30m30s     # back 1 day 2 hours 30 minutes and 30 seconds
  15    !        da_advance_time 2007073012    1s-3h30m       # back 3 hours 30 minutes less 1 second
  16    !        da_advance_time 200707301200  2d1s -w        # advance 2 days and 1 second, output in wrf date format
  17    !        da_advance_time 2007-07-30_12:00:00 2d1s -w               # same as previous example
  18    !        da_advance_time 200707301200  2d1s -f ccyy-mm-dd_hh:nn:ss # same as previous example
  19    !        da_advance_time 2007073006    120 -j         # advance 120 h, and print year and Julian day
  20    !        da_advance_time 2007073006    120 -J         # advance 120 h, print year, Julian day, hour, minute and second
  21    !        da_advance_time 2007073006    0 -g           # print Gregorian day and second (since year 1601)
  22    !
  23
  24 #ifdef crayx1
  25 #define iargc ipxfargc
  26 #endif
  27
  28    implicit none
  29
  30 !  interface
  31 !     integer function iargc()
  32 !     end function iargc
  33 !  end interface
  34    integer, external :: iargc
  35
  36    integer :: ccyy, mm, dd, hh, nn, ss, dday, dh, dn, ds, gday, gsec
  37
  38    integer :: nargum, i, n
  39
  40    character(len=80), dimension(10) :: argum
  41
  42    character(len=14) :: ccyymmddhhnnss
  43
  44    character(len=80) :: out_date_format, dtime
  45
  46    integer :: datelen
  47
  48    integer, parameter :: stdout=6
  49
  50    nargum=iargc()
  51
  52    if ( nargum < 2 ) then
  53       write(unit=stdout, fmt='(a)') &
  54          'Usage:   da_advance_time ccyymmddhh[nnss] [+|-]dt[d|h|m|s] [-w|-W|-wrf|-WRF] [-f|-F date_format] [-j|-J] [-g|-G]'
  55       write(unit=stdout, fmt='(a)') &
  56          'Option:  -w|-W|-wrf|-WRF  output in wrf date format as ccyy-mm-dd_hh:nn:ss'
  57       write(unit=stdout, fmt='(a)') &
  58          '         -f|-F  specify output date format, such as ccyy-mm-dd_hh:nn:ss, or ''ccyy/mm/dd  hh:nn:ss'''
  59       write(unit=stdout, fmt='(a)') &
  60          '         -j|-J  print Julian day'
  61       write(unit=stdout, fmt='(a)') &
  62          '         -g|-G  print Gregorian days and seconds (since year 1601)'
  63       write(unit=stdout, fmt='(a)') &
  64          'Example: da_advance_time 20070730      12            # advance 12 h'
  65       write(unit=stdout, fmt='(a)') &
  66          '         da_advance_time 2007073012   -1d2h30m30s    # back 1 day 2 hours 30 min and 30 sec'
  67       write(unit=stdout, fmt='(a)') &
  68          '         da_advance_time 2007073012    1s-3h30m      # back 3 hours 30 minutes less 1 second'
  69       write(unit=stdout, fmt='(a)') &
  70          '         da_advance_time 200707301200  1d1s -w       # advance 1 day 1 sec, output in wrf date format'
  71       write(unit=stdout, fmt='(a)') &
  72          '         da_advance_time 2007-07-30_12:00:00 2d1s -w               # same as previous example'
  73       write(unit=stdout, fmt='(a)') &
  74          '         da_advance_time 200707301200  2d1s -f ccyy-mm-dd_hh:nn:ss # same as previous'
  75       write(unit=stdout, fmt='(a)') &
  76          '         da_advance_time 2007073006    120 -j         # advance 120 h, and print year and Julian day'
  77       write(unit=stdout, fmt='(a)') &
  78          '         da_advance_time 2007073006    120 -J         # advance 120 h, print year, Julian day, hour, minute and second'
  79       write(unit=stdout, fmt='(a)') &
  80          '         da_advance_time 2007073006    0 -g           # print Gregorian day and second (since year 1601)'
  81       write(unit=stdout, fmt='(a)') ''
  82       stop 'try again.'
  83    end if
  84
  85    do i=1,nargum
  86       do n=1,80
  87          argum(i)(n:n)=' '
  88       end do
  89       call getarg(i,argum(i))
  90    end do
  91
  92    ccyymmddhhnnss = parsedate(argum(1))
  93    datelen = len_trim(ccyymmddhhnnss)
  94
  95    if (datelen == 8) then
  96       read(ccyymmddhhnnss(1:10), fmt='(i4, 2i2)')  ccyy, mm, dd
  97       hh = 0
  98       nn = 0
  99       ss = 0
 100    else if (datelen == 10) then
 101       read(ccyymmddhhnnss(1:10), fmt='(i4, 3i2)')  ccyy, mm, dd, hh
 102       nn = 0
 103       ss = 0
 104    else if (datelen == 12) then
 105       read(ccyymmddhhnnss(1:12), fmt='(i4, 4i2)')  ccyy, mm, dd, hh, nn
 106       ss = 0
 107    else if (datelen == 14) then
 108       read(ccyymmddhhnnss(1:14), fmt='(i4, 5i2)')  ccyy, mm, dd, hh, nn, ss
 109    else
 110       stop 'wrong input date'
 111    endif
 112
 113    if (.not. validdate(ccyy,mm,dd,hh,nn,ss)) then
 114       stop 'Start date is not valid, or has wrong format'
 115    endif
 116
 117    i = 0
 118
 119    dtime = trim(argum(2))
 120    call parsedt(dtime,dday,dh,dn,ds)
 121
 122    hh = hh + dh
 123    nn = nn + dn
 124    ss = ss + ds
 125
 126    ! advance minute according to second
 127    do while (ss < 0)
 128       ss = ss + 60
 129       nn = nn - 1
 130    end do
 131    do while (ss > 59)
 132       ss = ss - 60
 133       nn = nn + 1
 134    end do
 135
 136    ! advance hour according to minute
 137    do while (nn < 0)
 138       nn = nn + 60
 139       hh = hh - 1
 140    end do
 141    do while (nn > 59)
 142       nn = nn - 60
 143       hh = hh + 1
 144    end do
 145
 146    ! advance day according to hour
 147    do while (hh < 0)
 148       hh = hh + 24
 149       dday = dday - 1
 150    end do
 151
 152    do while (hh > 23)
 153       hh = hh - 24
 154       dday = dday + 1
 155    end do
 156
 157    ! advance day if dday /= 0
 158    if (dday /= 0) call change_date ( ccyy, mm, dd, dday)
 159
 160    write(ccyymmddhhnnss(1:14), fmt='(i4, 5i2.2)')  ccyy, mm, dd, hh, nn, ss
 161    if ( nargum == 2 ) then
 162       if (datelen<14) then
 163          if(nn /= 0) datelen=12
 164          if(ss /= 0) datelen=14
 165       endif
 166       write(unit=stdout, fmt='(a)') ccyymmddhhnnss(1:datelen)
 167    else if ( nargum > 2 ) then
 168       i = 3
 169       do while (i <= nargum)
 170         select case ( trim(argum(i)) )
 171            case ('-w', '-W', '-wrf','-WRF')
 172               out_date_format = 'ccyy-mm-dd_hh:nn:ss'
 173               write(unit=stdout, fmt='(a)') trim(formatdate(ccyymmddhhnnss, out_date_format))
 174               i = i+1
 175            case ('-f', '-F')
 176               out_date_format = trim(argum(i+1))
 177               write(unit=stdout, fmt='(a)') trim(formatdate(ccyymmddhhnnss, out_date_format))
 178               i = i+2
 179            case ('-j')
 180               write(unit=stdout, fmt='(I4,I4)') ccyy, julian_day(ccyy,mm,dd)
 181               i = i+1
 182            case ('-J')
 183               write(unit=stdout, fmt='(I4,I4,I3,I3,I3)') ccyy, julian_day(ccyy,mm,dd),hh,nn,ss
 184               i = i+1
 185            case ('-g','-G')
 186               call gregorian_day_sec(ccyy,mm,dd,hh,nn,ss,gday,gsec)
 187               write(unit=stdout, fmt='(I8,I8)') gday, gsec
 188               i = i+1
 189            case default
 190               i = i+1
 191         end select
 192       end do
 193    end if
 194
 195 contains
 196
 197 subroutine change_date( ccyy, mm, dd, delta )
 198
 199    implicit none
 200
 201    integer, intent(inout) :: ccyy, mm, dd
 202    integer, intent(in)    :: delta
 203
 204    integer                :: dday, direction
 205
 206    dday = abs(delta)
 207    direction = sign(1,delta)
 208
 209    do while (dday > 0)
 210
 211       dd = dd + direction
 212
 213       if (dd == 0) then
 214          mm = mm - 1
 215
 216          if (mm == 0) then
 217             mm = 12
 218             ccyy = ccyy - 1
 219          end if
 220
 221          dd = getmmday(ccyy,mm)
 222
 223       elseif ( dd > getmmday(ccyy,mm)) then
 224          dd = 1
 225          mm = mm + 1
 226          if(mm > 12 ) then
 227             mm = 1
 228             ccyy = ccyy + 1
 229          end if
 230       end if
 231
 232       dday = dday - 1
 233
 234    end do
 235    return
 236 end subroutine change_date
 237
 238 #ifdef crayx1
 239
 240    subroutine getarg(i, harg)
 241       implicit none
 242       character(len=*) :: harg
 243       integer :: ierr, ilen, i
 244
 245       call pxfgetarg(i, harg, ilen, ierr)
 246       return
 247    end subroutine getarg
 248 #endif
 249
 250 function parsedate(datein)
 251    character(len=80), intent(in) :: datein
 252
 253    character(len=14) :: parsedate
 254    character(len=1 ) :: ch
 255    integer :: n, i
 256    parsedate = '00000000000000'
 257    i=0
 258    do n = 1, len_trim(datein)
 259       ch = datein(n:n)
 260       if (ch >= '0' .and. ch <= '9') then
 261          i=i+1
 262          parsedate(i:i)=ch
 263       end if
 264    end do
 265    if (parsedate(11:14) == '0000') then
 266       parsedate(11:14) = ''
 267    else if(parsedate(13:14) == '00') then
 268       parsedate(13:14) = ''
 269    end if
 270    return
 271 end function parsedate
 272
 273 subroutine parsedt(dt,dday,dh,dn,ds)
 274    character(len=80), intent(in) :: dt
 275    integer,           intent(inout) :: dday, dh, dn, ds
 276
 277    character(len=1 ) :: ch
 278    integer :: n,i,d,s,nounit
 279    ! initialize time and sign
 280    nounit=1
 281    dday=0
 282    dh=0
 283    dn=0
 284    ds=0
 285    d=0
 286    s=1
 287    do n = 1, len_trim(dt)
 288       ch = dt(n:n)
 289       select case (ch)
 290          case ('0':'9')
 291            read(ch,fmt='(i1)') i
 292            d=d*10+i
 293          case ('-')
 294            s=-1
 295          case ('+')
 296            s=1
 297          case ('d')
 298            nounit=0
 299            dday=dday+d*s
 300            d=0
 301          case ('h')
 302            nounit=0
 303            dh=dh+d*s
 304            d=0
 305          case ('n','m')
 306            nounit=0
 307            dn=dn+d*s
 308            d=0
 309          case ('s')
 310            nounit=0
 311            ds=ds+d*s
 312            d=0
 313          case ('.')
 314            stop "Decimal values not allowed"
 315          case default
 316       end select
 317    end do
 318    if (nounit==1) dh=d*s
 319 end subroutine parsedt
 320
 321 function formatdate(datein,dateform)
 322    character(len=14), intent(in) :: datein
 323    character(len=80), intent(in) :: dateform
 324    character(len=80) :: formatdate
 325    integer :: ic,iy,im,id,ih,in,is
 326    ic=index(dateform,'cc')
 327    iy=index(dateform,'yy')
 328    im=index(dateform,'mm')
 329    id=index(dateform,'dd')
 330    ih=index(dateform,'hh')
 331    in=index(dateform,'nn')
 332    is=index(dateform,'ss')
 333    formatdate=trim(dateform)
 334    if (ic /= 0) formatdate(ic:ic+1) = datein(1:2)
 335    if (iy /= 0) formatdate(iy:iy+1) = datein(3:4)
 336    if (im /= 0) formatdate(im:im+1) = datein(5:6)
 337    if (id /= 0) formatdate(id:id+1) = datein(7:8)
 338    if (ih /= 0) formatdate(ih:ih+1) = datein(9:10)
 339    if (in /= 0) formatdate(in:in+1) = datein(11:12)
 340    if (is /= 0) formatdate(is:is+1) = datein(13:14)
 341    return
 342 end function formatdate
 343
 344 function julian_day(ccyy,mm,dd)
 345    integer, intent(in) :: ccyy,mm,dd
 346    integer :: julian_day
 347    integer, parameter, dimension( 13) :: &
 348       bgn_day = (/ 0,  31,  59,  90, 120, 151, &
 349                  181, 212, 243, 273, 304, 334, 365 /), &
 350       bgn_day_ly = (/ 0,  31,  60,  91, 121, 152, &
 351                     182, 213, 244, 274, 305, 335, 366 /)
 352    if (isleapyear(ccyy)) then
 353       julian_day = bgn_day_ly(mm)+dd
 354    else
 355       julian_day = bgn_day(mm)+dd
 356    end if
 357 end function julian_day
 358
 359 function isleapyear(year)
 360    ! check if year is leapyear
 361    integer,intent(in) :: year
 362    logical :: isleapyear
 363    if( mod(year,4) .ne. 0 ) then
 364      isleapyear=.FALSE.
 365    else
 366      isleapyear=.TRUE.
 367      if ( mod(year,100) == 0 .and. mod(year,400) .ne. 0 ) isleapyear=.FALSE.
 368    endif
 369 end function isleapyear
 370
 371 subroutine gregorian_day_sec(year,month,day,hours,minutes,seconds,gday,gsec)
 372    integer, intent(in)  :: day, month, year, hours, minutes, seconds
 373    integer, intent(out) :: gday, gsec
 374
 375    integer :: ndays, m, nleapyr
 376    integer :: base_year = 1601
 377    integer :: days_per_month(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
 378
 379    if( year < base_year ) stop "Year can not be before 1601!"
 380
 381    ! compute number of leap years fully past since base_year
 382    nleapyr = (year - base_year) / 4 - (year - base_year) / 100 + (year - base_year) / 400
 383    ! Count up days in this year
 384    ndays = 0
 385    do m=1,month-1
 386       ndays = ndays + days_per_month(m)
 387       if(isleapyear(year) .and. m == 2) ndays = ndays + 1
 388    enddo
 389    gsec = seconds + 60*(minutes + 60*hours)
 390    gday = day - 1 + ndays + 365*(year - base_year - nleapyr) + 366*(nleapyr)
 391    return
 392 end subroutine gregorian_day_sec
 393
 394 function validdate(ccyy,mm,dd,hh,nn,ss)
 395    integer, intent(in) :: ccyy,mm,dd,hh,nn,ss
 396
 397    logical :: validdate
 398
 399    validdate = .true.
 400
 401    if(ss > 59 .or. ss < 0 .or. &
 402       nn > 59 .or. nn < 0 .or. &
 403       hh > 23 .or. hh < 0 .or. &
 404                    dd < 1 .or. &
 405       mm > 12 .or. mm < 1 ) validdate = .false.
 406
 407    if (mm == 2 .and. ( dd > 29 .or. &
 408                      ((.not. isleapyear(ccyy)) .and. dd > 28))) &
 409       validdate = .false.
 410 end function validdate
 411
 412 function getmmday(ccyy,mm)
 413    integer, intent(in) :: ccyy,mm
 414
 415    integer :: getmmday
 416    integer, dimension(12) :: mmday, mmday_ly
 417
 418    mmday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
 419    mmday_ly = (/31,29,31,30,31,30,31,31,30,31,30,31/)
 420
 421    if(isleapyear(ccyy)) then
 422      getmmday=mmday_ly(mm)
 423    else
 424      getmmday=mmday(mm)
 425    endif
 426
 427 end function getmmday
 428
 429 end program da_advance_time