source: LMDZ5/branches/LMDZ5V1.0-dev/libf/dyn3dpar/groupe_p.F @ 3233

Last change on this file since 3233 was 764, checked in by Laurent Fairhead, 17 years ago

Merge entre la version V3_conv et le HEAD
YM, JG, LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.9 KB
Line 
1      subroutine groupe_p(pext,pbaru,pbarv,pbarum,pbarvm,wm)
2      USE parallel
3      implicit none
4
5c   sous-programme servant a fitlrer les champs de flux de masse aux
6c   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
7c   et a mesure qu'on se rapproche du pole.
8c
9c   en entree: pext, pbaru et pbarv
10c
11c   en sortie:  pbarum,pbarvm et wm.
12c
13c   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
14c   pas besoin de w en entree.
15
16#include "dimensions.h"
17#include "paramet.h"
18#include "comconst.h"
19#include "comgeom2.h"
20#include "comvert.h"
21
22      integer ngroup
23      parameter (ngroup=3)
24
25
26      real pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
27      real pext(iip1,jjp1,llm)
28
29      real pbarum(iip1,jjp1,llm),pbarvm(iip1,jjm,llm)
30      real wm(iip1,jjp1,llm)
31
32      real,save :: zconvm(iip1,jjp1,llm)
33      real,save :: zconvmm(iip1,jjp1,llm)
34
35      real uu
36
37      integer i,j,l
38
39      logical firstcall
40      save firstcall
41c$OMP THREADPRIVATE(firstcall)
42
43      data firstcall/.true./
44      integer ijb,ije,jjb,jje
45     
46      if (firstcall) then
47         if(mod(iim,2**ngroup).ne.0) stop'probleme du nombre ede point'
48         firstcall=.false.
49      endif
50
51c   Champs 1D
52
53      call convflu_p(pbaru,pbarv,llm,zconvm)
54
55c
56c      call scopy(ijp1llm,zconvm,1,zconvmm,1)
57c      call scopy(ijmllm,pbarv,1,pbarvm,1)
58     
59      jjb=jj_begin
60      jje=jj_end
61
62c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
63      do l=1,llm
64        zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l)
65      enddo
66c$OMP END DO NOWAIT
67
68      call groupeun_p(jjp1,llm,jjb,jje,zconvmm)
69     
70      jjb=jj_begin-1
71      jje=jj_end
72      if (pole_nord) jjb=jj_begin
73      if (pole_sud)  jje=jj_end-1
74c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
75      do l=1,llm
76        pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l)
77      enddo
78c$OMP END DO NOWAIT
79
80      call groupeun_p(jjm,llm,jjb,jje,pbarvm)
81
82c   Champs 3D
83   
84      jjb=jj_begin
85      jje=jj_end
86      if (pole_nord) jjb=jj_begin+1
87      if (pole_sud)  jje=jj_end-1
88     
89c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
90      do l=1,llm
91         do j=jjb,jje
92            uu=pbaru(iim,j,l)
93            do i=1,iim
94               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
95               pbarum(i,j,l)=uu
96c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
97c    *                      yflu(i,j,l)-yflu(i,j-1,l)
98            enddo
99            pbarum(iip1,j,l)=pbarum(1,j,l)
100         enddo
101      enddo
102c$OMP END DO NOWAIT
103c    integration de la convergence de masse de haut  en bas ......
104   
105      jjb=jj_begin
106      jje=jj_end
107
108c$OMP BARRIER
109c$OMP MASTER     
110      do  l = llm-1,1,-1
111          do j=jjb,jje
112             do i=1,iip1
113                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
114             enddo
115          enddo
116      enddo
117
118      if (.not. pole_sud) then
119        zconvmm(:,jj_end+1,:)=0
120cym     wm(:,jj_end+1,:)=0
121      endif
122     
123c$OMP END MASTER
124c$OMP BARRIER     
125
126      CALL vitvert_p(zconvmm(1,1,1),wm(1,1,1))
127
128      return
129      end
130
Note: See TracBrowser for help on using the repository browser.