/[lmdze]/trunk/phylmd/tlift.f90
ViewVC logotype

Diff of /trunk/phylmd/tlift.f90

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

revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC revision 17 by guez, Tue Aug 5 13:31:32 2008 UTC
# Line 1  Line 1 
1  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,NK, &  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,NK, TVP,TPK,CLW,ND,NL, DTVPDT1,DTVPDQ1)
2       TVP,TPK,CLW,ND,NL, &  
      DTVPDT1,DTVPDQ1)  
   !  
3    ! From phylmd/tlift.F, v 1.1.1.1 2004/05/19 12:53:08    ! From phylmd/tlift.F, v 1.1.1.1 2004/05/19 12:53:08
4    
5    !     Argument NK ajoute (jyg) = Niveau de depart de la    ! Argument NK ajoute (jyg) = Niveau de depart de la convection
6    !     convection  
7    !    use YOMCST, only: rcpd, RCPV, rcw, rcs, rv, rd, rlvtt, RLMLT
   use YOMCST, only: rg, rcpd, RCPV, rcw, rcs, rv, rd, rlvtt, RLMLT  
8    
9    implicit none    implicit none
10    
# Line 16  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,N Line 13  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,N
13    real plcl    real plcl
14    REAL GZ(ND),TPK(ND),CLW(ND)    REAL GZ(ND),TPK(ND),CLW(ND)
15    REAL T(ND),RR(ND),RS(ND),TVP(ND),P(ND)    REAL T(ND),RR(ND),RS(ND),TVP(ND),P(ND)
16    REAL DTVPDT1(ND),DTVPDQ1(ND)   ! Derivatives of parcel virtual  
17    !                                   temperature wrt T1 and Q1    REAL DTVPDT1(ND),DTVPDQ1(ND)
18    !    ! Derivatives of parcel virtual temperature with regard to T1 and Q1
19    
20    REAL QI(NA)    REAL QI(NA)
21    REAL DTPDT1(NA),DTPDQ1(NA)      ! Derivatives of parcel temperature  
22    !                                   wrt T1 and Q1    REAL DTPDT1(NA),DTPDQ1(NA)
23      ! Derivatives of parcel temperature with regard to T1 and Q1
24    
25    LOGICAL ICE_CONV    LOGICAL ICE_CONV
26    real gravity, cpd, cpv, cl, ci, CPVMCL, CLMCI, EPS, alv0, alf0, CPP, cpinv    real gravity, cpd, cpv, cl, ci, CPVMCL, CLMCI, EPS, alv0, alf0, CPP, cpinv
# Line 30  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,N Line 29  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,N
29    
30    !--------------------------------------------------------------    !--------------------------------------------------------------
31    
32    !   ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***    ! ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
33    ! on utilise les constantes thermo du Centre Europeen: (SB)    ! on utilise les constantes thermo du Centre Europeen: (SB)
34    !  
   GRAVITY = RG !sb: Pr que gravite ne devienne pas humidite!  
   !  
35    CPD = RCPD    CPD = RCPD
36    CPV = RCPV    CPV = RCPV
37    CL = RCW    CL = RCW
# Line 44  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,N Line 41  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,N
41    EPS = RD/RV    EPS = RD/RV
42    ALV0 = RLVTT    ALV0 = RLVTT
43    ALF0 = RLMLT ! (ALF0 = RLSTT-RLVTT)    ALF0 = RLMLT ! (ALF0 = RLSTT-RLVTT)
44    !  
45    !ccccccccccccccccccccc    ! ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***
46    !  
   !   ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***  
   !  
   ICB1=MAX(ICB,2)  
47    ICB1=MIN(ICB,NL)    ICB1=MIN(ICB,NL)
48    !  
   !jyg1  
   !C      CPP=CPD*(1.-RR(1))+RR(1)*CPV  
49    CPP=CPD*(1.-RR(NK))+RR(NK)*CPV    CPP=CPD*(1.-RR(NK))+RR(NK)*CPV
   !jyg2  
50    CPINV=1./CPP    CPINV=1./CPP
51    !jyg1  
52    !         ICB may be below condensation level    !         ICB may be below condensation level
53    DO I=1,ICB1    DO I=1,ICB1
54       CLW(I)=0.0       CLW(I)=0.0
55    end DO    end DO
56    !  
57    DO I=NK,ICB1    DO I=NK,ICB1
58       TPK(I)=T(NK)-(GZ(I) - GZ(NK))*CPINV       TPK(I)=T(NK)-(GZ(I) - GZ(NK))*CPINV
      !jyg1  
      !CC         TVP(I)=TPK(I)*(1.+RR(NK)/EPS)  
