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

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

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


Revision 1.25 - (show annotations) (download)
Fri Jun 25 18:19:20 2004 UTC (19 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint53f_post
Changes since 1.24: +8 -1 lines
AIM specific modif: zero vertical advection of S at top interface Nr.

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

  ViewVC Help
Powered by ViewVC 1.1.22