source: LMDZ5/branches/AI-cosp/libf/dyn3d/groupe.F @ 3717

Last change on this file since 3717 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • 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      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,groupe_ok
41      save firstcall,groupe_ok
42
43      data firstcall/.true./
44      data groupe_ok/.true./
45
46      if (iim==1) then
47         groupe_ok=.false.
48      endif
49
50      if (firstcall) then
51         if (groupe_ok) then
52           if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre de point'
53         endif
54         firstcall=.false.
55      endif
56
57
58c   Champs 1D
59
60      call convflu(pbaru,pbarv,llm,zconvm)
61
62      call scopy(ijp1llm,zconvm,1,zconvmm,1)
63      call scopy(ijmllm,pbarv,1,pbarvm,1)
64
65      if (groupe_ok) then
66      call groupeun(jjp1,llm,zconvmm)
67      call groupeun(jjm,llm,pbarvm)
68
69c   Champs 3D
70      do l=1,llm
71         do j=2,jjm
72            uu=pbaru(iim,j,l)
73            do i=1,iim
74               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
75               pbarum(i,j,l)=uu
76c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
77c    *                      yflu(i,j,l)-yflu(i,j-1,l)
78            enddo
79            pbarum(iip1,j,l)=pbarum(1,j,l)
80         enddo
81      enddo
82
83      else
84         pbarum(:,:,:)=pbaru(:,:,:)
85         pbarvm(:,:,:)=pbarv(:,:,:)
86      endif
87
88c    integration de la convergence de masse de haut  en bas ......
89      do l=1,llm
90         do j=1,jjp1
91            do i=1,iip1
92               zconvmm(i,j,l)=zconvmm(i,j,l)
93            enddo
94         enddo
95      enddo
96      do  l = llm-1,1,-1
97          do j=1,jjp1
98             do i=1,iip1
99                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
100             enddo
101          enddo
102      enddo
103
104      CALL vitvert(zconvmm,wm)
105
106      return
107      end
108
Note: See TracBrowser for help on using the repository browser.