/[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.23 - (show annotations) (download)
Wed Jan 7 21:35:00 2004 UTC (20 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint52l_pre, hrcube4, hrcube5, checkpoint52j_pre, checkpoint52l_post, checkpoint52k_post, checkpoint52f_post, checkpoint52i_pre, hrcube_1, hrcube_2, hrcube_3, checkpoint52e_post, checkpoint52f_pre, checkpoint52i_post, checkpoint52h_pre, checkpoint52j_post
Changes since 1.22: +30 -69 lines
rewrite (as in MultiDimAdvec) explicit tracer stepping (gad_calc_rhs.F)
 to work with implicit vertical advection and AB.

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

  ViewVC Help
Powered by ViewVC 1.1.22