/[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

trunk/libf/phylmd/concvl.f revision 10 by guez, Fri Apr 18 14:45:53 2008 UTC trunk/libf/phylmd/concvl.f90 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,&
2  ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/concvl.F,v 1.3 2005/04/15 12:36:17 lmdzadmin Exp $       ntra, work1, work2, d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas,&
3  !       ktop, upwd, dnwd, dnwdbis, ma, cape, tvp, iflag, pbase, bbase,&
4        SUBROUTINE concvl (iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra,       dtvpdt1, dtvpdq1, dplcldt, dplcldr, qcondc, wd, pmflxr, pmflxs,&
5       .             work1,work2,d_t,d_q,d_u,d_v,d_tra,       da, phi, mp)
6       .             rain, snow, kbas, ktop,  
7       .             upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag,    ! From phylmd/concvl.F, v 1.3 2005/04/15 12:36:17
8       .             pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,    ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
9       .             qcondc,wd,    ! Objet: schema de convection de Emanuel (1991) interface
10       .             pmflxr,pmflxs,  
11       .             da,phi,mp)    USE dimens_m
12      USE dimphy
13  c    USE yomcst
14        use dimens_m    USE yoethf
15        use dimphy    USE fcttre
16        use YOMCST  
17        use yoethf    IMPLICIT NONE
18        use fcttre  
19        IMPLICIT none    ! Arguments:
20  c======================================================================    ! dtime--input-R-pas d'integration (s)
21  c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818    ! s-------input-R-la valeur "s" pour chaque couche
22  c Objet: schema de convection de Emanuel (1991) interface    ! sigs----input-R-la valeur "sigma" de chaque couche
23  c======================================================================    ! sig-----input-R-la valeur de "sigma" pour chaque niveau
24  c Arguments:    ! psolpa--input-R-la pression au sol (en Pa)
25  c dtime--input-R-pas d'integration (s)    ! pskapa--input-R-exponentiel kappa de psolpa
26  c s-------input-R-la valeur "s" pour chaque couche    ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
27  c sigs----input-R-la valeur "sigma" de chaque couche    ! q-------input-R-vapeur d'eau (en kg/kg)
28  c sig-----input-R-la valeur de "sigma" pour chaque niveau  
29  c psolpa--input-R-la pression au sol (en Pa)    ! work*: input et output: deux variables de travail,
30  C pskapa--input-R-exponentiel kappa de psolpa    !                            on peut les mettre a 0 au debut
31  c h-------input-R-enthalpie potentielle (Cp*T/P**kappa)    ! ALE-----input-R-energie disponible pour soulevement
32  c q-------input-R-vapeur d'eau (en kg/kg)  
33  c    ! d_h-----output-R-increment de l'enthalpie potentielle (h)
34  c work*: input et output: deux variables de travail,    ! d_q-----output-R-increment de la vapeur d'eau
35  c                            on peut les mettre a 0 au debut    ! rain----output-R-la pluie (mm/s)
36  c ALE-----input-R-energie disponible pour soulevement    ! snow----output-R-la neige (mm/s)
37  c    ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
38  C d_h-----output-R-increment de l'enthalpie potentielle (h)    ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
39  c d_q-----output-R-increment de la vapeur d'eau    ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
40  c rain----output-R-la pluie (mm/s)    ! Cape----output-R-CAPE (J/kg)
41  c snow----output-R-la neige (mm/s)    ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
42  c upwd----output-R-saturated updraft mass flux (kg/m**2/s)    !                  adiabatiquement a partir du niveau 1 (K)
43  c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)    ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ;
44  c dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)    !  Pa)
45  c Cape----output-R-CAPE (J/kg)    ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de
46  c Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee    !  la glace
47  c                  adiabatiquement a partir du niveau 1 (K)  
48  c deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)    INTEGER ntrac
49  c Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace    PARAMETER (ntrac=nqmx-2)
50  c======================================================================  
51  c    INTEGER, INTENT (IN) :: iflag_con
52  c  
53        integer NTRAC    REAL, INTENT (IN) :: dtime
54        PARAMETER (NTRAC=nqmx-2)    REAL, INTENT (IN) :: paprs(klon, klev+1)
55  c    REAL, INTENT (IN) :: pplay(klon, klev)
56         INTEGER iflag_con    REAL t(klon, klev), q(klon, klev), u(klon, klev), v(klon, klev)
57  c    REAL, INTENT (IN):: tra(klon, klev, ntrac)
58         REAL dtime    INTEGER ntra
59         real, intent(in):: paprs(klon,klev+1)    REAL work1(klon, klev), work2(klon, klev)
60         real, intent(in):: pplay(klon,klev)    REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
61         REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)  
62         REAL tra(klon,klev,ntrac)    REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon,&
63         INTEGER ntra         klev)
64         REAL work1(klon,klev),work2(klon,klev)    REAL d_tra(klon, klev, ntrac)
65         REAL pmflxr(klon,klev+1),pmflxs(klon,klev+1)    REAL rain(klon), snow(klon)
66  c  
67         REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)    INTEGER kbas(klon), ktop(klon)
68         REAL d_tra(klon,klev,ntrac)    REAL em_ph(klon, klev+1), em_p(klon, klev)
69         REAL rain(klon),snow(klon)    REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev)
70  c    REAL ma(klon, klev), cape(klon), tvp(klon, klev)
71         INTEGER kbas(klon),ktop(klon)    REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
72         REAL em_ph(klon,klev+1),em_p(klon,klev)    INTEGER iflag(klon)
73         REAL upwd(klon,klev),dnwd(klon,klev),dnwdbis(klon,klev)    REAL pbase(klon), bbase(klon)
74         REAL Ma(klon,klev),cape(klon),tvp(klon,klev)    REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
75         real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)    REAL dplcldt(klon), dplcldr(klon)
76         INTEGER iflag(klon)    REAL qcondc(klon, klev)
77         REAL rflag(klon)    REAL wd(klon)
78         REAL pbase(klon),bbase(klon)  
79         REAL dtvpdt1(klon,klev),dtvpdq1(klon,klev)    REAL zx_t, zdelta, zx_qs, zcor
80         REAL dplcldt(klon),dplcldr(klon)  
81         REAL qcondc(klon,klev)    INTEGER i, k, itra
82         REAL wd(klon)    REAL qs(klon, klev)
83  c    REAL cbmf(klon)
84         REAL zx_t,zdelta,zx_qs,zcor    SAVE cbmf
85  c    INTEGER ifrst
86         INTEGER noff, minorig    SAVE ifrst
87         INTEGER i,k,itra    DATA ifrst/0/
88         REAL qs(klon,klev)  
89         REAL cbmf(klon)    !-----------------------------------------------------------------
90         SAVE cbmf  
91         INTEGER ifrst    snow(:) = 0
92         SAVE ifrst  
93         DATA ifrst /0/    IF (ifrst==0) THEN
94  c       ifrst = 1
95  c       DO i = 1, klon
96  cym          cbmf(i) = 0.
97        snow(:)=0       END DO
98            END IF
99        IF (ifrst .EQ. 0) THEN  
100           ifrst = 1    DO k = 1, klev + 1
101           DO i = 1, klon       DO i = 1, klon
102            cbmf(i) = 0.          em_ph(i, k) = paprs(i, k)/100.0
103           ENDDO          pmflxs(i, k) = 0.
104        ENDIF       END DO
105      END DO
106        DO k = 1, klev+1  
107           DO i=1,klon    DO k = 1, klev
108           em_ph(i,k) = paprs(i,k) / 100.0       DO i = 1, klon
109           pmflxs(i,k)=0.          em_p(i, k) = pplay(i, k)/100.0
110        ENDDO       END DO
111        ENDDO    END DO
112  c  
113        DO k = 1, klev  
114           DO i=1,klon    IF (iflag_con==4) THEN
115           em_p(i,k) = pplay(i,k) / 100.0       DO k = 1, klev
       ENDDO  
       ENDDO  
   
 c  
       if (iflag_con .eq. 4) then  
       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          ENDDO          END DO
