/[lmdze]/trunk/dyn3d/advy.f
ViewVC logotype

Contents of /trunk/dyn3d/advy.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 112 - (show annotations)
Thu Sep 18 13:36:51 2014 UTC (9 years, 8 months ago) by guez
File size: 10139 byte(s) 
Removed 8 first arguments of fxyhyper, use variables of module serre
instead.

Moved reading of variables of module serre from procedure conf_gcm to
new procedure read_serre.

In guide, added conditions to avoid useless calls to tau2alpha and
writefield. Bugfix: offline corresponds to alpha = 1. Open only one
NetCDF file to read number of vertical levels.

In tau2alpha, added conditions to avoid useless computations of dxdyu
and dxdyv. gamma is not needed for a regular grid.
1
2 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/advy.F,v 1.1.1.1 2004/05/19
3 ! 12:53:06 lmdzadmin Exp $
4
5 SUBROUTINE advy(limit, dty, pbarv, sm, s0, sx, sy, sz)
6 USE dimens_m
7 USE paramet_m
8 USE comconst
9 USE disvert_m
10 USE comgeom
11 IMPLICIT NONE
12
13 ! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
14 ! C
15 ! first-order moments (SOM) advection of tracer in Y direction C
16 ! C
17 ! Source : Pascal Simon ( Meteo, CNRM ) C
18 ! Adaptation : A.A. (LGGE) C
19 ! Derniere Modif : 15/12/94 LAST
20 ! C
21 ! sont les arguments d'entree pour le s-pg C
22 ! C
23 ! argument de sortie du s-pg C
24 ! C
25 ! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
26 ! CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
27
28 ! Rem : Probleme aux poles il faut reecrire ce cas specifique
29 ! Attention au sens de l'indexation
30
31 ! parametres principaux du modele
32
33
34
35 ! Arguments :
36 ! ----------
37 ! dty : frequence fictive d'appel du transport
38 ! parbu,pbarv : flux de masse en x et y en Pa.m2.s-1
39
40 INTEGER lon, lat, niv
41 INTEGER i, j, jv, k, kp, l
42 INTEGER ntra
43 PARAMETER (ntra=1)
44
45 REAL dty
46 REAL, INTENT (IN) :: pbarv(iip1, jjm, llm)
47
48 ! moments: SM total mass in each grid box
49 ! S0 mass of tracer in each grid box
50 ! Si 1rst order moment in i direction
51
52 REAL sm(iip1, jjp1, llm), s0(iip1, jjp1, llm, ntra)
53 REAL sx(iip1, jjp1, llm, ntra), sy(iip1, jjp1, llm, ntra), &
54 sz(iip1, jjp1, llm, ntra)
55
56
57 ! Local :
58 ! -------
59
60 ! mass fluxes across the boundaries (UGRI,VGRI,WGRI)
61 ! mass fluxes in kg
62 ! declaration :
63
64 REAL vgri(iip1, 0:jjp1, llm)
65
66 ! Rem : UGRI et WGRI ne sont pas utilises dans
67 ! cette subroutine ( advection en y uniquement )
68 ! Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
69
70 ! the moments F are similarly defined and used as temporary
71 ! storage for portions of the grid boxes in transit
72
73 REAL f0(iim, 0:jjp1, ntra), fm(iim, 0:jjp1)
74 REAL fx(iim, jjm, ntra), fy(iim, jjm, ntra)
75 REAL fz(iim, jjm, ntra)
76 REAL s00(ntra)
77 REAL sm0 ! Just temporal variable
78
79 ! work arrays
80
81 REAL alf(iim, 0:jjp1), alf1(iim, 0:jjp1)
82 REAL alfq(iim, 0:jjp1), alf1q(iim, 0:jjp1)
83 REAL temptm ! Just temporal variable
84
85 ! Special pour poles
86
87 REAL ssum
88 EXTERNAL ssum
89
90 LOGICAL limit
91
92 lon = iim ! rem : Il est possible qu'un pbl. arrive ici
93 lat = jjp1 ! a cause des dim. differentes entre les
94 niv = llm
95
96
97 ! the moments Fi are used as temporary storage for
98 ! portions of the grid boxes in transit at the current level
99
100 ! work arrays
101
102
103 DO l = 1, llm
104 DO j = 1, jjm
105 DO i = 1, iip1
106 vgri(i, j, llm+1-l) = -1.*pbarv(i, j, l)
107 END DO
108 END DO
109 DO i = 1, iip1
110 vgri(i, 0, l) = 0.
111 vgri(i, jjp1, l) = 0.
112 END DO
113 END DO
114
115 DO l = 1, niv
116
117 ! place limits on appropriate moments before transport
118 ! (if flux-limiting is to be applied)
119
120 IF (.NOT. limit) GO TO 11
121
122 DO jv = 1, ntra
123 DO k = 1, lat
124 DO i = 1, lon
125 sy(i, k, l, jv) = sign(amin1(amax1(s0(i,k,l,jv), &
126 0.),abs(sy(i,k,l,jv))), sy(i,k,l,jv))
127 END DO
128 END DO
129 END DO
130
131 11 CONTINUE
132
133 ! le flux a travers le pole Nord est traite separement
134
135 sm0 = 0.
136 DO jv = 1, ntra
137 s00(jv) = 0.
138 END DO
139
140 DO i = 1, lon
141
142 IF (vgri(i,0,l)<=0.) THEN
143 fm(i, 0) = -vgri(i, 0, l)*dty
144 alf(i, 0) = fm(i, 0)/sm(i, 1, l)
145 sm(i, 1, l) = sm(i, 1, l) - fm(i, 0)
146 sm0 = sm0 + fm(i, 0)
147 END IF
148
149 alfq(i, 0) = alf(i, 0)*alf(i, 0)
150 alf1(i, 0) = 1. - alf(i, 0)
151 alf1q(i, 0) = alf1(i, 0)*alf1(i, 0)
152
153 END DO
154
155 DO jv = 1, ntra
156 DO i = 1, lon
157
158 IF (vgri(i,0,l)<=0.) THEN
159
160 f0(i, 0, jv) = alf(i, 0)*(s0(i,1,l,jv)-alf1(i,0)*sy(i,1,l,jv))
161
162 s00(jv) = s00(jv) + f0(i, 0, jv)
163 s0(i, 1, l, jv) = s0(i, 1, l, jv) - f0(i, 0, jv)
164 sy(i, 1, l, jv) = alf1q(i, 0)*sy(i, 1, l, jv)
165 sx(i, 1, l, jv) = alf1(i, 0)*sx(i, 1, l, jv)
166 sz(i, 1, l, jv) = alf1(i, 0)*sz(i, 1, l, jv)
167
168 END IF
169
170 END DO
171 END DO
172
173 DO i = 1, lon
174 IF (vgri(i,0,l)>0.) THEN
175 fm(i, 0) = vgri(i, 0, l)*dty
176 alf(i, 0) = fm(i, 0)/sm0
177 END IF
178 END DO
179
180 DO jv = 1, ntra
181 DO i = 1, lon
182 IF (vgri(i,0,l)>0.) THEN
183 f0(i, 0, jv) = alf(i, 0)*s00(jv)
184 END IF
185 END DO
186 END DO
187
188 ! puts the temporary moments Fi into appropriate neighboring boxes
189
190 DO i = 1, lon
191
192 IF (vgri(i,0,l)>0.) THEN
193 sm(i, 1, l) = sm(i, 1, l) + fm(i, 0)
194 alf(i, 0) = fm(i, 0)/sm(i, 1, l)
195 END IF
196
197 alf1(i, 0) = 1. - alf(i, 0)
198
199 END DO
200
201 DO jv = 1, ntra
202 DO i = 1, lon
203
204 IF (vgri(i,0,l)>0.) THEN
205
206 temptm = alf(i, 0)*s0(i, 1, l, jv) - alf1(i, 0)*f0(i, 0, jv)
207 s0(i, 1, l, jv) = s0(i, 1, l, jv) + f0(i, 0, jv)
208 sy(i, 1, l, jv) = alf1(i, 0)*sy(i, 1, l, jv) + 3.*temptm
209
210 END IF
211
212 END DO
213 END DO
214
215 ! calculate flux and moments between adjacent boxes
216 ! 1- create temporary moments/masses for partial boxes in transit
217 ! 2- reajusts moments remaining in the box
218
219 ! flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
220
221 DO k = 1, lat - 1
222 kp = k + 1
223 DO i = 1, lon
224
225 IF (vgri(i,k,l)<0.) THEN
226 fm(i, k) = -vgri(i, k, l)*dty
227 alf(i, k) = fm(i, k)/sm(i, kp, l)
228 sm(i, kp, l) = sm(i, kp, l) - fm(i, k)
229 ELSE
230 fm(i, k) = vgri(i, k, l)*dty
231 alf(i, k) = fm(i, k)/sm(i, k, l)
232 sm(i, k, l) = sm(i, k, l) - fm(i, k)
233 END IF
234
235 alfq(i, k) = alf(i, k)*alf(i, k)
236 alf1(i, k) = 1. - alf(i, k)
237 alf1q(i, k) = alf1(i, k)*alf1(i, k)
238
239 END DO
240 END DO
241
242 DO jv = 1, ntra
243 DO k = 1, lat - 1
244 kp = k + 1
245 DO i = 1, lon
246
247 IF (vgri(i,k,l)<0.) THEN
248
249 f0(i, k, jv) = alf(i, k)*(s0(i,kp,l,jv)-alf1(i,k)*sy(i,kp,l,jv))
250 fy(i, k, jv) = alfq(i, k)*sy(i, kp, l, jv)
251 fx(i, k, jv) = alf(i, k)*sx(i, kp, l, jv)
252 fz(i, k, jv) = alf(i, k)*sz(i, kp, l, jv)
253
254 s0(i, kp, l, jv) = s0(i, kp, l, jv) - f0(i, k, jv)
255 sy(i, kp, l, jv) = alf1q(i, k)*sy(i, kp, l, jv)
256 sx(i, kp, l, jv) = sx(i, kp, l, jv) - fx(i, k, jv)
257 sz(i, kp, l, jv) = sz(i, kp, l, jv) - fz(i, k, jv)
258
259 ELSE
260
261 f0(i, k, jv) = alf(i, k)*(s0(i,k,l,jv)+alf1(i,k)*sy(i,k,l,jv))
262 fy(i, k, jv) = alfq(i, k)*sy(i, k, l, jv)
263 fx(i, k, jv) = alf(i, k)*sx(i, k, l, jv)
264 fz(i, k, jv) = alf(i, k)*sz(i, k, l, jv)
265
266 s0(i, k, l, jv) = s0(i, k, l, jv) - f0(i, k, jv)
267 sy(i, k, l, jv) = alf1q(i, k)*sy(i, k, l, jv)
268 sx(i, k, l, jv) = sx(i, k, l, jv) - fx(i, k, jv)
269 sz(i, k, l, jv) = sz(i, k, l, jv) - fz(i, k, jv)
270
271 END IF
272
273 END DO
274 END DO
275 END DO
276
277 ! puts the temporary moments Fi into appropriate neighboring boxes
278
279 DO k = 1, lat - 1
280 kp = k + 1
281 DO i = 1, lon
282
283 IF (vgri(i,k,l)<0.) THEN
284 sm(i, k, l) = sm(i, k, l) + fm(i, k)
285 alf(i, k) = fm(i, k)/sm(i, k, l)
286 ELSE
287 sm(i, kp, l) = sm(i, kp, l) + fm(i, k)
288 alf(i, k) = fm(i, k)/sm(i, kp, l)
289 END IF
290
291 alf1(i, k) = 1. - alf(i, k)
292
293 END DO
294 END DO
295
296 DO jv = 1, ntra
297 DO k = 1, lat - 1
298 kp = k + 1
299 DO i = 1, lon
300
301 IF (vgri(i,k,l)<0.) THEN
302
303 temptm = -alf(i, k)*s0(i, k, l, jv) + alf1(i, k)*f0(i, k, jv)
304 s0(i, k, l, jv) = s0(i, k, l, jv) + f0(i, k, jv)
305 sy(i, k, l, jv) = alf(i, k)*fy(i, k, jv) + &
306 alf1(i, k)*sy(i, k, l, jv) + 3.*temptm
307 sx(i, k, l, jv) = sx(i, k, l, jv) + fx(i, k, jv)
308 sz(i, k, l, jv) = sz(i, k, l, jv) + fz(i, k, jv)
309
310 ELSE
311
312 temptm = alf(i, k)*s0(i, kp, l, jv) - alf1(i, k)*f0(i, k, jv)
313 s0(i, kp, l, jv) = s0(i, kp, l, jv) + f0(i, k, jv)
314 sy(i, kp, l, jv) = alf(i, k)*fy(i, k, jv) + &
315 alf1(i, k)*sy(i, kp, l, jv) + 3.*temptm
316 sx(i, kp, l, jv) = sx(i, kp, l, jv) + fx(i, k, jv)
317 sz(i, kp, l, jv) = sz(i, kp, l, jv) + fz(i, k, jv)
318
319 END IF
320
321 END DO
322 END DO
323 END DO
324
325 ! traitement special pour le pole Sud (idem pole Nord)
326
327 k = lat
328
329 sm0 = 0.
330 DO jv = 1, ntra
331 s00(jv) = 0.
332 END DO
333
334 DO i = 1, lon
335
336 IF (vgri(i,k,l)>=0.) THEN
337 fm(i, k) = vgri(i, k, l)*dty
338 alf(i, k) = fm(i, k)/sm(i, k, l)
339 sm(i, k, l) = sm(i, k, l) - fm(i, k)
340 sm0 = sm0 + fm(i, k)
341 END IF
342
343 alfq(i, k) = alf(i, k)*alf(i, k)
344 alf1(i, k) = 1. - alf(i, k)
345 alf1q(i, k) = alf1(i, k)*alf1(i, k)
346
347 END DO
348
349 DO jv = 1, ntra
350 DO i = 1, lon
351
352 IF (vgri(i,k,l)>=0.) THEN
353 f0(i, k, jv) = alf(i, k)*(s0(i,k,l,jv)+alf1(i,k)*sy(i,k,l,jv))
354 s00(jv) = s00(jv) + f0(i, k, jv)
355
356 s0(i, k, l, jv) = s0(i, k, l, jv) - f0(i, k, jv)
357 sy(i, k, l, jv) = alf1q(i, k)*sy(i, k, l, jv)
358 sx(i, k, l, jv) = alf1(i, k)*sx(i, k, l, jv)
359 sz(i, k, l, jv) = alf1(i, k)*sz(i, k, l, jv)
360 END IF
361
362 END DO
363 END DO
364
365 DO i = 1, lon
366 IF (vgri(i,k,l)<0.) THEN
367 fm(i, k) = -vgri(i, k, l)*dty
368 alf(i, k) = fm(i, k)/sm0
369 END IF
370 END DO
371
372 DO jv = 1, ntra
373 DO i = 1, lon
374 IF (vgri(i,k,l)<0.) THEN
375 f0(i, k, jv) = alf(i, k)*s00(jv)
376 END IF
377 END DO
378 END DO
379
380 ! puts the temporary moments Fi into appropriate neighboring boxes
381
382 DO i = 1, lon
383
384 IF (vgri(i,k,l)<0.) THEN
385 sm(i, k, l) = sm(i, k, l) + fm(i, k)
386 alf(i, k) = fm(i, k)/sm(i, k, l)
387 END IF
388
389 alf1(i, k) = 1. - alf(i, k)
390
391 END DO
392
393 DO jv = 1, ntra
394 DO i = 1, lon
395
396 IF (vgri(i,k,l)<0.) THEN
397
398 temptm = -alf(i, k)*s0(i, k, l, jv) + alf1(i, k)*f0(i, k, jv)
399 s0(i, k, l, jv) = s0(i, k, l, jv) + f0(i, k, jv)
400 sy(i, k, l, jv) = alf1(i, k)*sy(i, k, l, jv) + 3.*temptm
401
402 END IF
403
404 END DO
405 END DO
406
407 END DO
408
409 RETURN
410 END SUBROUTINE advy
411
  ViewVC Help
Powered by ViewVC 1.1.21