9 |
C !INTERFACE: ========================================================== |
C !INTERFACE: ========================================================== |
10 |
SUBROUTINE GAD_SOM_ADV_Y( |
SUBROUTINE GAD_SOM_ADV_Y( |
11 |
I bi,bj,k, limiter, |
I bi,bj,k, limiter, |
12 |
|
I overlapOnly, interiorOnly, |
13 |
|
I N_edge, S_edge, E_edge, W_edge, |
14 |
I deltaTloc, vTrans, |
I deltaTloc, vTrans, |
15 |
U sm_v, sm_o, sm_x, sm_y, sm_z, |
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, |
U sm_xx, sm_yy, sm_zz, sm_xy, sm_xz, sm_yz, |
36 |
C !USES: =============================================================== |
C !USES: =============================================================== |
37 |
IMPLICIT NONE |
IMPLICIT NONE |
38 |
#include "SIZE.h" |
#include "SIZE.h" |
|
c #include "GRID.h" |
|
39 |
#include "GAD.h" |
#include "GAD.h" |
40 |
|
|
41 |
C !INPUT PARAMETERS: =================================================== |
C !INPUT PARAMETERS: =================================================== |
42 |
C bi,bj :: tile indices |
C bi,bj :: tile indices |
43 |
C k :: vertical level |
C k :: vertical level |
44 |
C limiter :: 0: no limiter ; 1: Prather, 1986 limiter |
C limiter :: 0: no limiter ; 1: Prather, 1986 limiter |
45 |
C vTrans :: zonal volume transport |
C overlapOnly :: only update the edges of myTile, but not the interior |
46 |
C myThid :: my Thread Id. number |
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 |
INTEGER bi,bj,k |
INTEGER bi,bj,k |
51 |
INTEGER limiter |
INTEGER limiter |
52 |
|
LOGICAL overlapOnly, interiorOnly |
53 |
|
LOGICAL N_edge, S_edge, E_edge, W_edge |
54 |
_RL deltaTloc |
_RL deltaTloc |
55 |
_RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
_RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
c _RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy) |
|
56 |
INTEGER myThid |
INTEGER myThid |
57 |
|
|
58 |
C !OUTPUT PARAMETERS: ================================================== |
C !OUTPUT PARAMETERS: ================================================== |
77 |
|
|
78 |
#ifdef GAD_ALLOW_SOM_ADVECT |
#ifdef GAD_ALLOW_SOM_ADVECT |
79 |
C !LOCAL VARIABLES: ==================================================== |
C !LOCAL VARIABLES: ==================================================== |
80 |
C i,j :: loop indices |
C i,j :: loop indices |
81 |
C vLoc :: volume transported (per time step) |
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 |
_RL two, three |
_RL two, three |
86 |
PARAMETER( two = 2. _d 0 ) |
PARAMETER( two = 2. _d 0 ) |
87 |
PARAMETER( three = 3. _d 0 ) |
PARAMETER( three = 3. _d 0 ) |
88 |
INTEGER i,j |
INTEGER i,j |
89 |
|
INTEGER ns, nbStrips |
90 |
|
INTEGER iMinUpd(2), iMaxUpd(2), jMinUpd(2), jMaxUpd(2) |
91 |
_RL recip_dT |
_RL recip_dT |
92 |
_RL slpmax, s1max, s1new, s2new |
_RL slpmax, s1max, s1new, s2new |
93 |
_RL vLoc, alf1, alf1q, alpmn |
_RL vLoc, alf1, alf1q, alpmn |
122 |
recip_dT = 0. |
recip_dT = 0. |
123 |
IF ( deltaTloc.GT.0. _d 0 ) recip_dT = 1.0 _d 0 / deltaTloc |
IF ( deltaTloc.GT.0. _d 0 ) recip_dT = 1.0 _d 0 / deltaTloc |
124 |
|
|
125 |
|
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 |
IF ( limiter.EQ.1 ) THEN |
IF ( limiter.EQ.1 ) THEN |
162 |
DO j=1-OLy,sNy+OLy |
DO j=jMinUpd(1)-1,jMaxUpd(1)+1 |
163 |
DO i=1-OLx,sNx+OLx |
DO i=iMinUpd(ns),iMaxUpd(ns) |
164 |
C If flux-limiting transport is to be applied, place limits on |
C If flux-limiting transport is to be applied, place limits on |
165 |
C appropriate moments before transport. |
C appropriate moments before transport. |
166 |
slpmax = 0. |
slpmax = 0. |
179 |
|
|
180 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
181 |
C--- part.1 : calculate flux for all moments |
C--- part.1 : calculate flux for all moments |
182 |
DO i=1-OLx,sNx+OLx |
DO j=jMinUpd(1),jMaxUpd(1)+1 |
183 |
vT(i,1-OLy)=0. |
DO i=iMinUpd(ns),iMaxUpd(ns) |
|
ENDDO |
|
|
DO j=1-OLy+1,sNy+OLy |
|
|
DO i=1-OLx,sNx+OLx |
|
184 |
vLoc = vTrans(i,j)*deltaTloc |
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) |
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 ) |
fp_v (i,j) = MAX( 0. _d 0, vLoc ) |
226 |
ENDDO |
ENDDO |
227 |
ENDDO |
ENDDO |
228 |
|
|
229 |
|
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 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
241 |
|
C-- start 2nd loop on strip number "ns" |
242 |
|
c DO ns=1,nbStrips |
243 |
|
|
244 |
C--- part.2 : re-adjust moments remaining in the box |
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) |
C take off from grid box (j): negative V(j) and positive V(j+1) |
246 |
DO j=1-OLy+1,sNy+OLy-1 |
DO j=jMinUpd(1),jMaxUpd(1) |
247 |
DO i=1-OLx,sNx+OLx |
DO i=iMinUpd(ns),iMaxUpd(ns) |
248 |
alf1 = 1. _d 0 - aln(i,j) - alp(i,j+1) |
alf1 = 1. _d 0 - aln(i,j) - alp(i,j+1) |
249 |
alf1q = alf1*alf1 |
alf1q = alf1*alf1 |
250 |
alpmn = alp(i,j+1) - aln(i,j) |
alpmn = alp(i,j+1) - aln(i,j) |
265 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
266 |
C--- part.3 : Put the temporary moments into appropriate neighboring boxes |
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) |
C add into grid box (j): positive V(j) and negative V(j+1) |
268 |
DO j=1-OLy+1,sNy+OLy-1 |
DO j=jMinUpd(1),jMaxUpd(1) |
269 |
DO i=1-OLx,sNx+OLx |
DO i=iMinUpd(ns),iMaxUpd(ns) |
270 |
sm_v (i,j) = sm_v (i,j) + fp_v (i,j) + fn_v (i,j+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) |
alfp = fp_v(i, j )/sm_v(i,j) |
272 |
alfn = fn_v(i,j+1)/sm_v(i,j) |
alfn = fn_v(i,j+1)/sm_v(i,j) |
304 |
ENDDO |
ENDDO |
305 |
ENDDO |
ENDDO |
306 |
|
|
307 |
|
C-- end 2nd loop on strip number "ns" |
308 |
|
ENDDO |
309 |
|
|
310 |
#endif /* GAD_ALLOW_SOM_ADVECT */ |
#endif /* GAD_ALLOW_SOM_ADVECT */ |
311 |
|
|
312 |
RETURN |
RETURN |