| 1 | SUBROUTINE tiedqneg (pres_h,q,d_q) |
|---|
| 2 | ! |
|---|
| 3 | USE dimphy |
|---|
| 4 | USE dimensions_mod, ONLY: iim, jjm, llm, ndm |
|---|
| 5 | IMPLICIT none |
|---|
| 6 | !====================================================================== |
|---|
| 7 | ! Auteur(s): CG (LGGE/CNRS) date: 19950201 |
|---|
| 8 | ! O. Boucher (LOA/CNRS) date 19961125 |
|---|
| 9 | ! Objet: Correction eventuelle des valeurs negatives d'humidite |
|---|
| 10 | ! induites par le schema de convection de Tiedke |
|---|
| 11 | !====================================================================== |
|---|
| 12 | ! Arguments: |
|---|
| 13 | ! pres_h--input-R-la valeur de la pression aux interfaces |
|---|
| 14 | ! q-------input-R-quantite de traceur |
|---|
| 15 | ! d_q-----input-output-R-increment du traceur |
|---|
| 16 | !====================================================================== |
|---|
| 17 | ! |
|---|
| 18 | |
|---|
| 19 | ! INCLUDE "dimphy.h" |
|---|
| 20 | REAL :: pres_h(klon,klev+1) |
|---|
| 21 | REAL :: q(klon,klev) |
|---|
| 22 | REAL :: d_q(klon,klev) |
|---|
| 23 | INTEGER :: nb_neg |
|---|
| 24 | INTEGER :: i, l |
|---|
| 25 | ! |
|---|
| 26 | REAL :: qmin |
|---|
| 27 | PARAMETER (qmin=0.0) |
|---|
| 28 | ! |
|---|
| 29 | DO l = klev,2,-1 |
|---|
| 30 | nb_neg = 0 |
|---|
| 31 | DO i = 1,klon |
|---|
| 32 | IF (q(i,l)+d_q(i,l).LT.qmin) THEN |
|---|
| 33 | nb_neg = nb_neg + 1 |
|---|
| 34 | d_q(i,l-1) = d_q(i,l-1) + (q(i,l)+d_q(i,l)-qmin) & |
|---|
| 35 | *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l-1)-pres_h(i,l)) |
|---|
| 36 | d_q(i,l) = qmin - q(i,l) |
|---|
| 37 | ENDIF |
|---|
| 38 | ENDDO |
|---|
| 39 | ! IF (nb_neg.NE.0) THEN |
|---|
| 40 | ! PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives' |
|---|
| 41 | ! ENDIF |
|---|
| 42 | ENDDO |
|---|
| 43 | ! |
|---|
| 44 | DO l = 1, klev-1 |
|---|
| 45 | nb_neg = 0 |
|---|
| 46 | DO i = 1,klon |
|---|
| 47 | IF (q(i,l)+d_q(i,l).LT.qmin) THEN |
|---|
| 48 | nb_neg = nb_neg + 1 |
|---|
| 49 | d_q(i,l+1) = d_q(i,l+1) + (q(i,l)+d_q(i,l)-qmin) & |
|---|
| 50 | *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l+1)-pres_h(i,l+2)) |
|---|
| 51 | d_q(i,l) = qmin - q(i,l) |
|---|
| 52 | ENDIF |
|---|
| 53 | ENDDO |
|---|
| 54 | ! IF (nb_neg.NE.0) THEN |
|---|
| 55 | ! PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives' |
|---|
| 56 | ! ENDIF |
|---|
| 57 | ENDDO |
|---|
| 58 | ! |
|---|
| 59 | l = klev |
|---|
| 60 | DO i = 1,klon |
|---|
| 61 | IF (q(i,l)+d_q(i,l).LT.qmin) THEN |
|---|
| 62 | d_q(i,l) = qmin - q(i,l) |
|---|
| 63 | ENDIF |
|---|
| 64 | ENDDO |
|---|
| 65 | ! |
|---|
| 66 | RETURN |
|---|
| 67 | END SUBROUTINE tiedqneg |
|---|
