source: LMDZ5/branches/LMDZ5_SPLA/libf/dyn3d/qminimum.F @ 2544

Last change on this file since 2544 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.6 KB
Line 
1!
2! $Header$
3!
4      SUBROUTINE qminimum( q,nq,deltap )
5
6      IMPLICIT none
7c
8c  -- Objet : Traiter les valeurs trop petites (meme negatives)
9c             pour l'eau vapeur et l'eau liquide
10c
11#include "dimensions.h"
12#include "paramet.h"
13#include "comvert.h"
14c
15      INTEGER nq
16      REAL q(ip1jmp1,llm,nq), deltap(ip1jmp1,llm)
17c
18      INTEGER iq_vap, iq_liq
19      PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur
20      PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide
21      REAL seuil_vap, seuil_liq
22      PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur
23      PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide
24c
25c  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des
26c            parametres seuil_vap, seuil_liq soient pareilles a celles
27c            qui  sont utilisees dans la routine    ADDFI       )
28c     .................................................................
29c
30      INTEGER i, k, iq
31      REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
32c
33      REAL SSUM
34c
35      INTEGER imprim
36      SAVE imprim
37      DATA imprim /0/
38c
39c Quand l'eau liquide est trop petite (ou negative), on prend
40c l'eau vapeur de la meme couche et la convertit en eau liquide
41c (sans changer la temperature !)
42c
43      DO 1000 k = 1, llm
44        DO 1040 i = 1, ip1jmp1
45          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
46             q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
47             q(i,k,iq_liq) = seuil_liq
48           endif
49 1040   CONTINUE
50 1000 CONTINUE
51c
52c Quand l'eau vapeur est trop faible (ou negative), on complete
53c le defaut en prennant de l'eau vapeur de la couche au-dessous.
54c
55      iq = iq_vap
56c
57      DO k = llm, 2, -1
58ccc      zx_abc = dpres(k) / dpres(k-1)
59        DO i = 1, ip1jmp1
60          if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
61            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
62     &                     deltap(i,k) / deltap(i,k-1)
63            q(i,k,iq)   =  seuil_vap 
64          endif
65        ENDDO
66      ENDDO
67c
68c Quand il s'agit de la premiere couche au-dessus du sol, on
69c doit imprimer un message d'avertissement (saturation possible).
70c
71      DO i = 1, ip1jmp1
72         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
73         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
74      ENDDO
75      pompe = SSUM(ip1jmp1,zx_pump,1)
76      IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN
77         WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe
78         DO i = 1, ip1jmp1
79            IF (zx_pump(i).GT.0.0) THEN
80               imprim = imprim + 1
81               PRINT*,'QMINIMUM:  en ',i,zx_pump(i)
82            ENDIF
83         ENDDO
84      ENDIF
85c
86      RETURN
87      END
Note: See TracBrowser for help on using the repository browser.