source: LMDZ4/trunk/libf/dyn3d/qminimum.F @ 802

Last change on this file since 802 was 524, checked in by lmdzadmin, 21 years ago

Initial revision

  • 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            zx_defau      = AMAX1( seuil_liq - q(i,k,iq_liq), 0.0 )
46            q(i,k,iq_vap) = q(i,k,iq_vap) - zx_defau
47            q(i,k,iq_liq) = q(i,k,iq_liq) + zx_defau
48 1040 CONTINUE
49 1000 CONTINUE
50c
51c Quand l'eau vapeur est trop faible (ou negative), on complete
52c le defaut en prennant de l'eau vapeur de la couche au-dessous.
53c
54      iq = iq_vap
55c
56      DO k = llm, 2, -1
57ccc      zx_abc = dpres(k) / dpres(k-1)
58      DO i = 1, ip1jmp1
59         zx_abc = deltap(i,k)/deltap(i,k-1)
60         zx_defau    = AMAX1( seuil_vap - q(i,k,iq), 0.0 )
61         q(i,k-1,iq) =  q(i,k-1,iq) - zx_defau * zx_abc
62         q(i,k,iq)   =  q(i,k,iq)   + zx_defau 
63      ENDDO
64      ENDDO
65c
66c Quand il s'agit de la premiere couche au-dessus du sol, on
67c doit imprimer un message d'avertissement (saturation possible).
68c
69      DO i = 1, ip1jmp1
70         zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )
71         q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )
72      ENDDO
73      pompe = SSUM(ip1jmp1,zx_pump,1)
74      IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN
75         WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe
76         DO i = 1, ip1jmp1
77            IF (zx_pump(i).GT.0.0) THEN
78               imprim = imprim + 1
79               PRINT*,'QMINIMUM:  en ',i,zx_pump(i)
80            ENDIF
81         ENDDO
82      ENDIF
83c
84      RETURN
85      END
Note: See TracBrowser for help on using the repository browser.