1 subroutine da_advance_time (date_in, dtime, date_out)
3 ! HISTORY: 11/17/2008 modified and simplified from da_util/da_advance_time.f90
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
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
18 character(len=*), intent(in) :: date_in, dtime
19 character(len=14), intent(out) :: date_out
21 integer :: ccyy, mm, dd, hh, nn, ss, dday, dh, dn, ds, gday, gsec
23 character(len=14) :: ccyymmddhhnnss
26 ccyymmddhhnnss = parsedate(date_in)
27 datelen = len_trim(ccyymmddhhnnss)
29 if (datelen == 8) then
30 read(ccyymmddhhnnss(1:10), fmt='(i4, 2i2)') ccyy, mm, dd
34 else if (datelen == 10) then
35 read(ccyymmddhhnnss(1:10), fmt='(i4, 3i2)') ccyy, mm, dd, hh
38 else if (datelen == 12) then
39 read(ccyymmddhhnnss(1:12), fmt='(i4, 4i2)') ccyy, mm, dd, hh, nn
41 else if (datelen == 14) then
42 read(ccyymmddhhnnss(1:14), fmt='(i4, 5i2)') ccyy, mm, dd, hh, nn, ss
44 stop 'wrong input date'
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'
52 call parsedt(dtime,dday,dh,dn,ds)
58 ! advance minute according to second
68 ! advance hour according to minute
78 ! advance day according to hour
89 ! advance day if dday /= 0
90 if (dday /= 0) call change_date ( ccyy, mm, dd, dday)
92 write(ccyymmddhhnnss(1:14), fmt='(i4, 5i2.2)') ccyy, mm, dd, hh, nn, ss
94 ! if(nn /= 0) datelen=12
95 ! if(ss /= 0) datelen=14
97 date_out = ccyymmddhhnnss
101 subroutine change_date( ccyy, mm, dd, delta )
105 integer, intent(inout) :: ccyy, mm, dd
106 integer, intent(in) :: delta
108 integer, dimension(12) :: mmday
109 integer :: dday, direction
111 mmday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
115 if (mod(ccyy,4) == 0) then
118 if (mod(ccyy,100) == 0) then
122 if (mod(ccyy,400) == 0) then
128 direction = sign(1,delta)
143 elseif ( dd > mmday(mm)) then
156 end subroutine change_date
158 function parsedate(datein)
159 character(len=*), intent(in) :: datein
161 character(len=14) :: parsedate
162 character(len=1 ) :: ch
164 parsedate = '00000000000000'
166 do n = 1, len_trim(datein)
168 if (ch >= '0' .and. ch <= '9') then
173 if (parsedate(11:14) == '0000') then
174 parsedate(11:14) = ''
175 else if(parsedate(13:14) == '00') then
176 parsedate(13:14) = ''
179 end function parsedate
181 subroutine parsedt(dt,dday,dh,dn,ds)
182 character(len=*), intent(in) :: dt
183 integer, intent(inout) :: dday, dh, dn, ds
185 character(len=1 ) :: ch
186 integer :: n,i,d,s,nounit
187 ! initialize time and sign
195 do n = 1, len_trim(dt)
199 read(ch,fmt='(i1)') i
224 if (nounit==1) dh=d*s
225 end subroutine parsedt
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
235 if ( mod(year,100) == 0 .and. mod(year,400) .ne. 0 ) isleapyear=.FALSE.
237 end function isleapyear
239 function validdate(ccyy,mm,dd,hh,nn,ss)
240 integer, intent(in) :: ccyy,mm,dd,hh,nn,ss
246 if(ss > 59 .or. ss < 0 .or. &
247 nn > 59 .or. nn < 0 .or. &
248 hh > 23 .or. hh < 0 .or. &
250 mm > 12 .or. mm < 1 ) validdate = .false.
252 if (mm == 2 .and. ( dd > 29 .or. &
253 ((.not. isleapyear(ccyy)) .and. dd > 28))) &
255 end function validdate
257 end subroutine da_advance_time