source: LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90 @ 5218

! $Header$

MODULE lmdz_groupe
  USE lmdz_paramet
  IMPLICIT NONE; PRIVATE
  PUBLIC groupe

CONTAINS

  SUBROUTINE groupe(pbaru, pbarv, pbarum, pbarvm, wm)

    USE comconst_mod, ONLY: ngroup
    USE lmdz_ssum_scopy, ONLY: scopy
    USE lmdz_comgeom2

  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    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: 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 :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
    REAL :: wm(iip1, jjp1, llm)

    REAL :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
    ! (gfortran) Warning: Array ‘zconvm’ at (1) is larger than limit set by ‘-fmax-stack-var-size=’, moved from stack to static storage.
    ! This makes the procedure unsafe when called recursively, or concurrently from multiple threads.

    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

END MODULE lmdz_groupe