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

Annotation of /trunk/dyn3d/advy.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 112 - (hide 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 guez 3
2 guez 81 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/advy.F,v 1.1.1.1 2004/05/19
3     ! 12:53:06 lmdzadmin Exp $
4 guez 3
5 guez 81 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 guez 3
13 guez 81 ! 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 guez 3
28 guez 81 ! Rem : Probleme aux poles il faut reecrire ce cas specifique
29     ! Attention au sens de l'indexation
30 guez 3
31 guez 81 ! parametres principaux du modele
32 guez 3
33    
34    
35 guez 81 ! 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 guez 3
40 guez 81 INTEGER lon, lat, niv
41     INTEGER i, j, jv, k, kp, l
42     INTEGER ntra
43     PARAMETER (ntra=1)
44 guez 3
45 guez 81 REAL dty
46     REAL, INTENT (IN) :: pbarv(iip1, jjm, llm)
47 guez 3
48 guez 81 ! 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 guez 3
52 guez 81 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 guez 3
56    
57 guez 81 ! 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