Changeset 1411 for LMDZ4/trunk/libf/phylmd/physiq.F

Timestamp:

Jul 9, 2010, 1:06:15 PM (14 years ago)

Author:

idelkadi

Message:

Nettoyage dans physiq.F des anciennes versions versions des options iflag_cldcon=5 ou 6.
Dans isrtilp.F, iflag_cldcon=5 : la version bi-gaussienne partout et iflag_cldcon=6 : bi-gaussiennes pour les thermiques et la lognormale ailleurs

File:

• LMDZ4/trunk/libf/phylmd/physiq.F (modified) (21 diffs)

LMDZ4/trunk/libf/phylmd/physiq.F

@@ -1 +1 @@
 ! $Id$
+!
 c#define IO_DEBUG
 
@@ -261 +262 @@
       CHARACTER*4 bb2
       CHARACTER*2 bb3
+c
 
       real twriteSTD(klon,nlevSTD,nfiles)
@@ -863 +865 @@
       REAL rflag(klon)          ! flag fonctionnement de convect
       INTEGER iflagctrl(klon)          ! flag fonctionnement de convect
-
 c -- convect43:
       INTEGER ntra              ! nb traceurs pour convect4.3
@@ -1232 +1233 @@
       call phys_state_var_init(read_climoz)
       call phys_output_var_init
+
       print*, '================================================='
 cIM for NMC files
@@ -1251 +1253 @@
 c         pmflxr=0.
 c         pmflxs=0.
-
         itau_con=0
         first=.false.
@@ -1423 +1424 @@
            ema_pcb(i)  = 0.
            ema_pct(i)  = 0.
-c          ema_workcbmf(i) = 0.
+           ema_workcbmf(i) = 0.
           ENDDO
 cIM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG
@@ -1448 +1449 @@
 c================================================================================
 
-         ENDIF !debut
+         ENDIF
 
            DO i=1,klon
@@ -2170 +2171 @@
      .        d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
      .        rain_con, snow_con, ibas_con, itop_con, sigd,
-     .        ema_cbmf,upwd,dnwd,dnwd0,
+     .        upwd,dnwd,dnwd0,
      .        Ma,mip,Vprecip,cape,cin,tvp,Tconv,iflagctrl,
      .        pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd,
@@ -2189 +2190 @@
 
           ELSE ! ok_cvl
-
 c MAF conema3 ne contient pas les traceurs
           CALL conema3 (dtime,
@@ -2229 +2229 @@
 
           DO i = 1, klon
-            ema_pcb(i)  = paprs(i,ibas_con(i))
+            ema_pcb(i)  = pbase(i)
           ENDDO
           DO i = 1, klon
+
 ! L'idicage de itop_con peut cacher un pb potentiel
 ! FH sous la dictee de JYG, CR
@@ -2242 +2243 @@
               endif
             endif
-          ENDDO     
+          ENDDO
+          DO i = 1, klon
+            ema_cbmf(i) = ema_workcbmf(i)
+          ENDDO      
       ELSE IF (iflag_con.eq.0) THEN
           write(lunout,*) 'On n appelle pas la convection'
@@ -2459 +2463 @@
 c  ==============
 
-! Dans le cas où on active les thermiques, on fait partir l'ajustement
+! Dans le cas où on active les thermiques, on fait partir l'ajustement
 ! a partir du sommet des thermiques.
 ! Dans le cas contraire, on demarre au niveau 1.
@@ -2544 +2548 @@
          if(prt_level.ge.9) print*,' CLOUDS_GNO OK'
 
-c-----------------------------------------------------------------------
-c   par calcul direct de l'ecart-type
-c-----------------------------------------------------------------------
-
-      else if (iflag_cldcon>=5) then
-         wmax_th(:)=0.
-         zmax_th(:)=0.
-         do k=1,klev
-            do i=1,klon
-               wmax_th(i)=max(wmax_th(i),zw2(i,k))
-               if (detr_therm(i,k).gt.0.) zmax_th(i)=pphi(i,k)/rg
-            enddo
-         enddo
-         tau_overturning_th(:)=zmax_th(:)/max(0.5*wmax_th(:),0.1)
-         if(prt_level.ge.9)
-     &     write(lunout,*)'TAU TH OK ',
-     &     tau_overturning_th(1),detr_therm(1,3)
-
-c On impose que l'air autour de la fraction couverte par le thermique
-c plus son air detraine durant tau_overturning_th soit superieur
-c a 0.1 q_seri
-         zz=0.1
-         do k=1,klev
-            do i=1,klon
-               lambda_th(i,k)=0.5*(fraca(i,k)+fraca(i,k+1))+
-     s         tau_overturning_th(i)*detr_therm(i,k)
-     s         *rg/(paprs(i,k)-paprs(i,k+1))
-               znum=(1.-zz)*q_seri(i,k)
-               zden=zqasc(i,k)-zz*q_seri(i,k)
-               if (znum-lambda_th(i,k)*zden<0.) lambda_th(i,k)=znum/zden
-               lambda_th(i,k)=min(lambda_th(i,k),0.9)
-            enddo
-         enddo
-
-         if(iflag_cldcon==5) then
-            do k=1,klev
-               do i=1,klon
-                  ratqsc(i,k)=sqrt(lambda_th(i,k)/(1.-lambda_th(i,k)))*
-     s            abs((zqasc(i,k)-q_seri(i,k))/q_seri(i,k))
-               enddo
-            enddo
-         else if(iflag_cldcon==6) then
-            do k=1,klev
-               do i=1,klon
-                  ratqsc(i,k)=sqrt(lambda_th(i,k))*
-     s            (zqasc(i,k)-q_seri(i,k))/q_seri(i,k)
-               enddo
-            enddo
-         endif
-
       endif
 
@@ -2657 +2611 @@
 
       if (iflag_cldcon.eq.1 .or.iflag_cldcon.eq.2
-     s    .or.iflag_cldcon.ge.4) then
+     s    .or.iflag_cldcon.eq.4) then
 
 ! On ajoute une constante au ratqsc*2 pour tenir compte de 
