source: LMDZ5/trunk/libf/phylmd/Dust/tiedqneg.F @ 3037

Last change on this file since 3037 was 2630, checked in by fhourdin, 8 years ago

Importation du modèle d'aérosols de Boucher, Escribano et al.

File size: 1.9 KB
Line 
1      SUBROUTINE tiedqneg (pres_h,q,d_q)
2c
3      USE dimphy
4      IMPLICIT none
5c======================================================================
6c Auteur(s): CG (LGGE/CNRS) date: 19950201
7c            O. Boucher (LOA/CNRS) date 19961125
8c Objet:  Correction eventuelle des valeurs negatives d'humidite
9c induites par le schema de convection de Tiedke
10c======================================================================
11c Arguments:
12c pres_h--input-R-la valeur de la pression aux interfaces
13c q-------input-R-quantite de traceur
14c d_q-----input-output-R-increment du traceur
15c======================================================================
16c
17#include "dimensions.h"
18c #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
24c
25      REAL qmin
26      PARAMETER (qmin=0.0)
27c
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
38c        IF (nb_neg.NE.0) THEN
39c        PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
40c        ENDIF
41      ENDDO
42c
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
53c        IF (nb_neg.NE.0) THEN
54c        PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives'
55c        ENDIF
56      ENDDO
57c
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
64c
65      RETURN
66      END
Note: See TracBrowser for help on using the repository browser.