/[lmdze]/trunk/dyn3d/qminimum.f
ViewVC logotype

Diff of /trunk/dyn3d/qminimum.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/qminimum.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/dyn3d/qminimum.f90 revision 76 by guez, Fri Nov 15 18:45:49 2013 UTC
# Line 1  Line 1 
1  !  module qminimum_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/qminimum.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $  
3  !    IMPLICIT none
4        SUBROUTINE qminimum( q,nq,deltap )  
5    contains
6        use dimens_m  
7        use paramet_m    SUBROUTINE qminimum(q, nq, deltap)
8        use comvert  
9        IMPLICIT none      ! From LMDZ4/libf/dyn3d/qminimum.F, version 1.1.1.1 2004/05/19 12:53:05
10  c  
11  c  -- Objet : Traiter les valeurs trop petites (meme negatives)      ! Objet : traiter les valeurs trop petites (même négatives) pour
12  c             pour l'eau vapeur et l'eau liquide      ! l'eau vapeur et l'eau liquide
13  c  
14  c      USE dimens_m, ONLY: llm
15        INTEGER nq      USE paramet_m, ONLY: ip1jmp1
16        REAL q(ip1jmp1,llm,nq), deltap(ip1jmp1,llm)  
17  c      INTEGER, intent(in):: nq
18        INTEGER iq_vap, iq_liq      REAL, intent(inout):: q(ip1jmp1, llm, nq)
19        PARAMETER ( iq_vap = 1 ) ! indice pour l'eau vapeur      real, intent(in):: deltap(ip1jmp1, llm)
20        PARAMETER ( iq_liq = 2 ) ! indice pour l'eau liquide  
21        REAL seuil_vap, seuil_liq      ! Local:
22        PARAMETER ( seuil_vap = 1.0e-10 ) ! seuil pour l'eau vapeur  
23        PARAMETER ( seuil_liq = 1.0e-11 ) ! seuil pour l'eau liquide      INTEGER, PARAMETER:: iq_vap = 1 ! indice pour l'eau vapeur
24  c      INTEGER, PARAMETER:: iq_liq = 2 ! indice pour l'eau liquide
25  c  NB. ....( Il est souhaitable mais non obligatoire que les valeurs des  
26  c            parametres seuil_vap, seuil_liq soient pareilles a celles      ! Il est souhaitable mais non obligatoire que les valeurs des
27  c            qui  sont utilisees dans la routine    ADDFI       )      ! paramètres seuil_vap, seuil_liq soient identiques à celles de la
28  c     .................................................................      ! routine ADDFI.
29  c      REAL, PARAMETER:: seuil_vap = 1e-10 ! seuil pour l'eau vapeur
30        INTEGER i, k, iq      REAL, PARAMETER:: seuil_liq = 1e-11 ! seuil pour l'eau liquide
31        REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe  
32  c      INTEGER i, k
33        REAL SSUM      REAL zx_defau, zx_abc, zx_pump(ip1jmp1), pompe
34  c      INTEGER:: imprim = 0
35        INTEGER imprim  
36        SAVE imprim      !-------------------------------------------------------------------
37        DATA imprim /0/  
38  c      ! Quand l'eau liquide est trop petite (ou négative), on prend
39  c Quand l'eau liquide est trop petite (ou negative), on prend      ! l'eau vapeur de la même couche et on la convertit en eau liquide
40  c l'eau vapeur de la meme couche et la convertit en eau liquide      ! (sans changer la température !).
41  c (sans changer la temperature !)      DO k = 1, llm
42  c         DO i = 1, ip1jmp1
43        DO 1000 k = 1, llm            zx_defau = MAX(seuil_liq - q(i, k, iq_liq), 0.0)
44        DO 1040 i = 1, ip1jmp1            q(i, k, iq_vap) = q(i, k, iq_vap) - zx_defau
45              zx_defau      = AMAX1( seuil_liq - q(i,k,iq_liq), 0.0 )            q(i, k, iq_liq) = q(i, k, iq_liq) + zx_defau
46              q(i,k,iq_vap) = q(i,k,iq_vap) - zx_defau         end DO
47              q(i,k,iq_liq) = q(i,k,iq_liq) + zx_defau      end DO
48   1040 CONTINUE  
49   1000 CONTINUE      ! Quand l'eau vapeur est trop faible (ou négative), on complète
50  c      ! le défaut en prenant de l'eau vapeur de la couche au-dessous.
51  c Quand l'eau vapeur est trop faible (ou negative), on complete      DO k = llm, 2, -1
52  c le defaut en prennant de l'eau vapeur de la couche au-dessous.         DO i = 1, ip1jmp1
53  c            zx_abc = deltap(i, k)/deltap(i, k-1)
54        iq = iq_vap            zx_defau = MAX(seuil_vap - q(i, k, iq_vap), 0.0)
55  c            q(i, k-1, iq_vap) = q(i, k-1, iq_vap) - zx_defau * zx_abc
56        DO k = llm, 2, -1            q(i, k, iq_vap) = q(i, k, iq_vap) + zx_defau
57  ccc      zx_abc = dpres(k) / dpres(k-1)         ENDDO
58        DO i = 1, ip1jmp1      ENDDO
59           zx_abc = deltap(i,k)/deltap(i,k-1)  
60           zx_defau    = AMAX1( seuil_vap - q(i,k,iq), 0.0 )      ! Quand il s'agit de la première couche au dessus du sol, on doit
61           q(i,k-1,iq) =  q(i,k-1,iq) - zx_defau * zx_abc      ! imprimer un message d'avertissement (saturation possible).
62           q(i,k,iq)   =  q(i,k,iq)   + zx_defau    
63        ENDDO      DO i = 1, ip1jmp1
64        ENDDO         zx_pump(i) = MAX(0., seuil_vap - q(i, 1, iq_vap))
65  c         q(i, 1, iq_vap) = MAX(q(i, 1, iq_vap), seuil_vap)
66  c Quand il s'agit de la premiere couche au-dessus du sol, on      ENDDO
67  c doit imprimer un message d'avertissement (saturation possible).      pompe = SUM(zx_pump)
68  c      IF (imprim <= 500 .AND. pompe > 0.) THEN
69        DO i = 1, ip1jmp1         print *, "Attention : on pompe de l'eau au sol, pompe = ", pompe
70           zx_pump(i) = AMAX1( 0.0, seuil_vap - q(i,1,iq) )         DO i = 1, ip1jmp1
71           q(i,1,iq)  = AMAX1( q(i,1,iq), seuil_vap )            IF (zx_pump(i) > 0.) THEN
72        ENDDO               imprim = imprim + 1
73        pompe = SSUM(ip1jmp1,zx_pump,1)            ENDIF
74        IF (imprim.LE.500 .AND. pompe.GT.0.0) THEN         ENDDO
75           WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe      ENDIF
76           DO i = 1, ip1jmp1  
77              IF (zx_pump(i).GT.0.0) THEN    END SUBROUTINE qminimum
78                 imprim = imprim + 1  
79  CC               PRINT*,'QMINIMUM:  en ',i,zx_pump(i)  end module qminimum_m
             ENDIF  
          ENDDO  
       ENDIF  
 c  
       RETURN  
       END  
Legend:
Removed from v.3  
changed lines
  Added in v.76
  ViewVC Help
Powered by ViewVC 1.1.21