subroutine da_advance_time (date_in, dtime, date_out) 2,8
! HISTORY: 11/17/2008 modified and simplified from da_util/da_advance_time.f90
!
! modified from da_advance_cymdh,
! - has accuracy down to second,
! - can use day/hour/minute/second (with/without +/- sign) to advance time,
! - can digest various input date format if it still has the right order (ie. cc yy mm dd hh nn ss)
! - can digest flexible time increment
!
! eg.: da_advance_time 20070730 12 # advance 12 h
! da_advance_time 2007073012 -1d2h30m30s # back 1 day 2 hours 30 minutes and 30 seconds
! da_advance_time 2007073012 1s-3h30m # back 3 hours 30 minutes less 1 second
!
implicit none
character(len=*), intent(in) :: date_in, dtime
character(len=14), intent(out) :: date_out
integer :: ccyy, mm, dd, hh, nn, ss, dday, dh, dn, ds, gday, gsec
integer :: i, n
character(len=14) :: ccyymmddhhnnss
integer :: datelen
ccyymmddhhnnss = parsedate
(date_in)
datelen = len_trim(ccyymmddhhnnss)
if (datelen == 8) then
read(ccyymmddhhnnss(1:10), fmt='(i4, 2i2)') ccyy, mm, dd
hh = 0
nn = 0
ss = 0
else if (datelen == 10) then
read(ccyymmddhhnnss(1:10), fmt='(i4, 3i2)') ccyy, mm, dd, hh
nn = 0
ss = 0
else if (datelen == 12) then
read(ccyymmddhhnnss(1:12), fmt='(i4, 4i2)') ccyy, mm, dd, hh, nn
ss = 0
else if (datelen == 14) then
read(ccyymmddhhnnss(1:14), fmt='(i4, 5i2)') ccyy, mm, dd, hh, nn, ss
else
stop 'wrong input date'
endif
if (.not. validdate(ccyy,mm,dd,hh,nn,ss)) then
write(0,*) trim(ccyymmddhhnnss)
stop 'Start date is not valid, or has wrong format'
endif
call parsedt(dtime,dday,dh,dn,ds)
hh = hh + dh
nn = nn + dn
ss = ss + ds
! advance minute according to second
do while (ss < 0)
ss = ss + 60
nn = nn - 1
end do
do while (ss > 59)
ss = ss - 60
nn = nn + 1
end do
! advance hour according to minute
do while (nn < 0)
nn = nn + 60
hh = hh - 1
end do
do while (nn > 59)
nn = nn - 60
hh = hh + 1
end do
! advance day according to hour
do while (hh < 0)
hh = hh + 24
dday = dday - 1
end do
do while (hh > 23)
hh = hh - 24
dday = dday + 1
end do
! advance day if dday /= 0
if (dday /= 0) call change_date ( ccyy, mm, dd, dday)
write(ccyymmddhhnnss(1:14), fmt='(i4, 5i2.2)') ccyy, mm, dd, hh, nn, ss
!if (datelen<14) then
! if(nn /= 0) datelen=12
! if(ss /= 0) datelen=14
!endif
date_out = ccyymmddhhnnss
contains
subroutine change_date( ccyy, mm, dd, delta ) 8,1
implicit none
integer, intent(inout) :: ccyy, mm, dd
integer, intent(in) :: delta
integer, dimension(12) :: mmday
integer :: dday, direction
mmday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
mmday(2) = 28
if (mod(ccyy,4) == 0) then
mmday(2) = 29
if (mod(ccyy,100) == 0) then
mmday(2) = 28
end if
if (mod(ccyy,400) == 0) then
mmday(2) = 29
end if
end if
dday = abs(delta)
direction = sign(1,delta)
do while (dday > 0)
dd = dd + direction
if (dd == 0) then
mm = mm - 1
if (mm == 0) then
mm = 12
ccyy = ccyy - 1
end if
dd = mmday(mm)
elseif ( dd > mmday(mm)) then
dd = 1
mm = mm + 1
if(mm > 12 ) then
mm = 1
ccyy = ccyy + 1
end if
end if
dday = dday - 1
end do
return
end subroutine change_date
function parsedate(datein) 2
character(len=*), intent(in) :: datein
character(len=14) :: parsedate
character(len=1 ) :: ch
integer :: n, i
parsedate = '00000000000000'
i=0
do n = 1, len_trim(datein)
ch = datein(n:n)
if (ch >= '0' .and. ch <= '9') then
i=i+1
parsedate(i:i)=ch
end if
end do
if (parsedate(11:14) == '0000') then
parsedate(11:14) = ''
else if(parsedate(13:14) == '00') then
parsedate(13:14) = ''
end if
return
end function parsedate
subroutine parsedt(dt,dday,dh,dn,ds) 2
character(len=*), intent(in) :: dt
integer, intent(inout) :: dday, dh, dn, ds
character(len=1 ) :: ch
integer :: n,i,d,s,nounit
! initialize time and sign
nounit=1
dday=0
dh=0
dn=0
ds=0
d=0
s=1
do n = 1, len_trim(dt)
ch = dt(n:n)
select case (ch)
case ('0':'9')
read(ch,fmt='(i1)') i
d=d*10+i
case ('-')
s=-1
case ('+')
s=1
case ('d')
nounit=0
dday=dday+d*s
d=0
case ('h')
nounit=0
dh=dh+d*s
d=0
case ('n','m')
nounit=0
dn=dn+d*s
d=0
case ('s')
nounit=0
ds=ds+d*s
d=0
case default
end select
end do
if (nounit==1) dh=d*s
end subroutine parsedt
function isleapyear(year)
! check if year is leapyear
integer,intent(in) :: year
logical :: isleapyear
if( mod(year,4) .ne. 0 ) then
isleapyear=.FALSE.
else
isleapyear=.TRUE.
if ( mod(year,100) == 0 .and. mod(year,400) .ne. 0 ) isleapyear=.FALSE.
endif
end function isleapyear
function validdate(ccyy,mm,dd,hh,nn,ss)
integer, intent(in) :: ccyy,mm,dd,hh,nn,ss
logical :: validdate
validdate = .true.
if(ss > 59 .or. ss < 0 .or. &
nn > 59 .or. nn < 0 .or. &
hh > 23 .or. hh < 0 .or. &
dd < 1 .or. &
mm > 12 .or. mm < 1 ) validdate = .false.
if (mm == 2 .and. ( dd > 29 .or. &
((.not. isleapyear(ccyy)) .and. dd > 28))) &
validdate = .false.
end function validdate
end subroutine da_advance_time