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