trunk/dyn3d/groupeun.f


! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/groupeun.F,v 1.1.1.1 2004/05/19
! 12:53:07 lmdzadmin Exp $

SUBROUTINE groupeun(jjmax, llmax, q)
  USE dimens_m
  USE paramet_m
  USE comconst
  USE comgeom
  IMPLICIT NONE


  INTEGER jjmax, llmax
  REAL q(iip1, jjmax, llmax)

  INTEGER ngroup
  PARAMETER (ngroup=3)

  REAL airen, qn
  REAL aires, qs

  INTEGER i, j, l, ig, j1, j2, i0, jd

  ! hamps 3D
  jd = jjp1 - jjmax
  DO l = 1, llm
    j1 = 1 + jd
    j2 = 2
    DO ig = 1, ngroup
      DO j = j1 - jd, j2 - jd
        DO i0 = 1, iim, 2**(ngroup-ig+1)
          airen = 0.
          qn = 0.
          aires = 0.
          qs = 0.
          DO i = i0, i0 + 2**(ngroup-ig+1) - 1
            airen = airen + aire_2d(i, j)
            aires = aires + aire_2d(i, jjp1-j+1)
            qn = qn + q(i, j, l)
            qs = qs + q(i, jjp1-j+1-jd, l)
          END DO
          DO i = i0, i0 + 2**(ngroup-ig+1) - 1
            q(i, j, l) = qn*aire_2d(i, j)/airen
            q(i, jjp1-j+1-jd, l) = qs*aire_2d(i, jjp1-j+1)/aires
          END DO
        END DO
        q(iip1, j, l) = q(1, j, l)
        q(iip1, jjp1-j+1-jd, l) = q(1, jjp1-j+1-jd, l)
      END DO
      j1 = j2 + 1
      j2 = j2 + 2**ig
    END DO
  END DO

  RETURN
END SUBROUTINE groupeun
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	178	REAL airen, qn
20			REAL aires, 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			qn = 0.
34			aires = 0.
35			qs = 0.
36			DO i = i0, i0 + 2**(ngroup-ig+1) - 1
37			airen = airen + aire_2d(i, j)
38			aires = aires + aire_2d(i, jjp1-j+1)
39			qn = qn + q(i, j, l)
40			qs = qs + q(i, jjp1-j+1-jd, l)
41			END DO
42			DO i = i0, i0 + 2**(ngroup-ig+1) - 1
43			q(i, j, l) = qn*aire_2d(i, j)/airen
44			q(i, jjp1-j+1-jd, l) = qs*aire_2d(i, jjp1-j+1)/aires
45			END DO
46			END DO
47			q(iip1, j, l) = q(1, j, l)
48			q(iip1, jjp1-j+1-jd, l) = q(1, jjp1-j+1-jd, l)
49			END DO
50			j1 = j2 + 1
51			j2 = j2 + 2**ig
52			END DO
53			END DO
54
55			RETURN
56			END SUBROUTINE groupeun