/[lmdze]/trunk/libf/phylmd/concvl.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/concvl.f90

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

revision 13 by guez, Fri Jul 25 19:59:34 2008 UTC revision 17 by guez, Tue Aug 5 13:31:32 2008 UTC
# Line 1  Line 1 
1  SUBROUTINE concvl(iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra,work1, &  SUBROUTINE concvl(iflag_con, dtime, paprs, pplay, t, q, u, v, tra,&
2       work2,d_t,d_q,d_u,d_v,d_tra,rain,snow,kbas,ktop,upwd,dnwd,dnwdbis,ma, &       ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas,&
3       cape,tvp,iflag,pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &       ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase,&
4       pmflxr,pmflxs,da,phi,mp)       dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs,&
5         da, phi, mp)
6    
7    ! From phylmd/concvl.F,v 1.3 2005/04/15 12:36:17    ! From phylmd/concvl.F, v 1.3 2005/04/15 12:36:17
8    ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818    ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
9    ! Objet: schema de convection de Emanuel (1991) interface    ! Objet: schema de convection de Emanuel (1991) interface
10    
# Line 39  SUBROUTINE concvl(iflag_con,dtime,paprs, Line 40  SUBROUTINE concvl(iflag_con,dtime,paprs,
40    ! Cape----output-R-CAPE (J/kg)    ! Cape----output-R-CAPE (J/kg)
41    ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee    ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
42    !                  adiabatiquement a partir du niveau 1 (K)    !                  adiabatiquement a partir du niveau 1 (K)
43    ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)    ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;
44    ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace    !  Pa)
45      ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de
46      !  la glace
47    
48    INTEGER ntrac    INTEGER ntrac
49    PARAMETER (ntrac=nqmx-2)    PARAMETER (ntrac=nqmx-2)
# Line 48  SUBROUTINE concvl(iflag_con,dtime,paprs, Line 51  SUBROUTINE concvl(iflag_con,dtime,paprs,
51    INTEGER, INTENT (IN) :: iflag_con    INTEGER, INTENT (IN) :: iflag_con
52    
53    REAL, INTENT (IN) :: dtime    REAL, INTENT (IN) :: dtime
54    REAL, INTENT (IN) :: paprs(klon,klev+1)    REAL, INTENT (IN) :: paprs(klon, klev+1)
55    REAL, INTENT (IN) :: pplay(klon,klev)    REAL, INTENT (IN) :: pplay(klon, klev)
56    REAL t(klon,klev), q(klon,klev), u(klon,klev), v(klon,klev)    REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
57    REAL tra(klon,klev,ntrac)    REAL, INTENT (IN):: tra(klon, klev, ntrac)
58    INTEGER ntra    INTEGER ntra
59    REAL work1(klon,klev), work2(klon,klev)    REAL work1(klon, klev), work2(klon, klev)
60    REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)    REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
61    
62    REAL d_t(klon,klev), d_q(klon,klev), d_u(klon,klev), d_v(klon,klev)    REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon,&
63    REAL d_tra(klon,klev,ntrac)         klev)
64      REAL d_tra(klon, klev, ntrac)
65    REAL rain(klon), snow(klon)    REAL rain(klon), snow(klon)
66    
67    INTEGER kbas(klon), ktop(klon)    INTEGER kbas(klon), ktop(klon)
68    REAL em_ph(klon,klev+1), em_p(klon,klev)    REAL em_ph(klon, klev+1), em_p(klon, klev)
69    REAL upwd(klon,klev), dnwd(klon,klev), dnwdbis(klon,klev)    REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
70    REAL ma(klon,klev), cape(klon), tvp(klon,klev)    REAL ma(klon, klev), cape(klon), tvp(klon, klev)
71    REAL da(klon,klev), phi(klon,klev,klev), mp(klon,klev)    REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
72    INTEGER iflag(klon)    INTEGER iflag(klon)
73    REAL pbase(klon), bbase(klon)    REAL pbase(klon), bbase(klon)
74    REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)    REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
75    REAL dplcldt(klon), dplcldr(klon)    REAL dplcldt(klon), dplcldr(klon)
76    REAL qcondc(klon,klev)    REAL qcondc(klon, klev)
77    REAL wd(klon)    REAL wd(klon)
78    
79    REAL zx_t, zdelta, zx_qs, zcor    REAL zx_t, zdelta, zx_qs, zcor
80    
81    INTEGER i, k, itra    INTEGER i, k, itra
82    REAL qs(klon,klev)    REAL qs(klon, klev)
83    REAL cbmf(klon)    REAL cbmf(klon)
84    SAVE cbmf    SAVE cbmf
85    INTEGER ifrst    INTEGER ifrst
# Line 95  SUBROUTINE concvl(iflag_con,dtime,paprs, Line 99  SUBROUTINE concvl(iflag_con,dtime,paprs,
99    
100    DO k = 1, klev + 1    DO k = 1, klev + 1
101       DO i = 1, klon       DO i = 1, klon
102          em_ph(i,k) = paprs(i,k)/100.0          em_ph(i, k) = paprs(i, k)/100.0
103          pmflxs(i,k) = 0.          pmflxs(i, k) = 0.
104       END DO       END DO
105    END DO    END DO
106    
107    DO k = 1, klev    DO k = 1, klev
108       DO i = 1, klon       DO i = 1, klon
109          em_p(i,k) = pplay(i,k)/100.0          em_p(i, k) = pplay(i, k)/100.0
110       END DO       END DO
111    END DO    END DO
112    
# Line 110  SUBROUTINE concvl(iflag_con,dtime,paprs, Line 114  SUBROUTINE concvl(iflag_con,dtime,paprs,
114    IF (iflag_con==4) THEN    IF (iflag_con==4) THEN
115       DO k = 1, klev       DO k = 1, klev
116          DO i = 1, klon          DO i = 1, klon
117             zx_t = t(i,k)             zx_t = t(i, k)
118             zdelta = max(0.,sign(1.,rtt-zx_t))             zdelta = max(0., sign(1., rtt-zx_t))
119             zx_qs = min(0.5,r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)             zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)
120             zcor = 1./(1.-retv*zx_qs)             zcor = 1./(1.-retv*zx_qs)
121             qs(i,k) = zx_qs*zcor             qs(i, k) = zx_qs*zcor
122          END DO          END DO
123       END DO       END DO
124    ELSE    ELSE
# Line 122  SUBROUTINE concvl(iflag_con,dtime,paprs, Line 126  SUBROUTINE concvl(iflag_con,dtime,paprs,
126       ! convergence numerique)       ! convergence numerique)
127       DO k = 1, klev       DO k = 1, klev
128          DO i = 1, klon          DO i = 1, klon
129             zx_t = t(i,k)             zx_t = t(i, k)
130             zdelta = max(0.,sign(1.,rtt-zx_t))             zdelta = max(0., sign(1., rtt-zx_t))
131             zx_qs = r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0             zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
132             zx_qs = min(0.5,zx_qs)             zx_qs = min(0.5, zx_qs)
133             zcor = 1./(1.-retv*zx_qs)             zcor = 1./(1.-retv*zx_qs)
134             zx_qs = zx_qs*zcor             zx_qs = zx_qs*zcor
135             qs(i,k) = zx_qs             qs(i, k) = zx_qs
136          END DO          END DO
137       END DO       END DO
138    END IF    END IF
# Line 137  SUBROUTINE concvl(iflag_con,dtime,paprs, Line 141  SUBROUTINE concvl(iflag_con,dtime,paprs,
141    !             iflag_con = 3  -> equivalent to convect3    !             iflag_con = 3  -> equivalent to convect3
142    !             iflag_con = 4  -> equivalent to convect1/2    !             iflag_con = 4  -> equivalent to convect1/2
143    
144    CALL cv_driver(klon,klev,klev+1,ntra,iflag_con,t,q,qs,u,v,tra,em_p, &    CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v,&
145         em_ph,iflag,d_t,d_q,d_u,d_v,d_tra,rain,pmflxr,cbmf,work1,work2,kbas, &         tra, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain,&
146         ktop,dtime,ma,upwd,dnwd,dnwdbis,qcondc,wd,cape,da,phi,mp)         pmflxr, cbmf, work1, work2, kbas, ktop, dtime, ma, upwd, dnwd,&
147           dnwdbis, qcondc, wd, cape, da, phi, mp)
148    
149    DO i = 1, klon    DO i = 1, klon
150       rain(i) = rain(i)/86400.       rain(i) = rain(i)/86400.
# Line 147  SUBROUTINE concvl(iflag_con,dtime,paprs, Line 152  SUBROUTINE concvl(iflag_con,dtime,paprs,
152    
153    DO k = 1, klev    DO k = 1, klev
154       DO i = 1, klon       DO i = 1, klon
155          d_t(i,k) = dtime*d_t(i,k)          d_t(i, k) = dtime*d_t(i, k)
156          d_q(i,k) = dtime*d_q(i,k)          d_q(i, k) = dtime*d_q(i, k)
157          d_u(i,k) = dtime*d_u(i,k)          d_u(i, k) = dtime*d_u(i, k)
158          d_v(i,k) = dtime*d_v(i,k)          d_v(i, k) = dtime*d_v(i, k)
159       END DO       END DO
160    END DO    END DO
161    DO itra = 1, ntra    DO itra = 1, ntra
162       DO k = 1, klev       DO k = 1, klev
163          DO i = 1, klon          DO i = 1, klon
164             d_tra(i,k,itra) = dtime*d_tra(i,k,itra)             d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
165          END DO          END DO
166       END DO       END DO
167    END DO    END DO
# Line 165  SUBROUTINE concvl(iflag_con,dtime,paprs, Line 170  SUBROUTINE concvl(iflag_con,dtime,paprs,
170       DO itra = 1, ntra       DO itra = 1, ntra
171          DO k = 1, klev          DO k = 1, klev
172             DO i = 1, klon             DO i = 1, klon
173                d_tra(i,k,itra) = 0.                d_tra(i, k, itra) = 0.
174             END DO             END DO
175          END DO          END DO
176       END DO       END DO
Legend:
Removed from v.13  
changed lines
  Added in v.17
  ViewVC Help
Powered by ViewVC 1.1.21