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

Annotation of /MITgcm/pkg/generic_advdiff/gad_advection.F

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


Revision 1.4 - (hide annotations) (download)
Wed Sep 19 20:45:09 2001 UTC (22 years, 8 months ago) by adcroft
Branch: MAIN
Changes since 1.3: +85 -11 lines
Added comments in form compatible with "protex".

1 adcroft 1.4 C $Header: /u/gcmpack/models/MITgcmUV/pkg/generic_advdiff/gad_advection.F,v 1.3 2001/09/17 19:48:04 adcroft Exp $
2 adcroft 1.2 C $Name: $
3 adcroft 1.1
4 adcroft 1.4 CBOI
5     C !TITLE: pkg/generic\_advdiff
6     C !AUTHORS: adcroft@mit.edu
7     C !INTRODUCTION:
8     C \section{Generica Advection Diffusion Package}
9     C
10     C Package "generic\_advdiff" provides a common set of routines for calculating
11     C advective/diffusive fluxes for tracers (cell centered quantities on a C-grid).
12     C
13     C Many different advection schemes are available: the standard centered
14     C second order, centered fourth order and upwind biased third order schemes
15     C are known as linear methods and require some stable time-stepping method
16     C such as Adams-Bashforth. Alternatives such as flux-limited schemes are
17     C stable in the forward sense and are best combined with the multi-dimensional
18     C method provided in gad\_advection.
19     C
20     C There are two high-level routines:
21     C \begin{itemize}
22     C \item{GAD\_CALC\_RHS} calculates all fluxes at time level "n" and is used
23     C for the standard linear schemes. This must be used in conjuction with
24     C Adams-Bashforth time-stepping. Diffusive and parameterized fluxes are
25     C always calculated here.
26     C \item{GAD\_ADVECTION} calculates just the advective fluxes using the
27     C non-linear schemes and can not be used in conjuction with Adams-Bashforth
28     C time-stepping.
29     C \end{itemize}
30     CEOI
31    
32 adcroft 1.1 #include "GAD_OPTIONS.h"
33    
34 adcroft 1.4 CBOP
35     C !ROUTINE: GAD_ADVECTION
36    
37     C !INTERFACE: ==========================================================
38 adcroft 1.1 SUBROUTINE GAD_ADVECTION(bi,bj,advectionScheme,tracerIdentity,
39     U Tracer,Gtracer,
40     I myTime,myIter,myThid)
41 adcroft 1.4
42     C !DESCRIPTION:
43     C Calculates the tendancy of a tracer due to advection.
44     C It uses the multi-dimensional method given in \ref{sect:multiDimAdvection}
45     C and can only be used for the non-linear advection schemes such as the
46     C direct-space-time method and flux-limiters.
47     C
48     C The algorithm is as follows:
49     C \begin{itemize}
50     C \item{$\theta^{(n+1/3)} = \theta^{(n)}
51     C - \Delta t \partial_x (u\theta) + \theta \partial_x u$}
52     C \item{$\theta^{(n+2/3)} = \theta^{(n+1/3)}
53     C - \Delta t \partial_y (v\theta) + \theta \partial_y v$}
54     C \item{$\theta^{(n+3/3)} = \theta^{(n+2/3)}
55     C - \Delta t \partial_r (w\theta) + \theta \partial_r w$}
56     C \item{$G_\theta = ( \theta^{(n+3/3)} - \theta^{(n)} )/\Delta t$}
57     C \end{itemize}
58     C
59     C The tendancy (output) is over-written by this routine.
60    
61     C !USES: ===============================================================
62 adcroft 1.1 IMPLICIT NONE
63     #include "SIZE.h"
64     #include "EEPARAMS.h"
65     #include "PARAMS.h"
66     #include "DYNVARS.h"
67     #include "GRID.h"
68     #include "GAD.h"
69    
70 adcroft 1.4 C !INPUT PARAMETERS: ===================================================
71     C bi,bj :: tile indices
72     C advectionScheme :: advection scheme to use
73     C tracerIdentity :: identifier for the tracer (required only for OBCS)
74     C Tracer :: tracer field
75     C myTime :: current time
76     C myIter :: iteration number
77     C myThid :: thread number
78 adcroft 1.1 INTEGER bi,bj
79     INTEGER advectionScheme
80     INTEGER tracerIdentity
81     _RL Gtracer(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
82     _RL myTime
83     INTEGER myIter
84     INTEGER myThid
85    
86 adcroft 1.4 C !OUTPUT PARAMETERS: ==================================================
87     C gTracer :: tendancy array
88     _RL Tracer(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
89    
90     C !LOCAL VARIABLES: ====================================================
91     C maskUp :: 2-D array for mask at W points
92     C iMin,iMax,jMin,jMax :: loop range for called routines
93     C i,j,k :: loop indices
94     C kup :: index into 2 1/2D array, toggles between 1 and 2
95     C kdown :: index into 2 1/2D array, toggles between 2 and 1
96     C kp1 :: =k+1 for k<Nr, =Nr for k=Nr
97     C xA,yA :: areas of X and Y face of tracer cells
98     C uTrans,vTrans,rTrans :: 2-D arrays of volume transports at U,V and W points
99     C af :: 2-D array for horizontal advective flux
100     C fVerT :: 2 1/2D arrays for vertical advective flux
101     C localTij :: 2-D array used as temporary local copy of tracer fld
102     C localTijk :: 3-D array used as temporary local copy of tracer fld
103     C kp1Msk :: flag (0,1) to act as over-riding mask for W levels
104     C calc_fluxes_X :: logical to indicate to calculate fluxes in X dir
105     C calc_fluxes_Y :: logical to indicate to calculate fluxes in Y dir
106     C nipass :: number of passes to make in multi-dimensional method
107     C ipass :: number of the current pass being made
108 adcroft 1.1 _RS maskUp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
109     INTEGER iMin,iMax,jMin,jMax
110     INTEGER i,j,k,kup,kDown,kp1
111     _RS xA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
112     _RS yA (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
113     _RL uTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
114     _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
115     _RL rTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
116     _RL af (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
117     _RL fVerT (1-OLx:sNx+OLx,1-OLy:sNy+OLy,2)
118     _RL localTij(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
119     _RL localTijk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
120     _RL kp1Msk
121 adcroft 1.3 LOGICAL calc_fluxes_X,calc_fluxes_Y
122     INTEGER nipass,ipass
123 adcroft 1.4 CEOP
124 adcroft 1.1
125     C-- Set up work arrays with valid (i.e. not NaN) values
126     C These inital values do not alter the numerical results. They
127     C just ensure that all memory references are to valid floating
128     C point numbers. This prevents spurious hardware signals due to
129     C uninitialised but inert locations.
130     DO j=1-OLy,sNy+OLy
131     DO i=1-OLx,sNx+OLx
132     xA(i,j) = 0. _d 0
133     yA(i,j) = 0. _d 0
134     uTrans(i,j) = 0. _d 0
135     vTrans(i,j) = 0. _d 0
136     rTrans(i,j) = 0. _d 0
137     fVerT(i,j,1) = 0. _d 0
138     fVerT(i,j,2) = 0. _d 0
139     ENDDO
140     ENDDO
141    
142     iMin = 1-OLx
143     iMax = sNx+OLx
144     jMin = 1-OLy
145     jMax = sNy+OLy
146    
147     C-- Start of k loop for horizontal fluxes
148     DO k=1,Nr
149    
150     C-- Get temporary terms used by tendency routines
151     CALL CALC_COMMON_FACTORS (
152     I bi,bj,iMin,iMax,jMin,jMax,k,
153     O xA,yA,uTrans,vTrans,rTrans,maskUp,
154     I myThid)
155    
156     C-- Make local copy of tracer array
157     DO j=1-OLy,sNy+OLy
158     DO i=1-OLx,sNx+OLx
159     localTij(i,j)=tracer(i,j,k,bi,bj)
160     ENDDO
161     ENDDO
162    
163 adcroft 1.3 IF (useCubedSphereExchange) THEN
164     nipass=3
165     ELSE
166     nipass=1
167     ENDIF
168     nipass=1
169    
170     C-- Multiple passes for different directions on different tiles
171     DO ipass=1,nipass
172    
173     IF (nipass.EQ.3) THEN
174     calc_fluxes_X=.FALSE.
175     calc_fluxes_Y=.FALSE.
176     IF (ipass.EQ.1 .AND. (bi.EQ.1 .OR. bi.EQ.2) ) THEN
177     calc_fluxes_X=.TRUE.
178     ELSEIF (ipass.EQ.1 .AND. (bi.EQ.4 .OR. bi.EQ.5) ) THEN
179     calc_fluxes_Y=.TRUE.
180     ELSEIF (ipass.EQ.2 .AND. (bi.EQ.1 .OR. bi.EQ.6) ) THEN
181     calc_fluxes_Y=.TRUE.
182     ELSEIF (ipass.EQ.2 .AND. (bi.EQ.3 .OR. bi.EQ.4) ) THEN
183     calc_fluxes_X=.TRUE.
184     ELSEIF (ipass.EQ.3 .AND. (bi.EQ.2 .OR. bi.EQ.3) ) THEN
185     calc_fluxes_Y=.TRUE.
186     ELSEIF (ipass.EQ.3 .AND. (bi.EQ.5 .OR. bi.EQ.6) ) THEN
187     calc_fluxes_X=.TRUE.
188     ENDIF
189     ELSE
190     calc_fluxes_X=.TRUE.
191     calc_fluxes_Y=.TRUE.
192     ENDIF
193    
194     C-- X direction
195     IF (calc_fluxes_X) THEN
196    
197     C-- Internal exchange for calculations in X
198     IF (useCubedSphereExchange) THEN
199     DO j=1,Oly
200     DO i=1,Olx
201     localTij( 1-i , 1-j )=localTij( 1-j , i )
202     localTij( 1-i ,sNy+j)=localTij( 1-j , sNy+1-i )
203     localTij(sNx+i, 1-j )=localTij(sNx+j, i )
204     localTij(sNx+i,sNy+j)=localTij(sNx+j, sNy+1-i )
205     ENDDO
206     ENDDO
207     ENDIF
208    
209 adcroft 1.1 C- Advective flux in X
210     DO j=1-Oly,sNy+Oly
211     DO i=1-Olx,sNx+Olx
212     af(i,j) = 0.
213     ENDDO
214     ENDDO
215     IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
216     CALL GAD_FLUXLIMIT_ADV_X(
217     & bi,bj,k,deltaTtracer,uTrans,uVel,localTij,af,myThid)
218     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
219     CALL GAD_DST3_ADV_X(
220     & bi,bj,k,deltaTtracer,uTrans,uVel,localTij,af,myThid)
221     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
222     CALL GAD_DST3FL_ADV_X(
223     & bi,bj,k,deltaTtracer,uTrans,uVel,localTij,af,myThid)
224     ELSE
225     STOP 'GAD_ADVECTION: adv. scheme incompatibale with mutli-dim'
226     ENDIF
227     DO j=1-Oly,sNy+Oly
228     DO i=1-Olx,sNx+Olx-1
229     localTij(i,j)=localTij(i,j)-deltaTtracer*
230     & _recip_hFacC(i,j,k,bi,bj)*recip_drF(k)
231     & *recip_rA(i,j,bi,bj)
232     & *( af(i+1,j)-af(i,j)
233     & -tracer(i,j,k,bi,bj)*(uTrans(i+1,j)-uTrans(i,j))
234     & )
235     ENDDO
236     ENDDO
237    
238     #ifdef ALLOW_OBCS
239     C-- Apply open boundary conditions
240     IF (useOBCS) THEN
241     IF (tracerIdentity.EQ.GAD_TEMPERATURE) THEN
242     CALL OBCS_APPLY_TLOC( bi, bj, k, localTij, myThid )
243     ELSEIF (tracerIdentity.EQ.GAD_SALINITY) THEN
244     CALL OBCS_APPLY_SLOC( bi, bj, k, localTij, myThid )
245     END IF
246     END IF
247     #endif /* ALLOW_OBCS */
248    
249 adcroft 1.3 C-- End of X direction
250     ENDIF
251    
252     C-- Y direction
253     IF (calc_fluxes_Y) THEN
254    
255     C-- Internal exchange for calculations in Y
256     IF (useCubedSphereExchange) THEN
257     DO j=1,Oly
258     DO i=1,Olx
259     localTij( 1-i , 1-j )=localTij( j , 1-i )
260     localTij( 1-i ,sNy+j)=localTij( j ,sNy+i)
261     localTij(sNx+i, 1-j )=localTij(sNx+1-j, 1-i )
262     localTij(sNx+i,sNy+j)=localTij(sNx+1-j,sNy+i)
263     ENDDO
264     ENDDO
265     ENDIF
266    
267 adcroft 1.1 C- Advective flux in Y
268     DO j=1-Oly,sNy+Oly
269     DO i=1-Olx,sNx+Olx
270     af(i,j) = 0.
271     ENDDO
272     ENDDO
273     IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
274     CALL GAD_FLUXLIMIT_ADV_Y(
275     & bi,bj,k,deltaTtracer,vTrans,vVel,localTij,af,myThid)
276     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
277     CALL GAD_DST3_ADV_Y(
278     & bi,bj,k,deltaTtracer,vTrans,vVel,localTij,af,myThid)
279     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
280     CALL GAD_DST3FL_ADV_Y(
281     & bi,bj,k,deltaTtracer,vTrans,vVel,localTij,af,myThid)
282     ELSE
283     STOP 'GAD_ADVECTION: adv. scheme incompatibale with mutli-dim'
284     ENDIF
285     DO j=1-Oly,sNy+Oly-1
286     DO i=1-Olx,sNx+Olx
287     localTij(i,j)=localTij(i,j)-deltaTtracer*
288     & _recip_hFacC(i,j,k,bi,bj)*recip_drF(k)
289     & *recip_rA(i,j,bi,bj)
290     & *( af(i,j+1)-af(i,j)
291     & -tracer(i,j,k,bi,bj)*(vTrans(i,j+1)-vTrans(i,j))
292     & )
293     ENDDO
294     ENDDO
295 adcroft 1.3
296 adcroft 1.1 #ifdef ALLOW_OBCS
297     C-- Apply open boundary conditions
298     IF (useOBCS) THEN
299     IF (tracerIdentity.EQ.GAD_TEMPERATURE) THEN
300     CALL OBCS_APPLY_TLOC( bi, bj, k, localTij, myThid )
301     ELSEIF (tracerIdentity.EQ.GAD_SALINITY) THEN
302     CALL OBCS_APPLY_SLOC( bi, bj, k, localTij, myThid )
303     END IF
304     END IF
305     #endif /* ALLOW_OBCS */
306 adcroft 1.3
307     C-- End of Y direction
308     ENDIF
309    
310     DO j=1-Oly,sNy+Oly
311 adcroft 1.1 DO i=1-Olx,sNx+Olx
312     localTijk(i,j,k)=localTij(i,j)
313     ENDDO
314     ENDDO
315    
316 adcroft 1.3 C-- End of ipass loop
317     ENDDO
318 adcroft 1.1
319     C-- End of K loop for horizontal fluxes
320     ENDDO
321    
322     C-- Start of k loop for vertical flux
323     DO k=Nr,1,-1
324    
325     C-- kup Cycles through 1,2 to point to w-layer above
326     C-- kDown Cycles through 2,1 to point to w-layer below
327     kup = 1+MOD(k+1,2)
328     kDown= 1+MOD(k,2)
329    
330     C-- Get temporary terms used by tendency routines
331     CALL CALC_COMMON_FACTORS (
332     I bi,bj,iMin,iMax,jMin,jMax,k,
333     O xA,yA,uTrans,vTrans,rTrans,maskUp,
334     I myThid)
335    
336     C- Advective flux in R
337     DO j=1-Oly,sNy+Oly
338     DO i=1-Olx,sNx+Olx
339     af(i,j) = 0.
340     ENDDO
341     ENDDO
342    
343     C Note: wVel needs to be masked
344     IF (K.GE.2) THEN
345     C- Compute vertical advective flux in the interior:
346     IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
347     CALL GAD_FLUXLIMIT_ADV_R(
348     & bi,bj,k,deltaTtracer,rTrans,wVel,localTijk,af,myThid)
349     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
350 adcroft 1.2 CALL GAD_DST3_ADV_R(
351     & bi,bj,k,deltaTtracer,rTrans,wVel,localTijk,af,myThid)
352 adcroft 1.1 ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
353 adcroft 1.2 CALL GAD_DST3FL_ADV_R(
354     & bi,bj,k,deltaTtracer,rTrans,wVel,localTijk,af,myThid)
355 adcroft 1.1 ELSE
356     STOP 'GAD_ADVECTION: adv. scheme incompatibale with mutli-dim'
357     ENDIF
358     C- Surface "correction" term at k>1 :
359     DO j=1-Oly,sNy+Oly
360     DO i=1-Olx,sNx+Olx
361     af(i,j) = af(i,j)
362     & + (maskC(i,j,k,bi,bj)-maskC(i,j,k-1,bi,bj))*
363     & rTrans(i,j)*localTijk(i,j,k)
364     ENDDO
365     ENDDO
366     ELSE
367     C- Surface "correction" term at k=1 :
368     DO j=1-Oly,sNy+Oly
369     DO i=1-Olx,sNx+Olx
370     af(i,j) = rTrans(i,j)*localTijk(i,j,k)
371     ENDDO
372     ENDDO
373     ENDIF
374     C- add the advective flux to fVerT
375     DO j=1-Oly,sNy+Oly
376     DO i=1-Olx,sNx+Olx
377     fVerT(i,j,kUp) = af(i,j)
378     ENDDO
379     ENDDO
380    
381     C-- Divergence of fluxes
382     kp1=min(Nr,k+1)
383     kp1Msk=1.
384     if (k.EQ.Nr) kp1Msk=0.
385     DO j=1-Oly,sNy+Oly
386     DO i=1-Olx,sNx+Olx
387     localTij(i,j)=localTijk(i,j,k)-deltaTtracer*
388     & _recip_hFacC(i,j,k,bi,bj)*recip_drF(k)
389     & *recip_rA(i,j,bi,bj)
390     & *( fVerT(i,j,kUp)-fVerT(i,j,kDown)
391     & -tracer(i,j,k,bi,bj)*rA(i,j,bi,bj)*
392     & (wVel(i,j,k,bi,bj)-kp1Msk*wVel(i,j,kp1,bi,bj))
393     & )*rkFac
394     gTracer(i,j,k,bi,bj)=
395     & (localTij(i,j)-tracer(i,j,k,bi,bj))/deltaTtracer
396     ENDDO
397     ENDDO
398    
399     C-- End of K loop for vertical flux
400     ENDDO
401    
402     RETURN
403     END

  ViewVC Help
Powered by ViewVC 1.1.22