source: LMDZ.3.3/trunk/libf/dyn3d/groupe.F @ 501

Last change on this file since 501 was 2, checked in by lmdz, 25 years ago

Initial revision

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