Index: LMDZ5/trunk/libf/phylmd/calcratqs.F =================================================================== --- LMDZ5/trunk/libf/phylmd/calcratqs.F (revision 1688) +++ (revision ) @@ -1,166 +1,0 @@ -! -! $Header$ -! - SUBROUTINE calcratqs ( flag_ratqs, - I paprs,pplay,q_seri,d_t_con,d_t_ajs - O ,ratqs,zpt_conv) - USE dimphy - IMPLICIT none -c====================================================================== -c -c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 -c -c Objet: Moniteur general de la physique du modele -cAA Modifications quant aux traceurs : -cAA - uniformisation des parametrisations ds phytrac -cAA - stockage des moyennes des champs necessaires -cAA en mode traceur off-line -c====================================================================== -c modif ( P. Le Van , 12/10/98 ) -c -c Arguments: -c -c paprs---input-R-pression pour chaque inter-couche (en Pa) -c pplay---input-R-pression pour le mileu de chaque couche (en Pa) -c presnivs-input_R_pressions approximat. des milieux couches ( en PA) -cym#include "dimensions.h" -cym#include "dimphy.h" - REAL paprs(klon,klev+1) - REAL pplay(klon,klev) - REAL d_t_con(klon,klev) - REAL d_t_ajs(klon,klev) - REAL ratqs(klon,klev) - LOGICAL pt_conv(klon,klev) - REAL q_seri(klon,klev) - - logical firstcall - save firstcall - data firstcall/.true./ -c$OMP THREADPRIVATE(firstcall) - - REAL ratqsmin,ratqsmax,zx,epmax - REAL ratqs1,ratqs2,ratqs3,ratqs4 - REAL ratqsc1,ratqsc2,ratqsc3,ratqsc4 - INTEGER i,k - INTEGER flag_ratqs - save ratqsmin,ratqsmax,epmax - save ratqs1,ratqs2,ratqs3,ratqs4 - save ratqsc1,ratqsc2,ratqsc3,ratqsc4 -c$OMP THREADPRIVATE(ratqsmin,ratqsmax,epmax) -c$OMP THREADPRIVATE(ratqs1,ratqs2,ratqs3,ratqs4) -c$OMP THREADPRIVATE(ratqsc1,ratqsc2,ratqsc3,ratqsc4) - real zpt_conv(klon,klev) - - REAL zx_min - PARAMETER (zx_min=1.0) - REAL zx_max - PARAMETER (zx_max=0.1) - - zpt_conv=0. -c -c Appeler le processus de condensation a grande echelle -c et le processus de precipitation -c - if (flag_ratqs.eq.0) then - - ratqsmax=0.01 - ratqsmin=0.3 - - if (firstcall) print*,'RATQS ANCIEN ' - do k=1,klev - do i=1,klon - zx = pplay(i,k)/paprs(i,1) - zx = (zx_max-zx)/(zx_max-zx_min) - zx = MIN(MAX(zx,0.0),1.0) - zx = zx * zx * zx - ratqs(i,k)= zx * (ratqsmax-ratqsmin) + ratqsmin - enddo - enddo - - else - -c On aplique un ratqs "interactif" a toutes les mailles affectees -c par la convection ou se trouvant "sous" une maille affectee. - do i=1,klon - pt_conv(i,klev)=.false. - enddo - do k=klev-1,1,-1 - do i=1,klon - pt_conv(i,k)=pt_conv(i,k+1).or. - s (abs(d_t_con(i,k))+abs(d_t_ajs(i,k))).gt.1.e-8 - if(pt_conv(i,k)) then - zpt_conv(i,k)=1. - else - zpt_conv(i,k)=0. - endif - enddo - enddo - - if (flag_ratqs.eq.1) then - - ratqsmin=0.4 - ratqsmax=0.99 - if (firstcall) print*,'RATQS INTERACTIF ' - do k=1,klev - do i=1,klon - if (pt_conv(i,k)) then - ratqs(i,k)=0.01 - s +1.5*0.25*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k) - ratqs(i,k)=min(ratqs(i,k),ratqsmax) - ratqs(i,k)=max(ratqs(i,k),0.1) - else - ratqs(i,k)=0.01+(ratqsmin-0.01)* - s min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) - endif - enddo - enddo - else if (flag_ratqs.eq.2) then - do k=1,klev - do i=1,klon - ratqs(i,k)=0.001+ - s (q_seri(i,1)-q_seri(i,k))/q_seri(i,k) - if (pt_conv(i,k)) then - ratqs(i,k)=min(ratqs(i,k),ratqsmax) - else - ratqs(i,k)=min(ratqs(i,k),ratqsmin) - endif - enddo - enddo - else - do k=1,klev - do i=1,klon - if (pplay(i,k).ge.95000.) then - if (pt_conv(i,k)) then - ratqs(i,k)=ratqsc1 - else - ratqs(i,k)=ratqs1 - endif - else if (pplay(i,k).ge.75000.) then - if (pt_conv(i,k)) then - ratqs(i,k)=ratqsc2 - else - ratqs(i,k)=ratqs2 - endif - else if (pplay(i,k).ge.50000.) then - if (pt_conv(i,k)) then - ratqs(i,k)=ratqsc3 - else - ratqs(i,k)=ratqs3 - endif - else - if (pt_conv(i,k)) then - ratqs(i,k)=ratqsc4 - else - ratqs(i,k)=ratqs4 - endif - endif - enddo - enddo - endif - - endif - - firstcall=.false. - - return - end Index: LMDZ5/trunk/libf/phylmd/calcratqs.F90 =================================================================== --- LMDZ5/trunk/libf/phylmd/calcratqs.F90 (revision 1689) +++ LMDZ5/trunk/libf/phylmd/calcratqs.F90 (revision 1689) @@ -0,0 +1,185 @@ +SUBROUTINE calcratqs(klon,klev,prt_level,lunout, & + iflag_ratqs,iflag_con,iflag_cldcon,pdtphys, & + ratqsbas,ratqshaut,tau_ratqs,fact_cldcon, & + ptconv,ptconvth,clwcon0th, rnebcon0th, & + paprs,pplay,q_seri,zqsat,fm_therm, & + ratqs,ratqsc) + +implicit none + +!======================================================================== +! Computation of ratqs, the width of the subrid scale water distribution +! (normalized by the mean value) +! Various options controled by flags iflag_con and iflag_ratqs +! F Hourdin 2012/12/06 +!======================================================================== + +! Declarations + +! Input +integer,intent(in) :: klon,klev,prt_level,lunout +integer,intent(in) :: iflag_con,iflag_cldcon,iflag_ratqs +real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs +real, dimension(klon,klev+1),intent(in) :: paprs +real, dimension(klon,klev),intent(in) :: pplay,q_seri,zqsat,fm_therm +logical, dimension(klon,klev),intent(in) :: ptconv +real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th + +! Output +real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc +logical, dimension(klon,klev),intent(inout) :: ptconvth + +! local +integer i,k +real, dimension(klon,klev) :: ratqss +real facteur,zfratqs1,zfratqs2 + +!------------------------------------------------------------------------- +! Caclul des ratqs +!------------------------------------------------------------------------- + +! print*,'calcul des ratqs' +! ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q +! ---------------- +! on ecrase le tableau ratqsc calcule par clouds_gno + if (iflag_cldcon.eq.1) then + do k=1,klev + do i=1,klon + if(ptconv(i,k)) then + ratqsc(i,k)=ratqsbas & + +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k) + else + ratqsc(i,k)=0. + endif + enddo + enddo + +!----------------------------------------------------------------------- +! par nversion de la fonction log normale +!----------------------------------------------------------------------- + else if (iflag_cldcon.eq.4) then + ptconvth(:,:)=.false. + ratqsc(:,:)=0. + if(prt_level.ge.9) print*,'avant clouds_gno thermique' + call clouds_gno & + (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th) + if(prt_level.ge.9) print*,' CLOUDS_GNO OK' + + endif + +! ratqs stables +! ------------- + + if (iflag_ratqs.eq.0) then + +! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele. + do k=1,klev + do i=1, klon + ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* & + min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) + enddo + enddo + +! Pour iflag_ratqs=1 ou 2, le ratqs est constant au dessus de +! 300 hPa (ratqshaut), varie lineariement en fonction de la pression +! entre 600 et 300 hPa et est soit constant (ratqsbas) pour iflag_ratqs=1 +! soit lineaire (entre 0 a la surface et ratqsbas) pour iflag_ratqs=2 +! Il s'agit de differents tests dans la phase de reglage du modele +! avec thermiques. + + else if (iflag_ratqs.eq.1) then + + do k=1,klev + do i=1, klon + if (pplay(i,k).ge.60000.) then + ratqss(i,k)=ratqsbas + else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then + ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.) + else + ratqss(i,k)=ratqshaut + endif + enddo + enddo + + else if (iflag_ratqs.eq.2) then + + do k=1,klev + do i=1, klon + if (pplay(i,k).ge.60000.) then + ratqss(i,k)=ratqsbas*(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.) + else if ((pplay(i,k).ge.30000.).and.(pplay(i,k).lt.60000.)) then + ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)*(60000.-pplay(i,k))/(60000.-30000.) + else + ratqss(i,k)=ratqshaut + endif + enddo + enddo + + else if (iflag_ratqs==3) then + do k=1,klev + ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas) & + *min( ((paprs(:,1)-pplay(:,k))/70000.)**2 , 1. ) + enddo + + else if (iflag_ratqs==4) then + do k=1,klev + ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) & + *( tanh( (50000.-pplay(:,k))/20000.) + 1.) + enddo + + endif + + + + +! ratqs final +! ----------- + + if (iflag_cldcon.eq.1 .or.iflag_cldcon.eq.2.or.iflag_cldcon.eq.4) then + +! On ajoute une constante au ratqsc*2 pour tenir compte de +! fluctuations turbulentes de petite echelle + + do k=1,klev + do i=1,klon + if ((fm_therm(i,k).gt.1.e-10)) then + ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2) + endif + enddo + enddo + +! les ratqs sont une combinaison de ratqss et ratqsc + if(prt_level.ge.9) write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs + + if (tau_ratqs>1.e-10) then + facteur=exp(-pdtphys/tau_ratqs) + else + facteur=0. + endif + ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FH 22/09/2009 +! La ligne ci-dessous faisait osciller le modele et donnait une solution +! assymptotique bidon et dépendant fortement du pas de temps. +! ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ratqs(:,:)=max(ratqs(:,:),ratqss(:,:)) + else if (iflag_cldcon<=6) then +! on ne prend que le ratqs stable pour fisrtilp + ratqs(:,:)=ratqss(:,:) + else + zfratqs1=exp(-pdtphys/10800.) + zfratqs2=exp(-pdtphys/10800.) + do k=1,klev + do i=1,klon + if (ratqsc(i,k).gt.1.e-10) then + ratqs(i,k)=ratqs(i,k)*zfratqs2+(iflag_cldcon/100.)*ratqsc(i,k)*(1.-zfratqs2) + endif + ratqs(i,k)=min(ratqs(i,k)*zfratqs1+ratqss(i,k)*(1.-zfratqs1),0.5) + enddo + enddo + endif + + +return +end Index: LMDZ5/trunk/libf/phylmd/physiq.F =================================================================== --- LMDZ5/trunk/libf/phylmd/physiq.F (revision 1688) +++ LMDZ5/trunk/libf/phylmd/physiq.F (revision 1689) @@ -178,5 +178,5 @@ save iflag_ratqs c$OMP THREADPRIVATE(iflag_ratqs) - real facteur,zfratqs1,zfratqs2 + real facteur REAL zz,znum,zden @@ -958,5 +958,5 @@ REAL snow_lsc(klon) c - REAL ratqss(klon,klev),ratqsc(klon,klev) + REAL ratqsc(klon,klev) real ratqsbas,ratqshaut,tau_ratqs save ratqsbas,ratqshaut,tau_ratqs @@ -2817,159 +2817,12 @@ c------------------------------------------------------------------------- -c Caclul des ratqs -c------------------------------------------------------------------------- - -c print*,'calcul des ratqs' -c ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q -c ---------------- -c on ecrase le tableau ratqsc calcule par clouds_gno - if (iflag_cldcon.eq.1) then - do k=1,klev - do i=1,klon - if(ptconv(i,k)) then - ratqsc(i,k)=ratqsbas - s +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k) - else - ratqsc(i,k)=0. - endif - enddo - enddo - -c----------------------------------------------------------------------- -c par nversion de la fonction log normale -c----------------------------------------------------------------------- - else if (iflag_cldcon.eq.4) then - ptconvth(:,:)=.false. - ratqsc(:,:)=0. - if(prt_level.ge.9) print*,'avant clouds_gno thermique' - call clouds_gno - s (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th) - if(prt_level.ge.9) print*,' CLOUDS_GNO OK' - - endif - -c ratqs stables -c ------------- - - if (iflag_ratqs.eq.0) then - -! Le cas iflag_ratqs=0 correspond a la version IPCC 2005 du modele. - do k=1,klev - do i=1, klon - ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* - s min((paprs(i,1)-pplay(i,k))/(paprs(i,1)-30000.),1.) - enddo - enddo - -! Pour iflag_ratqs=1 ou 2, le ratqs est constant au dessus de -! 300 hPa (ratqshaut), varie lineariement en fonction de la pression -! entre 600 et 300 hPa et est soit constant (ratqsbas) pour iflag_ratqs=1 -! soit lineaire (entre 0 a la surface et ratqsbas) pour iflag_ratqs=2 -! Il s'agit de differents tests dans la phase de reglage du modele -! avec thermiques. - - else if (iflag_ratqs.eq.1) then - - do k=1,klev - do i=1, klon - if (pplay(i,k).ge.60000.) then - ratqss(i,k)=ratqsbas - else if ((pplay(i,k).ge.30000.).and. - s (pplay(i,k).lt.60000.)) then - ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* - s (60000.-pplay(i,k))/(60000.-30000.) - else - ratqss(i,k)=ratqshaut - endif - enddo - enddo - - else if (iflag_ratqs.eq.2) then - - do k=1,klev - do i=1, klon - if (pplay(i,k).ge.60000.) then - ratqss(i,k)=ratqsbas - s *(paprs(i,1)-pplay(i,k))/(paprs(i,1)-60000.) - else if ((pplay(i,k).ge.30000.).and. - s (pplay(i,k).lt.60000.)) then - ratqss(i,k)=ratqsbas+(ratqshaut-ratqsbas)* - s (60000.-pplay(i,k))/(60000.-30000.) - else - ratqss(i,k)=ratqshaut - endif - enddo - enddo - - else if (iflag_ratqs==3) then - do k=1,klev - ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas) - s *min( ((paprs(:,1)-pplay(:,k))/70000.)**2 , 1. ) - enddo - - else if (iflag_ratqs==4) then - do k=1,klev - ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) - s *( tanh( (50000.-pplay(:,k))/20000.) + 1.) - enddo - - endif - - - - -c ratqs final -c ----------- - - if (iflag_cldcon.eq.1 .or.iflag_cldcon.eq.2 - s .or.iflag_cldcon.eq.4) then - -! On ajoute une constante au ratqsc*2 pour tenir compte de -! fluctuations turbulentes de petite echelle - - do k=1,klev - do i=1,klon - if ((fm_therm(i,k).gt.1.e-10)) then - ratqsc(i,k)=sqrt(ratqsc(i,k)**2+0.05**2) - endif - enddo - enddo - -! les ratqs sont une combinaison de ratqss et ratqsc - if(prt_level.ge.9) - $ write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs - - if (tau_ratqs>1.e-10) then - facteur=exp(-pdtphys/tau_ratqs) - else - facteur=0. - endif - ratqs(:,:)=ratqsc(:,:)*(1.-facteur)+ratqs(:,:)*facteur -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! FH 22/09/2009 -! La ligne ci-dessous faisait osciller le modele et donnait une solution -! assymptotique bidon et dépendant fortement du pas de temps. -! ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2) -!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ratqs(:,:)=max(ratqs(:,:),ratqss(:,:)) - else if (iflag_cldcon<=6) then -! on ne prend que le ratqs stable pour fisrtilp - ratqs(:,:)=ratqss(:,:) - else - zfratqs1=exp(-pdtphys/10800.) - zfratqs2=exp(-pdtphys/10800.) -! print*,'RAPPEL RATQS 1 ',zfratqs1,zfratqs2 -! s ,ratqss(1,14),ratqs(1,14),ratqsc(1,14) - do k=1,klev - do i=1,klon - if (ratqsc(i,k).gt.1.e-10) then - ratqs(i,k)=ratqs(i,k)*zfratqs2 - s +(iflag_cldcon/100.)*ratqsc(i,k)*(1.-zfratqs2) - endif - ratqs(i,k)=min(ratqs(i,k)*zfratqs1 - s +ratqss(i,k)*(1.-zfratqs1),0.5) - enddo - enddo - endif +! Computation of ratqs, the width (normalized) of the subrid scale +! water distribution + CALL calcratqs(klon,klev,prt_level,lunout, + s iflag_ratqs,iflag_con,iflag_cldcon,pdtphys, + s ratqsbas,ratqshaut,tau_ratqs,fact_cldcon, + s ptconv,ptconvth,clwcon0th, rnebcon0th, + s paprs,pplay,q_seri,zqsat,fm_therm, + s ratqs,ratqsc)