/[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.2 - (hide annotations) (download)
Thu May 30 22:49:56 2002 UTC (21 years, 11 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint47e_post, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, checkpoint50c_post, checkpoint46f_post, checkpoint48e_post, checkpoint50c_pre, checkpoint46b_post, checkpoint48i_post, checkpoint46l_pre, checkpoint51, checkpoint50, checkpoint50d_post, checkpoint50b_pre, checkpoint48b_post, checkpoint51d_post, checkpoint48c_pre, checkpoint47d_pre, checkpoint47a_post, checkpoint48d_pre, checkpoint47i_post, checkpoint47d_post, checkpoint46d_pre, checkpoint48d_post, checkpoint48f_post, checkpoint45d_post, checkpoint46j_pre, checkpoint48h_post, checkpoint51b_pre, checkpoint46a_post, checkpoint47g_post, checkpoint46j_post, checkpoint46k_post, checkpoint48a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint47j_post, branch-exfmods-tag, checkpoint46e_pre, checkpoint48c_post, checkpoint46b_pre, checkpoint51b_post, checkpoint51c_post, checkpoint46c_pre, checkpoint46, checkpoint47b_post, checkpoint46h_pre, checkpoint46m_post, checkpoint46a_pre, checkpoint50g_post, checkpoint45c_post, checkpoint46g_post, checkpoint50h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint47f_post, checkpoint50e_post, checkpoint46i_post, checkpoint46c_post, checkpoint50d_pre, checkpoint46e_post, checkpoint51e_post, checkpoint47, checkpoint48, checkpoint49, checkpoint46h_post, checkpoint51f_pre, checkpoint48g_post, checkpoint47h_post, checkpoint46d_post, checkpoint50b_post, checkpoint51a_post
Branch point for: branch-exfmods-curt
Changes since 1.1: +0 -25 lines
Modified initialisations to enable exf package for MITgcm
(without invoking ECCO_PACKAGE).

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

  ViewVC Help
Powered by ViewVC 1.1.22