/[MITgcm]/MITgcm/pkg/generic_advdiff/gad_calc_rhs.F
ViewVC logotype

Annotation of /MITgcm/pkg/generic_advdiff/gad_calc_rhs.F

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


Revision 1.26 - (hide annotations) (download)
Sat Jun 26 02:38:54 2004 UTC (21 years ago) by jmc
Branch: MAIN
CVS Tags: checkpoint54d_post, checkpoint54e_post, checkpoint55, checkpoint54, checkpoint54f_post, checkpoint55c_post, checkpoint54b_post, checkpoint54a_pre, checkpoint54a_post, checkpoint55b_post, checkpoint53g_post, checkpoint55a_post, checkpoint54c_post
Changes since 1.25: +12 -11 lines
T & S: separate Vert.Advec.Scheme from horizontal Advec.Scheme

1 jmc 1.26 C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_calc_rhs.F,v 1.25 2004/06/25 18:19:20 jmc Exp $
2 jmc 1.2 C $Name: $
3 adcroft 1.1
4     #include "GAD_OPTIONS.h"
5    
6 adcroft 1.11 CBOP
7     C !ROUTINE: GAD_CALC_RHS
8    
9     C !INTERFACE: ==========================================================
10 adcroft 1.1 SUBROUTINE GAD_CALC_RHS(
11     I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown,
12 jmc 1.23 I xA,yA,uTrans,vTrans,rTrans,rTransKp1,maskUp,
13     I uVel, vVel, wVel,
14 adcroft 1.1 I diffKh, diffK4, KappaRT, Tracer,
15 jmc 1.26 I tracerIdentity, advectionScheme, vertAdvecScheme,
16 jmc 1.23 I calcAdvection, implicitAdvection,
17 adcroft 1.1 U fVerT, gTracer,
18     I myThid )
19 adcroft 1.11
20     C !DESCRIPTION:
21     C Calculates the tendancy of a tracer due to advection and diffusion.
22     C It calculates the fluxes in each direction indepentently and then
23     C sets the tendancy to the divergence of these fluxes. The advective
24     C fluxes are only calculated here when using the linear advection schemes
25     C otherwise only the diffusive and parameterized fluxes are calculated.
26     C
27     C Contributions to the flux are calculated and added:
28     C \begin{equation*}
29     C {\bf F} = {\bf F}_{adv} + {\bf F}_{diff} +{\bf F}_{GM} + {\bf F}_{KPP}
30     C \end{equation*}
31     C
32     C The tendancy is the divergence of the fluxes:
33     C \begin{equation*}
34     C G_\theta = G_\theta + \nabla \cdot {\bf F}
35     C \end{equation*}
36     C
37     C The tendancy is assumed to contain data on entry.
38    
39     C !USES: ===============================================================
40 adcroft 1.1 IMPLICIT NONE
41     #include "SIZE.h"
42     #include "EEPARAMS.h"
43     #include "PARAMS.h"
44     #include "GRID.h"
45 jmc 1.16 #include "SURFACE.h"
46 adcroft 1.1 #include "GAD.h"
47    
48 heimbach 1.13 #ifdef ALLOW_AUTODIFF_TAMC
49     #include "tamc.h"
50     #include "tamc_keys.h"
51     #endif /* ALLOW_AUTODIFF_TAMC */
52    
53 adcroft 1.11 C !INPUT PARAMETERS: ===================================================
54 edhill 1.24 C bi,bj :: tile indices
55     C iMin,iMax :: loop range for called routines
56     C jMin,jMax :: loop range for called routines
57     C kup :: index into 2 1/2D array, toggles between 1|2
58     C kdown :: index into 2 1/2D array, toggles between 2|1
59     C kp1 :: =k+1 for k<Nr, =Nr for k=Nr
60     C xA,yA :: areas of X and Y face of tracer cells
61     C uTrans,vTrans :: 2-D arrays of volume transports at U,V points
62     C rTrans :: 2-D arrays of volume transports at W points
63     C rTransKp1 :: 2-D array of volume trans at W pts, interf k+1
64     C maskUp :: 2-D array for mask at W points
65     C uVel,vVel,wVel :: 3 components of the velcity field (3-D array)
66     C diffKh :: horizontal diffusion coefficient
67     C diffK4 :: bi-harmonic diffusion coefficient
68     C KappaRT :: 3-D array for vertical diffusion coefficient
69     C Tracer :: tracer field
70     C tracerIdentity :: tracer identifier (required for KPP,GM)
71 jmc 1.26 C advectionScheme :: advection scheme to use (Horizontal plane)
72     C vertAdvecScheme :: advection scheme to use (Vertical direction)
73 edhill 1.24 C calcAdvection :: =False if Advec computed with multiDim scheme
74     C implicitAdvection:: =True if vertical Advec computed implicitly
75     C myThid :: thread number
76 adcroft 1.11 INTEGER bi,bj,iMin,iMax,jMin,jMax
77 adcroft 1.1 INTEGER k,kUp,kDown,kM1
78     _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
79     _RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
80     _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
81     _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
82     _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
83 jmc 1.23 _RL rTransKp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84 adcroft 1.1 _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
85 jmc 1.23 _RL uVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
86     _RL vVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
87     _RL wVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
88 adcroft 1.1 _RL diffKh, diffK4
89     _RL KappaRT(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
90     _RL Tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
91     INTEGER tracerIdentity
92 jmc 1.26 INTEGER advectionScheme, vertAdvecScheme
93 jmc 1.14 LOGICAL calcAdvection
94 jmc 1.23 LOGICAL implicitAdvection
95 adcroft 1.11 INTEGER myThid
96    
97     C !OUTPUT PARAMETERS: ==================================================
98 edhill 1.24 C gTracer :: tendancy array
99     C fVerT :: 2 1/2D arrays for vertical advective flux
100 adcroft 1.11 _RL gTracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
101 adcroft 1.1 _RL fVerT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
102    
103 adcroft 1.11 C !LOCAL VARIABLES: ====================================================
104 edhill 1.24 C i,j :: loop indices
105     C df4 :: used for storing del^2 T for bi-harmonic term
106     C fZon :: zonal flux
107     C fmer :: meridional flux
108     C af :: advective flux
109     C df :: diffusive flux
110     C localT :: local copy of tracer field
111 adcroft 1.1 INTEGER i,j
112     _RL df4 (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
113     _RL fZon (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
114     _RL fMer (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
115     _RL af (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
116     _RL df (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
117     _RL localT(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
118 jmc 1.23 _RL advFac, rAdvFac
119 adcroft 1.11 CEOP
120 adcroft 1.1
121     #ifdef ALLOW_AUTODIFF_TAMC
122     C-- only the kUp part of fverT is set in this subroutine
123     C-- the kDown is still required
124     fVerT(1,1,kDown) = fVerT(1,1,kDown)
125     #endif
126 heimbach 1.13
127 jmc 1.23 advFac = 0. _d 0
128     IF (calcAdvection) advFac = 1. _d 0
129     rAdvFac = rkFac*advFac
130     IF (implicitAdvection) rAdvFac = 0. _d 0
131    
132 adcroft 1.1 DO j=1-OLy,sNy+OLy
133     DO i=1-OLx,sNx+OLx
134 heimbach 1.12 fZon(i,j) = 0. _d 0
135     fMer(i,j) = 0. _d 0
136     fVerT(i,j,kUp) = 0. _d 0
137 heimbach 1.13 df(i,j) = 0. _d 0
138     df4(i,j) = 0. _d 0
139 adcroft 1.1 ENDDO
140     ENDDO
141    
142     C-- Make local copy of tracer array
143     DO j=1-OLy,sNy+OLy
144     DO i=1-OLx,sNx+OLx
145     localT(i,j)=tracer(i,j,k,bi,bj)
146     ENDDO
147     ENDDO
148    
149 adcroft 1.8 C-- Unless we have already calculated the advection terms we initialize
150     C the tendency to zero.
151 jmc 1.20 C <== now done earlier at the beginning of thermodynamics.
152     c IF (calcAdvection) THEN
153     c DO j=1-Oly,sNy+Oly
154     c DO i=1-Olx,sNx+Olx
155     c gTracer(i,j,k,bi,bj)=0. _d 0
156     c ENDDO
157     c ENDDO
158     c ENDIF
159 adcroft 1.1
160     C-- Pre-calculate del^2 T if bi-harmonic coefficient is non-zero
161     IF (diffK4 .NE. 0.) THEN
162     CALL GAD_GRAD_X(bi,bj,k,xA,localT,fZon,myThid)
163     CALL GAD_GRAD_Y(bi,bj,k,yA,localT,fMer,myThid)
164     CALL GAD_DEL2(bi,bj,k,fZon,fMer,df4,myThid)
165     ENDIF
166    
167     C-- Initialize net flux in X direction
168     DO j=1-Oly,sNy+Oly
169     DO i=1-Olx,sNx+Olx
170 heimbach 1.12 fZon(i,j) = 0. _d 0
171 adcroft 1.1 ENDDO
172     ENDDO
173    
174     C- Advective flux in X
175 jmc 1.14 IF (calcAdvection) THEN
176 adcroft 1.3 IF (advectionScheme.EQ.ENUM_CENTERED_2ND) THEN
177 adcroft 1.1 CALL GAD_C2_ADV_X(bi,bj,k,uTrans,localT,af,myThid)
178 adcroft 1.3 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
179 adcroft 1.1 CALL GAD_FLUXLIMIT_ADV_X(
180     & bi,bj,k,deltaTtracer,uTrans,uVel,localT,af,myThid)
181 adcroft 1.3 ELSEIF (advectionScheme.EQ.ENUM_UPWIND_3RD ) THEN
182 jmc 1.2 CALL GAD_U3_ADV_X(bi,bj,k,uTrans,localT,af,myThid)
183 adcroft 1.3 ELSEIF (advectionScheme.EQ.ENUM_CENTERED_4TH) THEN
184 adcroft 1.1 CALL GAD_C4_ADV_X(bi,bj,k,uTrans,localT,af,myThid)
185 adcroft 1.4 ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
186     CALL GAD_DST3_ADV_X(
187     & bi,bj,k,deltaTtracer,uTrans,uVel,localT,af,myThid)
188     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
189     CALL GAD_DST3FL_ADV_X(
190     & bi,bj,k,deltaTtracer,uTrans,uVel,localT,af,myThid)
191 adcroft 1.1 ELSE
192 adcroft 1.3 STOP 'GAD_CALC_RHS: Bad advectionScheme (X)'
193 adcroft 1.1 ENDIF
194 adcroft 1.5 DO j=1-Oly,sNy+Oly
195     DO i=1-Olx,sNx+Olx
196 adcroft 1.1 fZon(i,j) = fZon(i,j) + af(i,j)
197     ENDDO
198     ENDDO
199 adcroft 1.8 ENDIF
200 adcroft 1.1
201     C- Diffusive flux in X
202     IF (diffKh.NE.0.) THEN
203     CALL GAD_DIFF_X(bi,bj,k,xA,diffKh,localT,df,myThid)
204     ELSE
205 adcroft 1.5 DO j=1-Oly,sNy+Oly
206     DO i=1-Olx,sNx+Olx
207 heimbach 1.12 df(i,j) = 0. _d 0
208 adcroft 1.1 ENDDO
209     ENDDO
210     ENDIF
211    
212     #ifdef ALLOW_GMREDI
213     C- GM/Redi flux in X
214     IF (useGMRedi) THEN
215     C *note* should update GMREDI_XTRANSPORT to use localT and set df *aja*
216     CALL GMREDI_XTRANSPORT(
217     I iMin,iMax,jMin,jMax,bi,bj,K,
218 heimbach 1.15 I xA,Tracer,tracerIdentity,
219 adcroft 1.1 U df,
220     I myThid)
221     ENDIF
222     #endif
223 adcroft 1.5 DO j=1-Oly,sNy+Oly
224     DO i=1-Olx,sNx+Olx
225 adcroft 1.1 fZon(i,j) = fZon(i,j) + df(i,j)
226     ENDDO
227     ENDDO
228    
229     C- Bi-harmonic duffusive flux in X
230     IF (diffK4 .NE. 0.) THEN
231     CALL GAD_BIHARM_X(bi,bj,k,xA,df4,diffK4,df,myThid)
232 adcroft 1.5 DO j=1-Oly,sNy+Oly
233     DO i=1-Olx,sNx+Olx
234 adcroft 1.1 fZon(i,j) = fZon(i,j) + df(i,j)
235     ENDDO
236     ENDDO
237     ENDIF
238    
239     C-- Initialize net flux in Y direction
240     DO j=1-Oly,sNy+Oly
241     DO i=1-Olx,sNx+Olx
242 heimbach 1.12 fMer(i,j) = 0. _d 0
243 adcroft 1.1 ENDDO
244     ENDDO
245    
246     C- Advective flux in Y
247 jmc 1.14 IF (calcAdvection) THEN
248 adcroft 1.3 IF (advectionScheme.EQ.ENUM_CENTERED_2ND) THEN
249 adcroft 1.1 CALL GAD_C2_ADV_Y(bi,bj,k,vTrans,localT,af,myThid)
250 adcroft 1.3 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
251 adcroft 1.1 CALL GAD_FLUXLIMIT_ADV_Y(
252     & bi,bj,k,deltaTtracer,vTrans,vVel,localT,af,myThid)
253 adcroft 1.3 ELSEIF (advectionScheme.EQ.ENUM_UPWIND_3RD ) THEN
254 jmc 1.2 CALL GAD_U3_ADV_Y(bi,bj,k,vTrans,localT,af,myThid)
255 adcroft 1.3 ELSEIF (advectionScheme.EQ.ENUM_CENTERED_4TH) THEN
256 adcroft 1.1 CALL GAD_C4_ADV_Y(bi,bj,k,vTrans,localT,af,myThid)
257 adcroft 1.4 ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
258     CALL GAD_DST3_ADV_Y(
259     & bi,bj,k,deltaTtracer,vTrans,vVel,localT,af,myThid)
260     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
261     CALL GAD_DST3FL_ADV_Y(
262     & bi,bj,k,deltaTtracer,vTrans,vVel,localT,af,myThid)
263 adcroft 1.1 ELSE
264 adcroft 1.3 STOP 'GAD_CALC_RHS: Bad advectionScheme (Y)'
265 adcroft 1.1 ENDIF
266     DO j=1-Oly,sNy+Oly
267     DO i=1-Olx,sNx+Olx
268     fMer(i,j) = fMer(i,j) + af(i,j)
269     ENDDO
270     ENDDO
271 adcroft 1.8 ENDIF
272 adcroft 1.1
273     C- Diffusive flux in Y
274     IF (diffKh.NE.0.) THEN
275     CALL GAD_DIFF_Y(bi,bj,k,yA,diffKh,localT,df,myThid)
276     ELSE
277     DO j=1-Oly,sNy+Oly
278     DO i=1-Olx,sNx+Olx
279 heimbach 1.12 df(i,j) = 0. _d 0
280 adcroft 1.1 ENDDO
281     ENDDO
282     ENDIF
283    
284     #ifdef ALLOW_GMREDI
285     C- GM/Redi flux in Y
286     IF (useGMRedi) THEN
287 heimbach 1.7 C *note* should update GMREDI_YTRANSPORT to use localT and set df *aja*
288 adcroft 1.1 CALL GMREDI_YTRANSPORT(
289     I iMin,iMax,jMin,jMax,bi,bj,K,
290 heimbach 1.15 I yA,Tracer,tracerIdentity,
291 adcroft 1.1 U df,
292     I myThid)
293     ENDIF
294     #endif
295     DO j=1-Oly,sNy+Oly
296     DO i=1-Olx,sNx+Olx
297     fMer(i,j) = fMer(i,j) + df(i,j)
298     ENDDO
299     ENDDO
300    
301     C- Bi-harmonic flux in Y
302     IF (diffK4 .NE. 0.) THEN
303     CALL GAD_BIHARM_Y(bi,bj,k,yA,df4,diffK4,df,myThid)
304     DO j=1-Oly,sNy+Oly
305     DO i=1-Olx,sNx+Olx
306     fMer(i,j) = fMer(i,j) + df(i,j)
307     ENDDO
308     ENDDO
309     ENDIF
310    
311 jmc 1.16 C-- Compute vertical flux fVerT(kUp) at interface k (between k-1 & k):
312 adcroft 1.1 C- Advective flux in R
313 jmc 1.25 #ifdef ALLOW_AIM
314     C- a hack to prevent Water-Vapor vert.transport into the stratospheric level Nr
315     IF (calcAdvection .AND. .NOT.implicitAdvection .AND. K.GE.2 .AND.
316     & (.NOT.useAIM .OR.tracerIdentity.NE.GAD_SALINITY .OR.K.LT.Nr)
317     & ) THEN
318     #else
319 jmc 1.23 IF (calcAdvection .AND. .NOT.implicitAdvection .AND. K.GE.2) THEN
320 jmc 1.25 #endif
321 jmc 1.2 C- Compute vertical advective flux in the interior:
322 jmc 1.26 IF (vertAdvecScheme.EQ.ENUM_CENTERED_2ND) THEN
323 jmc 1.2 CALL GAD_C2_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
324 jmc 1.26 ELSEIF (vertAdvecScheme.EQ.ENUM_FLUX_LIMIT) THEN
325 jmc 1.2 CALL GAD_FLUXLIMIT_ADV_R(
326 adcroft 1.1 & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
327 jmc 1.26 ELSEIF (vertAdvecScheme.EQ.ENUM_UPWIND_3RD ) THEN
328 jmc 1.2 CALL GAD_U3_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
329 jmc 1.26 ELSEIF (vertAdvecScheme.EQ.ENUM_CENTERED_4TH) THEN
330 jmc 1.2 CALL GAD_C4_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
331 jmc 1.26 ELSEIF (vertAdvecScheme.EQ.ENUM_DST3 ) THEN
332 adcroft 1.9 CALL GAD_DST3_ADV_R(
333     & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
334 jmc 1.26 ELSEIF (vertAdvecScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
335 adcroft 1.9 CALL GAD_DST3FL_ADV_R(
336     & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
337 jmc 1.2 ELSE
338 jmc 1.26 STOP 'GAD_CALC_RHS: Bad vertAdvecScheme (R)'
339 jmc 1.2 ENDIF
340 jmc 1.23 C- add the advective flux to fVerT
341 jmc 1.2 DO j=1-Oly,sNy+Oly
342     DO i=1-Olx,sNx+Olx
343 jmc 1.23 fVerT(i,j,kUp) = fVerT(i,j,kUp) + af(i,j)
344 jmc 1.2 ENDDO
345 adcroft 1.1 ENDDO
346 adcroft 1.8 ENDIF
347 adcroft 1.1
348     C- Diffusive flux in R
349     C Note: For K=1 then KM1=1 and this gives a dT/dr = 0 upper
350     C boundary condition.
351     IF (implicitDiffusion) THEN
352 adcroft 1.5 DO j=1-Oly,sNy+Oly
353     DO i=1-Olx,sNx+Olx
354 heimbach 1.12 df(i,j) = 0. _d 0
355 adcroft 1.1 ENDDO
356     ENDDO
357     ELSE
358     CALL GAD_DIFF_R(bi,bj,k,KappaRT,tracer,df,myThid)
359     ENDIF
360    
361     #ifdef ALLOW_GMREDI
362     C- GM/Redi flux in R
363     IF (useGMRedi) THEN
364     C *note* should update GMREDI_RTRANSPORT to set df *aja*
365     CALL GMREDI_RTRANSPORT(
366     I iMin,iMax,jMin,jMax,bi,bj,K,
367 heimbach 1.15 I Tracer,tracerIdentity,
368 adcroft 1.1 U df,
369     I myThid)
370     ENDIF
371     #endif
372    
373 adcroft 1.5 DO j=1-Oly,sNy+Oly
374     DO i=1-Olx,sNx+Olx
375 adcroft 1.11 fVerT(i,j,kUp) = fVerT(i,j,kUp) + df(i,j)*maskUp(i,j)
376 adcroft 1.1 ENDDO
377     ENDDO
378    
379     #ifdef ALLOW_KPP
380     C- Add non local KPP transport term (ghat) to diffusive T flux.
381     IF (useKPP) THEN
382 adcroft 1.5 DO j=1-Oly,sNy+Oly
383     DO i=1-Olx,sNx+Olx
384 heimbach 1.12 df(i,j) = 0. _d 0
385 adcroft 1.1 ENDDO
386     ENDDO
387     IF (tracerIdentity.EQ.GAD_TEMPERATURE) THEN
388     C *note* should update KPP_TRANSPORT_T to set df *aja*
389     CALL KPP_TRANSPORT_T(
390     I iMin,iMax,jMin,jMax,bi,bj,k,km1,
391     I KappaRT,
392     U df )
393     ELSEIF (tracerIdentity.EQ.GAD_SALINITY) THEN
394     CALL KPP_TRANSPORT_S(
395     I iMin,iMax,jMin,jMax,bi,bj,k,km1,
396     I KappaRT,
397     U df )
398 mlosch 1.18 #ifdef ALLOW_PTRACERS
399 dimitri 1.22 ELSEIF (tracerIdentity .GE. GAD_TR1) THEN
400 mlosch 1.18 CALL KPP_TRANSPORT_PTR(
401     I iMin,iMax,jMin,jMax,bi,bj,k,km1,
402 dimitri 1.21 I tracerIdentity-GAD_TR1+1,KappaRT,
403 mlosch 1.18 U df )
404     #endif
405 adcroft 1.1 ELSE
406 mlosch 1.18 PRINT*,'invalid tracer indentity: ', tracerIdentity
407 adcroft 1.1 STOP 'GAD_CALC_RHS: Ooops'
408     ENDIF
409 adcroft 1.5 DO j=1-Oly,sNy+Oly
410     DO i=1-Olx,sNx+Olx
411 adcroft 1.11 fVerT(i,j,kUp) = fVerT(i,j,kUp) + df(i,j)*maskUp(i,j)
412 adcroft 1.1 ENDDO
413     ENDDO
414     ENDIF
415     #endif
416    
417     C-- Divergence of fluxes
418 adcroft 1.10 DO j=1-Oly,sNy+Oly-1
419     DO i=1-Olx,sNx+Olx-1
420 adcroft 1.8 gTracer(i,j,k,bi,bj)=gTracer(i,j,k,bi,bj)
421 jmc 1.23 & -_recip_hFacC(i,j,k,bi,bj)*recip_drF(k)*recip_rA(i,j,bi,bj)
422     & *( (fZon(i+1,j)-fZon(i,j))
423     & +(fMer(i,j+1)-fMer(i,j))
424     & +(fVerT(i,j,kUp)-fVerT(i,j,kDown))*rkFac
425     & -localT(i,j)*( (uTrans(i+1,j)-uTrans(i,j))
426     & +(vTrans(i,j+1)-vTrans(i,j))
427     & +(rTrans(i,j)-rTransKp1(i,j))*rAdvFac
428     & )*advFac
429 adcroft 1.1 & )
430     ENDDO
431     ENDDO
432    
433     RETURN
434     END

  ViewVC Help
Powered by ViewVC 1.1.22