1 |
C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_set.F,v 1.4 2003/10/09 04:19:19 edhill 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's parameters. --> common blocks in |
138 |
c CALENDAR.h |
139 |
modelstart = modstart |
140 |
modelend = modend |
141 |
modelstep = modstep |
142 |
modeliter0 = moditerini |
143 |
modelintsteps = modintsteps |
144 |
|
145 |
modeliterend = moditerend |
146 |
|
147 |
c Do first consistency checks (most are taken from the MITgcmUV). |
148 |
c o Time step. |
149 |
if ( modelstep .le. 0. ) then |
150 |
ierr = 102 |
151 |
call cal_PrintError( ierr, mythid ) |
152 |
stop ' stopped in cal_Set.' |
153 |
endif |
154 |
if ( modelstep .lt. 1. ) then |
155 |
ierr = 103 |
156 |
call cal_PrintError( ierr, mythid ) |
157 |
stop ' stopped in cal_Set.' |
158 |
endif |
159 |
if ( abs(modelstep - nint(modelstep)) .gt. 0.000001 ) then |
160 |
ierr = 104 |
161 |
call cal_PrintError( ierr, mythid ) |
162 |
stop ' stopped in cal_Set.' |
163 |
else |
164 |
modelstep = float(nint(modelstep)) |
165 |
endif |
166 |
|
167 |
c o Start time |
168 |
if ( modeliter0 .ne. 0 .and. modelstart .eq. 0. ) then |
169 |
modelstart = modelstep*float(modeliter0) |
170 |
endif |
171 |
c o modeliter0 |
172 |
if ( modeliter0 .eq. 0 .and. modelstart .ne. 0. ) then |
173 |
modeliter0 = int( modelstart/modelstep ) |
174 |
endif |
175 |
|
176 |
c o modelintsteps |
177 |
if ( modelintsteps .eq. 0 .and. modeliterend .ne. 0 ) |
178 |
& modelintsteps = modeliterend - modeliter0 |
179 |
if ( modelintsteps .eq. 0 .and. modelend .ne. 0. ) |
180 |
& modelintsteps = int(0.5 + (modelend - modelstart)/modelstep) |
181 |
|
182 |
c o modeliterend |
183 |
if ( modeliterend .eq. 0 .and. modelintsteps .ne. 0 ) |
184 |
& modeliterend = modeliter0 + modelintsteps |
185 |
if ( modeliterend .eq. 0 .and. modelend .ne. 0. ) |
186 |
& modeliterend = int(0.5 + modelend/modelstep) |
187 |
|
188 |
c o modelend |
189 |
if ( modelend .eq. 0. .and. modelintsteps .ne. 0 ) |
190 |
& modelend = modelstart + modelstep*float(modelintsteps) |
191 |
if ( modelend .eq. 0. .and. modeliterend .ne. 0 ) |
192 |
& modelend = modelstep*float(modeliterend) |
193 |
|
194 |
c Start setting the calendar's parameters. |
195 |
|
196 |
c The calendar type. |
197 |
if ( modcalendartype .eq. 'none') then |
198 |
usingNoCalendar = .true. |
199 |
endif |
200 |
if ( modcalendartype .eq. 'gregorian') then |
201 |
usingGregorianCalendar = .true. |
202 |
endif |
203 |
if ( modcalendartype .eq. 'model') then |
204 |
usingModelCalendar = .true. |
205 |
endif |
206 |
if ( modcalendartype .eq. 'julian') then |
207 |
usingJulianCalendar = .true. |
208 |
endif |
209 |
|
210 |
if ( usingGregorianCalendar ) then |
211 |
c The reference date for the Gregorian Calendar. |
212 |
c and its format: ( yymmdd , hhmmss , leap year, weekday ) |
213 |
c (1/2) (1 - 7) |
214 |
c The Gregorian calendar starts on Friday, 15 Oct. 1582. |
215 |
refdate(1) = 15821015 |
216 |
refdate(2) = 0 |
217 |
refdate(3) = 1 |
218 |
refdate(4) = 1 |
219 |
|
220 |
c Number of months per year and other useful numbers. |
221 |
nmonthyear = 12 |
222 |
ndaysnoleap = 365 |
223 |
ndaysleap = 366 |
224 |
nmaxdaymonth = 31 |
225 |
hoursperday = 24 |
226 |
minutesperday = 1440 |
227 |
minutesperhour = 60 |
228 |
secondsperday = 86400 |
229 |
secondsperhour = 3600 |
230 |
secondsperminute = 60 |
231 |
|
232 |
c Number of days per month. |
233 |
c The "magic" number 2773 derives from the sequence: 101010110101 |
234 |
c read in reverse and interpreted as a dual number. An |
235 |
c alternative would be to take 2741 with the loop being |
236 |
c executed in reverse order. Accidentially, the latter |
237 |
c is a prime number. |
238 |
k=2773 |
239 |
do i=1,nmonthyear |
240 |
j = mod(k,2) |
241 |
k = (k-j)/2 |
242 |
ndaymonth(i,1) = 30+j |
243 |
ndaymonth(i,2) = 30+j |
244 |
enddo |
245 |
ndaymonth(2,1) = 28 |
246 |
ndaymonth(2,2) = 29 |
247 |
|
248 |
c Week days. |
249 |
dayofweek(1) = 'FRI' |
250 |
dayofweek(2) = 'SAT' |
251 |
dayofweek(3) = 'SUN' |
252 |
dayofweek(4) = 'MON' |
253 |
dayofweek(5) = 'TUE' |
254 |
dayofweek(6) = 'WED' |
255 |
dayofweek(7) = 'THU' |
256 |
|
257 |
else if ( usingModelCalendar ) then |
258 |
c Assume a model calendar having 12 months with thirty days each. |
259 |
c Reference date is the first day of year 0 at 0am, and model |
260 |
c day 1. |
261 |
refdate(1) = 00000101 |
262 |
refdate(2) = 0 |
263 |
refdate(3) = 1 |
264 |
refdate(4) = 1 |
265 |
|
266 |
c Some useful numbers. |
267 |
nmonthyear = 12 |
268 |
ndaysnoleap = 360 |
269 |
ndaysleap = 360 |
270 |
nmaxdaymonth = 30 |
271 |
hoursperday = 24 |
272 |
minutesperday = 1440 |
273 |
minutesperhour = 60 |
274 |
secondsperday = 86400 |
275 |
secondsperhour = 3600 |
276 |
secondsperminute = 60 |
277 |
do i=1,nmonthyear |
278 |
ndaymonth(i,1) = 30 |
279 |
ndaymonth(i,2) = 30 |
280 |
enddo |
281 |
|
282 |
c Week days (Model Day 1 - 7). |
283 |
dayofweek(1) = 'MD1' |
284 |
dayofweek(2) = 'MD2' |
285 |
dayofweek(3) = 'MD3' |
286 |
dayofweek(4) = 'MD4' |
287 |
dayofweek(5) = 'MD5' |
288 |
dayofweek(6) = 'MD6' |
289 |
dayofweek(7) = 'MD7' |
290 |
|
291 |
else if ( usingJulianCalendar ) then |
292 |
|
293 |
ierr = 110 |
294 |
call cal_PrintError( ierr, mythid ) |
295 |
|
296 |
refdate(1) = -4370 |
297 |
refdate(2) = -120000 |
298 |
refdate(3) = 0 |
299 |
refdate(4) = -1 |
300 |
|
301 |
c Some useful numbers. |
302 |
nmonthyear = 12 |
303 |
ndaysnoleap = 0 |
304 |
ndaysleap = 0 |
305 |
nmaxdaymonth = 0 |
306 |
hoursperday = 24 |
307 |
minutesperday = 1440 |
308 |
minutesperhour = 60 |
309 |
secondsperday = 86400 |
310 |
secondsperhour = 3600 |
311 |
secondsperminute = 60 |
312 |
do i=1,nmonthyear |
313 |
ndaymonth(i,1) = 0 |
314 |
ndaymonth(i,2) = 0 |
315 |
enddo |
316 |
stop ' stopped in cal_Set (Julian Calendar).' |
317 |
|
318 |
else if ( usingNoCalendar ) then |
319 |
|
320 |
ierr = 111 |
321 |
call cal_PrintError( ierr, mythid ) |
322 |
|
323 |
refdate(1) = 0 |
324 |
refdate(2) = 0 |
325 |
refdate(3) = 0 |
326 |
refdate(4) = -1 |
327 |
|
328 |
c Some useful numbers. |
329 |
nmonthyear = 12 |
330 |
ndaysnoleap = 0 |
331 |
ndaysleap = 0 |
332 |
nmaxdaymonth = 0 |
333 |
hoursperday = 24 |
334 |
minutesperday = 1440 |
335 |
minutesperhour = 60 |
336 |
secondsperday = 86400 |
337 |
secondsperhour = 3600 |
338 |
secondsperminute = 60 |
339 |
do i=1,nmonthyear |
340 |
ndaymonth(i,1) = 0 |
341 |
ndaymonth(i,2) = 0 |
342 |
enddo |
343 |
|
344 |
stop ' stopped in cal_Set (No Calendar).' |
345 |
|
346 |
else |
347 |
|
348 |
ierr = 101 |
349 |
call cal_PrintError( ierr, mythid ) |
350 |
stop |
351 |
|
352 |
endif |
353 |
|
354 |
c A next set of checks of the user specifications. |
355 |
c Number of possible modelsteps per calendar day. |
356 |
modelstepsperday = cal_nStepDay(mythid) |
357 |
cdm if (modelstepsperday .eq. 0 ) then |
358 |
cdm ierr = 105 |
359 |
cdm call cal_PrintError( ierr, mythid ) |
360 |
cdm stop ' stopped in cal_Set.' |
361 |
cdm endif |
362 |
|
363 |
c Complete the start date specification to get a full date array. |
364 |
call cal_FullDate( modstartdate_1, modstartdate_2, |
365 |
& modelstartdate, mythid ) |
366 |
|
367 |
c From here on, the final calendar settings are determined by the |
368 |
c following variables: |
369 |
c |
370 |
c modelstep, modelstart, modelstartdate, and modeliter0. |
371 |
|
372 |
c Two scenarios are allowed: |
373 |
c |
374 |
c First case: modelintsteps is given as well, modelenddate is |
375 |
c set to zero. |
376 |
c Second case: modelintsteps is set to zero, modelenddate is given. |
377 |
|
378 |
if ( (modelintsteps .ne. 0) .and. |
379 |
& ( (modenddate_1 .eq. 0) .and. |
380 |
& (modenddate_2 .eq. 0) ) ) then |
381 |
|
382 |
runtimesecs = float(modelintsteps)*modelstep |
383 |
modelend = modelstart + runtimesecs |
384 |
|
385 |
else if ( (modelintsteps .eq. 0) .and. |
386 |
& (.not. ( (modenddate_1 .eq. 0 ) .and. |
387 |
& (modenddate_2 .eq. 0) ) ) ) then |
388 |
|
389 |
call cal_FullDate( modenddate_1, modenddate_2, modelenddate, |
390 |
& mythid ) |
391 |
call cal_TimePassed( modelstartdate, modelenddate, datediff, |
392 |
& mythid ) |
393 |
call cal_ToSeconds( datediff, runtimesecs, mythid ) |
394 |
|
395 |
if ( runtimesecs .lt. 0.) then |
396 |
ierr = 107 |
397 |
call cal_PrintError( ierr, mythid ) |
398 |
stop ' stopped in cal_Set.' |
399 |
endif |
400 |
|
401 |
modelintsteps = int(runtimesecs/modelstep) |
402 |
runtimesecs = modelintsteps*modelstep |
403 |
modelend = modelstart + runtimesecs |
404 |
|
405 |
else |
406 |
ierr = 106 |
407 |
call cal_PrintError( ierr, mythid ) |
408 |
stop ' stopped in cal_Set.' |
409 |
endif |
410 |
|
411 |
c Determine the startdate of the integration. |
412 |
c (version 0.1.3 >> START << ) |
413 |
iterinisecs = float(modeliter0)*modelstep |
414 |
call cal_TimeInterval( iterinisecs, 'secs', iterinitime, mythid ) |
415 |
call cal_AddTime( modelstartdate, iterinitime, modelrundate, |
416 |
& mythid ) |
417 |
call cal_CopyDate( modelrundate, modelstartdate, mythid ) |
418 |
c (version 0.1.3 >> END << ) |
419 |
|
420 |
call cal_TimeInterval( runtimesecs, 'secs', timediff, mythid ) |
421 |
call cal_AddTime( modelstartdate, timediff, modelenddate, |
422 |
& mythid ) |
423 |
|
424 |
modeliterend = modeliter0 + modelintsteps |
425 |
|
426 |
c Check consistency of the numerical model and the calendar tool. |
427 |
if ( modelstart .ne. modstart) then |
428 |
ierr = 112 |
429 |
call cal_PrintError( ierr, mythid ) |
430 |
stop ' stopped in cal_Set.' |
431 |
else if ( modelend .ne. modend ) then |
432 |
ierr = 113 |
433 |
call cal_PrintError( ierr, mythid ) |
434 |
stop ' stopped in cal_Set.' |
435 |
else if ( modelstep .ne. modstep ) then |
436 |
ierr = 114 |
437 |
call cal_PrintError( ierr, mythid ) |
438 |
stop ' stopped in cal_Set.' |
439 |
else if ( modeliter0 .ne. moditerini ) then |
440 |
ierr = 115 |
441 |
call cal_PrintError( ierr, mythid ) |
442 |
stop ' stopped in cal_Set.' |
443 |
else if ( modeliterend .ne. moditerend ) then |
444 |
ierr = 116 |
445 |
call cal_PrintError( ierr, mythid ) |
446 |
stop ' stopped in cal_Set.' |
447 |
else if ( modelintsteps .ne. modintsteps) then |
448 |
ierr = 117 |
449 |
call cal_PrintError( ierr, mythid ) |
450 |
stop ' stopped in cal_Set.' |
451 |
endif |
452 |
|
453 |
return |
454 |
end |
455 |
|