Changeset 1322 for LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/physiq.F

Timestamp:

Mar 12, 2010, 11:54:11 AM (14 years ago)

Author:

Laurent Fairhead

Message:

Improvements concerning wake parametrisation (from JYG, NR, IT, with more to come).
Alp_offset is read in form physiq.def file

---

Améliorations à la paramétrisation des poches froides (de JYG, NR, IT, d'autres
sont à venir)
Alp_offset est rajouté à la liste des paramètres lus dans physiq.def

File:

• LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/physiq.F (modified) (13 diffs)

LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/physiq.F

@@ -625 +625 @@
       REAL q_undi(klon,klev)               ! humidite moyenne dans la zone non perturbee
 c
-      REAL wake_pe(klon)              ! Wake potential energy - WAPE 
+cjyg
+ccc      REAL wake_pe(klon)              ! Wake potential energy - WAPE 
 
       REAL wake_gfl(klon)             ! Gust Front Length
@@ -641 +642 @@
       REAL dt_a(klon,klev)
       REAL dq_a(klon,klev)
+      REAL, SAVE :: alp_offset
+c$OMP THREADPRIVATE(alp_offset)
+
 c
 cRR:fin declarations poches froides
@@ -1188 +1192 @@
      .     iflag_thermals_ed,iflag_thermals_optflux,
 c     nv flags pour la convection et les poches froides
-     .     iflag_coupl,iflag_clos,iflag_wake, read_climoz)
+     .     iflag_coupl,iflag_clos,iflag_wake, read_climoz,
+     &     alp_offset)
       call phys_state_var_init(read_climoz)
       print*, '================================================='
@@ -2021 +2026 @@
 c
 ccalcul de ale_wake et alp_wake
-       do i = 1,klon
-          if (iflag_wake.eq.1) then
-          ale_wake(i) = 0.5*wake_cstar(i)**2
-          alp_wake(i) = wake_fip(i)
-          else
-          ale_wake(i) = 0.
-          alp_wake(i) = 0.
-          endif
-       enddo
+       if (iflag_wake.eq.1) then
+         if (itap .le. it_wape_prescr) then
+          do i = 1,klon
+           ale_wake(i) = wape_prescr
+           alp_wake(i) = fip_prescr
+          enddo
+         else
+          do i = 1,klon
+cjyg  ALE=WAPE au lieu de ALE = 1/2 Cstar**2
+ccc           ale_wake(i) = 0.5*wake_cstar(i)**2
+           ale_wake(i) = wake_pe(i)
+           alp_wake(i) = wake_fip(i)
+          enddo
+         endif
+       else
+         do i = 1,klon
+           ale_wake(i) = 0.
+           alp_wake(i) = 0.
+         enddo
+       endif
 ccombinaison avec ale et alp de couche limite: constantes si pas de couplage, valeurs calculees
 cdans le thermique sinon
        if (iflag_coupl.eq.0) then
-          if (debut) print*,'ALE et ALP imposes'
+          if (debut.and.prt_level.gt.9)
+     $                     WRITE(lunout,*)'ALE et ALP imposes'
           do i = 1,klon
 con ne couple que ale
@@ -2046 +2063 @@
           do i = 1,klon
               ALE(i) = max(ale_wake(i),Ale_bl(i))
-              ALP(i) = alp_wake(i) + Alp_bl(i)
+c avant        ALP(i) = alp_wake(i) + Alp_bl(i)
+              ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
 c         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
 c         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
@@ -2289 +2307 @@
 
       endif
+c
+c===================================================================
+cJYG
+      IF (ip_ebil_phy.ge.2) THEN 
+        ztit='after wake'
+        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
+     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
+     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(airephy,ztit,ip_ebil_phy
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
+      END IF 
+
 c      print*,'apres callwake iflag_cldcon=', iflag_cldcon
 c
@@ -2402 +2435 @@
      e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
      s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(airephy,ztit,ip_ebil_phy
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
       END IF 
 
@@ -2450 +2488 @@
          enddo
          tau_overturning_th(:)=zmax_th(:)/max(0.5*wmax_th(:),0.1)
-         print*,'TAU TH OK ',tau_overturning_th(1),detr_therm(1,3)
+         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
@@ -2561 +2601 @@
 
 !   les ratqs sont une combinaison de ratqss et ratqsc
-!       write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
+       if(prt_level.ge.9)
+     $       write(lunout,*)'PHYLMD NOUVEAU TAU_RATQS ',tau_ratqs
 
          if (tau_ratqs>1.e-10) then
@@ -2785 +2826 @@
      e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
      s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+        call diagphy(airephy,ztit,ip_ebil_phy
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
       END IF 
 c
@@ -2992 +3038 @@
       itaprad = itaprad + 1
 
-      if (iflag_radia.eq.0) then
+      if (iflag_radia.eq.0 .and. prt_level.ge.9) then
       print *,'--------------------------------------------------'
       print *,'>>>> ATTENTION rayonnement desactive pour ce cas'
@@ -3195 +3241 @@
      e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
      s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
+         call diagphy(airephy,ztit,ip_ebil_phy
+     e      , zero_v, zero_v, zero_v, zero_v, zero_v
+     e      , zero_v, zero_v, zero_v, ztsol
+     e      , d_h_vcol, d_qt, d_ec
+     s      , fs_bound, fq_bound )
       END IF 
 c
@@ -3262 +3313 @@
       IF (offline) THEN
 
-         print*,'Attention on met a 0 les thermiques pour phystoke'
-         call phystokenc (
+       IF (prt_level.ge.9)
+     $    print*,'Attention on met a 0 les thermiques pour phystoke'
+         call phystokenc (
      I                   nlon,klev,pdtphys,rlon,rlat,
      I                   t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,