source: trunk/LMDZ.MARS/libf/dyn3d/groupe.F @ 1422

Last change on this file since 1422 was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).

File size: 1.8 KB
Line 
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 "comgeom2.h"
20
21
22      real pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
23      real pext(iip1,jjp1,llm)
24
25      real pbarum(iip1,jjp1,llm),pbarvm(iip1,jjm,llm)
26      real wm(iip1,jjp1,llm)
27
28      real zconvm(iip1,jjp1,llm),zconvmm(iip1,jjp1,llm)
29
30      real uu
31
32      integer i,j,l
33
34c   Champs 1D
35
36      call convflu(pbaru,pbarv,llm,zconvm)
37
38c
39      call scopy(ijp1llm,zconvm,1,zconvmm,1)
40      call scopy(ijmllm,pbarv,1,pbarvm,1)
41
42c
43      call groupeun(jjp1,llm,zconvmm)
44      call groupeun(jjm,llm,pbarvm)
45
46c   Champs 3D
47
48      do l=1,llm
49         do j=2,jjm
50            uu=pbaru(iim,j,l)
51            do i=1,iim
52               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
53               pbarum(i,j,l)=uu
54c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
55c    *                      yflu(i,j,l)-yflu(i,j-1,l)
56            enddo
57            pbarum(iip1,j,l)=pbarum(1,j,l)
58         enddo
59      enddo
60
61c    integration de la convergence de masse de haut  en bas ......
62      do l=1,llm
63         do j=1,jjp1
64            do i=1,iip1
65               zconvmm(i,j,l)=zconvmm(i,j,l)
66            enddo
67         enddo
68      enddo
69      do  l = llm-1,1,-1
70          do j=1,jjp1
71             do i=1,iip1
72                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
73             enddo
74          enddo
75      enddo
76
77      CALL vitvert(zconvmm,wm)
78
79      return
80      end
81
Note: See TracBrowser for help on using the repository browser.