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

Timestamp:

Jun 22, 2004, 1:45:36 PM (20 years ago)

Author:

lmdzadmin

Message:

Convergence avec la version d'Olivia Coindreau incluant:

• le offline
• les thermiques
• mellor & yamada dans la couche limite

LF

File:

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

LMDZ4/trunk/libf/phylmd/physiq.F

@@ -2 +2 @@
 ! $Header$
 !
-C
-c $Header$
 c
       SUBROUTINE physiq (nlon,nlev,nqmax,
@@ -88 +86 @@
 #include "advtrac.h"
 #include "iniprint.h"
+#include "thermcell.h"
 c======================================================================
       LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE
@@ -157 +156 @@
       PARAMETER (ok_region=.FALSE.)
 c======================================================================
+c     pour phsystoke avec thermiques
+      REAL fm_therm(klon,klev+1)
+      REAL entr_therm(klon,klev)
+      real q2(klon,klev+1,nbsrf)
+      save q2
+c======================================================================
 c
       INTEGER ivap          ! indice de traceurs pour vapeur d'eau
@@ -594 +599 @@
       REAL zxffonte(klon), zxfqcalving(klon)
 
-      LOGICAL offline           ! Controle du stockage ds "physique"
-      PARAMETER (offline=.false.)
-      INTEGER physid
+c$$$      LOGICAL offline           ! Controle du stockage ds "physique"
+c$$$      PARAMETER (offline=.false.)
+c$$$      INTEGER physid
       REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
       save pfrac_impa
@@ -807 +812 @@
       REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
       REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
+      REAL d_u_ajs(klon,klev), d_v_ajs(klon,klev)
       REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
       REAL rneb(klon,klev)
@@ -1034 +1040 @@
      .                  iflag_cldcon,ratqsbas,ratqshaut, if_ebil,
      .                  ok_ade, ok_aie, 
-     .                  bl95_b0, bl95_b1)
-cIM  .                  , RI0)
+     .                  bl95_b0, bl95_b1,
+     .                  iflag_thermals,nsplit_thermals)
 
 c
@@ -1053 +1059 @@
      .       run_off_lic_0)
 
+c   ATTENTION : il faudra a terme relire q2 dans l'etat initial
+         q2(:,:,:)=1.e-8
 c
          radpas = NINT( 86400./dtime/nbapp_rad)
@@ -1508 +1516 @@
      s            d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
      s            fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
+     s            q2,
      s            dsens, devap,
      s            ycoefh,yu1,yv1, t2m, q2m, u10m, v10m,
@@ -1850 +1859 @@
 c Appeler l'ajustement sec
 c
-      CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
-      DO k = 1, klev
-      DO i = 1, klon
-         t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
-         q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
-      ENDDO
-      ENDDO
+c===================================================================
+c Convection seche (thermiques ou ajustement)
+c===================================================================
+c
+      d_t_ajs(:,:)=0.
+      d_u_ajs(:,:)=0.
+      d_v_ajs(:,:)=0.
+      d_q_ajs(:,:)=0.
+      fm_therm(:,:)=0.
+      entr_therm(:,:)=0.
+c
+      print*,'AVANT LA CONVECTION SECHE , iflag_thermals='
+     s   ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
+      if(iflag_thermals.lt.0) then
+c  Rien
+c  ====
+         print*,'pas de convection'
+      else if(iflag_thermals.eq.0) then
+
+c  Ajustement sec
+c  ==============
+         print*,'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  ==========
+         print*,'JUSTE AVANT , iflag_thermals='
+     s   ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
+         call calltherm(pdtphys
+     s      ,pplay,paprs,pphi
+     s      ,u_seri,v_seri,t_seri,q_seri
+     s      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs
+     s      ,fm_therm,entr_therm)
+      endif
+c
+c===================================================================
 c
       IF (if_ebil.ge.2) THEN 
@@ -2573 +2613 @@
      I                   u,v,t,paprs,pplay,
      I                   pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
-     I                   ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
-     I                   frac_impa, frac_nucl,
+     I                   ycoefh,fm_therm,entr_therm,yu1,yv1,ftsol,
+     I                   pctsrf,rlat,frac_impa, frac_nucl,
      I                   rlon,presnivs,pphis,pphi,
      I                   albsol,
@@ -2589 +2629 @@
       IF (offline) THEN
 
+         print*,'Attention on met a 0 les thermiques pour phystoke'
          call phystokenc (
      I                   nlon,nlev,pdtphys,rlon,rlat,
      I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
+     I                   fm_therm,entr_therm,
      I                   ycoefh,yu1,yv1,ftsol,pctsrf,
      I                   frac_impa, frac_nucl,