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

Annotation of /trunk/Sources/dyn3d/advy.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 178 - (hide annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 2 months ago) by guez
File size: 10110 byte(s) 
Moved variables date0, deltat, datasz_max, ncvar_ids, point, buff_pos,
buffer, regular from module histcom_var to modules where they are
defined.

Removed procedure ioipslmpp, useless for a sequential program.

Added argument datasz_max to histwrite_real (to avoid circular
dependency with histwrite).

Removed useless variables and computations everywhere.

Changed real litteral constants from default kind to double precision
in lwb, lwu, lwvn, sw1s, swtt, swtt1, swu.

Removed unused arguments: paer of sw, sw1s, sw2s, swclr; pcldsw of
sw1s, sw2s; pdsig, prayl of swr; co2_ppm of clmain, clqh; tsol of
transp_lay; nsrf of screenp; kcrit and kknu of gwstress; pstd of
orosetup.

Added output of relative humidity.
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     LOGICAL limit
88    
89     lon = iim ! rem : Il est possible qu'un pbl. arrive ici
90     lat = jjp1 ! a cause des dim. differentes entre les
91     niv = llm
92    
93    
94     ! the moments Fi are used as temporary storage for
95     ! portions of the grid boxes in transit at the current level
96    
97     ! work arrays
98    
99    
100     DO l = 1, llm
101     DO j = 1, jjm
102     DO i = 1, iip1
103     vgri(i, j, llm+1-l) = -1.*pbarv(i, j, l)
104     END DO
105     END DO
106     DO i = 1, iip1
107     vgri(i, 0, l) = 0.
108     vgri(i, jjp1, l) = 0.
109     END DO
110     END DO
111    
112     DO l = 1, niv
113    
114     ! place limits on appropriate moments before transport
115     ! (if flux-limiting is to be applied)
116    
117     IF (.NOT. limit) GO TO 11
118    
119     DO jv = 1, ntra
120     DO k = 1, lat
121     DO i = 1, lon
122     sy(i, k, l, jv) = sign(amin1(amax1(s0(i,k,l,jv), &
123     0.),abs(sy(i,k,l,jv))), sy(i,k,l,jv))
124     END DO
125     END DO
126     END DO
127    
128     11 CONTINUE
129    
130     ! le flux a travers le pole Nord est traite separement
131    
132     sm0 = 0.
133     DO jv = 1, ntra
134     s00(jv) = 0.
135     END DO
136    
137     DO i = 1, lon
138    
139     IF (vgri(i,0,l)<=0.) THEN
140     fm(i, 0) = -vgri(i, 0, l)*dty
141     alf(i, 0) = fm(i, 0)/sm(i, 1, l)
142     sm(i, 1, l) = sm(i, 1, l) - fm(i, 0)
143     sm0 = sm0 + fm(i, 0)
144     END IF
145    
146     alfq(i, 0) = alf(i, 0)*alf(i, 0)
147     alf1(i, 0) = 1. - alf(i, 0)
148     alf1q(i, 0) = alf1(i, 0)*alf1(i, 0)
149    
150     END DO
151    
152     DO jv = 1, ntra
153     DO i = 1, lon
154    
155     IF (vgri(i,0,l)<=0.) THEN
156    
157     f0(i, 0, jv) = alf(i, 0)*(s0(i,1,l,jv)-alf1(i,0)*sy(i,1,l,jv))
158    
159     s00(jv) = s00(jv) + f0(i, 0, jv)
160     s0(i, 1, l, jv) = s0(i, 1, l, jv) - f0(i, 0, jv)
161     sy(i, 1, l, jv) = alf1q(i, 0)*sy(i, 1, l, jv)
162     sx(i, 1, l, jv) = alf1(i, 0)*sx(i, 1, l, jv)
163     sz(i, 1, l, jv) = alf1(i, 0)*sz(i, 1, l, jv)
164    
165     END IF
166    
167     END DO
168     END DO
169    
170     DO i = 1, lon
171     IF (vgri(i,0,l)>0.) THEN
172     fm(i, 0) = vgri(i, 0, l)*dty
173     alf(i, 0) = fm(i, 0)/sm0
174     END IF
175     END DO
176    
177     DO jv = 1, ntra
178     DO i = 1, lon
179     IF (vgri(i,0,l)>0.) THEN
180     f0(i, 0, jv) = alf(i, 0)*s00(jv)
181     END IF
182     END DO
183     END DO
184    
185     ! puts the temporary moments Fi into appropriate neighboring boxes
186    
187     DO i = 1, lon
188    
189     IF (vgri(i,0,l)>0.) THEN
190     sm(i, 1, l) = sm(i, 1, l) + fm(i, 0)
191     alf(i, 0) = fm(i, 0)/sm(i, 1, l)
192     END IF
193    
194     alf1(i, 0) = 1. - alf(i, 0)
195    
196     END DO
197    
198     DO jv = 1, ntra
199     DO i = 1, lon
200    
201     IF (vgri(i,0,l)>0.) THEN
202    
203     temptm = alf(i, 0)*s0(i, 1, l, jv) - alf1(i, 0)*f0(i, 0, jv)
204     s0(i, 1, l, jv) = s0(i, 1, l, jv) + f0(i, 0, jv)
205     sy(i, 1, l, jv) = alf1(i, 0)*sy(i, 1, l, jv) + 3.*temptm
206    
207     END IF
208    
209     END DO
210     END DO
211    
212     ! calculate flux and moments between adjacent boxes
213     ! 1- create temporary moments/masses for partial boxes in transit
214     ! 2- reajusts moments remaining in the box
215    
216     ! flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
217    
218     DO k = 1, lat - 1
219     kp = k + 1
220     DO i = 1, lon
221    
222     IF (vgri(i,k,l)<0.) THEN
223     fm(i, k) = -vgri(i, k, l)*dty
224     alf(i, k) = fm(i, k)/sm(i, kp, l)
225     sm(i, kp, l) = sm(i, kp, l) - fm(i, k)
226     ELSE
227     fm(i, k) = vgri(i, k, l)*dty
228     alf(i, k) = fm(i, k)/sm(i, k, l)
229     sm(i, k, l) = sm(i, k, l) - fm(i, k)
230     END IF
231    
232     alfq(i, k) = alf(i, k)*alf(i, k)
233     alf1(i, k) = 1. - alf(i, k)
234     alf1q(i, k) = alf1(i, k)*alf1(i, k)
235    
236     END DO
237     END DO
238    
239     DO jv = 1, ntra
240     DO k = 1, lat - 1
241     kp = k + 1
242     DO i = 1, lon
243    
244     IF (vgri(i,k,l)<0.) THEN
245    
246     f0(i, k, jv) = alf(i, k)*(s0(i,kp,l,jv)-alf1(i,k)*sy(i,kp,l,jv))
247     fy(i, k, jv) = alfq(i, k)*sy(i, kp, l, jv)
248     fx(i, k, jv) = alf(i, k)*sx(i, kp, l, jv)
249     fz(i, k, jv) = alf(i, k)*sz(i, kp, l, jv)
250    
251     s0(i, kp, l, jv) = s0(i, kp, l, jv) - f0(i, k, jv)
252     sy(i, kp, l, jv) = alf1q(i, k)*sy(i, kp, l, jv)
253     sx(i, kp, l, jv) = sx(i, kp, l, jv) - fx(i, k, jv)
254     sz(i, kp, l, jv) = sz(i, kp, l, jv) - fz(i, k, jv)
255    
256     ELSE
257    
258     f0(i, k, jv) = alf(i, k)*(s0(i,k,l,jv)+alf1(i,k)*sy(i,k,l,jv))
259     fy(i, k, jv) = alfq(i, k)*sy(i, k, l, jv)
260     fx(i, k, jv) = alf(i, k)*sx(i, k, l, jv)
261     fz(i, k, jv) = alf(i, k)*sz(i, k, l, jv)
262    
263     s0(i, k, l, jv) = s0(i, k, l, jv) - f0(i, k, jv)
264     sy(i, k, l, jv) = alf1q(i, k)*sy(i, k, l, jv)
265     sx(i, k, l, jv) = sx(i, k, l, jv) - fx(i, k, jv)
266     sz(i, k, l, jv) = sz(i, k, l, jv) - fz(i, k, jv)
267    
268     END IF
269    
270     END DO
271     END DO
272     END DO
273    
274     ! puts the temporary moments Fi into appropriate neighboring boxes
275    
276     DO k = 1, lat - 1
277     kp = k + 1
278     DO i = 1, lon
279    
280     IF (vgri(i,k,l)<0.) THEN
281     sm(i, k, l) = sm(i, k, l) + fm(i, k)
282     alf(i, k) = fm(i, k)/sm(i, k, l)
283     ELSE
284     sm(i, kp, l) = sm(i, kp, l) + fm(i, k)
285     alf(i, k) = fm(i, k)/sm(i, kp, l)
286     END IF
287    
288     alf1(i, k) = 1. - alf(i, k)
289    
290     END DO
291     END DO
292    
293     DO jv = 1, ntra
294     DO k = 1, lat - 1
295     kp = k + 1
296     DO i = 1, lon
297    
298     IF (vgri(i,k,l)<0.) THEN
299    
300     temptm = -alf(i, k)*s0(i, k, l, jv) + alf1(i, k)*f0(i, k, jv)
301     s0(i, k, l, jv) = s0(i, k, l, jv) + f0(i, k, jv)
302     sy(i, k, l, jv) = alf(i, k)*fy(i, k, jv) + &
303     alf1(i, k)*sy(i, k, l, jv) + 3.*temptm
304     sx(i, k, l, jv) = sx(i, k, l, jv) + fx(i, k, jv)
305     sz(i, k, l, jv) = sz(i, k, l, jv) + fz(i, k, jv)
306    
307     ELSE
308    
309     temptm = alf(i, k)*s0(i, kp, l, jv) - alf1(i, k)*f0(i, k, jv)
310     s0(i, kp, l, jv) = s0(i, kp, l, jv) + f0(i, k, jv)
311     sy(i, kp, l, jv) = alf(i, k)*fy(i, k, jv) + &
312     alf1(i, k)*sy(i, kp, l, jv) + 3.*temptm
313     sx(i, kp, l, jv) = sx(i, kp, l, jv) + fx(i, k, jv)
314     sz(i, kp, l, jv) = sz(i, kp, l, jv) + fz(i, k, jv)
315    
316     END IF
317    
318     END DO
319     END DO
320     END DO
321    
322     ! traitement special pour le pole Sud (idem pole Nord)
323    
324     k = lat
325    
326     sm0 = 0.
327     DO jv = 1, ntra
328     s00(jv) = 0.
329     END DO
330    
331     DO i = 1, lon
332    
333     IF (vgri(i,k,l)>=0.) THEN
334     fm(i, k) = vgri(i, k, l)*dty
335     alf(i, k) = fm(i, k)/sm(i, k, l)
336     sm(i, k, l) = sm(i, k, l) - fm(i, k)
337     sm0 = sm0 + fm(i, k)
338     END IF
339    
340     alfq(i, k) = alf(i, k)*alf(i, k)
341     alf1(i, k) = 1. - alf(i, k)
342     alf1q(i, k) = alf1(i, k)*alf1(i, k)
343    
344     END DO
345    
346     DO jv = 1, ntra
347     DO i = 1, lon
348    
349     IF (vgri(i,k,l)>=0.) THEN
350     f0(i, k, jv) = alf(i, k)*(s0(i,k,l,jv)+alf1(i,k)*sy(i,k,l,jv))
351     s00(jv) = s00(jv) + f0(i, k, jv)
352    
353     s0(i, k, l, jv) = s0(i, k, l, jv) - f0(i, k, jv)
354     sy(i, k, l, jv) = alf1q(i, k)*sy(i, k, l, jv)
355     sx(i, k, l, jv) = alf1(i, k)*sx(i, k, l, jv)
356     sz(i, k, l, jv) = alf1(i, k)*sz(i, k, l, jv)
357     END IF
358    
359     END DO
360     END DO
361    
362     DO i = 1, lon
363     IF (vgri(i,k,l)<0.) THEN
364     fm(i, k) = -vgri(i, k, l)*dty
365     alf(i, k) = fm(i, k)/sm0
366     END IF
367     END DO
368    
369     DO jv = 1, ntra
370     DO i = 1, lon
371     IF (vgri(i,k,l)<0.) THEN
372     f0(i, k, jv) = alf(i, k)*s00(jv)
373     END IF
374     END DO
375     END DO
376    
377     ! puts the temporary moments Fi into appropriate neighboring boxes
378    
379     DO i = 1, lon
380    
381     IF (vgri(i,k,l)<0.) THEN
382     sm(i, k, l) = sm(i, k, l) + fm(i, k)
383     alf(i, k) = fm(i, k)/sm(i, k, l)
384     END IF
385    
386     alf1(i, k) = 1. - alf(i, k)
387    
388     END DO
389    
390     DO jv = 1, ntra
391     DO i = 1, lon
392    
393     IF (vgri(i,k,l)<0.) THEN
394    
395     temptm = -alf(i, k)*s0(i, k, l, jv) + alf1(i, k)*f0(i, k, jv)
396     s0(i, k, l, jv) = s0(i, k, l, jv) + f0(i, k, jv)
397     sy(i, k, l, jv) = alf1(i, k)*sy(i, k, l, jv) + 3.*temptm
398    
399     END IF
400    
401     END DO
402     END DO
403    
404     END DO
405    
406     RETURN
407     END SUBROUTINE advy
408    
  ViewVC Help
Powered by ViewVC 1.1.21