--- trunk/libf/phylmd/concvl.f 2008/04/18 14:45:53 10 +++ trunk/phylmd/concvl.f 2014/08/29 13:00:05 103 @@ -1,194 +1,134 @@ -! -! $Header: /home/cvsroot/LMDZ4/libf/phylmd/concvl.F,v 1.3 2005/04/15 12:36:17 lmdzadmin Exp $ -! - SUBROUTINE concvl (iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra, - . work1,work2,d_t,d_q,d_u,d_v,d_tra, - . rain, snow, kbas, ktop, - . upwd,dnwd,dnwdbis,Ma,cape,tvp,iflag, - . pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr, - . qcondc,wd, - . pmflxr,pmflxs, - . da,phi,mp) - -c - use dimens_m - use dimphy - use YOMCST - use yoethf - use fcttre - IMPLICIT none -c====================================================================== -c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818 -c Objet: schema de convection de Emanuel (1991) interface -c====================================================================== -c Arguments: -c dtime--input-R-pas d'integration (s) -c s-------input-R-la valeur "s" pour chaque couche -c sigs----input-R-la valeur "sigma" de chaque couche -c sig-----input-R-la valeur de "sigma" pour chaque niveau -c psolpa--input-R-la pression au sol (en Pa) -C pskapa--input-R-exponentiel kappa de psolpa -c h-------input-R-enthalpie potentielle (Cp*T/P**kappa) -c q-------input-R-vapeur d'eau (en kg/kg) -c -c work*: input et output: deux variables de travail, -c on peut les mettre a 0 au debut -c ALE-----input-R-energie disponible pour soulevement -c -C d_h-----output-R-increment de l'enthalpie potentielle (h) -c d_q-----output-R-increment de la vapeur d'eau -c rain----output-R-la pluie (mm/s) -c snow----output-R-la neige (mm/s) -c upwd----output-R-saturated updraft mass flux (kg/m**2/s) -c dnwd----output-R-saturated downdraft mass flux (kg/m**2/s) -c dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s) -c Cape----output-R-CAPE (J/kg) -c Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee -c adiabatiquement a partir du niveau 1 (K) -c deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa) -c Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace -c====================================================================== -c -c - integer NTRAC - PARAMETER (NTRAC=nqmx-2) -c - INTEGER iflag_con -c - REAL dtime - real, intent(in):: paprs(klon,klev+1) - real, intent(in):: pplay(klon,klev) - REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev) - REAL tra(klon,klev,ntrac) - INTEGER ntra - REAL work1(klon,klev),work2(klon,klev) - REAL pmflxr(klon,klev+1),pmflxs(klon,klev+1) -c - REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev) - REAL d_tra(klon,klev,ntrac) - REAL rain(klon),snow(klon) -c - INTEGER kbas(klon),ktop(klon) - REAL em_ph(klon,klev+1),em_p(klon,klev) - REAL upwd(klon,klev),dnwd(klon,klev),dnwdbis(klon,klev) - REAL Ma(klon,klev),cape(klon),tvp(klon,klev) - real da(klon,klev),phi(klon,klev,klev),mp(klon,klev) - INTEGER iflag(klon) - REAL rflag(klon) - REAL pbase(klon),bbase(klon) - REAL dtvpdt1(klon,klev),dtvpdq1(klon,klev) - REAL dplcldt(klon),dplcldr(klon) - REAL qcondc(klon,klev) - REAL wd(klon) -c - REAL zx_t,zdelta,zx_qs,zcor -c - INTEGER noff, minorig - INTEGER i,k,itra - REAL qs(klon,klev) - REAL cbmf(klon) - SAVE cbmf - INTEGER ifrst - SAVE ifrst - DATA ifrst /0/ -c -c -cym - snow(:)=0 - - IF (ifrst .EQ. 0) THEN - ifrst = 1 - DO i = 1, klon +module concvl_m + + IMPLICIT NONE + +contains + + SUBROUTINE concvl(dtime, paprs, play, t, q, u, v, sig1, w01, d_t, d_q, d_u, & + d_v, rain, snow, kbas, ktop, upwd, dnwd, dnwd0, ma, cape, iflag, & + qcondc, wd, pmflxr, pmflxs, da, phi, mp) + + ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17 + ! Author: Z. X. Li (LMD/CNRS) + ! Date: 1993 August 18 + ! Objet : schéma de convection d'Emanuel (1991), interface + ! (driver commun aux versions 3 et 4) + + use clesphys2, only: iflag_con + use cv_driver_m, only: cv_driver + USE dimens_m, ONLY: nqmx + USE dimphy, ONLY: klev, klon + USE fcttre, ONLY: foeew + USE suphec_m, ONLY: retv, rtt + USE yoethf_m, ONLY: r2es + + REAL, INTENT (IN):: dtime ! pas d'integration (s) + REAL, INTENT (IN):: paprs(klon, klev+1) + REAL, INTENT (IN):: play(klon, klev) + REAL, intent(in):: t(klon, klev) + real, intent(in):: q(klon, klev) ! vapeur d'eau (en kg/kg) + real, INTENT (IN):: u(klon, klev), v(klon, klev) + REAL, intent(inout):: sig1(klon, klev), w01(klon, klev) + REAL, intent(out):: d_t(klon, klev) + REAL, intent(out):: d_q(klon, klev) ! increment de la vapeur d'eau + REAL, intent(out):: d_u(klon, klev), d_v(klon, klev) + REAL, intent(out):: rain(klon) ! pluie (mm/s) + REAL, intent(out):: snow(klon) ! neige (mm/s) + INTEGER kbas(klon), ktop(klon) + + REAL, intent(out):: upwd(klon, klev) + ! saturated updraft mass flux (kg/m**2/s) + + real, intent(out):: dnwd(klon, klev) + ! saturated downdraft mass flux (kg/m**2/s) + + real, intent(out):: dnwd0(klon, klev) + ! unsaturated downdraft mass flux (kg/m**2/s) + + REAL ma(klon, klev), cape(klon) + ! Cape----output-R-CAPE (J/kg) + + INTEGER iflag(klon) + REAL qcondc(klon, klev) + REAL wd(klon) + REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1) + REAL, intent(inout):: da(klon, klev), phi(klon, klev, klev), mp(klon, klev) + + ! Local: + + REAL em_ph(klon, klev+1), em_p(klon, klev) + REAL zx_t, zx_qs, zcor + INTEGER i, k + REAL qs(klon, klev) + REAL, save:: cbmf(klon) + INTEGER:: ifrst = 0 + + !----------------------------------------------------------------- + + snow = 0 + + IF (ifrst==0) THEN + ifrst = 1 + DO i = 1, klon cbmf(i) = 0. - ENDDO - ENDIF + END DO + END IF + + DO k = 1, klev + 1 + DO i = 1, klon + em_ph(i, k) = paprs(i, k)/100.0 + pmflxs(i, k) = 0. + END DO + END DO + + DO k = 1, klev + DO i = 1, klon + em_p(i, k) = play(i, k)/100.0 + END DO + END DO + + + IF (iflag_con==4) THEN + DO k = 1, klev + DO i = 1, klon + zx_t = t(i, k) + zx_qs = min(0.5, r2es*foeew(zx_t, rtt >= zx_t)/em_p(i, k)/100.0) + zcor = 1./(1.-retv*zx_qs) + qs(i, k) = zx_qs*zcor + END DO + END DO + ELSE + ! iflag_con=3 (modif de puristes qui fait la diffce pour la + ! convergence numerique) + DO k = 1, klev + DO i = 1, klon + zx_t = t(i, k) + zx_qs = r2es*foeew(zx_t, rtt >= zx_t)/em_p(i, k)/100.0 + zx_qs = min(0.5, zx_qs) + zcor = 1./(1.-retv*zx_qs) + zx_qs = zx_qs*zcor + qs(i, k) = zx_qs + END DO + END DO + END IF + + CALL cv_driver(t, q, qs, u, v, em_p, em_ph, iflag, d_t, d_q, & + d_u, d_v, rain, pmflxr, cbmf, sig1, w01, kbas, ktop, dtime, ma, & + upwd, dnwd, dnwd0, qcondc, wd, cape, da, phi, mp) + + DO i = 1, klon + rain(i) = rain(i)/86400. + END DO + + DO k = 1, klev + DO i = 1, klon + d_t(i, k) = dtime*d_t(i, k) + d_q(i, k) = dtime*d_q(i, k) + d_u(i, k) = dtime*d_u(i, k) + d_v(i, k) = dtime*d_v(i, k) + END DO + END DO + + END SUBROUTINE concvl - DO k = 1, klev+1 - DO i=1,klon - em_ph(i,k) = paprs(i,k) / 100.0 - pmflxs(i,k)=0. - ENDDO - ENDDO -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 - DO i = 1, klon - zx_t = t(i,k) - zdelta=MAX(0.,SIGN(1.,rtt-zx_t)) - zx_qs= MIN(0.5 , r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0) - zcor=1./(1.-retv*zx_qs) - qs(i,k)=zx_qs*zcor - ENDDO - ENDDO - else ! iflag_con=3 (modif de puristes qui fait la diffce pour la convergence numerique) - DO k = 1, klev - DO i = 1, klon - zx_t = t(i,k) - zdelta=MAX(0.,SIGN(1.,rtt-zx_t)) - zx_qs= r2es * FOEEW(zx_t,zdelta)/em_p(i,k)/100.0 - zx_qs= MIN(0.5,zx_qs) - zcor=1./(1.-retv*zx_qs) - zx_qs=zx_qs*zcor - qs(i,k)=zx_qs - ENDDO - ENDDO - endif ! iflag_con -c -C------------------------------------------------------------------ - -C Main driver for convection: -C iflag_con = 3 -> equivalent to convect3 -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,em_ph,iflag, - $ d_t,d_q,d_u,d_v,d_tra,rain, - $ pmflxr,cbmf,work1,work2, - $ kbas,ktop, - $ dtime,Ma,upwd,dnwd,dnwdbis,qcondc,wd,cape, - $ da,phi,mp) - -C------------------------------------------------------------------ - - DO i = 1,klon - rain(i) = rain(i)/86400. - rflag(i)=iflag(i) - ENDDO - - DO k = 1, klev - DO i = 1, klon - d_t(i,k) = dtime*d_t(i,k) - d_q(i,k) = dtime*d_q(i,k) - d_u(i,k) = dtime*d_u(i,k) - d_v(i,k) = dtime*d_v(i,k) - ENDDO - ENDDO - DO itra = 1,ntra - DO k = 1, klev - DO i = 1, klon - d_tra(i,k,itra) =dtime*d_tra(i,k,itra) - ENDDO - ENDDO - ENDDO -c les traceurs ne sont pas mis dans cette version de convect4: - if (iflag_con.eq.4) then - DO itra = 1,ntra - DO k = 1, klev - DO i = 1, klon - d_tra(i,k,itra) = 0. - ENDDO - ENDDO - ENDDO - endif - - RETURN - END - +end module concvl_m