| 37 |
michaesp |
1 |
program calcnewdate
|
|
|
2 |
C ===================
|
|
|
3 |
|
|
|
4 |
implicit none
|
|
|
5 |
|
|
|
6 |
integer date1(5),date2(5)
|
|
|
7 |
integer iargc
|
|
|
8 |
real diff
|
|
|
9 |
character*(80) arg,yychar,cdat
|
|
|
10 |
character*(2) cdate(5)
|
|
|
11 |
integer flag,nc
|
|
|
12 |
|
|
|
13 |
c check for sufficient requested arguments
|
|
|
14 |
if (iargc().ne.2) then
|
|
|
15 |
print*,'USAGE: newtime date (format (YY)YYMMDD_HH(MM)) timestep'
|
|
|
16 |
call exit(1)
|
|
|
17 |
endif
|
|
|
18 |
|
|
|
19 |
c read and transform input
|
|
|
20 |
call getarg(1,arg)
|
|
|
21 |
call lenchar(arg,nc)
|
|
|
22 |
if (nc.eq.9) then
|
|
|
23 |
yychar=''
|
|
|
24 |
read(arg(1:2),'(i2)',err=120)date1(1)
|
|
|
25 |
read(arg(3:4),'(i2)',err=120)date1(2)
|
|
|
26 |
read(arg(5:6),'(i2)',err=120)date1(3)
|
|
|
27 |
read(arg(8:9),'(i2)',err=120)date1(4)
|
|
|
28 |
date1(5)=99
|
|
|
29 |
else if (nc.eq.11) then
|
|
|
30 |
yychar=arg(1:2)
|
|
|
31 |
read(arg(3:4),'(i2)',err=120)date1(1)
|
|
|
32 |
read(arg(5:6),'(i2)',err=120)date1(2)
|
|
|
33 |
read(arg(7:8),'(i2)',err=120)date1(3)
|
|
|
34 |
read(arg(10:11),'(i2)',err=120)date1(4)
|
|
|
35 |
date1(5)=99
|
|
|
36 |
else if (nc.eq.13) then
|
|
|
37 |
yychar=arg(1:2)
|
|
|
38 |
read(arg(3:4),'(i2)',err=120)date1(1)
|
|
|
39 |
read(arg(5:6),'(i2)',err=120)date1(2)
|
|
|
40 |
read(arg(7:8),'(i2)',err=120)date1(3)
|
|
|
41 |
read(arg(10:11),'(i2)',err=120)date1(4)
|
|
|
42 |
read(arg(12:13),'(i2)',err=120)date1(5)
|
|
|
43 |
else
|
|
|
44 |
print*,'USAGE: newtime date (format (YY)YYMMDD_HH(MM)) timestep'
|
|
|
45 |
call exit(1)
|
|
|
46 |
endif
|
|
|
47 |
|
|
|
48 |
call getarg(2,arg)
|
|
|
49 |
call checkchar(arg,".",flag)
|
|
|
50 |
if (flag.eq.0) arg=trim(arg)//"."
|
|
|
51 |
read(arg,*) diff
|
|
|
52 |
|
|
|
53 |
call newdate_test(date1,diff,date2)
|
|
|
54 |
|
|
|
55 |
if ((date2(1).lt.date1(1)).and.
|
|
|
56 |
> (diff.gt.0.).and.
|
|
|
57 |
> (yychar.eq.'19')) yychar='20'
|
|
|
58 |
|
|
|
59 |
if (date2(1).lt.0) date2(1)=date2(1)+100
|
|
|
60 |
|
|
|
61 |
if ((date2(1).gt.date1(1)).and.
|
|
|
62 |
> (diff.lt.0.).and.
|
|
|
63 |
> (yychar.eq.'20')) yychar='19'
|
|
|
64 |
|
|
|
65 |
if (date2(1).lt.10) then
|
|
|
66 |
write(cdate(1),'(a,i1)')'0',date2(1)
|
|
|
67 |
else
|
|
|
68 |
write(cdate(1),'(i2)')date2(1)
|
|
|
69 |
endif
|
|
|
70 |
if (date2(2).lt.10) then
|
|
|
71 |
write(cdate(2),'(a,i1)')'0',date2(2)
|
|
|
72 |
else
|
|
|
73 |
write(cdate(2),'(i2)')date2(2)
|
|
|
74 |
endif
|
|
|
75 |
if (date2(3).lt.10) then
|
|
|
76 |
write(cdate(3),'(a,i1)')'0',date2(3)
|
|
|
77 |
else
|
|
|
78 |
write(cdate(3),'(i2)')date2(3)
|
|
|
79 |
endif
|
|
|
80 |
if (date2(4).lt.10) then
|
|
|
81 |
write(cdate(4),'(a,i1)')'0',date2(4)
|
|
|
82 |
else
|
|
|
83 |
write(cdate(4),'(i2)')date2(4)
|
|
|
84 |
endif
|
|
|
85 |
if (date1(5).eq.99) then
|
|
|
86 |
cdate(5)=''
|
|
|
87 |
else
|
|
|
88 |
if (date2(5).lt.10) then
|
|
|
89 |
write(cdate(5),'(a,i1)')'0',date2(5)
|
|
|
90 |
else
|
|
|
91 |
write(cdate(5),'(i2)')date2(5)
|
|
|
92 |
endif
|
|
|
93 |
endif
|
|
|
94 |
|
|
|
95 |
cdat=trim(yychar)//cdate(1)//cdate(2)//cdate(3)//
|
|
|
96 |
> '_'//cdate(4)//cdate(5)
|
|
|
97 |
write(*,'(a)')trim(cdat)
|
|
|
98 |
|
|
|
99 |
goto 200
|
|
|
100 |
|
|
|
101 |
120 write(*,*)
|
|
|
102 |
> "*** error: date must be in format (YY)YYMMDD_HH(MM) ***"
|
|
|
103 |
|
|
|
104 |
200 continue
|
|
|
105 |
|
|
|
106 |
end
|
|
|
107 |
|
|
|
108 |
subroutine checkchar(string,char,flag)
|
|
|
109 |
C ======================================
|
|
|
110 |
|
|
|
111 |
character*(*) string
|
|
|
112 |
character*(1) char
|
|
|
113 |
integer n,flag
|
|
|
114 |
|
|
|
115 |
flag=0
|
|
|
116 |
do n=1,len(string)
|
|
|
117 |
if (string(n:n).eq.char) then
|
|
|
118 |
flag=n
|
|
|
119 |
return
|
|
|
120 |
endif
|
|
|
121 |
enddo
|
|
|
122 |
end
|
|
|
123 |
|
|
|
124 |
subroutine lenchar(string,lstr)
|
|
|
125 |
C ===============================
|
|
|
126 |
|
|
|
127 |
character*(*) string
|
|
|
128 |
integer n,lstr
|
|
|
129 |
|
|
|
130 |
do n=1,len(string)
|
|
|
131 |
if (string(n:n).eq."") then
|
|
|
132 |
lstr=n-1
|
|
|
133 |
goto 100
|
|
|
134 |
endif
|
|
|
135 |
enddo
|
|
|
136 |
100 continue
|
|
|
137 |
end
|
|
|
138 |
|
|
|
139 |
subroutine newdate_test(date1,diff,date2)
|
|
|
140 |
C ====================================
|
|
|
141 |
C
|
|
|
142 |
C Routine calculates the new date when diff (in hours) is added to
|
|
|
143 |
C date1.
|
|
|
144 |
C date1 int input array contains a date in the form
|
|
|
145 |
C year,month,day,hour,minute
|
|
|
146 |
C diff real input timestep to go from date1; if date1(5)
|
|
|
147 |
C is equal to 99, diff is assumed to be
|
|
|
148 |
C given in hours, otherwise in minutes
|
|
|
149 |
C date2 int output array contains new date in the same form
|
|
|
150 |
|
|
|
151 |
integer date1(5),date2(5)
|
|
|
152 |
integer idays(12) ! array containing the days of the monthes
|
|
|
153 |
real diff
|
|
|
154 |
logical yearchange
|
|
|
155 |
|
|
|
156 |
data idays/31,28,31,30,31,30,31,31,30,31,30,31/
|
|
|
157 |
|
|
|
158 |
yearchange=.false.
|
|
|
159 |
|
|
|
160 |
if ((mod(date1(1),4).eq.0).and.(date1(2).le.2)) idays(2)=29
|
|
|
161 |
|
|
|
162 |
date2(1)=date1(1)
|
|
|
163 |
date2(2)=date1(2)
|
|
|
164 |
date2(3)=date1(3)
|
|
|
165 |
if (date1(5).eq.99) then
|
|
|
166 |
date2(4)=date1(4)+int(diff)
|
|
|
167 |
date2(5)=0
|
|
|
168 |
else
|
|
|
169 |
date2(4)=date1(4)
|
|
|
170 |
date2(5)=date1(5)+int(diff)
|
|
|
171 |
endif
|
|
|
172 |
|
|
|
173 |
if (date2(5).ge.60) then
|
|
|
174 |
date2(4)=date2(4)+int(date2(5)/60)
|
|
|
175 |
date2(5)=date2(5)-int(date2(5)/60)*60
|
|
|
176 |
endif
|
|
|
177 |
if (date2(5).lt.0) then
|
|
|
178 |
if (mod(date2(5),60).eq.0) then
|
|
|
179 |
date2(4)=date2(4)-int(abs(date2(5))/60)
|
|
|
180 |
date2(5)=date2(5)+int(abs(date2(5))/60)*60
|
|
|
181 |
else
|
|
|
182 |
date2(4)=date2(4)-(1+int(abs(date2(5))/60))
|
|
|
183 |
date2(5)=date2(5)+(1+int(abs(date2(5))/60))*60
|
|
|
184 |
endif
|
|
|
185 |
endif
|
|
|
186 |
|
|
|
187 |
if (date2(4).ge.24) then
|
|
|
188 |
date2(3)=date2(3)+int(date2(4)/24)
|
|
|
189 |
date2(4)=date2(4)-int(date2(4)/24)*24
|
|
|
190 |
endif
|
|
|
191 |
if (date2(4).lt.0) then
|
|
|
192 |
if (mod(date2(4),24).eq.0) then
|
|
|
193 |
date2(3)=date2(3)-int(abs(date2(4))/24)
|
|
|
194 |
date2(4)=date2(4)+int(abs(date2(4))/24)*24
|
|
|
195 |
else
|
|
|
196 |
date2(3)=date2(3)-(1+int(abs(date2(4))/24))
|
|
|
197 |
date2(4)=date2(4)+(1+int(abs(date2(4))/24))*24
|
|
|
198 |
endif
|
|
|
199 |
endif
|
|
|
200 |
|
|
|
201 |
100 if (date2(3).gt.idays(date2(2))) then
|
|
|
202 |
if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29
|
|
|
203 |
date2(3)=date2(3)-idays(date2(2))
|
|
|
204 |
if (idays(2).eq.29) idays(2)=28
|
|
|
205 |
date2(2)=date2(2)+1
|
|
|
206 |
if (date2(2).gt.12) then
|
|
|
207 |
* date2(1)=date2(1)+int(date2(2)/12)
|
|
|
208 |
* date2(2)=date2(2)-int(date2(2)/12)*12
|
|
|
209 |
date2(1)=date2(1)+1
|
|
|
210 |
date2(2)=date2(2)-12
|
|
|
211 |
endif
|
|
|
212 |
if (date2(2).lt.1) then
|
|
|
213 |
date2(1)=date2(1)-(1+int(abs(date2(2)/12)))
|
|
|
214 |
date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12
|
|
|
215 |
endif
|
|
|
216 |
goto 100
|
|
|
217 |
endif
|
|
|
218 |
200 if (date2(3).lt.1) then
|
|
|
219 |
date2(2)=date2(2)-1
|
|
|
220 |
if (date2(2).gt.12) then
|
|
|
221 |
date2(1)=date2(1)+int(date2(2)/12)
|
|
|
222 |
date2(2)=date2(2)-int(date2(2)/12)*12
|
|
|
223 |
endif
|
|
|
224 |
if (date2(2).lt.1) then
|
|
|
225 |
date2(1)=date2(1)-(1+int(abs(date2(2)/12)))
|
|
|
226 |
date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12
|
|
|
227 |
endif
|
|
|
228 |
if ((date2(2).eq.2).and.(mod(date2(1),4).eq.0)) idays(2)=29
|
|
|
229 |
date2(3)=date2(3)+idays(date2(2))
|
|
|
230 |
if (idays(2).eq.29) idays(2)=28
|
|
|
231 |
goto 200
|
|
|
232 |
endif
|
|
|
233 |
|
|
|
234 |
if (date2(2).gt.12) then
|
|
|
235 |
date2(1)=date2(1)+int(date2(2)/12)
|
|
|
236 |
date2(2)=date2(2)-int(date2(2)/12)*12
|
|
|
237 |
endif
|
|
|
238 |
if (date2(2).lt.1) then
|
|
|
239 |
date2(1)=date2(1)-(1+int(abs(date2(2)/12)))
|
|
|
240 |
date2(2)=date2(2)+(1+int(abs(date2(2)/12)))*12
|
|
|
241 |
endif
|
|
|
242 |
|
|
|
243 |
if (date2(1).lt.1000) then
|
|
|
244 |
if (date2(1).ge.100) date2(1)=date2(1)-100
|
|
|
245 |
endif
|
|
|
246 |
|
|
|
247 |
return
|
|
|
248 |
end
|