/[lmdze]/trunk/dyn3d/groupeun.f
ViewVC logotype

Diff of /trunk/dyn3d/groupeun.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/dyn3d/groupeun.f revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/dyn3d/groupeun.f90 revision 81 by guez, Wed Mar 5 14:38:41 2014 UTC
# Line 1  Line 1 
 !  
 ! $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  
1    
2        return  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/groupeun.F,v 1.1.1.1 2004/05/19
3        end  ! 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, airecn, qn
20      REAL aires, airecs, 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              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_2d(i, j)
40                aires = aires + aire_2d(i, jjp1-j+1)
41                qn = qn + q(i, j, l)
42                qs = qs + q(i, jjp1-j+1-jd, l)
43              END DO
44              airecn = 0.
45              airecs = 0.
46              DO i = i0, i0 + 2**(ngroup-ig+1) - 1
47                q(i, j, l) = qn*aire_2d(i, j)/airen
48                q(i, jjp1-j+1-jd, l) = qs*aire_2d(i, jjp1-j+1)/aires
49              END DO
50            END DO
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          END DO
54          j1 = j2 + 1
55          j2 = j2 + 2**ig
56        END DO
57      END DO
58    
59      RETURN
60    END SUBROUTINE groupeun
Legend:
Removed from v.76  
changed lines
  Added in v.81
  ViewVC Help
Powered by ViewVC 1.1.21