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,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	!
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