Changeset 852 for LMDZ4/trunk/libf/phytherm/physiq.F

Timestamp:

Oct 11, 2007, 3:43:42 PM (17 years ago)

Author:

Laurent Fairhead

Message:

Mise a jour de la physique avec thermiques avec la version de FH d'aout 2007
LF

File:

• LMDZ4/trunk/libf/phytherm/physiq.F (modified) (15 diffs)

LMDZ4/trunk/libf/phytherm/physiq.F

@@ -189 +189 @@
 
       integer lmax_th(klon)
+      integer limbas(klon)
       real ratqscth(klon,klev)
       real ratqsdiff(klon,klev)
@@ -945 +946 @@
       REAL fluxu(klon,klev, nbsrf)   ! flux turbulent de vitesse u
       REAL fluxv(klon,klev, nbsrf)   ! flux turbulent de vitesse v
+
+      REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: pbl_tke ! turb kinetic energy
+c   !$OMP THREADPRIVATE(pbl_tke)
+
 c
       REAL zxfluxt(klon, klev)
@@ -1066 +1071 @@
 c$OMP THREADPRIVATE(d_u_con,d_v_con)
       REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
+      REAL d_t_ajsb(klon,klev), d_q_ajsb(klon,klev)
       REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
       REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
@@ -1554 +1560 @@
          itaprad = 0
 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! Un petit travail à faire ici.
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+         if (iflag_pbl>1) then
+             PRINT*, "Using method MELLOR&YAMADA" 
+         endif
+          ! NB! pbl_tke could/should be read and written from (re)startphy.nc
+          ALLOCATE(pbl_tke(klon,klev+1,nbsrf))  
+          pbl_tke(:,:,:) = 1.e-8 
+
+
          CALL phyetat0 ("startphy.nc",dtime,co2_ppm_etat0,solaire_etat0,
      .       rlat,rlon,pctsrf, ftsol,
@@ -1561 +1579 @@
      .       radsol,clesphy0,
      .       zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
-     .       t_ancien, q_ancien, ancien_ok, rnebcon, ratqs,clwcon)
+     .       t_ancien, q_ancien, ancien_ok, rnebcon, ratqs,clwcon,
+     .       pbl_tke)
+
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 
        DO i=1,klon
@@ -1643 +1668 @@
          ENDIF
 
+           rugoro=0.
 c34EK
          IF (ok_orodr) THEN
-           DO i=1,klon
-             rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
-           ENDDO
+
+           rugoro=0.
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! FH sans doute a enlever de finitivement ou, si on le garde, l'activer
+! justement quand ok_orodr = false.
+! ce rugoro est utilise par la couche limite et fait double emploi
+! avec les paramétrisations spécifiques de Francois Lott.
+!           DO i=1,klon
+!             rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
+!           ENDDO
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
            CALL SUGWD(klon,klev,paprs,pplay)
            DO i=1,klon
@@ -2061 +2097 @@
      d     wfbils,    wfbilo,    fluxt,   fluxu,  fluxv,
      -     dsens,     devap,     zxsnow,
-     -     zxfluxt,   zxfluxq,   q2m,     fluxq )
+     -     zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke )
 c
 c
@@ -2233 +2269 @@
           DO i = 1, klon
             ema_pct(i)  = paprs(i,itop_con(i))
+            if (itop_con(i).gt.klev-3) then
+               print*,'La convection monte trop haut '
+               print*,'itop_con(,',i,',)=',itop_con(i)
+            endif
           ENDDO
           DO i = 1, klon
@@ -2321 +2361 @@
 
 
+      d_t_ajsb(:,:)=0.
+      d_q_ajsb(:,:)=0.
       d_t_ajs(:,:)=0.
       d_u_ajs(:,:)=0.
@@ -2336 +2378 @@
 c  ====
          IF(prt_level>9)WRITE(lunout,*)'pas de convection'
-      else if(iflag_thermals.eq.0) then
-
-c  Ajustement sec
-c  ==============
-         IF(prt_level>9)WRITE(lunout,*)'ajsec'
-         CALL ajsec(paprs, pplay, t_seri,q_seri, d_t_ajs, d_q_ajs)
-         t_seri(:,:) = t_seri(:,:) + d_t_ajs(:,:)
-         q_seri(:,:) = q_seri(:,:) + d_q_ajs(:,:)
+
+
       else
+
 c  Thermiques
 c  ==========
@@ -2351 +2388 @@
          print*,'JUSTE AVANT , iflag_thermals='
      s   ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
+
+
+         if (iflag_thermals.gt.1) then
          call calltherm(pdtphys
      s      ,pplay,paprs,pphi,weak_inversion
@@ -2357 +2397 @@
      s      ,fm_therm,entr_therm,zqasc,clwcon0th,lmax_th,ratqscth,
      s       ratqsdiff,zqsatth)
+         endif
 
 !        call calltherm(pdtphys
@@ -2363 +2404 @@
 !    s      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs
 !    s      ,fm_therm,entr_therm)
+
+c  Ajustement sec
+c  ==============
+
+! 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.
+
+         if (iflag_thermals.ge.13.or.iflag_thermals.eq.0) then
+
+         if(iflag_thermals.eq.0) then
+            IF(prt_level>9)WRITE(lunout,*)'ajsec'
+            limbas(:)=1
+         else
+            limbas(:)=lmax_th(:)
+         endif
+  
+! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
+! pour des test de convergence numerique.
+! Le nouveau ajsec est a priori mieux, meme pour le cas 
+! iflag_thermals = 0 (l'ancienne version peut faire des tendances
+! non nulles numeriquement pour des mailles non concernees.
+
+         if (iflag_thermals.eq.0) then
+            CALL ajsec_convV2(paprs, pplay, t_seri,q_seri
+     s      , d_t_ajsb, d_q_ajsb)
+         else
+            CALL ajsec(paprs, pplay, t_seri,q_seri,limbas
+     s      , d_t_ajsb, d_q_ajsb)
+         endif
+
+         t_seri(:,:) = t_seri(:,:) + d_t_ajsb(:,:)
+         q_seri(:,:) = q_seri(:,:) + d_q_ajsb(:,:)
+         d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
+         d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
+
+         endif
+
       endif
 c
@@ -2397 +2476 @@
          ptconvth(:,:)=.false.
          ratqsc(:,:)=0.
-         print*,'avant clouds_gno'
+         print*,'avant clouds_gno thermique'
          call clouds_gno
      s   (klon,klev,q_seri,zqsat,clwcon0th,ptconvth,ratqsc,rnebcon0th)
@@ -3321 +3400 @@
      .      radsol,
      .      zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
-     .      t_ancien, q_ancien, rnebcon, ratqs, clwcon)
+     .      t_ancien, q_ancien, rnebcon, ratqs, clwcon,
+     .      pbl_tke)
       ENDIF