source: LMDZ6/branches/Ocean_skin/libf/phylmd/Dust/tiedqneg.F

      SUBROUTINE tiedqneg (pres_h,q,d_q)
c
      USE dimphy
      IMPLICIT none
c======================================================================
c Auteur(s): CG (LGGE/CNRS) date: 19950201
c            O. Boucher (LOA/CNRS) date 19961125
c Objet:  Correction eventuelle des valeurs negatives d'humidite
c induites par le schema de convection de Tiedke 
c======================================================================
c Arguments:
c pres_h--input-R-la valeur de la pression aux interfaces
c q-------input-R-quantite de traceur
c d_q-----input-output-R-increment du traceur
c======================================================================
c
#include "dimensions.h"
c #include "dimphy.h"
      REAL pres_h(klon,klev+1)
      REAL q(klon,klev)
      REAL d_q(klon,klev)
      INTEGER nb_neg
      INTEGER i, l
c
      REAL qmin
      PARAMETER (qmin=0.0)
c
      DO l = klev,2,-1
        nb_neg = 0
        DO i = 1,klon
          IF (q(i,l)+d_q(i,l).LT.qmin) THEN 
          nb_neg = nb_neg + 1
          d_q(i,l-1) = d_q(i,l-1) + (q(i,l)+d_q(i,l)-qmin)
     .       *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l-1)-pres_h(i,l))
            d_q(i,l) = qmin - q(i,l)
          ENDIF
        ENDDO
c        IF (nb_neg.NE.0) THEN 
c        PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
c        ENDIF
      ENDDO
c
      DO l = 1, klev-1
        nb_neg = 0
        DO i = 1,klon
          IF (q(i,l)+d_q(i,l).LT.qmin) THEN
          nb_neg = nb_neg + 1
          d_q(i,l+1) = d_q(i,l+1) + (q(i,l)+d_q(i,l)-qmin)
     .      *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l+1)-pres_h(i,l+2))
          d_q(i,l) = qmin - q(i,l)
          ENDIF
        ENDDO
c        IF (nb_neg.NE.0) THEN 
c        PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
c        ENDIF
      ENDDO
c
      l = klev
      DO i = 1,klon
        IF (q(i,l)+d_q(i,l).LT.qmin) THEN 
          d_q(i,l) = qmin - q(i,l)
        ENDIF
      ENDDO
c
      RETURN
      END