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

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

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

Revision 1.4 - (hide annotations) (download)
Mon Jul 26 23:24:11 2004 UTC (19 years, 11 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint57m_post, checkpoint62u, checkpoint57g_pre, checkpoint62t, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint54d_post, checkpoint54e_post, checkpoint62c, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint59, checkpoint58, checkpoint55, checkpoint57, checkpoint56, checkpoint58f_post, checkpoint57n_post, checkpoint58d_post, checkpoint62s, checkpoint58a_post, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint57z_post, checkpoint54f_post, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint58y_post, checkpoint58t_post, checkpoint55i_post, checkpoint58m_post, checkpoint57l_post, checkpoint57t_post, checkpoint55c_post, checkpoint63g, checkpoint57v_post, checkpoint57f_post, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint57a_post, checkpoint57h_pre, checkpoint58w_post, checkpoint57h_post, checkpoint57y_pre, checkpoint55g_post, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint55d_post, checkpoint58e_post, checkpoint63l, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint55h_post, checkpoint58n_post, checkpoint57e_post, checkpoint55b_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint62b, checkpoint58v_post, checkpoint56a_post, checkpoint58l_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint61f, checkpoint58g_post, checkpoint58x_post, checkpoint61n, checkpoint59j, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint61q, checkpoint57k_post, checkpoint57w_post, checkpoint61e, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post, checkpoint55e_post, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.3: +15 -11 lines 
Bug fix:
for TheCalendar='model' day count is wrong, leading
to additional shift by 5 days each year of integration
(i.e. leading to considerable offset over the years).
1 heimbach 1.4 C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_addtime.F,v 1.3 2003/10/20 06:25:16 dimitri Exp $
2     C $Name: checkpoint54 $
3 heimbach 1.1
4 edhill 1.2 #include "CAL_OPTIONS.h"
5 heimbach 1.1
6     subroutine cal_AddTime(
7     I date,
8     I interval,
9     O added,
10     I mythid
11     & )
12    
13     c ==================================================================
14     c SUBROUTINE cal_AddTime
15     c ==================================================================
16     c
17     c o Add a time interval either to a calendar date or to a time
18     c interval.
19     c
20     c started: Christian Eckert eckert@mit.edu 30-Jun-1999
21     c
22     c changed: Christian Eckert eckert@mit.edu 29-Dec-1999
23     c
24     c - restructured the original version in order to have a
25     c better interface to the MITgcmUV.
26     c
27     c Christian Eckert eckert@mit.edu 03-Feb-2000
28     c
29     c - Introduced new routine and function names, cal_<NAME>,
30     c for verion 0.1.3.
31     c
32     c ralf.giering@fastopt.de 31-May-2000
33     c datesecs was computed at wrong place (cph)
34     c
35 dimitri 1.3 c menemenlis@jpl.nasa.gov 8-Oct-2003
36     c speed-up computations for long integration interval
37     c
38 heimbach 1.1 c ==================================================================
39     c SUBROUTINE cal_AddTime
40     c ==================================================================
41    
42     implicit none
43    
44     c == global variables ==
45    
46     #include "cal.h"
47    
48     c == routine arguments ==
49    
50     integer date(4)
51     integer interval(4)
52     integer added(4)
53     integer mythid
54    
55     c == local variables ==
56    
57     integer intsecs
58     integer datesecs
59     integer nsecs
60     integer hhmmss
61     integer yi,mi,di,si,li,wi
62 dimitri 1.3 integer ndays, ndays_left, days_in_year
63 heimbach 1.1 integer date_1,date_2
64     integer intv_1,intv_2
65     integer fac
66     integer iday
67     integer switch
68     integer ndayssub
69     integer ierr
70    
71     c == external ==
72    
73     integer cal_IsLeap
74     external cal_IsLeap
75    
76     c == end of interface ==
77    
78 dimitri 1.3 if (interval(4) .ne. -1) then
79     ierr = 601
80     call cal_PrintError( ierr, mythid)
81     stop ' stopped in cal_AddTime.'
82     endif
83    
84 heimbach 1.1 date_1 = 0
85     date_2 = 0
86 dimitri 1.3 fac = 1
87 heimbach 1.1
88 dimitri 1.3 if (date(4) .eq. -1) then
89     if (date(1) .ge. 0) then
90 heimbach 1.1 date_1 = date(1)
91     date_2 = date(2)
92     intv_1 = interval(1)
93     intv_2 = interval(2)
94 dimitri 1.3 else
95 heimbach 1.1 if (interval(1) .lt. 0) then
96 dimitri 1.3 date_1 = -date(1)
97     date_2 = -date(2)
98     intv_1 = -interval(1)
99     intv_2 = -interval(2)
100     fac = -1
101 heimbach 1.1 else
102 dimitri 1.3 date_1 = interval(1)
103     date_2 = interval(2)
104     intv_1 = date(1)
105     intv_2 = date(2)
106     fac = 1
107 heimbach 1.1 endif
108 dimitri 1.3 endif
109     else
110     if (interval(1) .ge. 0) then
111 heimbach 1.1 intv_1 = interval(1)
112     intv_2 = interval(2)
113 dimitri 1.3 else
114 heimbach 1.1 intv_1 = -interval(1)
115     intv_2 = -interval(2)
116     fac = -1
117 dimitri 1.3 endif
118     endif
119 heimbach 1.1
120 dimitri 1.3 intsecs = fac*(intv_2/10000*secondsperhour +
121     & (mod(intv_2/100,100)*secondsperminute +
122     & mod(intv_2,100)))
123    
124     if (date(4) .eq. -1) then
125     datesecs = date_2/10000*secondsperhour +
126     & mod(date_2/100,100)*secondsperminute +
127     & mod(date_2,100)
128     date_1 = date_1 + intv_1
129     nsecs = datesecs + intsecs
130     if ((date_1 .gt. 0) .and.
131 heimbach 1.1 & (nsecs .lt. 0)) then
132     date_1 = date_1 - 1
133     nsecs = nsecs + secondsperday
134 dimitri 1.3 endif
135     nsecs = fac*nsecs
136     yi = 0
137     mi = 0
138     di = fac*date_1
139     li = 0
140     wi = -1
141     else
142     call cal_ConvDate( date,yi,mi,di,si,li,wi,mythid )
143     if ((interval(1) .ge. 0) .and.
144 heimbach 1.1 & (interval(2) .ge. 0)) then
145     nsecs = si + intsecs
146 dimitri 1.3 ndays = interval(1)+nsecs/secondsperday
147 heimbach 1.1 nsecs = mod(nsecs,secondsperday)
148 dimitri 1.3
149     c This used to be called by exf_getffieldrec -> cal_GetDate
150     c and was very slow for a long integration interval.
151     c do iday = 1,ndays
152     c di = di + 1
153     c if (di .gt. ndaymonth(mi,li)) then
154     c di = 1
155     c mi = mi + 1
156     c endif
157     c switch = (mi-1)/nmonthyear
158     c yi = yi + switch
159     c mi = mod(mi-1,nmonthyear)+1
160     c if (switch .eq. 1) li = cal_IsLeap( yi, mythid )
161     c enddo
162    
163 heimbach 1.4 c Set start value
164     ndays_left=ndays
165    
166 dimitri 1.3 c First take care of February 29
167 heimbach 1.4 if ( usingGregorianCalendar ) then
168     if ( mi.eq.2 .and. di.eq.29 .and. ndays_left.gt.1 ) then
169     mi = 3
170     di = 1
171     ndays_left = ndays_left - 1
172     endif
173 dimitri 1.3 endif
174    
175     c Next compute year
176 heimbach 1.4 days_in_year=ndaysnoleap
177 dimitri 1.3 if ((mi.gt.2.and.cal_IsLeap(yi+1,mythid).eq.2).or.
178     & (mi.le.2.and.cal_IsLeap(yi,mythid).eq.2) )
179 heimbach 1.4 & days_in_year=ndaysleap
180 dimitri 1.3 do while (ndays_left .ge. days_in_year)
181     ndays_left = ndays_left - days_in_year
182     yi = yi + 1
183 heimbach 1.4 days_in_year=ndaysnoleap
184 dimitri 1.3 if ((mi.gt.2.and.cal_IsLeap(yi+1,mythid).eq.2).or.
185     & (mi.le.2.and.cal_IsLeap(yi,mythid).eq.2) )
186 heimbach 1.4 & days_in_year=ndaysleap
187 heimbach 1.1 enddo
188 dimitri 1.3 li = cal_IsLeap( yi, mythid )
189    
190     c Finally compute day and month
191     do iday = 1,ndays_left
192     di = di + 1
193     if (di .gt. ndaymonth(mi,li)) then
194     di = 1
195     mi = mi + 1
196     endif
197     switch = (mi-1)/nmonthyear
198     yi = yi + switch
199     mi = mod(mi-1,nmonthyear)+1
200     if (switch .eq. 1) li = cal_IsLeap( yi, mythid )
201     enddo
202     wi = mod(wi+ndays-1,7)+1
203    
204     else
205 heimbach 1.1 nsecs = si + intsecs
206     if (nsecs .ge. 0) then
207 dimitri 1.3 ndayssub = intv_1
208 heimbach 1.1 else
209 dimitri 1.3 nsecs = nsecs + secondsperday
210     ndayssub = intv_1 + 1
211 heimbach 1.1 endif
212     do iday = 1,ndayssub
213 dimitri 1.3 di = di - 1
214     if (di .eq. 0) then
215     mi = mod(mi+10,nmonthyear)+1
216     switch = mi/nmonthyear
217     yi = yi - switch
218     if (switch .eq. 1) li = cal_IsLeap( yi, mythid )
219     di = ndaymonth(mi,li)
220     endif
221 heimbach 1.1 enddo
222     wi = mod(wi+6-mod(ndayssub,7),7)+1
223 dimitri 1.3 endif
224     endif
225 heimbach 1.1
226 dimitri 1.3 c Convert to calendar format.
227     added(1) = yi*10000 + mi*100 + di
228     hhmmss = nsecs/secondsperminute
229     added(2) = hhmmss/minutesperhour*10000 +
230     & (mod(fac*hhmmss,minutesperhour)*100 +
231     & mod(fac*nsecs,secondsperminute))*fac
232     added(3) = li
233     added(4) = wi
234 heimbach 1.1
235     return
236     end
  ViewVC Help
Powered by ViewVC 1.1.22