/[lmdze]/trunk/Sources/phylmd/CV30_routines/cv30_undilute1.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/CV30_routines/cv30_undilute1.f

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

revision 196 by guez, Mon May 23 13:50:39 2016 UTC revision 198 by guez, Tue May 31 16:17:35 2016 UTC
# Line 4  module cv30_undilute1_m Line 4  module cv30_undilute1_m
4    
5  contains  contains
6    
7    SUBROUTINE cv30_undilute1(t1, q1, qs1, gz1, plcl1, p1, nk1, icb1, tp1, &    SUBROUTINE cv30_undilute1(t1, q1, qs1, gz1, plcl1, p1, icb1, tp1, tvp1, &
8         tvp1, clw1, icbs1)         clw1, icbs1)
9    
10      ! UNDILUTE (ADIABATIC) UPDRAFT / 1st part      ! UNDILUTE (ADIABATIC) UPDRAFT / 1st part
11      ! (up through ICB1 + 1)      ! (up through ICB1 + 1)
12      ! Calculates the lifted parcel virtual temperature at nk1, the      ! Calculates the lifted parcel virtual temperature at minorig, the
13      ! actual temperature, and the adiabatic liquid water content.      ! actual temperature, and the adiabatic liquid water content.
14    
15      ! Equivalent de TLIFT entre NK1 et ICB1+1 inclus      ! Equivalent de TLIFT entre MINORIG et ICB1+1 inclus
16    
17      ! Differences with convect4:      ! Differences with convect4:
18      ! - icbs1 is the first level above LCL (may differ from icb1)      ! - icbs1 is the first level above LCL (may differ from icb1)
# Line 22  contains Line 22  contains
22      ! - if icbs1=icb1, compute also tp1(icb1+1), tvp1(icb1+1) & clw1(icb1+1)      ! - if icbs1=icb1, compute also tp1(icb1+1), tvp1(icb1+1) & clw1(icb1+1)
23    
24      use cv30_param_m, only: minorig, nl      use cv30_param_m, only: minorig, nl
25      use cv_thermo_m, only: cl, clmcpv, cpd, cpv, eps, lv0, rrv      use cv_thermo_m, only: cl, clmcpv, cpd, cpv, eps, rrv
26      USE dimphy, ONLY: klev, klon      USE dimphy, ONLY: klev, klon
27        use SUPHEC_M, only: rlvtt
28    
29      ! inputs:      ! inputs:
30      integer, intent(in):: nk1(klon), icb1(klon)      integer, intent(in):: icb1(klon)
31      real, intent(in):: t1(klon, klev)      real, intent(in):: t1(klon, klev)
32      real, intent(in):: q1(klon, klev), qs1(klon, klev), gz1(klon, klev)      real, intent(in):: q1(klon, klev), qs1(klon, klev), gz1(klon, klev)
33      real, intent(in):: p1(klon, klev)      real, intent(in):: p1(klon, klev)
# Line 46  contains Line 47  contains
47    
48      !-------------------------------------------------------------------      !-------------------------------------------------------------------
49    
50      !  Calculates the lifted parcel virtual temperature at nk1,      !  Calculates the lifted parcel virtual temperature at minorig,
51      !  the actual temperature, and the adiabatic      !  the actual temperature, and the adiabatic
52      !  liquid water content. The procedure is to solve the equation.      !  liquid water content. The procedure is to solve the equation.
53      ! cp*tp1+L*qp+phi=cp*tnk+L*qnk+gznk.      ! cp*tp1+L*qp+phi=cp*tnk+L*qnk+gznk.
54    
55      do i=1, klon      do i=1, klon
56         tnk(i)=t1(i, nk1(i))         tnk(i)=t1(i, minorig)
57         qnk(i)=q1(i, nk1(i))         qnk(i)=q1(i, minorig)
58         gznk(i)=gz1(i, nk1(i))         gznk(i)=gz1(i, minorig)
59      end do      end do
60    
61      ! *** Calculate certain parcel quantities, including static energy ***      ! *** Calculate certain parcel quantities, including static energy ***
62    
63      do i=1, klon      do i=1, klon
64         ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) &         ah0(i)=(cpd*(1.-qnk(i))+cl*qnk(i))*tnk(i) &
65              +qnk(i)*(lv0-clmcpv*(tnk(i)-273.15))+gznk(i)              +qnk(i)*(rlvtt-clmcpv*(tnk(i)-273.15))+gznk(i)
66         cpp(i)=cpd*(1.-qnk(i))+qnk(i)*cpv         cpp(i)=cpd*(1.-qnk(i))+qnk(i)*cpv
67         cpinv(i)=1./cpp(i)         cpinv(i)=1./cpp(i)
68      end do      end do
# Line 113  contains Line 114  contains
114      do i=1, klon      do i=1, klon
115         tg=ticb(i)         tg=ticb(i)
116         qg=qsicb(i)         qg=qsicb(i)
117         !debug alv=lv0-clmcpv*(ticb(i)-t0)         !debug alv=rlvtt-clmcpv*(ticb(i)-t0)
118         alv=lv0-clmcpv*(ticb(i)-273.15)         alv=rlvtt-clmcpv*(ticb(i)-273.15)
119    
120         ! First iteration.         ! First iteration.
121    
# Line 147  contains Line 148  contains
148    
149         qg=eps*es/(p1(i, icbs1(i))-es*(1.-eps))         qg=eps*es/(p1(i, icbs1(i))-es*(1.-eps))
150    
151         alv=lv0-clmcpv*(ticb(i)-273.15)         alv=rlvtt-clmcpv*(ticb(i)-273.15)
152    
153         ! no approximation:         ! no approximation:
154         tp1(i, icbs1(i))=(ah0(i)-gz1(i, icbs1(i))-alv*qg) &         tp1(i, icbs1(i))=(ah0(i)-gz1(i, icbs1(i))-alv*qg) &
# Line 183  contains Line 184  contains
184      do i=1, klon      do i=1, klon
185         tg=ticb(i)         tg=ticb(i)
186         qg=qsicb(i)         qg=qsicb(i)
187         !debug alv=lv0-clmcpv*(ticb(i)-t0)         !debug alv=rlvtt-clmcpv*(ticb(i)-t0)
188         alv=lv0-clmcpv*(ticb(i)-273.15)         alv=rlvtt-clmcpv*(ticb(i)-273.15)
189    
190         ! First iteration.         ! First iteration.
191    
# Line 218  contains Line 219  contains
219    
220         qg=eps*es/(p1(i, icb1(i)+1)-es*(1.-eps))         qg=eps*es/(p1(i, icb1(i)+1)-es*(1.-eps))
221    
222         alv=lv0-clmcpv*(ticb(i)-273.15)         alv=rlvtt-clmcpv*(ticb(i)-273.15)
223    
224         ! no approximation:         ! no approximation:
225         tp1(i, icb1(i)+1)=(ah0(i)-gz1(i, icb1(i)+1)-alv*qg) &         tp1(i, icb1(i)+1)=(ah0(i)-gz1(i, icb1(i)+1)-alv*qg) &
Legend:
Removed from v.196  
changed lines
  Added in v.198
  ViewVC Help
Powered by ViewVC 1.1.21