SUBROUTINE groupe_loc(pext, pbaru, pbarv, pbarum, pbarvm, wm) USE parallel_lmdz USE Write_field_loc USE groupe_mod USE comconst_mod, ONLY: ngroup USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DEBUGIO 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. INCLUDE "dimensions.h" INCLUDE "paramet.h" INCLUDE "comgeom2.h" ! 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) END SUBROUTINE groupe_loc