tiedqneg.f90 Source File

SUBROUTINE tiedqneg (pres_h,q,d_q)
  !
  USE dimphy
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
  !======================================================================
  !

    ! INCLUDE "dimphy.h"
  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).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
     ! 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).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
     ! 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).LT.qmin) THEN
      d_q(i,l) = qmin - q(i,l)
    ENDIF
  ENDDO
  !
  RETURN
END SUBROUTINE tiedqneg