subroutine groupe_loc(pext,pbaru,pbarv,pbarum,pbarvm,wm) USE comgeom2_mod_h USE parallel_lmdz USE Write_field_loc USE groupe_mod USE comconst_mod, ONLY: ngroup USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, & ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm implicit none ! sous-programme servant a fitlrer les champs de flux de masse aux ! poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur ! et a mesure qu'on se rapproche du pole. ! ! en entree: pext, pbaru et pbarv ! ! en sortie: pbarum,pbarvm et wm. ! ! remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc ! pas besoin de w en entree. ! integer ngroup ! parameter (ngroup=3) real :: pbaru(iip1,jjb_u:jje_u,llm),pbarv(iip1,jjb_v:jje_v,llm) real :: pext(iip1,jjb_u:jje_u,llm) real :: pbarum(iip1,jjb_u:jje_u,llm),pbarvm(iip1,jjb_v:jje_v,llm) real :: wm(iip1,jjb_u:jje_u,llm) real :: uu integer :: i,j,l logical :: firstcall save firstcall !$OMP THREADPRIVATE(firstcall) integer :: ijb,ije,jjb,jje ! Champs 1D call convflu_loc(pbaru,pbarv,llm,zconvm) ! ! call scopy(ijp1llm,zconvm,1,zconvmm,1) ! call scopy(ijmllm,pbarv,1,pbarvm,1) jjb=jj_begin jje=jj_end !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l) enddo !$OMP END DO NOWAIT call groupeun_loc(jjp1,llm,jjb_u,jje_u,jjb,jje,zconvmm) jjb=jj_begin-1 jje=jj_end if (pole_nord) jjb=jj_begin if (pole_sud) jje=jj_end-1 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l) enddo !$OMP END DO NOWAIT IF (CPPKEY_DEBUGIO) THEN CALL WriteField_v('pbarvm',reshape(pbarvm,(/ip1jm,llm/))) END IF call groupeun_loc(jjm,llm,jjb_v,jje_v,jjb,jje,pbarvm) IF (CPPKEY_DEBUGIO) THEN CALL WriteField_v('pbarvm',reshape(pbarvm,(/ip1jm,llm/))) END IF ! Champs 3D jjb=jj_begin jje=jj_end if (pole_nord) jjb=jj_begin+1 if (pole_sud) jje=jj_end-1 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) do l=1,llm do j=jjb,jje uu=pbaru(iim,j,l) do i=1,iim uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l) pbarum(i,j,l)=uu ! zconvm(i,j,l ) = xflu(i-1,j,l)-xflu(i,j,l)+ ! * yflu(i,j,l)-yflu(i,j-1,l) enddo pbarum(iip1,j,l)=pbarum(1,j,l) enddo enddo !$OMP END DO NOWAIT ! integration de la convergence de masse de haut en bas ...... jjb=jj_begin jje=jj_end !$OMP BARRIER !$OMP MASTER do l = llm-1,1,-1 do j=jjb,jje do i=1,iip1 zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1) enddo enddo enddo if (.not. pole_sud) then zconvmm(:,jj_end+1,:)=0 !ym wm(:,jj_end+1,:)=0 endif !$OMP END MASTER !$OMP BARRIER CALL vitvert_loc(zconvmm,wm) return end subroutine groupe_loc