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