source: LMDZ4/trunk/libf/dyn3d/groupe.F @ 4035

Last change on this file since 4035 was 524, checked in by lmdzadmin, 20 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.1 KB
Line 
1!
2! $Header$
3!
4      subroutine groupe(pext,pbaru,pbarv,pbarum,pbarvm,wm)
5      implicit none
6
7c   sous-programme servant a fitlrer les champs de flux de masse aux
8c   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
9c   et a mesure qu'on se rapproche du pole.
10c
11c   en entree: pext, pbaru et pbarv
12c
13c   en sortie:  pbarum,pbarvm et wm.
14c
15c   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
16c   pas besoin de w en entree.
17
18#include "dimensions.h"
19#include "paramet.h"
20#include "comconst.h"
21#include "comgeom2.h"
22#include "comvert.h"
23
24      integer ngroup
25      parameter (ngroup=3)
26
27
28      real pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
29      real pext(iip1,jjp1,llm)
30
31      real pbarum(iip1,jjp1,llm),pbarvm(iip1,jjm,llm)
32      real wm(iip1,jjp1,llm)
33
34      real zconvm(iip1,jjp1,llm),zconvmm(iip1,jjp1,llm)
35
36      real uu
37
38      integer i,j,l
39
40      logical firstcall
41      save firstcall
42
43      data firstcall/.true./
44
45      if (firstcall) then
46         if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre ede point'
47         firstcall=.false.
48      endif
49
50c   Champs 1D
51
52      call convflu(pbaru,pbarv,llm,zconvm)
53
54c
55      call scopy(ijp1llm,zconvm,1,zconvmm,1)
56      call scopy(ijmllm,pbarv,1,pbarvm,1)
57
58c
59      call groupeun(jjp1,llm,zconvmm)
60      call groupeun(jjm,llm,pbarvm)
61
62c   Champs 3D
63
64      do l=1,llm
65         do j=2,jjm
66            uu=pbaru(iim,j,l)
67            do i=1,iim
68               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
69               pbarum(i,j,l)=uu
70c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
71c    *                      yflu(i,j,l)-yflu(i,j-1,l)
72            enddo
73            pbarum(iip1,j,l)=pbarum(1,j,l)
74         enddo
75      enddo
76
77c    integration de la convergence de masse de haut  en bas ......
78      do l=1,llm
79         do j=1,jjp1
80            do i=1,iip1
81               zconvmm(i,j,l)=zconvmm(i,j,l)
82            enddo
83         enddo
84      enddo
85      do  l = llm-1,1,-1
86          do j=1,jjp1
87             do i=1,iip1
88                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
89             enddo
90          enddo
91      enddo
92
93      CALL vitvert(zconvmm,wm)
94
95      return
96      end
97
Note: See TracBrowser for help on using the repository browser.