source: LMDZ.3.3/trunk/libf/dyn3d/qminimum.F @ 507

Last change on this file since 507 was 2, checked in by lmdz, 25 years ago

Initial revision

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