/[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.1 - (hide annotations) (download)
Tue Jan 16 04:38:34 2007 UTC (17 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58w_post, checkpoint58x_post, checkpoint59e, checkpoint59d, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59, checkpoint58y_post, checkpoint58v_post
2nd-Order Moment Advection Scheme (Prather, 1986): first check-in
 - enable by setting #define GAD_ALLOW_SOM_ADVECT (in GAD_OPTIONS.h)
 - used without limiter (AdvScheme=80) or with Prather limiter (AdvScheme=81)
 - still needs work (not working with some options ; efficiency to improve)
   and serious testing.

1 jmc 1.1 C $Header: /u/gcmpack/MITgcm/pkg/generic_advdiff/gad_dst2u1_adv_x.F,v 1.6 2006/12/05 22:21:50 jmc Exp $
2     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     I deltaTloc, vTrans,
13     U sm_v, sm_o, sm_x, sm_y, sm_z,
14     U sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz,
15     O vT,
16     I myThid )
17    
18     C !DESCRIPTION:
19     C Calculates the area integrated meridional flux due to advection
20     C of a tracer using
21     C--
22     C Second-Order Moments Advection of tracer in Y-direction
23     C ref: M.J.Prather, 1986, JGR, 91, D6, pp 6671-6681.
24     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
25     C The 3-D grid has dimension (Nx,Ny,Nz) with corresponding
26     C velocity field (U,V,W). Parallel subroutine calculate
27     C advection in the X- and Z- directions.
28     C The moment [Si] are as defined in the text, Sm refers to
29     C the total mass in each grid box
30     C the moments [Fi] are similarly defined and used as temporary
31     C storage for portions of the grid boxes in transit.
32     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
33    
34     C !USES: ===============================================================
35     IMPLICIT NONE
36     #include "SIZE.h"
37     c #include "GRID.h"
38     #include "GAD.h"
39    
40     C !INPUT PARAMETERS: ===================================================
41     C bi,bj :: tile indices
42     C k :: vertical level
43     C limiter :: 0: no limiter ; 1: Prather, 1986 limiter
44     C vTrans :: zonal volume transport
45     C myThid :: my Thread Id. number
46     INTEGER bi,bj,k
47     INTEGER limiter
48     _RL deltaTloc
49     _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50     c _RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
51     INTEGER myThid
52    
53     C !OUTPUT PARAMETERS: ==================================================
54     C sm_v :: volume of grid cell
55     C sm_o :: tracer content of grid cell (zero order moment)
56     C sm_x,y,z :: 1rst order moment of tracer distribution, in x,y,z direction
57     C sm_xx,yy,zz :: 2nd order moment of tracer distribution, in x,y,z direction
58     C sm_xy,xz,yz :: 2nd order moment of tracer distr., in cross direction xy,xz,yz
59     C vT :: meridional advective flux
60     _RL sm_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61     _RL sm_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
62     _RL sm_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
63     _RL sm_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
64     _RL sm_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
65     _RL sm_xx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
66     _RL sm_yy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
67     _RL sm_zz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
68     _RL sm_xy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
69     _RL sm_xz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
70     _RL sm_yz (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
71     _RL vT (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
72    
73     #ifdef GAD_ALLOW_SOM_ADVECT
74     C !LOCAL VARIABLES: ====================================================
75     C i,j :: loop indices
76     C vLoc :: volume transported (per time step)
77     _RL two, three
78     PARAMETER( two = 2. _d 0 )
79     PARAMETER( three = 3. _d 0 )
80     INTEGER i,j
81     _RL slpmax, s1max, s1new, s2new
82     _RL vLoc, alf1, alf1q, alpmn
83     _RL alfp, alpq, alp1, locTp
84     _RL alfn, alnq, aln1, locTn
85     _RL alp (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
86     _RL aln (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
87     _RL fp_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
88     _RL fn_v (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
89     _RL fp_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
90     _RL fn_o (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
91     _RL fp_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
92     _RL fn_x (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
93     _RL fp_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
94     _RL fn_y (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
95     _RL fp_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
96     _RL fn_z (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
97     _RL fp_xx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
98     _RL fn_xx(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
99     _RL fp_yy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
100     _RL fn_yy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
101     _RL fp_zz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
102     _RL fn_zz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
103     _RL fp_xy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
104     _RL fn_xy(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
105     _RL fp_xz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
106     _RL fn_xz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
107     _RL fp_yz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
108     _RL fn_yz(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
109     CEOP
110    
111     IF ( limiter.EQ.1 ) THEN
112     DO j=1-OLy,sNy+OLy
113     DO i=1-OLx,sNx+OLx
114     C If flux-limiting transport is to be applied, place limits on
115     C appropriate moments before transport.
116     slpmax = 0.
117     IF ( sm_o(i,j).GT.0. ) slpmax = sm_o(i,j)
118     s1max = slpmax*1.5 _d 0
119     s1new = MIN( s1max, MAX(-s1max,sm_y(i,j)) )
120     s2new = MIN( (slpmax+slpmax-ABS(s1new)/three),
121     & MAX(ABS(s1new)-slpmax,sm_yy(i,j)) )
122     sm_xy(i,j) = MIN( slpmax, MAX(-slpmax,sm_xy(i,j)) )
123     sm_yz(i,j) = MIN( slpmax, MAX(-slpmax,sm_yz(i,j)) )
124     sm_y (i,j) = s1new ;
125     sm_yy(i,j) = s2new ;
126     ENDDO
127     ENDDO
128     ENDIF
129    
130     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
131     C--- part.1 : calculate flux for all moments
132     DO i=1-OLx,sNx+OLx
133     vT(i,1-OLy)=0.
134     ENDDO
135     DO j=1-OLy+1,sNy+OLy
136     DO i=1-OLx,sNx+OLx
137     vLoc = vTrans(i,j)*deltaTloc
138     C-- Flux from (j-1) to (j) when V>0 (i.e., take right side of box j-1)
139     fp_v (i,j) = MAX( 0. _d 0, vLoc )
140     alp (i,j) = fp_v(i,j)/sm_v(i,j-1)
141     alpq = alp(i,j)*alp(i,j)
142     alp1 = 1. _d 0 - alp(i,j)
143     C- Create temporary moments/masses for partial boxes in transit
144     C use same indexing as velocity, "p" for positive V
145     fp_o (i,j) = alp(i,j)*( sm_o(i,j-1) + alp1*sm_y(i,j-1)
146     & + alp1*(alp1-alp(i,j))*sm_yy(i,j-1)
147     & )
148     fp_y (i,j) = alpq *( sm_y(i,j-1) + three*alp1*sm_yy(i,j-1) )
149     fp_yy(i,j) = alp(i,j)*alpq*sm_yy(i,j-1)
150     fp_x (i,j) = alp(i,j)*( sm_x(i,j-1) + alp1*sm_xy(i,j-1) )
151     fp_z (i,j) = alp(i,j)*( sm_z(i,j-1) + alp1*sm_yz(i,j-1) )
152    
153     fp_xy(i,j) = alpq *sm_xy(i,j-1)
154     fp_yz(i,j) = alpq *sm_yz(i,j-1)
155     fp_xx(i,j) = alp(i,j)*sm_xx(i,j-1)
156     fp_zz(i,j) = alp(i,j)*sm_zz(i,j-1)
157     fp_xz(i,j) = alp(i,j)*sm_xz(i,j-1)
158     C-- Flux from (j) to (j-1) when V<0 (i.e., take left side of box j)
159     fn_v (i,j) = MAX( 0. _d 0, -vLoc )
160     aln (i,j) = fn_v(i,j)/sm_v(i, j )
161     alnq = aln(i,j)*aln(i,j)
162     aln1 = 1. _d 0 - aln(i,j)
163     C- Create temporary moments/masses for partial boxes in transit
164     C use same indexing as velocity, "n" for negative V
165     fn_o (i,j) = aln(i,j)*( sm_o(i, j ) - aln1*sm_y(i, j )
166     & + aln1*(aln1-aln(i,j))*sm_yy(i, j )
167     & )
168     fn_y (i,j) = alnq *( sm_y(i, j ) - three*aln1*sm_yy(i, j ) )
169     fn_yy(i,j) = aln(i,j)*alnq*sm_yy(i, j )
170     fn_x (i,j) = aln(i,j)*( sm_x(i, j ) - aln1*sm_xy(i, j ) )
171     fn_z (i,j) = aln(i,j)*( sm_z(i, j ) - aln1*sm_yz(i, j ) )
172     fn_xy(i,j) = alnq *sm_xy(i, j )
173     fn_yz(i,j) = alnq *sm_yz(i, j )
174     fn_xx(i,j) = aln(i,j)*sm_xx(i, j )
175     fn_zz(i,j) = aln(i,j)*sm_zz(i, j )
176     fn_xz(i,j) = aln(i,j)*sm_xz(i, j )
177     C-- Save zero-order flux:
178     vT(i,j) = fp_o(i,j) - fn_o(i,j)
179     ENDDO
180     ENDDO
181    
182     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
183     C--- part.2 : re-adjust moments remaining in the box
184     C take off from grid box (j): negative V(j) and positive V(j+1)
185     DO j=1-OLy+1,sNy+OLy-1
186     DO i=1-OLx,sNx+OLx
187     alf1 = 1. _d 0 - aln(i,j) - alp(i,j+1)
188     alf1q = alf1*alf1
189     alpmn = alp(i,j+1) - aln(i,j)
190     sm_v (i,j) = sm_v (i,j) - fn_v (i,j) - fp_v (i,j+1)
191     sm_o (i,j) = sm_o (i,j) - fn_o (i,j) - fp_o (i,j+1)
192     sm_y (i,j) = alf1q*( sm_y(i,j) - three*alpmn*sm_yy(i,j) )
193     sm_yy(i,j) = alf1*alf1q*sm_yy(i,j)
194     sm_xy(i,j) = alf1q*sm_xy(i,j)
195     sm_yz(i,j) = alf1q*sm_yz(i,j)
196     sm_x (i,j) = sm_x (i,j) - fn_x (i,j) - fp_x (i,j+1)
197     sm_xx(i,j) = sm_xx(i,j) - fn_xx(i,j) - fp_xx(i,j+1)
198     sm_z (i,j) = sm_z (i,j) - fn_z (i,j) - fp_z (i,j+1)
199     sm_zz(i,j) = sm_zz(i,j) - fn_zz(i,j) - fp_zz(i,j+1)
200     sm_xz(i,j) = sm_xz(i,j) - fn_xz(i,j) - fp_xz(i,j+1)
201     ENDDO
202     ENDDO
203    
204     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
205     C--- part.3 : Put the temporary moments into appropriate neighboring boxes
206     C add into grid box (j): positive V(j) and negative V(j+1)
207     DO j=1-OLy+1,sNy+OLy-1
208     DO i=1-OLx,sNx+OLx
209     sm_v (i,j) = sm_v (i,j) + fp_v (i,j) + fn_v (i,j+1)
210     alfp = fp_v(i, j )/sm_v(i,j)
211     alfn = fn_v(i,j+1)/sm_v(i,j)
212     alf1 = 1. _d 0 - alfp - alfn
213     alp1 = 1. _d 0 - alfp
214     aln1 = 1. _d 0 - alfn
215     alpmn = alfp - alfn
216     locTp = alfp*sm_o(i,j) - alp1*fp_o(i,j)
217     locTn = alfn*sm_o(i,j) - aln1*fn_o(i,j+1)
218     sm_yy(i,j) = alf1*alf1*sm_yy(i,j) + alfp*alfp*fp_yy(i,j)
219     & + alfn*alfn*fn_yy(i,j+1)
220     & - 5. _d 0*(-alpmn*alf1*sm_y(i,j) + alfp*alp1*fp_y(i,j)
221     & - alfn*aln1*fn_y(i,j+1)
222     & + two*alfp*alfn*sm_o(i,j) + (alp1-alfp)*locTp
223     & + (aln1-alfn)*locTn
224     & )
225     sm_xy(i,j) = alf1*sm_xy(i,j) + alfp*fp_xy(i,j)
226     & + alfn*fn_xy(i,j+1)
227     & + three*( alpmn*sm_x(i,j) - alp1*fp_x(i,j)
228     & + aln1*fn_x(i,j+1)
229     & )
230     sm_yz(i,j) = alf1*sm_yz(i,j) + alfp*fp_yz(i,j)
231     & + alfn*fn_yz(i,j+1)
232     & + three*( alpmn*sm_z(i,j) - alp1*fp_z(i,j)
233     & + aln1*fn_z(i,j+1)
234     & )
235     sm_y (i,j) = alf1*sm_y(i,j) + alfp*fp_y(i,j) + alfn*fn_y(i,j+1)
236     & + three*( locTp - locTn )
237     sm_o (i,j) = sm_o (i,j) + fp_o (i,j) + fn_o (i,j+1)
238     sm_x (i,j) = sm_x (i,j) + fp_x (i,j) + fn_x (i,j+1)
239     sm_xx(i,j) = sm_xx(i,j) + fp_xx(i,j) + fn_xx(i,j+1)
240     sm_z (i,j) = sm_z (i,j) + fp_z (i,j) + fn_z (i,j+1)
241     sm_zz(i,j) = sm_zz(i,j) + fp_zz(i,j) + fn_zz(i,j+1)
242     sm_xz(i,j) = sm_xz(i,j) + fp_xz(i,j) + fn_xz(i,j+1)
243     ENDDO
244     ENDDO
245    
246     #endif /* GAD_ALLOW_SOM_ADVECT */
247    
248     RETURN
249     END

  ViewVC Help
Powered by ViewVC 1.1.22