source: LMDZ6/trunk/libf/dyn3dmem/groupe_loc.f90 @ 5278

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



  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)

  return
end subroutine groupe_loc