var/da/da_tools/da_advance_time.inc

   1 subroutine da_advance_time (date_in, dtime, date_out)
   2
   3    ! HISTORY: 11/17/2008 modified and simplified from da_util/da_advance_time.f90
   4    !
   5    !   modified from da_advance_cymdh,
   6    !   - has accuracy down to second,
   7    !   - can use day/hour/minute/second (with/without +/- sign) to advance time,
   8    !   - can digest various input date format if it still has the right order (ie. cc yy mm dd hh nn ss)
   9    !   - can digest flexible time increment
  10    !
  11    !   eg.: da_advance_time 20070730      12             # advance 12 h
  12    !        da_advance_time 2007073012   -1d2h30m30s     # back 1 day 2 hours 30 minutes and 30 seconds
  13    !        da_advance_time 2007073012    1s-3h30m       # back 3 hours 30 minutes less 1 second
  14    !
  15
  16    implicit none
  17
  18    character(len=*),  intent(in)            :: date_in, dtime
  19    character(len=14), intent(out)           :: date_out
  20
  21    integer :: ccyy, mm, dd, hh, nn, ss, dday, dh, dn, ds, gday, gsec
  22    integer :: i, n
  23    character(len=14) :: ccyymmddhhnnss
  24    integer :: datelen
  25
  26    ccyymmddhhnnss = parsedate(date_in)
  27    datelen = len_trim(ccyymmddhhnnss)
  28
  29    if (datelen == 8) then
  30       read(ccyymmddhhnnss(1:10), fmt='(i4, 2i2)')  ccyy, mm, dd
  31       hh = 0
  32       nn = 0
  33       ss = 0
  34    else if (datelen == 10) then
  35       read(ccyymmddhhnnss(1:10), fmt='(i4, 3i2)')  ccyy, mm, dd, hh
  36       nn = 0
  37       ss = 0
  38    else if (datelen == 12) then
  39       read(ccyymmddhhnnss(1:12), fmt='(i4, 4i2)')  ccyy, mm, dd, hh, nn
  40       ss = 0
  41    else if (datelen == 14) then
  42       read(ccyymmddhhnnss(1:14), fmt='(i4, 5i2)')  ccyy, mm, dd, hh, nn, ss
  43    else
  44       stop 'wrong input date'
  45    endif
  46
  47    if (.not. validdate(ccyy,mm,dd,hh,nn,ss)) then
  48       write(0,*) trim(ccyymmddhhnnss)
  49       stop 'Start date is not valid, or has wrong format'
  50    endif
  51
  52    call parsedt(dtime,dday,dh,dn,ds)
  53
  54    hh = hh + dh
  55    nn = nn + dn
  56    ss = ss + ds
  57
  58    ! advance minute according to second
  59    do while (ss < 0)
  60       ss = ss + 60
  61       nn = nn - 1
  62    end do
  63    do while (ss > 59)
  64       ss = ss - 60
  65       nn = nn + 1
  66    end do
  67
  68    ! advance hour according to minute
  69    do while (nn < 0)
  70       nn = nn + 60
  71       hh = hh - 1
  72    end do
  73    do while (nn > 59)
  74       nn = nn - 60
  75       hh = hh + 1
  76    end do
  77
  78    ! advance day according to hour
  79    do while (hh < 0)
  80       hh = hh + 24
  81       dday = dday - 1
  82    end do
  83
  84    do while (hh > 23)
  85       hh = hh - 24
  86       dday = dday + 1
  87    end do
  88
  89    ! advance day if dday /= 0
  90    if (dday /= 0) call change_date ( ccyy, mm, dd, dday)
  91
  92    write(ccyymmddhhnnss(1:14), fmt='(i4, 5i2.2)')  ccyy, mm, dd, hh, nn, ss
  93    !if (datelen<14) then
  94    !   if(nn /= 0) datelen=12
  95    !   if(ss /= 0) datelen=14
  96    !endif
  97    date_out = ccyymmddhhnnss
  98
  99 contains
 100
 101 subroutine change_date( ccyy, mm, dd, delta )
 102
 103    implicit none
 104
 105    integer, intent(inout) :: ccyy, mm, dd
 106    integer, intent(in)    :: delta
 107
 108    integer, dimension(12) :: mmday
 109    integer                :: dday, direction
 110
 111    mmday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
 112
 113    mmday(2) = 28
 114
 115    if (mod(ccyy,4) == 0) then
 116       mmday(2) = 29
 117
 118       if (mod(ccyy,100) == 0) then
 119          mmday(2) = 28
 120       end if
 121
 122       if (mod(ccyy,400) == 0) then
 123          mmday(2) = 29
 124       end if
 125    end if
 126
 127    dday = abs(delta)
 128    direction = sign(1,delta)
 129
 130    do while (dday > 0)
 131
 132       dd = dd + direction
 133
 134       if (dd == 0) then
 135          mm = mm - 1
 136
 137          if (mm == 0) then
 138             mm = 12
 139             ccyy = ccyy - 1
 140          end if
 141
 142          dd = mmday(mm)
 143       elseif ( dd > mmday(mm)) then
 144          dd = 1
 145          mm = mm + 1
 146          if(mm > 12 ) then
 147             mm = 1
 148             ccyy = ccyy + 1
 149          end if
 150       end if
 151
 152       dday = dday - 1
 153
 154    end do
 155    return
 156 end subroutine change_date
 157
 158 function parsedate(datein)
 159    character(len=*), intent(in) :: datein
 160
 161    character(len=14) :: parsedate
 162    character(len=1 ) :: ch
 163    integer :: n, i
 164    parsedate = '00000000000000'
 165    i=0
 166    do n = 1, len_trim(datein)
 167       ch = datein(n:n)
 168       if (ch >= '0' .and. ch <= '9') then
 169          i=i+1
 170          parsedate(i:i)=ch
 171       end if
 172    end do
 173    if (parsedate(11:14) == '0000') then
 174       parsedate(11:14) = ''
 175    else if(parsedate(13:14) == '00') then
 176       parsedate(13:14) = ''
 177    end if
 178    return
 179 end function parsedate
 180
 181 subroutine parsedt(dt,dday,dh,dn,ds)
 182    character(len=*),  intent(in)    :: dt
 183    integer,           intent(inout) :: dday, dh, dn, ds
 184
 185    character(len=1 ) :: ch
 186    integer :: n,i,d,s,nounit
 187    ! initialize time and sign
 188    nounit=1
 189    dday=0
 190    dh=0
 191    dn=0
 192    ds=0
 193    d=0
 194    s=1
 195    do n = 1, len_trim(dt)
 196       ch = dt(n:n)
 197       select case (ch)
 198          case ('0':'9')
 199            read(ch,fmt='(i1)') i
 200            d=d*10+i
 201          case ('-')
 202            s=-1
 203          case ('+')
 204            s=1
 205          case ('d')
 206            nounit=0
 207            dday=dday+d*s
 208            d=0
 209          case ('h')
 210            nounit=0
 211            dh=dh+d*s
 212            d=0
 213          case ('n','m')
 214            nounit=0
 215            dn=dn+d*s
 216            d=0
 217          case ('s')
 218            nounit=0
 219            ds=ds+d*s
 220            d=0
 221          case default
 222       end select
 223    end do
 224    if (nounit==1) dh=d*s
 225 end subroutine parsedt
 226
 227 function isleapyear(year)
 228    ! check if year is leapyear
 229    integer,intent(in) :: year
 230    logical :: isleapyear
 231    if( mod(year,4) .ne. 0 ) then
 232      isleapyear=.FALSE.
 233    else
 234      isleapyear=.TRUE.
 235      if ( mod(year,100) == 0 .and. mod(year,400) .ne. 0 ) isleapyear=.FALSE.
 236    endif
 237 end function isleapyear
 238
 239 function validdate(ccyy,mm,dd,hh,nn,ss)
 240    integer, intent(in) :: ccyy,mm,dd,hh,nn,ss
 241
 242    logical :: validdate
 243
 244    validdate = .true.
 245
 246    if(ss > 59 .or. ss < 0 .or. &
 247       nn > 59 .or. nn < 0 .or. &
 248       hh > 23 .or. hh < 0 .or. &
 249                    dd < 1 .or. &
 250       mm > 12 .or. mm < 1 ) validdate = .false.
 251
 252    if (mm == 2 .and. ( dd > 29 .or. &
 253                      ((.not. isleapyear(ccyy)) .and. dd > 28))) &
 254       validdate = .false.
 255 end function validdate
 256
 257 end subroutine da_advance_time