source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/tiedqneg.f90 @ 5208

SUBROUTINE tiedqneg(pres_h, q, d_q)

  USE dimphy
  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
  IMPLICIT NONE
  !======================================================================
  ! Auteur(s): CG (LGGE/CNRS) date: 19950201
  ! O. Boucher (LOA/CNRS) date 19961125
  ! Objet:  Correction eventuelle des valeurs negatives d'humidite
  ! induites par le schema de convection de Tiedke
  !======================================================================
  ! Arguments:
  ! pres_h--input-R-la valeur de la pression aux interfaces
  ! q-------input-R-quantite de traceur
  ! d_q-----input-output-R-increment du traceur
  !======================================================================


  REAL :: pres_h(klon, klev + 1)
  REAL :: q(klon, klev)
  REAL :: d_q(klon, klev)
  INTEGER :: nb_neg
  INTEGER :: i, l

  REAL :: qmin
  PARAMETER (qmin = 0.0)

  DO l = klev, 2, -1
    nb_neg = 0
    DO i = 1, klon
      IF (q(i, l) + d_q(i, l)<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
    ! IF (nb_neg.NE.0) THEN
    ! PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
    ! ENDIF
  ENDDO

  DO l = 1, klev - 1
    nb_neg = 0
    DO i = 1, klon
      IF (q(i, l) + d_q(i, l)<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
    ! IF (nb_neg.NE.0) THEN
    ! PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
    ! ENDIF
  ENDDO

  l = klev
  DO i = 1, klon
    IF (q(i, l) + d_q(i, l)<qmin) THEN
      d_q(i, l) = qmin - q(i, l)
    ENDIF
  ENDDO


END SUBROUTINE tiedqneg