source: trunk/LMDZ.PLUTO.old/libf/dyn3d/groupe.F @ 3436

Last change on this file since 3436 was 3175, checked in by emillour, 11 months ago

Pluto PCM:
Add the old Pluto LMDZ for reference (required prior step to making
an LMDZ.PLUTO using the same framework as the other physics packages).
TB+EM

File size: 1.9 KB
RevLine 
[3175]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.