source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.f90 @ 5295

! $Header$

SUBROUTINE limx(s0,sx,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 lmdz_comgeom

USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
  USE lmdz_paramet
  IMPLICIT NONE
  !




  !   Arguments:
  !   ----------
  REAL :: pente_max
  REAL :: s0(ip1jmp1,llm),sm(ip1jmp1,llm)
  REAL :: sx(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 :: dxq(ip1jmp1,llm)


  REAL :: new_m,zm
  REAL :: dxqu(ip1jmp1)
  REAL :: adxqu(ip1jmp1),dxqmax(ip1jmp1)

  Logical :: extremum,first
  save first
  data first/.TRUE./


   DO  l = 1,llm
     DO  ij=1,ip1jmp1
           q(ij,l) = s0(ij,l) / sm ( ij,l )
           dxq(ij,l) = sx(ij,l) /sm(ij,l)
     ENDDO
   ENDDO

  !   calcul de la pente a droite et a gauche de la maille

  DO l = 1, llm
     DO ij=iip2,ip1jm-1
        dxqu(ij)=q(ij+1,l)-q(ij,l)
     enddo
     DO ij=iip1+iip1,ip1jm,iip1
        dxqu(ij)=dxqu(ij-iim)
     enddo

     DO ij=iip2,ip1jm
        adxqu(ij)=abs(dxqu(ij))
     enddo

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

     DO ij=iip2+1,ip1jm
        dxqmax(ij)=pente_max*min(adxqu(ij-1),adxqu(ij))
     enddo

     DO ij=iip1+iip1,ip1jm,iip1
        dxqmax(ij-iim)=dxqmax(ij)
     enddo

  !   calcul de la pente avec limitation

     DO ij=iip2+1,ip1jm
        IF(     dxqu(ij-1)*dxqu(ij)>0. &
              .AND. dxq(ij,l)*dxqu(ij)>0.) THEN
          dxq(ij,l)= &
                sign(min(abs(dxq(ij,l)),dxqmax(ij)),dxq(ij,l))
        else
  !   extremum local
           dxq(ij,l)=0.
        endif
     enddo
     DO ij=iip1+iip1,ip1jm,iip1
        dxq(ij-iim,l)=dxq(ij,l)
     enddo

     DO  ij=1,ip1jmp1
           sx(ij,l) = dxq(ij,l)*sm(ij,l)
     ENDDO

   ENDDO

  RETURN
END SUBROUTINE limx