1 |
|
2 |
#include "CAL_CPPOPTIONS.h" |
3 |
|
4 |
subroutine cal_Set( |
5 |
I modstart, |
6 |
I modend, |
7 |
I modstep, |
8 |
I modcalendartype, |
9 |
I modstartdate_1, |
10 |
I modstartdate_2, |
11 |
I modenddate_1, |
12 |
I modenddate_2, |
13 |
I moditerini, |
14 |
I moditerend, |
15 |
I modintsteps, |
16 |
I mythid |
17 |
& ) |
18 |
|
19 |
c ================================================================== |
20 |
c SUBROUTINE cal_Set |
21 |
c ================================================================== |
22 |
c |
23 |
c o This routine initialises the calendar according to the user |
24 |
c specifications in "data". |
25 |
c |
26 |
c Purpose: Precalculations for the calendar. |
27 |
c |
28 |
c Given the type of calendar that should be used date |
29 |
c arrays and some additional information is returned. |
30 |
c |
31 |
c Check for consistency with other specifications such |
32 |
c as modintsteps. |
33 |
c |
34 |
c started: Christian Eckert eckert@mit.edu 30-Jun-1999 |
35 |
c |
36 |
c changed: Christian Eckert eckert@mit.edu 29-Dec-1999 |
37 |
c |
38 |
c - restructured the original version in order to have a |
39 |
c better interface to the MITgcmUV. |
40 |
c |
41 |
c Christian Eckert eckert@mit.edu 19-Jan-2000 |
42 |
c |
43 |
c - Changed the role of the routine arguments. Chris Hill |
44 |
c proposed to make the calendar less "invasive". The tool |
45 |
c now assumes that the MITgcmUV already provides an ade- |
46 |
c quate set of time stepping parameters. The calendar |
47 |
c only associates a date with the given starttime of the |
48 |
c numerical model. startdate corresponds to zero start- |
49 |
c time. So, given niter0 or startdate .ne. zero the actual |
50 |
c startdate of the current integration is shifted by the |
51 |
c time interval correponding to niter0, startdate respec- |
52 |
c tively. |
53 |
c |
54 |
c Christian Eckert eckert@mit.edu 03-Feb-2000 |
55 |
c |
56 |
c - Introduced new routine and function names, cal_<NAME>, |
57 |
c for verion 0.1.3. |
58 |
c |
59 |
c Christian Eckert eckert@mit.edu 23-Feb-2000 |
60 |
c |
61 |
c - Corrected the declaration of *modelrundate* |
62 |
c --> integer modelrundate(4) |
63 |
c |
64 |
c ================================================================== |
65 |
c SUBROUTINE cal_Set |
66 |
c ================================================================== |
67 |
|
68 |
implicit none |
69 |
|
70 |
c == global variables == |
71 |
|
72 |
#include "cal.h" |
73 |
|
74 |
c == routine arguments == |
75 |
|
76 |
c modcalendartype - the type of calendar that is to be used. |
77 |
c Available: 'model' |
78 |
c 'gregorian' |
79 |
c modstartdate_1 - startdate of the integration: yyyymmdd |
80 |
c modstartdate_2 - startdate of the integration: hhmmss |
81 |
c modenddate_1 - enddate of the integration: yyyymmdd |
82 |
c modenddate_2 - enddate of the integration: hhmmss |
83 |
c moditerini - initial iteration number of the model |
84 |
c moditerend - last iteration number of the model |
85 |
c modstep - timestep of the numerical model |
86 |
c modintsteps - number of timesteps that are to be performed. |
87 |
c mythid - number of this instance of the subrotuine. |
88 |
|
89 |
_RL modstart |
90 |
_RL modend |
91 |
_RL modstep |
92 |
character*(*) modcalendartype |
93 |
integer modstartdate_1 |
94 |
integer modstartdate_2 |
95 |
integer modenddate_1 |
96 |
integer modenddate_2 |
97 |
integer moditerini |
98 |
integer moditerend |
99 |
integer modintsteps |
100 |
integer mythid |
101 |
|
102 |
c == local variables == |
103 |
|
104 |
integer i,j,k |
105 |
integer ierr |
106 |
integer datediff(4) |
107 |
integer timediff(4) |
108 |
integer iterinitime(4) |
109 |
integer modelrundate(4) |
110 |
_RL runtimesecs |
111 |
_RL iterinisecs |
112 |
|
113 |
c == external == |
114 |
|
115 |
integer cal_IntYears |
116 |
external cal_IntYears |
117 |
|
118 |
integer cal_IntMonths |
119 |
external cal_IntMonths |
120 |
|
121 |
integer cal_IntDays |
122 |
external cal_IntDays |
123 |
|
124 |
integer cal_nStepDay |
125 |
external cal_nStepDay |
126 |
|
127 |
c == end of interface == |
128 |
|
129 |
c Initialise some variables. |
130 |
usingNoCalendar = .false. |
131 |
usingGregorianCalendar = .false. |
132 |
usingModelCalendar = .false. |
133 |
usingJulianCalendar = .false. |
134 |
|
135 |
c Map the numerical model's parameters. --> common blocks in |
136 |
c CALENDAR.h |
137 |
modelstart = modstart |
138 |
modelend = modend |
139 |
modelstep = modstep |
140 |
modeliter0 = moditerini |
141 |
modelintsteps = modintsteps |
142 |
|
143 |
modeliterend = moditerend |
144 |
|
145 |
c Do first consistency checks (most are taken from the MITgcmUV). |
146 |
c o Time step. |
147 |
if ( modelstep .le. 0. ) then |
148 |
ierr = 102 |
149 |
call cal_PrintError( ierr, mythid ) |
150 |
stop ' stopped in cal_Set.' |
151 |
endif |
152 |
if ( modelstep .lt. 1. ) then |
153 |
ierr = 103 |
154 |
call cal_PrintError( ierr, mythid ) |
155 |
stop ' stopped in cal_Set.' |
156 |
endif |
157 |
if ( abs(modelstep - nint(modelstep)) .gt. 0.000001 ) then |
158 |
ierr = 104 |
159 |
call cal_PrintError( ierr, mythid ) |
160 |
stop ' stopped in cal_Set.' |
161 |
else |
162 |
modelstep = float(nint(modelstep)) |
163 |
endif |
164 |
|
165 |
c o Start time |
166 |
if ( modeliter0 .ne. 0 .and. modelstart .eq. 0. ) then |
167 |
modelstart = modelstep*float(modeliter0) |
168 |
endif |
169 |
c o modeliter0 |
170 |
if ( modeliter0 .eq. 0 .and. modelstart .ne. 0. ) then |
171 |
modeliter0 = int( modelstart/modelstep ) |
172 |
endif |
173 |
|
174 |
c o modelintsteps |
175 |
if ( modelintsteps .eq. 0 .and. modeliterend .ne. 0 ) |
176 |
& modelintsteps = modeliterend - modeliter0 |
177 |
if ( modelintsteps .eq. 0 .and. modelend .ne. 0. ) |
178 |
& modelintsteps = int(0.5 + (modelend - modelstart)/modelstep) |
179 |
|
180 |
c o modeliterend |
181 |
if ( modeliterend .eq. 0 .and. modelintsteps .ne. 0 ) |
182 |
& modeliterend = modeliter0 + modelintsteps |
183 |
if ( modeliterend .eq. 0 .and. modelend .ne. 0. ) |
184 |
& modeliterend = int(0.5 + modelend/modelstep) |
185 |
|
186 |
c o modelend |
187 |
if ( modelend .eq. 0. .and. modelintsteps .ne. 0 ) |
188 |
& modelend = modelstart + modelstep*float(modelintsteps) |
189 |
if ( modelend .eq. 0. .and. modeliterend .ne. 0 ) |
190 |
& modelend = modelstep*float(modeliterend) |
191 |
|
192 |
c Start setting the calendar's parameters. |
193 |
|
194 |
c The calendar type. |
195 |
if ( modcalendartype .eq. 'none') then |
196 |
usingNoCalendar = .true. |
197 |
endif |
198 |
if ( modcalendartype .eq. 'gregorian') then |
199 |
usingGregorianCalendar = .true. |
200 |
endif |
201 |
if ( modcalendartype .eq. 'model') then |
202 |
usingModelCalendar = .true. |
203 |
endif |
204 |
if ( modcalendartype .eq. 'julian') then |
205 |
usingJulianCalendar = .true. |
206 |
endif |
207 |
|
208 |
if ( usingGregorianCalendar ) then |
209 |
c The reference date for the Gregorian Calendar. |
210 |
c and its format: ( yymmdd , hhmmss , leap year, weekday ) |
211 |
c (1/2) (1 - 7) |
212 |
c The Gregorian calendar starts on Friday, 15 Oct. 1582. |
213 |
refdate(1) = 15821015 |
214 |
refdate(2) = 0 |
215 |
refdate(3) = 1 |
216 |
refdate(4) = 1 |
217 |
|
218 |
c Number of months per year and other useful numbers. |
219 |
nmonthyear = 12 |
220 |
ndaysnoleap = 365 |
221 |
ndaysleap = 366 |
222 |
nmaxdaymonth = 31 |
223 |
hoursperday = 24 |
224 |
minutesperday = 1440 |
225 |
minutesperhour = 60 |
226 |
secondsperday = 86400 |
227 |
secondsperhour = 3600 |
228 |
secondsperminute = 60 |
229 |
|
230 |
c Number of days per month. |
231 |
c The "magic" number 2773 derives from the sequence: 101010110101 |
232 |
c read in reverse and interpreted as a dual number. An |
233 |
c alternative would be to take 2741 with the loop being |
234 |
c executed in reverse order. Accidentially, the latter |
235 |
c is a prime number. |
236 |
k=2773 |
237 |
do i=1,nmonthyear |
238 |
j = mod(k,2) |
239 |
k = (k-j)/2 |
240 |
ndaymonth(i,1) = 30+j |
241 |
ndaymonth(i,2) = 30+j |
242 |
enddo |
243 |
ndaymonth(2,1) = 28 |
244 |
ndaymonth(2,2) = 29 |
245 |
|
246 |
c Week days. |
247 |
dayofweek(1) = 'FRI' |
248 |
dayofweek(2) = 'SAT' |
249 |
dayofweek(3) = 'SUN' |
250 |
dayofweek(4) = 'MON' |
251 |
dayofweek(5) = 'TUE' |
252 |
dayofweek(6) = 'WED' |
253 |
dayofweek(7) = 'THU' |
254 |
|
255 |
else if ( usingModelCalendar ) then |
256 |
c Assume a model calendar having 12 months with thirty days each. |
257 |
c Reference date is the first day of year 0 at 0am, and model |
258 |
c day 1. |
259 |
refdate(1) = 1 |
260 |
refdate(2) = 0 |
261 |
refdate(3) = 1 |
262 |
refdate(4) = 1 |
263 |
|
264 |
c Some useful numbers. |
265 |
nmonthyear = 12 |
266 |
ndaysnoleap = 360 |
267 |
ndaysleap = 360 |
268 |
nmaxdaymonth = 30 |
269 |
hoursperday = 24 |
270 |
minutesperday = 1440 |
271 |
minutesperhour = 60 |
272 |
secondsperday = 86400 |
273 |
secondsperhour = 3600 |
274 |
secondsperminute = 60 |
275 |
do i=1,nmonthyear |
276 |
ndaymonth(i,1) = 30 |
277 |
ndaymonth(i,2) = 30 |
278 |
enddo |
279 |
|
280 |
c Week days (Model Day 1 - 7). |
281 |
dayofweek(1) = 'MD1' |
282 |
dayofweek(2) = 'MD2' |
283 |
dayofweek(3) = 'MD3' |
284 |
dayofweek(4) = 'MD4' |
285 |
dayofweek(5) = 'MD5' |
286 |
dayofweek(6) = 'MD6' |
287 |
dayofweek(7) = 'MD7' |
288 |
|
289 |
else if ( usingJulianCalendar ) then |
290 |
|
291 |
ierr = 110 |
292 |
call cal_PrintError( ierr, mythid ) |
293 |
|
294 |
refdate(1) = -4370 |
295 |
refdate(2) = -120000 |
296 |
refdate(3) = 0 |
297 |
refdate(4) = -1 |
298 |
|
299 |
c Some useful numbers. |
300 |
nmonthyear = 12 |
301 |
ndaysnoleap = 0 |
302 |
ndaysleap = 0 |
303 |
nmaxdaymonth = 0 |
304 |
hoursperday = 24 |
305 |
minutesperday = 1440 |
306 |
minutesperhour = 60 |
307 |
secondsperday = 86400 |
308 |
secondsperhour = 3600 |
309 |
secondsperminute = 60 |
310 |
do i=1,nmonthyear |
311 |
ndaymonth(i,1) = 0 |
312 |
ndaymonth(i,2) = 0 |
313 |
enddo |
314 |
stop ' stopped in cal_Set (Julian Calendar).' |
315 |
|
316 |
else if ( usingNoCalendar ) then |
317 |
|
318 |
ierr = 111 |
319 |
call cal_PrintError( ierr, mythid ) |
320 |
|
321 |
refdate(1) = 0 |
322 |
refdate(2) = 0 |
323 |
refdate(3) = 0 |
324 |
refdate(4) = -1 |
325 |
|
326 |
c Some useful numbers. |
327 |
nmonthyear = 12 |
328 |
ndaysnoleap = 0 |
329 |
ndaysleap = 0 |
330 |
nmaxdaymonth = 0 |
331 |
hoursperday = 24 |
332 |
minutesperday = 1440 |
333 |
minutesperhour = 60 |
334 |
secondsperday = 86400 |
335 |
secondsperhour = 3600 |
336 |
secondsperminute = 60 |
337 |
do i=1,nmonthyear |
338 |
ndaymonth(i,1) = 0 |
339 |
ndaymonth(i,2) = 0 |
340 |
enddo |
341 |
|
342 |
stop ' stopped in cal_Set (No Calendar).' |
343 |
|
344 |
else |
345 |
|
346 |
ierr = 101 |
347 |
call cal_PrintError( ierr, mythid ) |
348 |
stop |
349 |
|
350 |
endif |
351 |
|
352 |
c A next set of checks of the user specifications. |
353 |
c Number of possible modelsteps per calendar day. |
354 |
modelstepsperday = cal_nStepDay(mythid) |
355 |
cdm if (modelstepsperday .eq. 0 ) then |
356 |
cdm ierr = 105 |
357 |
cdm call cal_PrintError( ierr, mythid ) |
358 |
cdm stop ' stopped in cal_Set.' |
359 |
cdm endif |
360 |
|
361 |
c Complete the start date specification to get a full date array. |
362 |
call cal_FullDate( modstartdate_1, modstartdate_2, |
363 |
& modelstartdate, mythid ) |
364 |
|
365 |
c From here on, the final calendar settings are determined by the |
366 |
c following variables: |
367 |
c |
368 |
c modelstep, modelstart, modelstartdate, and modeliter0. |
369 |
|
370 |
c Two scenarios are allowed: |
371 |
c |
372 |
c First case: modelintsteps is given as well, modelenddate is |
373 |
c set to zero. |
374 |
c Second case: modelintsteps is set to zero, modelenddate is given. |
375 |
|
376 |
if ( (modelintsteps .ne. 0) .and. |
377 |
& ( (modenddate_1 .eq. 0) .and. |
378 |
& (modenddate_2 .eq. 0) ) ) then |
379 |
|
380 |
runtimesecs = float(modelintsteps)*modelstep |
381 |
modelend = modelstart + runtimesecs |
382 |
|
383 |
else if ( (modelintsteps .eq. 0) .and. |
384 |
& (.not. ( (modenddate_1 .eq. 0 ) .and. |
385 |
& (modenddate_2 .eq. 0) ) ) ) then |
386 |
|
387 |
call cal_FullDate( modenddate_1, modenddate_2, modelenddate, |
388 |
& mythid ) |
389 |
call cal_TimePassed( modelstartdate, modelenddate, datediff, |
390 |
& mythid ) |
391 |
call cal_ToSeconds( datediff, runtimesecs, mythid ) |
392 |
|
393 |
if ( runtimesecs .lt. 0.) then |
394 |
ierr = 107 |
395 |
call cal_PrintError( ierr, mythid ) |
396 |
stop ' stopped in cal_Set.' |
397 |
endif |
398 |
|
399 |
modelintsteps = int(runtimesecs/modelstep) |
400 |
runtimesecs = modelintsteps*modelstep |
401 |
modelend = modelstart + runtimesecs |
402 |
|
403 |
else |
404 |
ierr = 106 |
405 |
call cal_PrintError( ierr, mythid ) |
406 |
stop ' stopped in cal_Set.' |
407 |
endif |
408 |
|
409 |
c Determine the startdate of the integration. |
410 |
c (version 0.1.3 >> START << ) |
411 |
iterinisecs = float(modeliter0)*modelstep |
412 |
call cal_TimeInterval( iterinisecs, 'secs', iterinitime, mythid ) |
413 |
call cal_AddTime( modelstartdate, iterinitime, modelrundate, |
414 |
& mythid ) |
415 |
call cal_CopyDate( modelrundate, modelstartdate, mythid ) |
416 |
c (version 0.1.3 >> END << ) |
417 |
|
418 |
call cal_TimeInterval( runtimesecs, 'secs', timediff, mythid ) |
419 |
call cal_AddTime( modelstartdate, timediff, modelenddate, |
420 |
& mythid ) |
421 |
|
422 |
modeliterend = modeliter0 + modelintsteps |
423 |
|
424 |
c Check consistency of the numerical model and the calendar tool. |
425 |
if ( modelstart .ne. modstart) then |
426 |
ierr = 112 |
427 |
call cal_PrintError( ierr, mythid ) |
428 |
stop ' stopped in cal_Set.' |
429 |
else if ( modelend .ne. modend ) then |
430 |
ierr = 113 |
431 |
call cal_PrintError( ierr, mythid ) |
432 |
stop ' stopped in cal_Set.' |
433 |
else if ( modelstep .ne. modstep ) then |
434 |
ierr = 114 |
435 |
call cal_PrintError( ierr, mythid ) |
436 |
stop ' stopped in cal_Set.' |
437 |
else if ( modeliter0 .ne. moditerini ) then |
438 |
ierr = 115 |
439 |
call cal_PrintError( ierr, mythid ) |
440 |
stop ' stopped in cal_Set.' |
441 |
else if ( modeliterend .ne. moditerend ) then |
442 |
ierr = 116 |
443 |
call cal_PrintError( ierr, mythid ) |
444 |
stop ' stopped in cal_Set.' |
445 |
else if ( modelintsteps .ne. modintsteps) then |
446 |
ierr = 117 |
447 |
call cal_PrintError( ierr, mythid ) |
448 |
stop ' stopped in cal_Set.' |
449 |
endif |
450 |
|
451 |
return |
452 |
end |
453 |
|