! ! $Header$ ! subroutine groupe(pext,pbaru,pbarv,pbarum,pbarvm,wm) USE comgeom2_mod_h use comconst_mod, only: ngroup USE dimensions_mod, ONLY: iim, jjm, llm, ndm USE paramet_mod_h 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,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).ne.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) return end subroutine groupe