source: LMDZ6/trunk/libf/dyn3dmem/groupe_loc.F @ 5069

Last change on this file since 5069 was 3802, checked in by lguez, 4 years ago

Move existing constraint on ngroup from groupeun_loc to conf_gcm
(abort as soon as possible if input is bad) and add constraint on
ngroup and jjm.

  • 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.0 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      integer ijb,ije,jjb,jje
43     
44c   Champs 1D
45
46      call convflu_loc(pbaru,pbarv,llm,zconvm)
47
48c
49c      call scopy(ijp1llm,zconvm,1,zconvmm,1)
50c      call scopy(ijmllm,pbarv,1,pbarvm,1)
51     
52      jjb=jj_begin
53      jje=jj_end
54
55c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
56      do l=1,llm
57        zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l)
58      enddo
59c$OMP END DO NOWAIT
60
61      call groupeun_loc(jjp1,llm,jjb_u,jje_u,jjb,jje,zconvmm)
62     
63      jjb=jj_begin-1
64      jje=jj_end
65      if (pole_nord) jjb=jj_begin
66      if (pole_sud)  jje=jj_end-1
67c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
68      do l=1,llm
69        pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l)
70      enddo
71c$OMP END DO NOWAIT
72
73#ifdef DEBUG_IO   
74      CALL WriteField_v('pbarvm',reshape(pbarvm,(/ip1jm,llm/)))
75#endif
76      call groupeun_loc(jjm,llm,jjb_v,jje_v,jjb,jje,pbarvm)
77#ifdef DEBUG_IO   
78      CALL WriteField_v('pbarvm',reshape(pbarvm,(/ip1jm,llm/)))
79#endif
80c   Champs 3D
81   
82      jjb=jj_begin
83      jje=jj_end
84      if (pole_nord) jjb=jj_begin+1
85      if (pole_sud)  jje=jj_end-1
86     
87c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
88      do l=1,llm
89         do j=jjb,jje
90            uu=pbaru(iim,j,l)
91            do i=1,iim
92               uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
93               pbarum(i,j,l)=uu
94c     zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
95c    *                      yflu(i,j,l)-yflu(i,j-1,l)
96            enddo
97            pbarum(iip1,j,l)=pbarum(1,j,l)
98         enddo
99      enddo
100c$OMP END DO NOWAIT
101c    integration de la convergence de masse de haut  en bas ......
102   
103      jjb=jj_begin
104      jje=jj_end
105
106c$OMP BARRIER
107c$OMP MASTER     
108      do  l = llm-1,1,-1
109          do j=jjb,jje
110             do i=1,iip1
111                zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
112             enddo
113          enddo
114      enddo
115
116      if (.not. pole_sud) then
117        zconvmm(:,jj_end+1,:)=0
118cym     wm(:,jj_end+1,:)=0
119      endif
120     
121c$OMP END MASTER
122c$OMP BARRIER     
123
124      CALL vitvert_loc(zconvmm,wm)
125
126      return
127      end
128
Note: See TracBrowser for help on using the repository browser.