libf/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,airecn,qn
      real aires,airecs,qs

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

Champs 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.
               airecn=0.
               qn=0.
               aires=0.
               airecs=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)
               enddo
               airecn=0.
               airecs=0.
               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
               enddo
            enddo
            q(iip1,j,l)=q(1,j,l)
            q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
         enddo
         j1=j2+1
         j2=j2+2**ig
      enddo
      enddo

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