source: trunk/LMDZ.COMMON/libf/dyn3dpar/groupe_p.F @ 3567

Last change on this file since 3567 was 1572, checked in by emillour, 8 years ago

All GCMs:
Further adaptations to keep up with changes in LMDZ5 concerning
physics/dynamics separation (up to rev r2500 of LMDZ5)

  • arch:
  • remove ifort debug option '-check all', replace it with '-check bounds,format,output_conversion,pointers,uninit' (i.e. get it to stop complaining about copying into temporary arrays)
  • dyn3d_common:
  • comconst_mod.F90 : add ngroup
  • dyn3d:
  • gcm.F90 : minor bug fix (arguments to a call_abort())
  • leapfrog.F90 : recompute geopotential for bilan_dyn outputs
  • conf_gcm.F90 : read "ngroup" from run.def
  • groupe.F , groupeun.F : ngroup no longer a local parameter
  • dyn3d_par:
  • conf_gcm.F90 : read "ngroup" from run.def
  • groupe_p.F , groupeun_p.F : ngroup no longer a local parameter
  • misc:
  • regr1_step_av_m.F90 : removed (not used)
  • phy_common:
  • mod_phys_lmdz_mpi_transfert.F90 , mod_phys_lmdz_mpi_data.F90 : change is_north_pole and is_south_pole to is_north_pole_dyn and is_south_pole_dyn
  • mod_phys_lmdz_omp_data.F90 : introduce is_nort_pole_phy and is_south_pole_phy
  • dynphy_lonlat:
  • mod_interface_dyn_phys.F90 : use is_north_pole_dyn and is_south_pole_dyn
  • calfis_p.F : use is_north_pole_dyn and is_south_pole_dyn
  • phyvenus:
  • physiq_mod , write_hist*.h : use is_north_pole_phy and is_south_pole_phy to correctly compute mesh area at poles to send to hist*nc files.
  • phytitan:
  • physiq_mod , write_hist*.h : use is_north_pole_phy and is_south_pole_phy to correctly compute mesh area at poles to send to hist*nc files.

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