/[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.19 - (show annotations) (download)
Mon Aug 4 22:53:42 2003 UTC (20 years, 10 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint51f_pre
Changes since 1.18: +9 -4 lines
checkpoint51f_post
o Added on-the-fly spatial interpolation capability
    "USE_EXF_INTERPOLATION" to pkg/exf.
    This is a temporary Cartesian-grid hack until
    the super-duper ESMF coupler becomes available.
    Usage example is in verification/global_with_exf.
o Bug fix to pkg/ptracers, pkg/generic_advdiff/gad_calc_rhs.F,
    and pkg/kpp/kpp_transport_ptr.F for dealing with tracer
    non-local transport term.

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

  ViewVC Help
Powered by ViewVC 1.1.22