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