source: LMDZ6/trunk/libf/dyn3d_common/pbar.f90 @ 5281

!
! $Header$
!
SUBROUTINE pbar ( pext, pbarx, pbary, pbarxy )
  USE comgeom_mod_h
  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

  !=======================================================================
  !
  !   Auteur:  P. Le Van
  !   -------
  !
  !   Objet:
  !   ------
  !
  ! **********************************************************************
  ! calcul des moyennes en x et en y de (pression au sol*aire variable) ..
  ! *********************************************************************
  !
  !      pext               est  un argum. d'entree  pour le s-pg ..
  ! pbarx,pbary et pbarxy  sont des argum. de sortie pour le s-pg ..
  !
  !   Methode:
  !   --------
  !
  !    A chaque point scalaire P (i,j) est affecte 4 coefficients d'aires
  !   alpha1(i,j)  calcule  au point ( i+1/4,j-1/4 )
  !   alpha2(i,j)  calcule  au point ( i+1/4,j+1/4 )
  !   alpha3(i,j)  calcule  au point ( i-1/4,j+1/4 )
  !   alpha4(i,j)  calcule  au point ( i-1/4,j-1/4 )
  !
  !    Avec  alpha1(i,j) = aire(i+1/4,j-1/4)/ aire(i,j)
  !
  !    N.B .  Pour plus de details, voir s-pg  ...  iniconst ...
  !
  !
  !
  !   alpha4 .         . alpha1    . alpha4
  !    (i,j)             (i,j)       (i+1,j)
  !
  !         P .        U .          . P
  !       (i,j)       (i,j)         (i+1,j)
  !
  !   alpha3 .         . alpha2    .alpha3
  !    (i,j)              (i,j)     (i+1,j)
  !
  !         V .        Z .          . V
  !       (i,j)
  !
  !   alpha4 .         . alpha1    .alpha4
  !   (i,j+1)            (i,j+1)   (i+1,j+1)
  !
  !         P .        U .          . P
  !      (i,j+1)                    (i+1,j+1)
  !
  !
  !
  !
  !                   On  a :
  !
  !    pbarx(i,j) = Pext(i  ,j) * ( alpha1(i  ,j) + alpha2(i,j))      +
  !             Pext(i+1,j) * ( alpha3(i+1,j) + alpha4(i+1,j) )
  ! localise  au point  ... U (i,j) ...
  !
  !    pbary(i,j) = Pext(i,j  ) * ( alpha2(i,j  ) + alpha3(i,j  )     +
  !             Pext(i,j+1) * ( alpha1(i,j+1) + alpha4(i,j+1)
  ! localise  au point  ... V (i,j) ...
  !
  !  pbarxy(i,j)= Pext(i,j) *alpha2(i,j) + Pext(i+1,j) *alpha3(i+1,j) +
  !           Pext(i,j+1)*alpha1(i,j+1)+ Pext(i+1,j+1)*alpha4(i+1,j+1)
  ! localise  au point  ... Z (i,j) ...
  !
  !
  !
  !=======================================================================


  REAL :: pext( ip1jmp1 ),  pbarx ( ip1jmp1 )
  REAL :: pbary(  ip1jm  ),  pbarxy(  ip1jm  )

  INTEGER :: ij



  DO ij = 1, ip1jmp1 - 1
  pbarx( ij ) = pext(ij) * alpha1p2(ij) + pext(ij+1)*alpha3p4(ij+1)
  END DO

  !    .... correction pour pbarx( iip1,j) .....

  !    ...    pbarx(iip1,j)= pbarx(1,j) ...
  !DIR$ IVDEP
  DO ij = iip1, ip1jmp1, iip1
  pbarx( ij ) = pbarx( ij - iim )
  END DO


  DO ij = 1,ip1jm
  pbary( ij ) = pext(   ij  )   * alpha2p3(   ij   )     + &
        pext( ij+iip1 ) * alpha1p4( ij+iip1 )
  END DO


  DO ij = 1, ip1jm - 1
  pbarxy( ij ) = pext(ij)*alpha2(ij) + pext(ij+1)*alpha3(ij+1) + &
        pext(ij+iip1)*alpha1(ij+iip1) + pext(ij+iip2)*alpha4(ij+iip2)
  END DO


  !    ....  correction pour     pbarxy( iip1,j )  ........

  !DIR$ IVDEP

  DO ij = iip1, ip1jm, iip1
  pbarxy( ij ) = pbarxy( ij - iim )
  END DO


  RETURN
END SUBROUTINE pbar