source: LMDZ6/trunk/libf/dyn3dpar/groupe_p.F @ 3138

Last change on this file since 3138 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: 3.2 KB
Line 
1      subroutine groupe_p(pext,pbaru,pbarv,pbarum,pbarvm,wm)
2      USE parallel_lmdz
3      USE comconst_mod, ONLY: ngroup
4      implicit none
5
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 "comgeom2.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,save :: zconvm(iip1,jjp1,llm)
32      real,save :: zconvmm(iip1,jjp1,llm)
33
34      real uu
35
36      integer i,j,l
37
38      logical firstcall,groupe_ok
39      save firstcall,groupe_ok
40c$OMP THREADPRIVATE(firstcall,groupe_ok)
41
42      data firstcall/.true./
43      data groupe_ok/.true./
44
45      integer ijb,ije,jjb,jje
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
58c   Champs 1D
59
60      call convflu_p(pbaru,pbarv,llm,zconvm)
61
62c
63c      call scopy(ijp1llm,zconvm,1,zconvmm,1)
64c      call scopy(ijmllm,pbarv,1,pbarvm,1)
65     
66      jjb=jj_begin
67      jje=jj_end
68
69c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
70      do l=1,llm
71        zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l)
72      enddo
73c$OMP END DO NOWAIT
74
75      if (groupe_ok) then
76         call groupeun_p(jjp1,llm,jjb,jje,zconvmm)
77      endif
78     
79      jjb=jj_begin-1
80      jje=jj_end
81      if (pole_nord) jjb=jj_begin
82      if (pole_sud)  jje=jj_end-1
83c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
84      do l=1,llm
85        pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l)
86      enddo
87c$OMP END DO NOWAIT
88
89      if (groupe_ok) then
90         call groupeun_p(jjm,llm,jjb,jje,pbarvm)
91      endif
92
93c   Champs 3D
94   
95      jjb=jj_begin
96      jje=jj_end
97      if (pole_nord) jjb=jj_begin+1
98      if (pole_sud)  jje=jj_end-1
99     
100c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
101      do l=1,llm
102         do j=jjb,jje
103            uu=pbaru(iim,j,l)
104            do i=1,iim
105               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
106               pbarum(i,j,l)=uu
107c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
108c    *                      yflu(i,j,l)-yflu(i,j-1,l)
109            enddo
110            pbarum(iip1,j,l)=pbarum(1,j,l)
111         enddo
112      enddo
113c$OMP END DO NOWAIT
114
115c    integration de la convergence de masse de haut  en bas ......
116   
117      jjb=jj_begin
118      jje=jj_end
119
120c$OMP BARRIER
121c$OMP MASTER     
122      do  l = llm-1,1,-1
123          do j=jjb,jje
124             do i=1,iip1
125                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
126             enddo
127          enddo
128      enddo
129
130      if (.not. pole_sud) then
131        zconvmm(:,jj_end+1,:)=0
132cym     wm(:,jj_end+1,:)=0
133      endif
134     
135c$OMP END MASTER
136c$OMP BARRIER     
137
138      CALL vitvert_p(zconvmm(1,1,1),wm(1,1,1))
139
140      return
141      end
142
Note: See TracBrowser for help on using the repository browser.