/[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.26 - (show annotations) (download)
Sat Jun 26 02:38:54 2004 UTC (19 years, 11 months 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 C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_calc_rhs.F,v 1.25 2004/06/25 18:19:20 jmc 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, vertAdvecScheme,
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 (Horizontal plane)
72 C vertAdvecScheme :: advection scheme to use (Vertical direction)
73 C calcAdvection :: =False if Advec computed with multiDim scheme
74 C implicitAdvection:: =True if vertical Advec computed implicitly
75 C myThid :: thread number
76 INTEGER bi,bj,iMin,iMax,jMin,jMax
77 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 _RL rTransKp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84 _RS maskUp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
85 _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 _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 INTEGER advectionScheme, vertAdvecScheme
93 LOGICAL calcAdvection
94 LOGICAL implicitAdvection
95 INTEGER myThid
96
97 C !OUTPUT PARAMETERS: ==================================================
98 C gTracer :: tendancy array
99 C fVerT :: 2 1/2D arrays for vertical advective flux
100 _RL gTracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
101 _RL fVerT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
102
103 C !LOCAL VARIABLES: ====================================================
104 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 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 _RL advFac, rAdvFac
119 CEOP
120
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
127 advFac = 0. _d 0
128 IF (calcAdvection) advFac = 1. _d 0
129 rAdvFac = rkFac*advFac
130 IF (implicitAdvection) rAdvFac = 0. _d 0
131
132 DO j=1-OLy,sNy+OLy
133 DO i=1-OLx,sNx+OLx
134 fZon(i,j) = 0. _d 0
135 fMer(i,j) = 0. _d 0
136 fVerT(i,j,kUp) = 0. _d 0
137 df(i,j) = 0. _d 0
138 df4(i,j) = 0. _d 0
139 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 C-- Unless we have already calculated the advection terms we initialize
150 C the tendency to zero.
151 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
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 fZon(i,j) = 0. _d 0
171 ENDDO
172 ENDDO
173
174 C- Advective flux in X
175 IF (calcAdvection) THEN
176 IF (advectionScheme.EQ.ENUM_CENTERED_2ND) THEN
177 CALL GAD_C2_ADV_X(bi,bj,k,uTrans,localT,af,myThid)
178 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
179 CALL GAD_FLUXLIMIT_ADV_X(
180 & bi,bj,k,deltaTtracer,uTrans,uVel,localT,af,myThid)
181 ELSEIF (advectionScheme.EQ.ENUM_UPWIND_3RD ) THEN
182 CALL GAD_U3_ADV_X(bi,bj,k,uTrans,localT,af,myThid)
183 ELSEIF (advectionScheme.EQ.ENUM_CENTERED_4TH) THEN
184 CALL GAD_C4_ADV_X(bi,bj,k,uTrans,localT,af,myThid)
185 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 ELSE
192 STOP 'GAD_CALC_RHS: Bad advectionScheme (X)'
193 ENDIF
194 DO j=1-Oly,sNy+Oly
195 DO i=1-Olx,sNx+Olx
196 fZon(i,j) = fZon(i,j) + af(i,j)
197 ENDDO
198 ENDDO
199 ENDIF
200
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 DO j=1-Oly,sNy+Oly
206 DO i=1-Olx,sNx+Olx
207 df(i,j) = 0. _d 0
208 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 I xA,Tracer,tracerIdentity,
219 U df,
220 I myThid)
221 ENDIF
222 #endif
223 DO j=1-Oly,sNy+Oly
224 DO i=1-Olx,sNx+Olx
225 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 DO j=1-Oly,sNy+Oly
233 DO i=1-Olx,sNx+Olx
234 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 fMer(i,j) = 0. _d 0
243 ENDDO
244 ENDDO
245
246 C- Advective flux in Y
247 IF (calcAdvection) THEN
248 IF (advectionScheme.EQ.ENUM_CENTERED_2ND) THEN
249 CALL GAD_C2_ADV_Y(bi,bj,k,vTrans,localT,af,myThid)
250 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
251 CALL GAD_FLUXLIMIT_ADV_Y(
252 & bi,bj,k,deltaTtracer,vTrans,vVel,localT,af,myThid)
253 ELSEIF (advectionScheme.EQ.ENUM_UPWIND_3RD ) THEN
254 CALL GAD_U3_ADV_Y(bi,bj,k,vTrans,localT,af,myThid)
255 ELSEIF (advectionScheme.EQ.ENUM_CENTERED_4TH) THEN
256 CALL GAD_C4_ADV_Y(bi,bj,k,vTrans,localT,af,myThid)
257 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 ELSE
264 STOP 'GAD_CALC_RHS: Bad advectionScheme (Y)'
265 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 ENDIF
272
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 df(i,j) = 0. _d 0
280 ENDDO
281 ENDDO
282 ENDIF
283
284 #ifdef ALLOW_GMREDI
285 C- GM/Redi flux in Y
286 IF (useGMRedi) THEN
287 C *note* should update GMREDI_YTRANSPORT to use localT and set df *aja*
288 CALL GMREDI_YTRANSPORT(
289 I iMin,iMax,jMin,jMax,bi,bj,K,
290 I yA,Tracer,tracerIdentity,
291 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 C-- Compute vertical flux fVerT(kUp) at interface k (between k-1 & k):
312 C- Advective flux in R
313 #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 IF (calcAdvection .AND. .NOT.implicitAdvection .AND. K.GE.2) THEN
320 #endif
321 C- Compute vertical advective flux in the interior:
322 IF (vertAdvecScheme.EQ.ENUM_CENTERED_2ND) THEN
323 CALL GAD_C2_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
324 ELSEIF (vertAdvecScheme.EQ.ENUM_FLUX_LIMIT) THEN
325 CALL GAD_FLUXLIMIT_ADV_R(
326 & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
327 ELSEIF (vertAdvecScheme.EQ.ENUM_UPWIND_3RD ) THEN
328 CALL GAD_U3_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
329 ELSEIF (vertAdvecScheme.EQ.ENUM_CENTERED_4TH) THEN
330 CALL GAD_C4_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
331 ELSEIF (vertAdvecScheme.EQ.ENUM_DST3 ) THEN
332 CALL GAD_DST3_ADV_R(
333 & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
334 ELSEIF (vertAdvecScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
335 CALL GAD_DST3FL_ADV_R(
336 & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
337 ELSE
338 STOP 'GAD_CALC_RHS: Bad vertAdvecScheme (R)'
339 ENDIF
340 C- add the advective flux to fVerT
341 DO j=1-Oly,sNy+Oly
342 DO i=1-Olx,sNx+Olx
343 fVerT(i,j,kUp) = fVerT(i,j,kUp) + af(i,j)
344 ENDDO
345 ENDDO
346 ENDIF
347
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 DO j=1-Oly,sNy+Oly
353 DO i=1-Olx,sNx+Olx
354 df(i,j) = 0. _d 0
355 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 I Tracer,tracerIdentity,
368 U df,
369 I myThid)
370 ENDIF
371 #endif
372
373 DO j=1-Oly,sNy+Oly
374 DO i=1-Olx,sNx+Olx
375 fVerT(i,j,kUp) = fVerT(i,j,kUp) + df(i,j)*maskUp(i,j)
376 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 DO j=1-Oly,sNy+Oly
383 DO i=1-Olx,sNx+Olx
384 df(i,j) = 0. _d 0
385 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 #ifdef ALLOW_PTRACERS
399 ELSEIF (tracerIdentity .GE. GAD_TR1) THEN
400 CALL KPP_TRANSPORT_PTR(
401 I iMin,iMax,jMin,jMax,bi,bj,k,km1,
402 I tracerIdentity-GAD_TR1+1,KappaRT,
403 U df )
404 #endif
405 ELSE
406 PRINT*,'invalid tracer indentity: ', tracerIdentity
407 STOP 'GAD_CALC_RHS: Ooops'
408 ENDIF
409 DO j=1-Oly,sNy+Oly
410 DO i=1-Olx,sNx+Olx
411 fVerT(i,j,kUp) = fVerT(i,j,kUp) + df(i,j)*maskUp(i,j)
412 ENDDO
413 ENDDO
414 ENDIF
415 #endif
416
417 C-- Divergence of fluxes
418 DO j=1-Oly,sNy+Oly-1
419 DO i=1-Olx,sNx+Olx-1
420 gTracer(i,j,k,bi,bj)=gTracer(i,j,k,bi,bj)
421 & -_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 & )
430 ENDDO
431 ENDDO
432
433 RETURN
434 END

  ViewVC Help
Powered by ViewVC 1.1.22