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

Contents of /MITgcm/pkg/cal/cal_getmonthsrec.F

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

Revision 1.2 - (show annotations) (download)
Thu Oct 9 04:19:19 2003 UTC (20 years, 6 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint51k_post, checkpoint62v, checkpoint57m_post, checkpoint52l_pre, checkpoint62u, hrcube4, hrcube5, checkpoint57g_pre, checkpoint62t, checkpoint57s_post, checkpoint58b_post, checkpoint57b_post, checkpoint52d_pre, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint52j_pre, checkpoint51o_pre, checkpoint54d_post, checkpoint54e_post, checkpoint62c, checkpoint51l_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint52l_post, checkpoint52k_post, checkpoint59, checkpoint58, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint53, checkpoint52, checkpoint58f_post, checkpoint52f_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, checkpoint51t_post, checkpoint58t_post, checkpoint51n_post, checkpoint55i_post, checkpoint58m_post, checkpoint57l_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51s_post, checkpoint57t_post, checkpoint55c_post, checkpoint63g, checkpoint52e_pre, checkpoint57v_post, checkpoint57f_post, checkpoint52e_post, checkpoint51n_pre, checkpoint53d_post, checkpoint60, checkpoint61, checkpoint62, checkpoint63, checkpoint57a_post, checkpoint57h_pre, checkpoint52b_pre, checkpoint54b_post, checkpoint58w_post, checkpoint57h_post, checkpoint51l_pre, checkpoint52m_post, checkpoint57y_pre, checkpoint55g_post, checkpoint51q_post, checkpoint52b_post, checkpoint52c_post, checkpoint58o_post, checkpoint57c_post, checkpoint58p_post, checkpoint58q_post, checkpoint52f_pre, checkpoint55d_post, checkpoint58e_post, checkpoint54a_pre, checkpoint63l, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint53c_post, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint55d_pre, checkpoint57c_pre, checkpoint58r_post, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint58n_post, checkpoint51r_post, checkpoint51i_post, checkpoint57e_post, checkpoint55b_post, checkpoint53a_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint55f_post, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint52d_post, checkpoint53g_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint58k_post, checkpoint52a_pre, checkpoint62b, checkpoint58v_post, checkpoint52i_post, checkpoint52h_pre, checkpoint56a_post, checkpoint58l_post, checkpoint53f_post, checkpoint57h_done, checkpoint52j_post, checkpoint57j_post, checkpoint57f_pre, checkpoint61f, checkpoint58g_post, branch-netcdf, checkpoint58x_post, checkpoint61n, checkpoint52n_post, checkpoint53b_pre, checkpoint59j, checkpoint58h_post, checkpoint56c_post, checkpoint58j_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint51o_post, checkpoint61q, checkpoint57k_post, checkpoint53b_post, checkpoint52a_post, checkpoint57w_post, checkpoint61e, checkpoint58i_post, ecco_c52_e35, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint51m_post, checkpoint53d_pre, checkpoint58s_post, checkpoint55e_post, checkpoint61g, checkpoint61d, checkpoint54c_post, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint51p_post, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint51u_post
Branch point for: branch-nonh, tg2-branch, netcdf-sm0, checkpoint51n_branch
Changes since 1.1: +3 -2 lines 
 o first check-in for the "branch-genmake2" merge
 o verification suite as run on shelley (gcc 3.2.2):

Wed Oct  8 23:42:29 EDT 2003
                T           S           U           V
G D M    c        m  s        m  s        m  s        m  s
E p a R  g  m  m  e  .  m  m  e  .  m  m  e  .  m  m  e  .
N n k u  2  i  a  a  d  i  a  a  d  i  a  a  d  i  a  a  d
2 d e n  d  n  x  n  .  n  x  n  .  n  x  n  .  n  x  n  .

OPTFILE=NONE

Y Y Y Y 13 16 16 16  0 16 16 16 16 16 16 16 16 13 12  0  0 pass  adjustment.128x64x1
Y Y Y Y 16 16 16 16  0 16 16 16 16 16 16  0  0 16 16  0  0 pass  adjustment.cs-32x32x1
Y Y Y Y 16 16 16 16  0 16 16 16 16 16 16 22  0 16 16 22  0 pass  adjust_nlfs.cs-32x32x1
Y Y Y Y -- 13 13 16 16 13 13 13 13 16 16 16 16 16 16 16 16 N/O   advect_cs
Y Y Y Y -- 22 16 16 16 16 16 16 13 16 16 16 16 16 16 16 16 N/O   advect_xy
Y Y Y Y -- 13 16 13 16 16 16 16 16 16 16 22 16 16 16 16 16 N/O   advect_xz
Y Y Y Y 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 pass  aim.5l_cs
Y Y Y Y 14 16 16 16 16 16 16 16 16 13 16 16 16 16 16 13 16 pass  aim.5l_Equatorial_Channel
Y Y Y Y 16 16 16 16 16 16 16 16 16 16 16 13 16 16 13 13 16 pass  aim.5l_LatLon
Y Y Y Y 13 16 16 16 16 16 16 16 16 16 13 12 13 13 16 13 16 pass  exp0
Y Y Y Y 14 16 16 16 16 16 16 16 22 16 16 16 13 16 16 22 16 pass  exp1
Y Y Y Y 13 13 16 13 16 16 16 16 16 13 13 16 16 13 13 13 13 pass  exp2
Y Y Y Y 16 16 16 16 16 16 16 16 22 16 16 16 16 16 16 16 16 pass  exp4
Y Y Y Y 16 16 16 16 16 16 16 16 16 16 16 22 16 16 16 22 16 pass  exp5
Y Y Y Y 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 16 pass  front_relax
Y Y Y Y 14 16 16 13 13 16 16 13 13 16 13 13 16 12 13 13 16 pass  global_ocean.90x40x15
Y Y Y Y 10 16 16 13 13 16 13 16 16 13 13 13 13 16 16 13 16 FAIL  global_ocean.cs32x15
Y Y Y Y  6 11 12 13 13 12 13 16 13  9  9  9  9 10  9  9 11 FAIL  global_ocean_pressure
Y Y Y Y 14 16 16 13 16 16 16 13 13 13 13 13 16 12 16 13 16 pass  global_with_exf
Y Y Y Y 14 16 16 16 16 16 16 16 16 11 13 22 13 16 16  9 16 pass  hs94.128x64x5
Y Y Y Y 13 16 16 16 16 16 16 16 16 11 16 16 16 13 16 22 13 pass  hs94.1x64x5
Y Y Y Y 14 16 16 16 16 16 16 16 16 13 16 13 13 16 16 22 13 pass  hs94.cs-32x32x5
Y Y Y Y 10 10 16 13 13 16 16 16 22 16 13 13 13 13 13 22 13 FAIL  ideal_2D_oce
Y Y Y Y  8 16 16 16 16 16 16 16 16 13 13  8 16 16 16 16 16 FAIL  internal_wave
Y Y Y Y 14 16 16 16 16 16 16 16 16 13 13 22 13 13 13 22 16 pass  inverted_barometer
Y Y Y Y 12 16 16 16 16 16 16 16 16 16 13 12 13 13 13 13 13 FAIL  lab_sea
Y Y Y Y 11 16 16 16 16 16 16 16 13 13 13 12 13 16 13 12 13 FAIL  natl_box
Y Y Y Y 16 16 16 16 16 16 16 16 22 16 16 16 16 16 16 16 16 pass  plume_on_slope
Y Y Y Y 13 16 16 16 16 13 16 16 16 16 16 16 16 13 16 16 16 pass  solid-body.cs-32x32x1
1 C $Header: /u/u3/gcmpack/MITgcm/pkg/cal/cal_getmonthsrec.F,v 1.1.20.2 2003/10/07 20:46:37 adcroft Exp $
2 C $Name: $
3
4 #include "CAL_OPTIONS.h"
5
6 subroutine cal_GetMonthsRec(
7 O fac, first, changed,
8 O count0, count1,
9 I mytime, myiter, mythid
10 & )
11
12 c ==================================================================
13 c SUBROUTINE cal_GetMonthsRec
14 c ==================================================================
15 c
16 c o Given the current model time or iteration number this routine
17 c returns the corrresponding months that will have to be used in
18 c order to interpolate monthly mean fields. The routine derives
19 c from *exf_GetMonthsRec* of the external forcing package.
20 c
21 c started: Christian Eckert eckert@mit.edu 21-Apr-2000
22 c - ported from the external forcing package and slightly
23 c modified (10 --> nmonthyear-2, 12 --> nmonthyear).
24 c
25 c changed: Patrick Heimbach heimbach@mit.edu 15-Jun-2000
26 c - fixed bug for count1 = nmonthyear
27 c
28 c ==================================================================
29 c SUBROUTINE cal_GetMonthsRec
30 c ==================================================================
31
32 implicit none
33
34 c == global variables ==
35
36 #include "cal.h"
37
38 c == routine arguments ==
39
40 _RL fac
41 logical first
42 logical changed
43 integer count0
44 integer count1
45 _RL mytime
46 integer myiter
47 integer mythid
48
49 c == local variables ==
50
51 integer currentdate(4)
52 integer midtime(4)
53 integer middate(4)
54 integer middate0(4)
55 integer middate1(4)
56 integer prevdate(4)
57 integer shifttime(4)
58 integer startofmonth(4)
59 integer endofmonth(4)
60 integer difftime(4)
61 integer present
62 integer previous
63 integer next
64 integer prevcount
65 integer modelsteptime(4)
66
67 _RL currentsecs
68 _RL prevsecs
69 _RL midsecs_np
70 _RL diffsecs
71 _RL midsecs
72
73 c == end of interface ==
74
75 ce --> Include a check whether the right calendar is used.
76
77 shifttime(1) = 1
78 shifttime(2) = 0
79 shifttime(3) = 0
80 shifttime(4) = -1
81
82 call cal_TimeInterval( -modelstep, 'secs', modelsteptime,
83 & mythid )
84
85 c Determine the current date and the current month.
86 call cal_GetDate( myiter, mytime, currentdate, mythid )
87
88 present = mod(currentdate(1)/100,100)
89 startofmonth(1) = (currentdate(1)/100)*100 + 1
90 startofmonth(2) = 0
91 startofmonth(3) = 0
92 startofmonth(4) = 0
93 endofmonth(1) = (currentdate(1)/100)*100 +
94 & ndaymonth(present,currentdate(3))
95 endofmonth(2) = 235959
96 endofmonth(3) = 0
97 endofmonth(4) = 0
98
99 call cal_FullDate( startofmonth(1), startofmonth(2),
100 & startofmonth, mythid )
101 call cal_FullDate( endofmonth(1), endofmonth(2),
102 & endofmonth, mythid )
103
104 c Determine middle of current month.
105 currentsecs = float(
106 & (mod(currentdate(1),100)-1)*secondsperday +
107 & currentdate(2)/10000*secondsperhour +
108 & mod(currentdate(2)/100,100)*secondsperminute +
109 & mod(currentdate(2),100)
110 & )
111 midsecs = float(ndaymonth(present,currentdate(3))*
112 & secondsperday/2)
113
114 call cal_TimeInterval( midsecs, 'secs', midtime, mythid )
115 call cal_AddTime( startofmonth, midtime, middate, mythid )
116 call cal_AddTime( currentdate, modelsteptime, prevdate, mythid )
117
118 prevsecs = float(
119 & (mod(prevdate(1),100)-1)*secondsperday +
120 & prevdate(2)/10000*secondsperhour +
121 & mod(prevdate(2)/100,100)*secondsperminute +
122 & mod(prevdate(2),100)
123 & )
124
125 c-- Set switches for reading new records.
126 first = ((mytime - modelstart) .lt. 0.5*modelstep)
127
128 if ( first ) then
129 changed = .false.
130 endif
131
132 if ( currentsecs .lt. midsecs ) then
133
134 count0 = mod(present+nmonthyear-2,nmonthyear)+1
135 prevcount = count0
136
137 shifttime(1) = -shifttime(1)
138 call cal_AddTime( startofmonth, shifttime, middate0, mythid )
139 middate0(1) = (middate0(1)/100)*100 + 1
140 middate0(2) = 0
141 middate0(3) = 0
142 middate0(4) = 0
143 call cal_FullDate( middate0(1), middate0(2), middate0,
144 & mythid )
145
146 previous = mod(middate0(1)/100,100)
147
148 midsecs_np = float(ndaymonth(previous,middate0(3))*
149 & secondsperday/2)
150
151 call cal_TimeInterval( midsecs_np, 'secs', midtime, mythid )
152 call cal_AddTime( middate0, midtime, middate0, mythid )
153
154 count1 = present
155
156 middate1(1) = middate(1)
157 middate1(2) = middate(2)
158 middate1(3) = middate(3)
159 middate1(4) = middate(4)
160
161 else
162
163 count0 = present
164
165 if ( prevsecs .lt. midsecs ) then
166 prevcount = mod(present+nmonthyear-2,nmonthyear)+1
167 else
168 prevcount = present
169 endif
170
171 middate0(1) = middate(1)
172 middate0(2) = middate(2)
173 middate0(3) = middate(3)
174 middate0(4) = middate(4)
175
176 count1 = mod(present+1,nmonthyear)
177 if ( count1 .EQ. 0 ) count1 = nmonthyear
178
179 call cal_AddTime( endofmonth, shifttime, middate1, mythid )
180 middate1(1) = (middate1(1)/100)*100 + 1
181 middate1(2) = 0
182 middate1(3) = 0
183 middate1(4) = 0
184
185 call cal_FullDate( middate1(1), middate1(2), middate1,
186 & mythid )
187 next = mod(middate1(1)/100,100)
188 midsecs_np = float(ndaymonth(next,middate1(3))*
189 & secondsperday/2)
190 call cal_TimeInterval( midsecs_np, 'secs', midtime, mythid )
191 call cal_AddTime( middate1, midtime, middate1, mythid )
192
193 endif
194
195 call cal_SubDates( middate1, middate0, difftime, mythid )
196 call cal_ToSeconds( difftime, diffsecs, mythid )
197
198 c Set counters, switches, and the linear interpolation factor.
199 if ( (.not. first) .and. (prevcount .ne. count0) ) then
200 changed = .true.
201 else
202 changed = .false.
203 endif
204
205 if ( currentsecs .lt. midsecs ) then
206 fac = (midsecs - currentsecs)/diffsecs
207 else
208 fac = (2.*midsecs + midsecs_np - currentsecs)/
209 & diffsecs
210 endif
211
212 return
213 end
214
  ViewVC Help
Powered by ViewVC 1.1.22