source: LMDZ5/trunk/libf/dyn3dmem/groupe_loc.F @ 5362

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