source: trunk/LMDZ.GENERIC/libf/dyn3d/groupe.F @ 1243

Last change on this file since 1243 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 1.9 KB
RevLine 
[135]1      subroutine groupe(pext,pbaru,pbarv,pbarum,pbarvm,wm)
2      implicit none
3
4c   SEE COMMENTS IN groupeun.F
5c
6c   sous-programme servant a fitlrer les champs de flux de masse aux
7c   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
8c   et a mesure qu'on se rapproche du pole.
9c
10c   en entree: pext, pbaru et pbarv
11c
12c   en sortie:  pbarum,pbarvm et wm.
13c
14c   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
15c   pas besoin de w en entree.
16
17#include "dimensions.h"
18#include "paramet.h"
19#include "comconst.h"
20#include "comgeom2.h"
21#include "comvert.h"
22
23
24      real pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
25      real pext(iip1,jjp1,llm)
26
27      real pbarum(iip1,jjp1,llm),pbarvm(iip1,jjm,llm)
28      real wm(iip1,jjp1,llm)
29
30      real zconvm(iip1,jjp1,llm),zconvmm(iip1,jjp1,llm)
31
32      real uu
33
34      integer i,j,l
35
36c   Champs 1D
37
38      call convflu(pbaru,pbarv,llm,zconvm)
39
40c
41      call scopy(ijp1llm,zconvm,1,zconvmm,1)
42      call scopy(ijmllm,pbarv,1,pbarvm,1)
43
44c
45      call groupeun(jjp1,llm,zconvmm)
46      call groupeun(jjm,llm,pbarvm)
47
48c   Champs 3D
49
50      do l=1,llm
51         do j=2,jjm
52            uu=pbaru(iim,j,l)
53            do i=1,iim
54               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
55               pbarum(i,j,l)=uu
56c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
57c    *                      yflu(i,j,l)-yflu(i,j-1,l)
58            enddo
59            pbarum(iip1,j,l)=pbarum(1,j,l)
60         enddo
61      enddo
62
63c    integration de la convergence de masse de haut  en bas ......
64      do l=1,llm
65         do j=1,jjp1
66            do i=1,iip1
67               zconvmm(i,j,l)=zconvmm(i,j,l)
68            enddo
69         enddo
70      enddo
71      do  l = llm-1,1,-1
72          do j=1,jjp1
73             do i=1,iip1
74                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
75             enddo
76          enddo
77      enddo
78
79      CALL vitvert(zconvmm,wm)
80
81      return
82      end
83
Note: See TracBrowser for help on using the repository browser.