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