source: LMDZ4/branches/pre_V3/libf/dyn3dpar/groupeun_p.F @ 5373

Last change on this file since 5373 was 630, checked in by Laurent Fairhead, 20 years ago

Import d'une version parallele de la dynamique YM
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.9 KB
Line 
1      subroutine groupeun_p(jjmax,llmax,jjb,jje,q)
2      USE parallel
3      implicit none
4
5#include "dimensions.h"
6#include "paramet.h"
7#include "comconst.h"
8#include "comgeom2.h"
9
10      integer jjmax,llmax,jjb,jje
11      real q(iip1,jjmax,llmax)
12
13      integer ngroup
14      parameter (ngroup=3)
15
16      real airen,airecn,qn
17      real aires,airecs,qs
18
19      integer i,j,l,ig,j1,j2,i0,jd
20
21Champs 3D
22      jd=jjp1-jjmax
23      do l=1,llm
24      j1=1+jd
25      j2=2
26      do ig=1,ngroup
27         do j=j1-jd,j2-jd
28c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
29            if ( j >= jjb .AND. j <= jje) THEN
30             
31              do i0=1,iim,2**(ngroup-ig+1)
32                 
33                 airen=0.
34                 airecn=0.
35                 qn=0.
36                 
37                 do i=i0,i0+2**(ngroup-ig+1)-1
38                    airen=airen+aire(i,j)
39                    qn=qn+q(i,j,l)
40                 enddo
41                 airecn=0.
42                 do i=i0,i0+2**(ngroup-ig+1)-1
43                   q(i,j,l)=qn*aire(i,j)/airen
44                 enddo
45              enddo
46              q(iip1,j,l)=q(1,j,l)
47             
48            endif
49           
50            if ( jjp1-j+1-jd >= jjb .AND. jjp1-j+1-jd <= jje) THEN
51             
52              do i0=1,iim,2**(ngroup-ig+1)
53                 aires=0.
54                 airecs=0.
55                 qs=0.
56                 do i=i0,i0+2**(ngroup-ig+1)-1
57                    aires=aires+aire(i,jjp1-j+1)
58                    qs=qs+q(i,jjp1-j+1-jd,l)
59                 enddo
60                 airecs=0.
61                 do i=i0,i0+2**(ngroup-ig+1)-1
62                   q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
63                 enddo
64              enddo
65              q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
66           
67            endif
68         enddo
69             
70           j1=j2+1
71           j2=j2+2**ig
72      enddo
73      enddo
74
75      return
76      end
Note: See TracBrowser for help on using the repository browser.