123        ENDDO       END DO
124        else ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique)    ELSE
125        DO k = 1, klev       ! iflag_con=3 (modif de puristes qui fait la diffce pour la
126         ! convergence numerique)
127         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          ENDDO          END DO
137        ENDDO       END DO
138        endif ! iflag_con    END IF
139  c  
140  C------------------------------------------------------------------    ! Main driver for convection:
141      !             iflag_con = 3  -> equivalent to convect3
142  C Main driver for convection:    !             iflag_con = 4  -> equivalent to convect1/2
143  C               iflag_con = 3  -> equivalent to convect3  
144  C               iflag_con = 4  -> equivalent to convect1/2    CALL cv_driver(klon, klev, klev+1, ntra, iflag_con, t, q, qs, u, v,&
145           tra, em_p, em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain,&
146        CALL cv_driver(klon,klev,klev+1,ntra,iflag_con,         pmflxr, cbmf, work1, work2, kbas, ktop, dtime, ma, upwd, dnwd,&
147       :              t,q,qs,u,v,tra,         dnwdbis, qcondc, wd, cape, da, phi, mp)
148       $              em_p,em_ph,iflag,  
149       $              d_t,d_q,d_u,d_v,d_tra,rain,    DO i = 1, klon
150       $              pmflxr,cbmf,work1,work2,       rain(i) = rain(i)/86400.
151       $              kbas,ktop,    END DO
152       $              dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape,  
153       $              da,phi,mp)    DO k = 1, klev
154         DO i = 1, klon
155  C------------------------------------------------------------------          d_t(i, k) = dtime*d_t(i, k)
156            d_q(i, k) = dtime*d_q(i, k)
157        DO i = 1,klon          d_u(i, k) = dtime*d_u(i, k)
158          rain(i) = rain(i)/86400.          d_v(i, k) = dtime*d_v(i, k)
159          rflag(i)=iflag(i)       END DO
160        ENDDO    END DO
161      DO itra = 1, ntra
162        DO k = 1, klev       DO k = 1, klev
163          DO i = 1, klon          DO i = 1, klon
164             d_t(i,k) = dtime*d_t(i,k)             d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
165             d_q(i,k) = dtime*d_q(i,k)          END DO
166             d_u(i,k) = dtime*d_u(i,k)       END DO
167             d_v(i,k) = dtime*d_v(i,k)    END DO
168          ENDDO    ! les traceurs ne sont pas mis dans cette version de convect4:
169        ENDDO    IF (iflag_con==4) THEN
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) =dtime*d_tra(i,k,itra)                d_tra(i, k, itra) = 0.
174           ENDDO             END DO
175          ENDDO          END DO
176         ENDDO       END DO
177  c les traceurs ne sont pas mis dans cette version de convect4:    END IF
178        if (iflag_con.eq.4) then  
179         DO itra = 1,ntra  END SUBROUTINE concvl
         DO k = 1, klev  
          DO i = 1, klon  
             d_tra(i,k,itra) = 0.  
          ENDDO  
         ENDDO  
        ENDDO  
       endif  
   
       RETURN  
       END  
   
Legend:
Removed from v.10  
changed lines
  Added in v.17
  ViewVC Help
Powered by ViewVC 1.1.21