source: LMDZ4/trunk/libf/dyn3d/groupeun.F @ 540

Last change on this file since 540 was 524, checked in by lmdzadmin, 21 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.4 KB
RevLine 
[524]1!
2! $Header$
3!
4      subroutine groupeun(jjmax,llmax,q)
5      implicit none
6
7#include "dimensions.h"
8#include "paramet.h"
9#include "comconst.h"
10#include "comgeom2.h"
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
23Champs 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
30c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
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(i,j)
40                  aires=aires+aire(i,jjp1-j+1)
41                  qn=qn+q(i,j,l)
42                  qs=qs+q(i,jjp1-j+1-jd,l)
43               enddo
44               airecn=0.
45               airecs=0.
46               do i=i0,i0+2**(ngroup-ig+1)-1
47                  q(i,j,l)=qn*aire(i,j)/airen
48                  q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
49               enddo
50            enddo
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         enddo
54         j1=j2+1
55         j2=j2+2**ig
56      enddo
57      enddo
58
59      return
60      end
Note: See TracBrowser for help on using the repository browser.