/[MITgcm]/MITgcm/pkg/cal/cal_set.F
ViewVC logotype

Annotation of /MITgcm/pkg/cal/cal_set.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Mon May 14 22:07:27 2001 UTC (23 years, 1 month ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint44e_post, checkpoint44f_post, checkpoint43a-release1mods, checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, chkpt44d_post, release1_p1, release1_p2, release1_p3, checkpoint44e_pre, release1_b1, checkpoint43, release1_chkpt44d_post, checkpoint40pre2, release1-branch_tutorials, chkpt44a_post, checkpoint44h_pre, checkpoint40pre4, chkpt44c_pre, checkpoint45a_post, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, checkpoint44g_post, checkpoint45b_post, release1-branch-end, release1_final_v1, checkpoint44b_post, checkpoint44h_post, checkpoint39, ecco_c44_e22, checkpoint40pre5, chkpt44a_pre, ecco_c44_e23, ecco_c44_e20, ecco_c44_e21, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint40, checkpoint41, checkpoint44, checkpoint45, chkpt44c_post, checkpoint44f_pre, release1-branch_branchpoint
Branch point for: release1_final, release1-branch, release1, ecco-branch, release1_coupled
Added calendar package.
Not currently supported by mitgcm, i.e. disabled by default.

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    

  ViewVC Help
Powered by ViewVC 1.1.22