1 |
guez |
3 |
|
2 |
guez |
81 |
! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/groupeun.F,v 1.1.1.1 2004/05/19 |
3 |
|
|
! 12:53:07 lmdzadmin Exp $ |
4 |
guez |
3 |
|
5 |
guez |
81 |
SUBROUTINE groupeun(jjmax, llmax, q) |
6 |
|
|
USE dimens_m |
7 |
|
|
USE paramet_m |
8 |
|
|
USE comconst |
9 |
|
|
USE comgeom |
10 |
|
|
IMPLICIT NONE |
11 |
guez |
3 |
|
12 |
|
|
|
13 |
guez |
81 |
INTEGER jjmax, llmax |
14 |
|
|
REAL q(iip1, jjmax, llmax) |
15 |
guez |
3 |
|
16 |
guez |
81 |
INTEGER ngroup |
17 |
|
|
PARAMETER (ngroup=3) |
18 |
guez |
3 |
|
19 |
guez |
81 |
REAL airen, airecn, qn |
20 |
|
|
REAL aires, airecs, qs |
21 |
guez |
3 |
|
22 |
guez |
81 |
INTEGER i, j, l, ig, j1, j2, i0, jd |
23 |
|
|
|
24 |
|
|
! hamps 3D |
25 |
|
|
jd = jjp1 - jjmax |
26 |
|
|
DO l = 1, llm |
27 |
|
|
j1 = 1 + jd |
28 |
|
|
j2 = 2 |
29 |
|
|
DO ig = 1, ngroup |
30 |
|
|
DO j = j1 - jd, j2 - jd |
31 |
|
|
DO i0 = 1, iim, 2**(ngroup-ig+1) |
32 |
|
|
airen = 0. |
33 |
|
|
airecn = 0. |
34 |
|
|
qn = 0. |
35 |
|
|
aires = 0. |
36 |
|
|
airecs = 0. |
37 |
|
|
qs = 0. |
38 |
|
|
DO i = i0, i0 + 2**(ngroup-ig+1) - 1 |
39 |
|
|
airen = airen + aire_2d(i, j) |
40 |
|
|
aires = aires + aire_2d(i, jjp1-j+1) |
41 |
|
|
qn = qn + q(i, j, l) |
42 |
|
|
qs = qs + q(i, jjp1-j+1-jd, l) |
43 |
|
|
END DO |
44 |
|
|
airecn = 0. |
45 |
|
|
airecs = 0. |
46 |
|
|
DO i = i0, i0 + 2**(ngroup-ig+1) - 1 |
47 |
|
|
q(i, j, l) = qn*aire_2d(i, j)/airen |
48 |
|
|
q(i, jjp1-j+1-jd, l) = qs*aire_2d(i, jjp1-j+1)/aires |
49 |
|
|
END DO |
50 |
|
|
END DO |
51 |
|
|
q(iip1, j, l) = q(1, j, l) |
52 |
|
|
q(iip1, jjp1-j+1-jd, l) = q(1, jjp1-j+1-jd, l) |
53 |
|
|
END DO |
54 |
|
|
j1 = j2 + 1 |
55 |
|
|
j2 = j2 + 2**ig |
56 |
|
|
END DO |
57 |
|
|
END DO |
58 |
|
|
|
59 |
|
|
RETURN |
60 |
|
|
END SUBROUTINE groupeun |