1 |
|
2 |
! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/groupeun.F,v 1.1.1.1 2004/05/19 |
3 |
! 12:53:07 lmdzadmin Exp $ |
4 |
|
5 |
SUBROUTINE groupeun(jjmax, llmax, q) |
6 |
USE dimens_m |
7 |
USE paramet_m |
8 |
USE comconst |
9 |
USE comgeom |
10 |
IMPLICIT NONE |
11 |
|
12 |
|
13 |
INTEGER jjmax, llmax |
14 |
REAL q(iip1, jjmax, llmax) |
15 |
|
16 |
INTEGER ngroup |
17 |
PARAMETER (ngroup=3) |
18 |
|
19 |
REAL airen, airecn, qn |
20 |
REAL aires, airecs, qs |
21 |
|
22 |
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 |