@@ -2692 +2646 @@
       endif
 
+      print*,'PHSYIQ NUAGES4'
 
 c
@@ -2869 +2824 @@
 
 c   On prend la somme des fractions nuageuses et des contenus en eau
-      cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
-      cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
+
+      if (iflag_cldcon>=5) then
+
+! Si on est sur un point touche par la convection profonde et pas
+! par les thermiques, on prend la couverture nuageuse et l'eau nuageuse
+! de la convection profonde.
+
+         print*,'TEST SCHEMA DE NUAGES '
+         do k=1,klev
+            do i=1,klon
+               if (ptconv(i,k).and. .not. ptconvth(i,k)) then
+                   cldfra(i,k)=rnebcon(i,k)
+                   cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
+               endif
+            enddo
+         enddo
+      else
+! Ancienne version
+         cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
+         cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
+      endif
 
       ENDIF
@@ -3338 +3312 @@
 !     s        ref_liq,ref_ice
           call phys_cosp(itap,dtime,freq_cosp,
-     $                   ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP,
-     $                   ecrit_mth,ecrit_day,ecrit_hf,
-     $                   klon,klev,rlon,rlat,presnivs,overlap,
+     $                 ecrit_mth,ecrit_day,ecrit_hf,overlap,
+     $                   klon,klev,rlon,rlat,presnivs,
      $                   ref_liq,ref_ice,
      $                   pctsrf(:,is_ter)+pctsrf(:,is_lic),
@@ -3349 +3322 @@
      $                   pmflxr(:,1:klev),pmflxs(:,1:klev),
      $                   mr_ozone,cldtau, cldemi)
-
 !     L          calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol,
 !     L          cfaddbze,clcalipso2,dbze,cltlidarradar,
@@ -3497 +3469 @@
       wwriteSTD(:,:,4)=wlevSTD(:,:)
 c
-cIM initialisation 5eme fichier de sortie 
 cIM ajoute 5eme niveau 170310 BEG
       twriteSTD(:,:,5)=tlevSTD(:,:)
@@ -3610 +3581 @@
 cIM global posePB#include "write_bilKP_ave.h"
 c
-
 c Sauvegarder les valeurs de t et q a la fin de la physique:
 c
@@ -3669 +3639 @@
       DO k = 1, klev
       DO i = 1, klon
-cJYG/IM theta en debut du pas de temps
-cJYG/IM       theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
-cJYG/IM theta en fin de pas de temps de physique
-        theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
+        theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
       ENDDO
       ENDDO