source: LMDZ5/branches/LMDZ5-DOFOCO/libf/dyn3d/groupe.F @ 4538

Last change on this file since 4538 was 1674, checked in by Ehouarn Millour, 12 years ago

Modification pour activation du 2D latitude-pression
(pour pouvoir compiler en -d 1xjmxlm)
dyn3d/fxhyp.F : calcul des longitudes a la main pour iim=1
dyn3d/groupe.F : desactive si iim=1
dyn3d/paramet.h : iip1=iim+1 au lieu de iim+1-1/iim precedemment
phylmd/iophy.F90 : on enleve les -1/iim
phylmd/phyetat0.F90 : on enleve les -1/iim

Modification for activation of the 3D latitude-pressure version
(to be compiled with -d 1xjmxlm)
dyn3d/fxhyp.F : longitudes imposed for iim=1
dyn3d/groupe.F : desactived when iim=1
dyn3d/paramet.h : iip1=iim+1 instead of iim+1-1/iim previously
phylmd/iophy.F90 : -1/iim removed
phylmd/phyetat0.F90 : -1/iim removed

FH et EM

  • 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.