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

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

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


Revision 1.4 - (hide annotations) (download)
Tue Feb 12 20:32:34 2008 UTC (16 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint59q, checkpoint59p, checkpoint59o
Changes since 1.3: +81 -21 lines
prather advection scheme (SOM) coded for Cubed-Sphere grid

1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_som_adv_y.F,v 1.3 2008/01/08 19:57:34 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "GAD_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: GAD_SOM_ADV_Y
8    
9     C !INTERFACE: ==========================================================
10     SUBROUTINE GAD_SOM_ADV_Y(
11     I bi,bj,k, limiter,
12 jmc 1.4 I overlapOnly, interiorOnly,
13     I N_edge, S_edge, E_edge, W_edge,
14 jmc 1.1 I deltaTloc, vTrans,
15     U sm_v, sm_o, sm_x, sm_y, sm_z,
16     U sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,
17     O vT,
18     I myThid )
19    
20     C !DESCRIPTION:
21     C Calculates the area integrated meridional flux due to advection
22     C of a tracer using
23     C--
24     C Second-Order Moments Advection of tracer in Y-direction
25     C ref: M.J.Prather, 1986, JGR, 91, D6, pp 6671-6681.
26     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
27     C The 3-D grid has dimension (Nx,Ny,Nz) with corresponding
28     C velocity field (U,V,W). Parallel subroutine calculate
29     C advection in the X- and Z- directions.
30     C The moment [Si] are as defined in the text, Sm refers to
31     C the total mass in each grid box
32     C the moments [Fi] are similarly defined and used as temporary
33     C storage for portions of the grid boxes in transit.
34     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
35    
36     C !USES: ===============================================================
37     IMPLICIT NONE
38     #include "SIZE.h"
39     #include "GAD.h"
40    
41     C !INPUT PARAMETERS: ===================================================
42 jmc 1.4 C bi,bj :: tile indices
43     C k :: vertical level
44     C limiter :: 0: no limiter ; 1: Prather, 1986 limiter
45     C overlapOnly :: only update the edges of myTile, but not the interior
46     C interiorOnly :: only update the interior of myTile, but not the edges
47     C [N,S,E,W]_edge :: true if N,S,E,W edge of myTile is an Edge of the cube
48     C vTrans :: zonal volume transport
49     C myThid :: my Thread Id. number
50 jmc 1.1 INTEGER bi,bj,k
51     INTEGER limiter
52 jmc 1.4 LOGICAL overlapOnly, interiorOnly
53     LOGICAL N_edge, S_edge, E_edge, W_edge
54 jmc 1.1 _RL deltaTloc
55     _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56     INTEGER myThid
57    
58     C !OUTPUT PARAMETERS: ==================================================
59     C sm_v :: volume of grid cell
60     C sm_o :: tracer content of grid cell (zero order moment)
61     C sm_x,y,z :: 1rst order moment of tracer distribution, in x,y,z direction
62     C sm_xx,yy,zz :: 2nd order moment of tracer distribution, in x,y,z direction
63     C sm_xy,xz,yz :: 2nd order moment of tracer distr., in cross direction xy,xz,yz
64     C vT :: meridional advective flux
65     _RL sm_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
66     _RL sm_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
67     _RL sm_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68     _RL sm_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
69     _RL sm_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
70     _RL sm_xx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
71     _RL sm_yy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
72     _RL sm_zz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
73     _RL sm_xy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
74     _RL sm_xz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
75     _RL sm_yz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
76     _RL vT (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
77    
78     #ifdef GAD_ALLOW_SOM_ADVECT
79     C !LOCAL VARIABLES: ====================================================
80 jmc 1.4 C i,j :: loop indices
81     C vLoc :: volume transported (per time step)
82     C [iMin,iMax]Upd :: loop range to update tracer field
83     C [jMin,jMax]Upd :: loop range to update tracer field
84     C nbStrips :: number of strips (if region to update is splitted)
85 jmc 1.1 _RL two, three
86     PARAMETER( two = 2. _d 0 )
87     PARAMETER( three = 3. _d 0 )
88     INTEGER i,j
89 jmc 1.4 INTEGER ns, nbStrips
90     INTEGER iMinUpd(2), iMaxUpd(2), jMinUpd(2), jMaxUpd(2)
91 jmc 1.3 _RL recip_dT
92 jmc 1.1 _RL slpmax, s1max, s1new, s2new
93     _RL vLoc, alf1, alf1q, alpmn
94     _RL alfp, alpq, alp1, locTp
95     _RL alfn, alnq, aln1, locTn
96     _RL alp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
97     _RL aln (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
98     _RL fp_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
99     _RL fn_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
100     _RL fp_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
101     _RL fn_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
102     _RL fp_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
103     _RL fn_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
104     _RL fp_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
105     _RL fn_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
106     _RL fp_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
107     _RL fn_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
108     _RL fp_xx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
109     _RL fn_xx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
110     _RL fp_yy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
111     _RL fn_yy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
112     _RL fp_zz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
113     _RL fn_zz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
114     _RL fp_xy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
115     _RL fn_xy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
116     _RL fp_xz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
117     _RL fn_xz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
118     _RL fp_yz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
119     _RL fn_yz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
120     CEOP
121    
122 jmc 1.3 recip_dT = 0.
123     IF ( deltaTloc.GT.0. _d 0 ) recip_dT = 1.0 _d 0 / deltaTloc
124    
125 jmc 1.4 C- Set loop ranges for updating tracer field (splitted in 2 strips)
126     nbStrips = 1
127     iMinUpd(1) = 1-Olx
128     iMaxUpd(1) = sNx+Olx
129     jMinUpd(1) = 1-Oly+1
130     jMaxUpd(1) = sNy+Oly-1
131     IF ( overlapOnly ) THEN
132     C update in overlap-Only
133     IF ( S_edge ) jMinUpd(1) = 1
134     IF ( N_edge ) jMaxUpd(1) = sNy
135     IF ( W_edge ) THEN
136     iMinUpd(1) = 1-Olx
137     iMaxUpd(1) = 0
138     ENDIF
139     IF ( E_edge ) THEN
140     IF ( W_edge ) nbStrips = 2
141     iMinUpd(nbStrips) = sNx+1
142     iMaxUpd(nbStrips) = sNx+Olx
143     ENDIF
144     ELSE
145     C do not only update the overlap
146     IF ( interiorOnly .AND. W_edge ) iMinUpd(1) = 1
147     IF ( interiorOnly .AND. E_edge ) iMaxUpd(1) = sNx
148     ENDIF
149    
150     C- Internal exchange for calculations in Y
151     c IF ( overlapOnly ) THEN
152     c CALL GAD_SOM_FILL_CS_CORNER( .FALSE.,
153     c U sm_v, sm_o, sm_x, sm_y, sm_z,
154     c U sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,
155     c I bi, bj, myThid )
156     c ENDIF
157    
158     C-- start 1rst loop on strip number "ns"
159     DO ns=1,nbStrips
160    
161 jmc 1.1 IF ( limiter.EQ.1 ) THEN
162 jmc 1.4 DO j=jMinUpd(1)-1,jMaxUpd(1)+1
163     DO i=iMinUpd(ns),iMaxUpd(ns)
164 jmc 1.1 C If flux-limiting transport is to be applied, place limits on
165     C appropriate moments before transport.
166     slpmax = 0.
167     IF ( sm_o(i,j).GT.0. ) slpmax = sm_o(i,j)
168     s1max = slpmax*1.5 _d 0
169     s1new = MIN( s1max, MAX(-s1max,sm_y(i,j)) )
170     s2new = MIN( (slpmax+slpmax-ABS(s1new)/three),
171     & MAX(ABS(s1new)-slpmax,sm_yy(i,j)) )
172     sm_xy(i,j) = MIN( slpmax, MAX(-slpmax,sm_xy(i,j)) )
173     sm_yz(i,j) = MIN( slpmax, MAX(-slpmax,sm_yz(i,j)) )
174 jmc 1.2 sm_y (i,j) = s1new
175     sm_yy(i,j) = s2new
176 jmc 1.1 ENDDO
177     ENDDO
178     ENDIF
179    
180     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
181     C--- part.1 : calculate flux for all moments
182 jmc 1.4 DO j=jMinUpd(1),jMaxUpd(1)+1
183     DO i=iMinUpd(ns),iMaxUpd(ns)
184 jmc 1.1 vLoc = vTrans(i,j)*deltaTloc
185     C-- Flux from (j-1) to (j) when V>0 (i.e., take right side of box j-1)
186     fp_v (i,j) = MAX( 0. _d 0, vLoc )
187     alp (i,j) = fp_v(i,j)/sm_v(i,j-1)
188     alpq = alp(i,j)*alp(i,j)
189     alp1 = 1. _d 0 - alp(i,j)
190     C- Create temporary moments/masses for partial boxes in transit
191     C use same indexing as velocity, "p" for positive V
192     fp_o (i,j) = alp(i,j)*( sm_o(i,j-1) + alp1*sm_y(i,j-1)
193     & + alp1*(alp1-alp(i,j))*sm_yy(i,j-1)
194     & )
195     fp_y (i,j) = alpq *( sm_y(i,j-1) + three*alp1*sm_yy(i,j-1) )
196     fp_yy(i,j) = alp(i,j)*alpq*sm_yy(i,j-1)
197     fp_x (i,j) = alp(i,j)*( sm_x(i,j-1) + alp1*sm_xy(i,j-1) )
198     fp_z (i,j) = alp(i,j)*( sm_z(i,j-1) + alp1*sm_yz(i,j-1) )
199    
200     fp_xy(i,j) = alpq *sm_xy(i,j-1)
201     fp_yz(i,j) = alpq *sm_yz(i,j-1)
202     fp_xx(i,j) = alp(i,j)*sm_xx(i,j-1)
203     fp_zz(i,j) = alp(i,j)*sm_zz(i,j-1)
204     fp_xz(i,j) = alp(i,j)*sm_xz(i,j-1)
205     C-- Flux from (j) to (j-1) when V<0 (i.e., take left side of box j)
206     fn_v (i,j) = MAX( 0. _d 0, -vLoc )
207     aln (i,j) = fn_v(i,j)/sm_v(i, j )
208     alnq = aln(i,j)*aln(i,j)
209     aln1 = 1. _d 0 - aln(i,j)
210     C- Create temporary moments/masses for partial boxes in transit
211     C use same indexing as velocity, "n" for negative V
212     fn_o (i,j) = aln(i,j)*( sm_o(i, j ) - aln1*sm_y(i, j )
213     & + aln1*(aln1-aln(i,j))*sm_yy(i, j )
214     & )
215     fn_y (i,j) = alnq *( sm_y(i, j ) - three*aln1*sm_yy(i, j ) )
216     fn_yy(i,j) = aln(i,j)*alnq*sm_yy(i, j )
217     fn_x (i,j) = aln(i,j)*( sm_x(i, j ) - aln1*sm_xy(i, j ) )
218     fn_z (i,j) = aln(i,j)*( sm_z(i, j ) - aln1*sm_yz(i, j ) )
219     fn_xy(i,j) = alnq *sm_xy(i, j )
220     fn_yz(i,j) = alnq *sm_yz(i, j )
221     fn_xx(i,j) = aln(i,j)*sm_xx(i, j )
222     fn_zz(i,j) = aln(i,j)*sm_zz(i, j )
223     fn_xz(i,j) = aln(i,j)*sm_xz(i, j )
224     C-- Save zero-order flux:
225 jmc 1.3 vT(i,j) = ( fp_o(i,j) - fn_o(i,j) )*recip_dT
226 jmc 1.1 ENDDO
227     ENDDO
228    
229 jmc 1.4 C-- end 1rst loop on strip number "ns"
230     c ENDDO
231    
232     C- Internal exchange for next calculations in X
233     c IF ( overlapOnly ) THEN
234     c CALL GAD_SOM_FILL_CS_CORNER( .TRUE.,
235     c U sm_v, sm_o, sm_x, sm_y, sm_z,
236     c U sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,
237     c I bi, bj, myThid )
238     c ENDIF
239    
240 jmc 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
241 jmc 1.4 C-- start 2nd loop on strip number "ns"
242     c DO ns=1,nbStrips
243    
244 jmc 1.1 C--- part.2 : re-adjust moments remaining in the box
245     C take off from grid box (j): negative V(j) and positive V(j+1)
246 jmc 1.4 DO j=jMinUpd(1),jMaxUpd(1)
247     DO i=iMinUpd(ns),iMaxUpd(ns)
248 jmc 1.1 alf1 = 1. _d 0 - aln(i,j) - alp(i,j+1)
249     alf1q = alf1*alf1
250     alpmn = alp(i,j+1) - aln(i,j)
251     sm_v (i,j) = sm_v (i,j) - fn_v (i,j) - fp_v (i,j+1)
252     sm_o (i,j) = sm_o (i,j) - fn_o (i,j) - fp_o (i,j+1)
253     sm_y (i,j) = alf1q*( sm_y(i,j) - three*alpmn*sm_yy(i,j) )
254     sm_yy(i,j) = alf1*alf1q*sm_yy(i,j)
255     sm_xy(i,j) = alf1q*sm_xy(i,j)
256     sm_yz(i,j) = alf1q*sm_yz(i,j)
257     sm_x (i,j) = sm_x (i,j) - fn_x (i,j) - fp_x (i,j+1)
258     sm_xx(i,j) = sm_xx(i,j) - fn_xx(i,j) - fp_xx(i,j+1)
259     sm_z (i,j) = sm_z (i,j) - fn_z (i,j) - fp_z (i,j+1)
260     sm_zz(i,j) = sm_zz(i,j) - fn_zz(i,j) - fp_zz(i,j+1)
261     sm_xz(i,j) = sm_xz(i,j) - fn_xz(i,j) - fp_xz(i,j+1)
262     ENDDO
263     ENDDO
264    
265     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
266     C--- part.3 : Put the temporary moments into appropriate neighboring boxes
267     C add into grid box (j): positive V(j) and negative V(j+1)
268 jmc 1.4 DO j=jMinUpd(1),jMaxUpd(1)
269     DO i=iMinUpd(ns),iMaxUpd(ns)
270 jmc 1.1 sm_v (i,j) = sm_v (i,j) + fp_v (i,j) + fn_v (i,j+1)
271     alfp = fp_v(i, j )/sm_v(i,j)
272     alfn = fn_v(i,j+1)/sm_v(i,j)
273     alf1 = 1. _d 0 - alfp - alfn
274     alp1 = 1. _d 0 - alfp
275     aln1 = 1. _d 0 - alfn
276     alpmn = alfp - alfn
277     locTp = alfp*sm_o(i,j) - alp1*fp_o(i,j)
278     locTn = alfn*sm_o(i,j) - aln1*fn_o(i,j+1)
279     sm_yy(i,j) = alf1*alf1*sm_yy(i,j) + alfp*alfp*fp_yy(i,j)
280     & + alfn*alfn*fn_yy(i,j+1)
281     & - 5. _d 0*(-alpmn*alf1*sm_y(i,j) + alfp*alp1*fp_y(i,j)
282     & - alfn*aln1*fn_y(i,j+1)
283     & + two*alfp*alfn*sm_o(i,j) + (alp1-alfp)*locTp
284     & + (aln1-alfn)*locTn
285     & )
286     sm_xy(i,j) = alf1*sm_xy(i,j) + alfp*fp_xy(i,j)
287     & + alfn*fn_xy(i,j+1)
288     & + three*( alpmn*sm_x(i,j) - alp1*fp_x(i,j)
289     & + aln1*fn_x(i,j+1)
290     & )
291     sm_yz(i,j) = alf1*sm_yz(i,j) + alfp*fp_yz(i,j)
292     & + alfn*fn_yz(i,j+1)
293     & + three*( alpmn*sm_z(i,j) - alp1*fp_z(i,j)
294     & + aln1*fn_z(i,j+1)
295     & )
296     sm_y (i,j) = alf1*sm_y(i,j) + alfp*fp_y(i,j) + alfn*fn_y(i,j+1)
297     & + three*( locTp - locTn )
298     sm_o (i,j) = sm_o (i,j) + fp_o (i,j) + fn_o (i,j+1)
299     sm_x (i,j) = sm_x (i,j) + fp_x (i,j) + fn_x (i,j+1)
300     sm_xx(i,j) = sm_xx(i,j) + fp_xx(i,j) + fn_xx(i,j+1)
301     sm_z (i,j) = sm_z (i,j) + fp_z (i,j) + fn_z (i,j+1)
302     sm_zz(i,j) = sm_zz(i,j) + fp_zz(i,j) + fn_zz(i,j+1)
303     sm_xz(i,j) = sm_xz(i,j) + fp_xz(i,j) + fn_xz(i,j+1)
304     ENDDO
305     ENDDO
306    
307 jmc 1.4 C-- end 2nd loop on strip number "ns"
308     ENDDO
309    
310 jmc 1.1 #endif /* GAD_ALLOW_SOM_ADVECT */
311    
312     RETURN
313     END

  ViewVC Help
Powered by ViewVC 1.1.22