/[lmdze]/trunk/libf/dyn3d/qminimum.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/qminimum.f90

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

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