source: LMDZ6/branches/Optimisation_LMDZ/libf/dyn3d/groupe.F

Last change on this file was 2600, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn comvert.h into module comvert_mod.F90
EM

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