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