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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 178 - (show 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
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 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