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

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

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

Revision 1.2 - (hide annotations) (download)
Thu Oct 9 04:19:19 2003 UTC (20 years, 11 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 edhill 1.2 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 heimbach 1.1
4 edhill 1.2 #include "CAL_OPTIONS.h"
5 heimbach 1.1
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