59       TVP(I)=TPK(I)*(1.+RR(NK)/EPS-RR(NK))       TVP(I)=TPK(I)*(1.+RR(NK)/EPS-RR(NK))
      !jyg2  
60       DTVPDT1(I) = 1.+RR(NK)/EPS-RR(NK)       DTVPDT1(I) = 1.+RR(NK)/EPS-RR(NK)
61       DTVPDQ1(I) = TPK(I)*(1./EPS-1.)       DTVPDQ1(I) = TPK(I)*(1./EPS-1.)
      !  
      !jyg2  
   
62    end DO    end DO
63    
   !  
64    !    ***  FIND LIFTED PARCEL TEMPERATURE AND MIXING RATIO    ***    !    ***  FIND LIFTED PARCEL TEMPERATURE AND MIXING RATIO    ***
65    !  
   !jyg1  
   !C        AH0=(CPD*(1.-RR(1))+CL*RR(1))*T(1)  
   !C     $     +RR(1)*(ALV0-CPVMCL*(T(1)-273.15))  
66    AH0=(CPD*(1.-RR(NK))+CL*RR(NK))*T(NK) &    AH0=(CPD*(1.-RR(NK))+CL*RR(NK))*T(NK) &
67         +RR(NK)*(ALV0-CPVMCL*(T(NK)-273.15)) + GZ(NK)         +RR(NK)*(ALV0-CPVMCL*(T(NK)-273.15)) + GZ(NK)
   !jyg2  
   !  
   !jyg1  
68    IMIN = ICB1    IMIN = ICB1
69    !         If ICB is below LCL, start loop at ICB+1    !         If ICB is below LCL, start loop at ICB+1
70    IF (PLCL .LT. P(ICB1)) IMIN = MIN(IMIN+1,NL)    IF (PLCL .LT. P(ICB1)) IMIN = MIN(IMIN+1,NL)
71    !  
72    DO  I=IMIN,NL    DO  I=IMIN,NL
      !jyg2  
73       ALV=ALV0-CPVMCL*(T(I)-273.15)       ALV=ALV0-CPVMCL*(T(I)-273.15)
74       ALF=ALF0+CLMCI*(T(I)-273.15)       ALF=ALF0+CLMCI*(T(I)-273.15)
75    
76       RG=RS(I)       GRAVITY=RS(I)
77       TG=T(I)       TG=T(I)
78       S=CPD*(1.-RR(NK))+CL*RR(NK)+ALV*ALV*RG/(RV*T(I)*T(I))       S=CPD*(1.-RR(NK))+CL*RR(NK)+ALV*ALV*GRAVITY/(RV*T(I)*T(I))
79       !jyg2  
80       S=1./S       S=1./S
81    
82       DO  J=1,2       DO  J=1,2
83          !jyg1          AHG=CPD*TG+(CL-CPD)*RR(NK)*TG+ALV*GRAVITY+GZ(I)
84          AHG=CPD*TG+(CL-CPD)*RR(NK)*TG+ALV*RG+GZ(I)  
         !jyg2  
85          TG=TG+S*(AH0-AHG)          TG=TG+S*(AH0-AHG)
86          TC=TG-273.15          TC=TG-273.15
87          DENOM=243.5+TC          DENOM=243.5+TC
88          DENOM=MAX(DENOM,1.0)          DENOM=MAX(DENOM,1.0)
89          !  
90          !       FORMULE DE BOLTON POUR PSAT          !       FORMULE DE BOLTON POUR PSAT
         !  
91          ES=6.112*EXP(17.67*TC/DENOM)          ES=6.112*EXP(17.67*TC/DENOM)
92          RG=EPS*ES/(P(I)-ES*(1.-EPS))          GRAVITY=EPS*ES/(P(I)-ES*(1.-EPS))
   
   
93       end DO       end DO
94    
95       !jyg1       TPK(I)=(AH0-GZ(I)-ALV*GRAVITY)/(CPD+(CL-CPD)*RR(NK))
96       TPK(I)=(AH0-GZ(I)-ALV*RG)/(CPD+(CL-CPD)*RR(NK))       CLW(I)=RR(NK)-GRAVITY
      !jyg2  
   
      CLW(I)=RR(NK)-RG  
      !jyg2  
