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