source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/groupe_loc.f90 @ 5106

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