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