/[MITgcm]/MITgcm/model/src/the_correction_step.F
ViewVC logotype

Contents of /MITgcm/model/src/the_correction_step.F

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

Revision 1.24 - (show annotations) (download)
Thu Oct 9 04:19:18 2003 UTC (20 years, 8 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint51k_post, checkpoint52l_pre, hrcube4, hrcube5, checkpoint52d_pre, checkpoint52j_pre, checkpoint51o_pre, checkpoint54d_post, checkpoint54e_post, checkpoint51l_post, checkpoint52k_post, checkpoint54, checkpoint53, checkpoint52, checkpoint52f_post, checkpoint51t_post, checkpoint51n_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint51s_post, checkpoint52e_pre, checkpoint52e_post, checkpoint51n_pre, checkpoint53d_post, checkpoint52b_pre, checkpoint54b_post, checkpoint51l_pre, checkpoint52m_post, checkpoint53b_post, checkpoint51q_post, checkpoint52b_post, checkpoint52h_pre, checkpoint51m_post, checkpoint52c_post, checkpoint53c_post, checkpoint54a_post, checkpoint51r_post, checkpoint51i_post, checkpoint53a_post, checkpoint52d_post, checkpoint53g_post, checkpoint52a_pre, checkpoint52i_post, checkpoint53f_post, checkpoint54a_pre, checkpoint53b_pre, checkpoint52j_post, branch-netcdf, checkpoint52l_post, checkpoint52n_post, checkpoint51o_post, checkpoint52a_post, ecco_c52_e35, checkpoint52f_pre, checkpoint53d_pre, checkpoint54c_post, checkpoint51p_post, checkpoint51u_post
Branch point for: branch-nonh, tg2-branch, netcdf-sm0, checkpoint51n_branch
Changes since 1.23: +6 -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: $
2 C $Name: $
3
4 #include "PACKAGES_CONFIG.h"
5 #include "CPP_OPTIONS.h"
6 #ifdef ALLOW_GCHEM
7 #include "GCHEM_OPTIONS.h"
8 #endif
9
10 CBOP
11 C !ROUTINE: THE_CORRECTION_STEP
12 C !INTERFACE:
13 SUBROUTINE THE_CORRECTION_STEP(myTime, myIter, myThid)
14 C !DESCRIPTION: \bv
15 C *==========================================================*
16 C | SUBROUTINE THE_CORRECTION_STEP
17 C *==========================================================*
18 C |1rst Part : Update U,V,T,S.
19 C |
20 C | The arrays used for time stepping are cycled.
21 C | Tracers:
22 C | T(n) = Gt(n)
23 C | Momentum:
24 C | V(n) = Gv(n) - dt * grad Eta
25 C |
26 C |part1: update U,V,T,S
27 C | U*,V* (contained in gU,gV) have the surface
28 C | pressure gradient term added and the result stored
29 C | in U,V (contained in uVel, vVel)
30 C | T* (contained in gT) is copied to T (theta)
31 C | S* (contained in gS) is copied to S (salt)
32 C |
33 C |part2: Adjustments & Diagnostics
34 C | o Filter U,V,T,S (Shapiro Filter, Zonal_Filter)
35 C | o Convective Adjustment
36 C | o Compute again Eta (exact volume conservation)
37 C | o Compute vertical velocity
38 C | o Diagmnostic of state variables (Time average)
39 C *==========================================================*
40 C \ev
41
42 C !USES:
43 IMPLICIT NONE
44 C == Global variables ===
45 #include "SIZE.h"
46 #include "EEPARAMS.h"
47 #include "PARAMS.h"
48 #include "DYNVARS.h"
49 #ifdef ALLOW_PASSIVE_TRACER
50 #include "TR1.h"
51 #endif
52
53 #ifdef ALLOW_SHAP_FILT
54 #include "SHAP_FILT.h"
55 #endif
56 #ifdef ALLOW_ZONAL_FILT
57 #include "ZONAL_FILT.h"
58 #endif
59
60 C !INPUT/OUTPUT PARAMETERS:
61 C == Routine arguments ==
62 C myTime - Current time in simulation
63 C myIter - Current iteration number in simulation
64 C myThid - Thread number for this instance of the routine.
65 _RL myTime
66 INTEGER myIter
67 INTEGER myThid
68
69 C !LOCAL VARIABLES:
70 C == Local variables
71 _RL phiSurfX(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
72 _RL phiSurfY(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
73 INTEGER iMin,iMax
74 INTEGER jMin,jMax
75 INTEGER bi,bj
76 INTEGER k,i,j
77
78 CEOP
79
80 DO bj=myByLo(myThid),myByHi(myThid)
81 DO bi=myBxLo(myThid),myBxHi(myThid)
82
83 C-- Set up work arrays that need valid initial values
84 DO j=1-OLy,sNy+OLy
85 DO i=1-OLx,sNx+OLx
86 phiSurfX(i,j)=0.
87 phiSurfY(i,j)=0.
88 ENDDO
89 ENDDO
90
91 C Loop range: Gradients of Eta are evaluated so valid
92 C range is all but first row and column in overlaps.
93 iMin = 1-OLx+1
94 iMax = sNx+OLx
95 jMin = 1-OLy+1
96 jMax = sNy+OLy
97
98 C- Calculate gradient of surface Potentiel
99 CALL CALC_GRAD_PHI_SURF(
100 I bi,bj,iMin,iMax,jMin,jMax,
101 I etaN,
102 O phiSurfX,phiSurfY,
103 I myThid )
104
105 C-- Loop over all layers, top to bottom
106 DO K=1,Nr
107
108 C- Update velocity fields: V(n) = V** - dt * grad Eta
109 IF (momStepping)
110 & CALL CORRECTION_STEP(
111 I bi,bj,iMin,iMax,jMin,jMax,K,
112 I phiSurfX,phiSurfY,myTime,myThid )
113
114 C- Update tracer fields: T(n) = T**, Gt(n-1) = Gt(n)
115 IF (tempStepping)
116 & CALL CYCLE_TRACER(
117 I bi,bj,iMin,iMax,jMin,jMax,K,
118 U theta,gT,gTNm1,
119 I myTime,myThid )
120 IF (saltStepping)
121 & CALL CYCLE_TRACER(
122 I bi,bj,iMin,iMax,jMin,jMax,K,
123 U salt,gS,gSNm1,
124 I myTime,myThid )
125 #ifdef ALLOW_PASSIVE_TRACER
126 ceh3 ??? should this have IF ( usePASSIVE_TRACER .AND. tr1Stepping )
127 IF (tr1Stepping)
128 & CALL CYCLE_TRACER(
129 I bi,bj,iMin,iMax,jMin,jMax,K,
130 U Tr1,gTr1,gTr1Nm1,
131 I myTime,myThid )
132 #endif
133 #ifdef ALLOW_PTRACERS
134 C- Update passive tracer fields: T(n) = T**, Gt(n-1) = Gt(n)
135 IF (usePTRACERS)
136 & CALL PTRACERS_CYCLE(bi,bj,k,myIter,myTime,myThid)
137 #endif /* ALLOW_PTRACERS */
138
139
140 #ifdef ALLOW_OBCS
141 IF (useOBCS) THEN
142 CALL OBCS_APPLY_UV(bi,bj,K,uVel,vVel,myThid)
143 ENDIF
144 #endif /* ALLOW_OBCS */
145
146 C-- End DO K=1,Nr
147 ENDDO
148
149 C-- End of 1rst bi,bj loop
150 ENDDO
151 ENDDO
152
153 C--- 2nd Part : Adjustment.
154 C
155 C Static stability is calculated and the tracers are
156 C convective adjusted where statically unstable.
157
158 C-- Filter (and exchange)
159 #ifdef ALLOW_SHAP_FILT
160 IF (useSHAP_FILT) THEN
161 IF ( .NOT.shap_filt_uvStar )
162 & CALL SHAP_FILT_APPLY_UV( uVel, vVel, myTime, myIter, myThid )
163
164 IF ( .NOT.(staggerTimeStep .AND. shap_filt_TrStagg) )
165 & CALL SHAP_FILT_APPLY_TS( theta,salt, myTime, myIter, myThid )
166 ENDIF
167 #endif
168 #ifdef ALLOW_ZONAL_FILT
169 IF (useZONAL_FILT) THEN
170 IF ( .NOT.zonal_filt_uvStar )
171 & CALL ZONAL_FILT_APPLY_UV( uVel, vVel, myThid )
172
173 IF ( .NOT.(staggerTimeStep .AND. zonal_filt_TrStagg) )
174 & CALL ZONAL_FILT_APPLY_TS( theta, salt, myThid )
175
176 ENDIF
177 #endif
178
179 DO bj=myByLo(myThid),myByHi(myThid)
180 DO bi=myBxLo(myThid),myBxHi(myThid)
181
182 C-- Convectively adjust new fields to be statically stable
183 iMin = 1
184 iMax = sNx
185 jMin = 1
186 jMax = sNy
187 CALL CONVECTIVE_ADJUSTMENT(
188 I bi, bj, iMin, iMax, jMin, jMax,
189 I myTime, myIter, myThid )
190
191 C-- Integrate continuity vertically
192 C-- for vertical velocity and "etaN" (exact volume conservation) :
193 CALL INTEGR_CONTINUITY( bi, bj, uVel, vVel,
194 I myTime, myIter, myThid )
195
196 #ifdef ALLOW_TIMEAVE
197 IF (taveFreq.GT.0.) THEN
198 CALL TIMEAVE_STATVARS(myTime, myIter, bi, bj, myThid)
199 ENDIF
200 cswdptr -- add ---
201 #ifdef ALLOW_PTRACERS
202 ceh3 this define should not be visible!
203 #ifndef PTRACERS_SEPARATE_FORCING
204 ceh3 this should have an IF ( usePTRACERS ) THEN
205 CALL PTRACERS_STATVARS(myTime, myIter, bi, bj, myThid)
206 #endif
207 #endif
208 cswdptr -- end add ---
209 #endif /* ALLOW_TIMEAVE */
210
211 C-- End of 2nd bi,bj loop
212 ENDDO
213 ENDDO
214
215 RETURN
216 END
  ViewVC Help
Powered by ViewVC 1.1.22