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
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, qn
20	REAL aires, 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	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