/[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.24 - (show annotations) (download)
Mon Mar 29 03:33:51 2004 UTC (20 years, 2 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint53, checkpoint53d_post, checkpoint52m_post, checkpoint53c_post, checkpoint53a_post, checkpoint52n_post, checkpoint53b_pre, checkpoint53b_post, checkpoint53d_pre
Changes since 1.23: +31 -29 lines
 o new "poster children" for the API reference:
   - generic_advdiff
   - mnc

1 C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_calc_rhs.F,v 1.23 2004/01/07 21:35:00 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,
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 IF (calcAdvection .AND. .NOT.implicitAdvection .AND. K.GE.2) THEN
313 C- Compute vertical advective flux in the interior:
314 IF (advectionScheme.EQ.ENUM_CENTERED_2ND) THEN
315 CALL GAD_C2_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
316 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
317 CALL GAD_FLUXLIMIT_ADV_R(
318 & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
319 ELSEIF (advectionScheme.EQ.ENUM_UPWIND_3RD ) THEN
320 CALL GAD_U3_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
321 ELSEIF (advectionScheme.EQ.ENUM_CENTERED_4TH) THEN
322 CALL GAD_C4_ADV_R(bi,bj,k,rTrans,tracer,af,myThid)
323 ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
324 CALL GAD_DST3_ADV_R(
325 & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
326 ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
327 CALL GAD_DST3FL_ADV_R(
328 & bi,bj,k,deltaTtracer,rTrans,wVel,tracer,af,myThid)
329 ELSE
330 STOP 'GAD_CALC_RHS: Bad advectionScheme (R)'
331 ENDIF
332 C- add the advective flux to fVerT
333 DO j=1-Oly,sNy+Oly
334 DO i=1-Olx,sNx+Olx
335 fVerT(i,j,kUp) = fVerT(i,j,kUp) + af(i,j)
336 ENDDO
337 ENDDO
338 ENDIF
339
340 C- Diffusive flux in R
341 C Note: For K=1 then KM1=1 and this gives a dT/dr = 0 upper
342 C boundary condition.
343 IF (implicitDiffusion) THEN
344 DO j=1-Oly,sNy+Oly
345 DO i=1-Olx,sNx+Olx
346 df(i,j) = 0. _d 0
347 ENDDO
348 ENDDO
349 ELSE
350 CALL GAD_DIFF_R(bi,bj,k,KappaRT,tracer,df,myThid)
351 ENDIF
352
353 #ifdef ALLOW_GMREDI
354 C- GM/Redi flux in R
355 IF (useGMRedi) THEN
356 C *note* should update GMREDI_RTRANSPORT to set df *aja*
357 CALL GMREDI_RTRANSPORT(
358 I iMin,iMax,jMin,jMax,bi,bj,K,
359 I Tracer,tracerIdentity,
360 U df,
361 I myThid)
362 ENDIF
363 #endif
364
365 DO j=1-Oly,sNy+Oly
366 DO i=1-Olx,sNx+Olx
367 fVerT(i,j,kUp) = fVerT(i,j,kUp) + df(i,j)*maskUp(i,j)
368 ENDDO
369 ENDDO
370
371 #ifdef ALLOW_KPP
372 C- Add non local KPP transport term (ghat) to diffusive T flux.
373 IF (useKPP) THEN
374 DO j=1-Oly,sNy+Oly
375 DO i=1-Olx,sNx+Olx
376 df(i,j) = 0. _d 0
377 ENDDO
378 ENDDO
379 IF (tracerIdentity.EQ.GAD_TEMPERATURE) THEN
380 C *note* should update KPP_TRANSPORT_T to set df *aja*
381 CALL KPP_TRANSPORT_T(
382 I iMin,iMax,jMin,jMax,bi,bj,k,km1,
383 I KappaRT,
384 U df )
385 ELSEIF (tracerIdentity.EQ.GAD_SALINITY) THEN
386 CALL KPP_TRANSPORT_S(
387 I iMin,iMax,jMin,jMax,bi,bj,k,km1,
388 I KappaRT,
389 U df )
390 #ifdef ALLOW_PTRACERS
391 ELSEIF (tracerIdentity .GE. GAD_TR1) THEN
392 CALL KPP_TRANSPORT_PTR(
393 I iMin,iMax,jMin,jMax,bi,bj,k,km1,
394 I tracerIdentity-GAD_TR1+1,KappaRT,
395 U df )
396 #endif
397 ELSE
398 PRINT*,'invalid tracer indentity: ', tracerIdentity
399 STOP 'GAD_CALC_RHS: Ooops'
400 ENDIF
401 DO j=1-Oly,sNy+Oly
402 DO i=1-Olx,sNx+Olx
403 fVerT(i,j,kUp) = fVerT(i,j,kUp) + df(i,j)*maskUp(i,j)
404 ENDDO
405 ENDDO
406 ENDIF
407 #endif
408
409 C-- Divergence of fluxes
410 DO j=1-Oly,sNy+Oly-1
411 DO i=1-Olx,sNx+Olx-1
412 gTracer(i,j,k,bi,bj)=gTracer(i,j,k,bi,bj)
413 & -_recip_hFacC(i,j,k,bi,bj)*recip_drF(k)*recip_rA(i,j,bi,bj)
414 & *( (fZon(i+1,j)-fZon(i,j))
415 & +(fMer(i,j+1)-fMer(i,j))
416 & +(fVerT(i,j,kUp)-fVerT(i,j,kDown))*rkFac
417 & -localT(i,j)*( (uTrans(i+1,j)-uTrans(i,j))
418 & +(vTrans(i,j+1)-vTrans(i,j))
419 & +(rTrans(i,j)-rTransKp1(i,j))*rAdvFac
420 & )*advFac
421 & )
422 ENDDO
423 ENDDO
424
425 RETURN
426 END

  ViewVC Help
Powered by ViewVC 1.1.22