source: LMDZ6/trunk/libf/dyn3d_common/limz.f90 @ 5440

!
! $Header$
!
SUBROUTINE limz(s0,sz,sm,pente_max)
  !
  ! Auteurs:   P.Le Van, F.Hourdin, F.Forget
  !
  !    ********************************************************************
  ! Shema  d'advection " pseudo amont " .
  !    ********************************************************************
  ! nq,iq,q,pbaru,pbarv,w sont des arguments d'entree  pour le s-pg ....
  !
  !
  !   --------------------------------------------------------------------
  USE comgeom_mod_h
  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
USE paramet_mod_h
IMPLICIT NONE
  !


  !
  !
  !   Arguments:
  !   ----------
  real :: pente_max
  REAL :: s0(ip1jmp1,llm),sm(ip1jmp1,llm)
  real :: sz(ip1jmp1,llm)
  !
  !  Local
  !   ---------
  !
  INTEGER :: ij,l,j,i,iju,ijq,indu(ip1jmp1),niju
  integer :: n0,iadvplus(ip1jmp1,llm),nl(llm)
  !
  REAL :: q(ip1jmp1,llm)
  real :: dzq(ip1jmp1,llm)


  REAL :: new_m,zm
  real :: dzqw(ip1jmp1)
  real :: adzqw(ip1jmp1),dzqmax(ip1jmp1)

  Logical :: extremum,first
  save first

  REAL :: SSUM,CVMGP,CVMGT
  integer :: ismax,ismin
  EXTERNAL  SSUM, ismin,ismax

  data first/.true./


   DO  l = 1,llm
     DO  ij=1,ip1jmp1
           q(ij,l) = s0(ij,l) / sm ( ij,l )
           dzq(ij,l) = sz(ij,l) /sm(ij,l)
     ENDDO
   ENDDO

  !   calcul de la pente en haut et en bas de la maille
   do ij=1,ip1jmp1
   do l = 1, llm-1
        dzqw(l)=q(ij,l+1)-q(ij,l)
     enddo
        dzqw(llm)=0.

     do  l=1,llm
        adzqw(l)=abs(dzqw(l))
     enddo

  !   calcul de la pente maximum dans la maille en valeur absolue

     do l=2,llm-1
        dzqmax(l)=pente_max*min(adzqw(l-1),adzqw(l))
     enddo

  !   calcul de la pente avec limitation

     do l=2,llm-1
        if(     dzqw(l-1)*dzqw(l).gt.0. &
              .and. dzq(ij,l)*dzqw(l).gt.0.) then
          dzq(ij,l)= &
                sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l))
        else
  !   extremum local
           dzq(ij,l)=0.
        endif
     enddo

     DO  l=1,llm
           sz(ij,l) = dzq(ij,l)*sm(ij,l)
     ENDDO

   ENDDO

  RETURN
END SUBROUTINE limz