1 |
mlosch |
1.5 |
C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_set.F,v 1.4 2003/10/09 04:19:19 edhill Exp $ |
2 |
edhill |
1.4 |
C $Name: $ |
3 |
heimbach |
1.1 |
|
4 |
edhill |
1.4 |
#include "CAL_OPTIONS.h" |
5 |
heimbach |
1.1 |
|
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 |
mlosch |
1.5 |
refdate(1) = 00000101 |
262 |
heimbach |
1.1 |
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 |
dimitri |
1.3 |
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 |
heimbach |
1.1 |
|
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 |
|
|
|