Index: DZ5/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)
 
 