97       CLW(I)=MAX(0.0,CLW(I))       CLW(I)=MAX(0.0,CLW(I))
98       !jyg1       TVP(I)=TPK(I)*(1.+GRAVITY/EPS-RR(NK))
99       TVP(I)=TPK(I)*(1.+RG/EPS-RR(NK))  
      !jyg2  
      !  
100       !jyg1       Derivatives       !jyg1       Derivatives
      !  
101       DTPDT1(I) = CPD*S       DTPDT1(I) = CPD*S
102       DTPDQ1(I) = ALV*S       DTPDQ1(I) = ALV*S
      !  
      DTVPDT1(I) = DTPDT1(I)*(1. + RG/EPS - &  
           RR(NK) + ALV*RG/(RD*TPK(I)) )  
      DTVPDQ1(I) = DTPDQ1(I)*(1. + RG/EPS - &  
           RR(NK) + ALV*RG/(RD*TPK(I)) ) - TPK(I)  
      !  
      !jyg2  
103    
104         DTVPDT1(I) = DTPDT1(I)*(1. + GRAVITY/EPS - &
105              RR(NK) + ALV*GRAVITY/(RD*TPK(I)) )
106         DTVPDQ1(I) = DTPDQ1(I)*(1. + GRAVITY/EPS - &
107              RR(NK) + ALV*GRAVITY/(RD*TPK(I)) ) - TPK(I)
108    end DO    end DO
109    !  
110    ICE_CONV = .FALSE.    ICE_CONV = .FALSE.
111    
112    IF (ICE_CONV) THEN    IF (ICE_CONV) THEN
# Line 162  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,N Line 125  SUBROUTINE TLIFT(P,T,RR,RS,GZ,PLCL,ICB,N
125    
126                SNEW= CPD*(1.-RR(NK))+CL*RR(NK) &                SNEW= CPD*(1.-RR(NK))+CL*RR(NK) &
127                     +ALV*ALV*QSAT_NEW/(RV*TPK(I)*TPK(I))                     +ALV*ALV*QSAT_NEW/(RV*TPK(I)*TPK(I))
128                !  
129                SNEW=1./SNEW                SNEW=1./SNEW
130                TPK(I)=TG+(ALF*QI(I)+ALV*RG*(1.-(ESI/ES)))*SNEW                TPK(I)=TG+(ALF*QI(I)+ALV*GRAVITY*(1.-(ESI/ES)))*SNEW
131             ENDDO             ENDDO
            !CC        CLW(I)=RR(1)-QSAT_NEW  
132             CLW(I)=RR(NK)-QSAT_NEW             CLW(I)=RR(NK)-QSAT_NEW
133             CLW(I)=MAX(0.0,CLW(I))             CLW(I)=MAX(0.0,CLW(I))
            !jyg1  
            !CC        TVP(I)=TPK(I)*(1.+QSAT_NEW/EPS)  
134             TVP(I)=TPK(I)*(1.+QSAT_NEW/EPS-RR(NK))             TVP(I)=TPK(I)*(1.+QSAT_NEW/EPS-RR(NK))
            !jyg2  
         ELSE  
            CONTINUE  
135          ENDIF          ENDIF
   
136       end DO       end DO
      !  
137    ENDIF    ENDIF
   !  
138    
139    !* BK :  RAJOUT DE LA TEMPERATURE DES ASCENDANCES    !* BK :  RAJOUT DE LA TEMPERATURE DES ASCENDANCES
140    !*   NON DILUES AU  NIVEAU KLEV = ND    !*   NON DILUES AU  NIVEAU KLEV = ND
141    !*   POSONS LE ENVIRON EGAL A CELUI DE KLEV-1    !*   POSONS LE ENVIRON EGAL A CELUI DE KLEV-1
142    TPK(NL+1)=TPK(NL)    TPK(NL+1)=TPK(NL)
143    
   RG = GRAVITY  ! RG redevient la gravite de YOMCST (sb)  
   
144  END SUBROUTINE TLIFT  END SUBROUTINE TLIFT
Legend:
Removed from v.3  
changed lines
  Added in v.17
  ViewVC Help
Powered by ViewVC 1.1.21