! $Header$ SUBROUTINE groupe(pext, pbaru, pbarv, pbarum, pbarvm, wm) USE comconst_mod, ONLY: ngroup USE lmdz_ssum_scopy, ONLY: scopy 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, jjp1, llm), pbarv(iip1, jjm, llm) REAL :: pext(iip1, jjp1, llm) REAL :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm) REAL :: wm(iip1, jjp1, llm) REAL :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm) REAL :: uu INTEGER :: i, j, l LOGICAL :: firstcall, groupe_ok save firstcall, groupe_ok data firstcall/.TRUE./ data groupe_ok/.TRUE./ IF (iim==1) THEN groupe_ok = .FALSE. ENDIF IF (firstcall) THEN IF (groupe_ok) THEN IF(mod(iim, 2**ngroup)/=0) & CALL abort_gcm('groupe', 'probleme du nombre de point', 1) endif firstcall = .FALSE. ENDIF ! Champs 1D CALL convflu(pbaru, pbarv, llm, zconvm) CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1) CALL scopy(ijmllm, pbarv, 1, pbarvm, 1) IF (groupe_ok) THEN CALL groupeun(jjp1, llm, zconvmm) CALL groupeun(jjm, llm, pbarvm) ! Champs 3D do l = 1, llm do j = 2, jjm 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 else pbarum(:, :, :) = pbaru(:, :, :) pbarvm(:, :, :) = pbarv(:, :, :) ENDIF ! integration de la convergence de masse de haut en bas ...... do l = 1, llm do j = 1, jjp1 do i = 1, iip1 zconvmm(i, j, l) = zconvmm(i, j, l) enddo enddo enddo do l = llm - 1, 1, -1 do j = 1, jjp1 do i = 1, iip1 zconvmm(i, j, l) = zconvmm(i, j, l) + zconvmm(i, j, l + 1) enddo enddo enddo CALL vitvert(zconvmm, wm) END SUBROUTINE groupe