Changeset 1638


Ignore:
Timestamp:
Jul 23, 2012, 1:11:05 PM (12 years ago)
Author:
idelkadi
Message:

Introduction du declenchement stochastique de la convection

Location:
LMDZ5/trunk/libf/phylmd
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/calltherm.F90

    r1517 r1638  
    88     &      ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth,  &
    99     &       ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, &
    10      &       zmax0,f0,zw2,fraca,ztv,zpspsk,ztla,zthl)
     10     &       zmax0,f0,zw2,fraca,ztv,zpspsk,ztla,zthl &
     11!!! nrlmd le 10/04/2012
     12     &      ,pbl_tke,pctsrf,omega,airephy &
     13     &      ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
     14     &      ,n2,s2,ale_bl_stat &
     15     &      ,therm_tke_max,env_tke_max &
     16     &      ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
     17     &      ,alp_bl_conv,alp_bl_stat &
     18!!! fin nrlmd le 10/04/2012
     19     &                    )
    1120
    1221      USE dimphy
    … …  
    1625#include "thermcell.h"
    1726#include "iniprint.h"
     27
     28!!! nrlmd le 10/04/2012
     29#include "indicesol.h"
     30!!! fin nrlmd le 10/04/2012
    1831
    1932!IM 140508
    … …  
    7588      !on garde le zmax du pas de temps precedent
    7689      real zmax0(klon), f0(klon)
     90
     91!!! nrlmd le 10/04/2012
     92      real pbl_tke(klon,klev+1,nbsrf)
     93      real pctsrf(klon,nbsrf)
     94      real omega(klon,klev)
     95      real airephy(klon)
     96      real zlcl_th(klon),fraca0(klon),w0(klon),w_conv(klon)
     97      real therm_tke_max0(klon),env_tke_max0(klon)
     98      real n2(klon),s2(klon)
     99      real ale_bl_stat(klon)
     100      real therm_tke_max(klon,klev),env_tke_max(klon,klev)
     101      real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
     102!!! fin nrlmd le 10/04/2012
     103
    77104!********************************************************
    78105
    … …  
    220247     &      ,Ale,Alp,lalim_conv,wght_th &
    221248     &      ,zmax0,f0,zw2,fraca,ztv,zpspsk &
    222      &      ,ztla,zthl)
     249     &      ,ztla,zthl &
     250!!! nrlmd le 10/04/2012
     251     &      ,pbl_tke,pctsrf,omega,airephy &
     252     &      ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
     253     &      ,n2,s2,ale_bl_stat &
     254     &      ,therm_tke_max,env_tke_max &
     255     &      ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
     256     &      ,alp_bl_conv,alp_bl_stat &
     257!!! fin nrlmd le 10/04/2012
     258     &                         )
    223259           if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK'
    224260         else
    … …  
    227263         endif
    228264
    229        flag_bidouille_stratocu=iflag_thermals.eq.14.or.iflag_thermals.eq.16
     265! Attention : les noms sont contre intuitif.
     266! flag_bidouille_stratocu est .true. si on ne fait pas de bidouille.
     267! Il aurait mieux valu avoir un nobidouille_stratocu
     268! Et pour simplifier :
     269! nobidouille_stratocu=.not.(iflag_thermals==13.or.iflag_thermals=15)
     270! Ce serait bien de changer, mai en prenant le temps de vérifier que ca
     271! fait bien ce qu'on croit.
     272
     273       flag_bidouille_stratocu=iflag_thermals<=12.or.iflag_thermals==14.or.iflag_thermals==16
     274
     275      if (iflag_thermals<=12) then
     276         lmax=1
     277         do k=1,klev-1
     278            zdetr_therm(:,k)=zentr_therm(:,k)+zfm_therm(:,k)-zfm_therm(:,k+1)
     279         enddo
     280      endif
    230281
    231282      fact(:)=0.
    … …  
    267318
    268319       DO i=1,klon
    269         if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i)
    270320            fm_therm(i,klev+1)=0.
    271321            Ale_bl(i)=Ale_bl(i)+Ale(i)/REAL(nsplit_thermals)
    … …  
    273323            Alp_bl(i)=Alp_bl(i)+Alp(i)/REAL(nsplit_thermals)
    274324!            write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i)
     325        if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i)
    275326       ENDDO
    276327

  • LMDZ5/trunk/libf/phylmd/conf_phys.F90

    r1575 r1638  
    110110  integer,SAVE :: iflag_thermals_omp,nsplit_thermals_omp
    111111  real,save :: tau_thermals_omp,alp_bl_k_omp
     112!!! nrlmd le 10/04/2012
     113  integer,SAVE :: iflag_trig_bl_omp,iflag_clos_bl_omp
     114  integer,SAVE :: tau_trig_shallow_omp,tau_trig_deep_omp
     115  real,SAVE    :: s_trig_omp
     116!!! fin nrlmd le 10/04/2012
    112117  real :: alp_offset
    113118  REAL, SAVE :: alp_offset_omp
    … …  
    10831088  alp_bl_k_omp = 1.
    10841089  call getin('alp_bl_k',alp_bl_k_omp)
     1090
     1091!!! nrlmd le 10/04/2012
     1092
     1093!Config Key  = iflag_trig_bl
     1094!Config Desc = 
     1095!Config Def  = 0
     1096!Config Help =
     1097!
     1098  iflag_trig_bl_omp = 0
     1099  call getin('iflag_trig_bl',iflag_trig_bl_omp)
     1100
     1101!Config Key  = s_trig_bl
     1102!Config Desc = 
     1103!Config Def  = 0
     1104!Config Help =
     1105!
     1106  s_trig_omp = 2e7
     1107  call getin('s_trig',s_trig_omp)
     1108
     1109!Config Key  = tau_trig_shallow
     1110!Config Desc = 
     1111!Config Def  = 0
     1112!Config Help =
     1113!
     1114  tau_trig_shallow_omp = 600
     1115  call getin('tau_trig_shallow',tau_trig_shallow_omp)
     1116
     1117!Config Key  = tau_trig_deep
     1118!Config Desc = 
     1119!Config Def  = 0
     1120!Config Help =
     1121!
     1122  tau_trig_deep_omp = 1800
     1123  call getin('tau_trig_deep',tau_trig_deep_omp)
     1124
     1125!Config Key  = iflag_clos_bl
     1126!Config Desc = 
     1127!Config Def  = 0
     1128!Config Help =
     1129!
     1130  iflag_clos_bl_omp = 0
     1131  call getin('iflag_clos_bl',iflag_clos_bl_omp)
     1132
     1133!!! fin nrlmd le 10/04/2012
    10851134
    10861135!
    … …  
    16501699    tau_thermals = tau_thermals_omp
    16511700    alp_bl_k = alp_bl_k_omp
     1701!!! nrlmd le 10/04/2012
     1702    iflag_trig_bl = iflag_trig_bl_omp
     1703    s_trig = s_trig_omp
     1704    tau_trig_shallow = tau_trig_shallow_omp
     1705    tau_trig_deep = tau_trig_deep_omp
     1706    iflag_clos_bl = iflag_clos_bl_omp
     1707!!! fin nrlmd le 10/04/2012
    16521708    iflag_coupl = iflag_coupl_omp
    16531709    iflag_clos = iflag_clos_omp
    … …  
    18391895  write(lunout,*)' iflag_wake = ', iflag_wake
    18401896  write(lunout,*)' alp_offset = ', alp_offset
     1897!!! nrlmd le 10/04/2012
     1898  write(lunout,*)' iflag_trig_bl = ', iflag_trig_bl
     1899  write(lunout,*)' s_trig = ', s_trig
     1900  write(lunout,*)' tau_trig_shallow = ', tau_trig_shallow
     1901  write(lunout,*)' tau_trig_deep = ', tau_trig_deep
     1902  write(lunout,*)' iflag_clos_bl = ', iflag_clos_bl
     1903!!! fin nrlmd le 10/04/2012
    18411904
    18421905  write(lunout,*)' lonmin lonmax latmin latmax bilKP_ins =',&

  • LMDZ5/trunk/libf/phylmd/phys_output_mod.F90

    r1633 r1638  
    260260  type(ctrl_out),save :: o_wape         = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'wape')
    261261
     262!!! nrlmd le 10/04/2012
     263
     264!-------Propriétés du thermiques au LCL
     265  type(ctrl_out),save :: o_zlcl_th        = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'zlcl_th')
     266  type(ctrl_out),save :: o_fraca0         = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'fraca0')
     267  type(ctrl_out),save :: o_w0             = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'w0')
     268  type(ctrl_out),save :: o_w_conv         = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'w_conv')
     269  type(ctrl_out),save :: o_therm_tke_max0 = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'therm_tke_max0')
     270  type(ctrl_out),save :: o_env_tke_max0   = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'env_tke_max0')
     271
     272!-------Spectre de thermiques de type 2 au LCL
     273  type(ctrl_out),save :: o_n2                = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'n2')
     274  type(ctrl_out),save :: o_s2                = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'s2')
     275                                                                             
     276!-------Déclenchement stochastique                                           
     277  type(ctrl_out),save :: o_proba_notrig      = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'proba_notrig')
     278  type(ctrl_out),save :: o_random_notrig     = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'random_notrig')
     279  type(ctrl_out),save :: o_ale_bl_stat       = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'ale_bl_stat')
     280  type(ctrl_out),save :: o_ale_bl_trig       = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'ale_bl_trig')
     281                                                                             
     282!-------Profils de TKE dans et hors du thermique                             
     283  type(ctrl_out),save :: o_therm_tke_max     = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'therm_tke_max')
     284  type(ctrl_out),save :: o_env_tke_max       = ctrl_out((/ 1, 1, 1, 6, 10, 10 /),'env_tke_max')
     285
     286!-------Fermeture statistique
     287  type(ctrl_out),save :: o_alp_bl_det        = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_det')
     288  type(ctrl_out),save :: o_alp_bl_fluct_m    = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_fluct_m')
     289  type(ctrl_out),save :: o_alp_bl_fluct_tke  = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_fluct_tke')
     290  type(ctrl_out),save :: o_alp_bl_conv       = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_conv')
     291  type(ctrl_out),save :: o_alp_bl_stat       = ctrl_out((/ 1, 1, 1, 10, 10, 10 /),'alp_bl_stat')
     292
     293!!! fin nrlmd le 10/04/2012
    262294
    263295  ! Champs interpolles sur des niveaux de pression ??? a faire correctement
    … …  
    432464  type(ctrl_out),save :: o_ovap         = ctrl_out((/ 2, 3, 4, 10, 10, 10 /),'ovap')
    433465  type(ctrl_out),save :: o_ovapinit     = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'ovapinit')
     466  type(ctrl_out),save :: o_oliq         = ctrl_out((/ 2, 3, 4, 10, 10, 10 /),'oliq')
    434467  type(ctrl_out),save :: o_wvapp        = ctrl_out((/ 2, 10, 10, 10, 10, 10 /),'wvapp')
    435468  type(ctrl_out),save :: o_geop         = ctrl_out((/ 2, 3, 10, 10, 10, 10 /),'geop')
    … …  
    494527  type(ctrl_out),save :: o_dtcon        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtcon')
    495528  type(ctrl_out),save :: o_ducon        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ducon')
     529  type(ctrl_out),save :: o_dvcon        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dvcon')
    496530  type(ctrl_out),save :: o_dqcon        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqcon')
    497531  type(ctrl_out),save :: o_dtwak        = ctrl_out((/ 4, 5, 10, 10, 10, 10 /),'dtwak')
    … …  
    531565  type(ctrl_out),save :: o_e_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'e_th')
    532566  type(ctrl_out),save :: o_w_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'w_th')
    533   type(ctrl_out),save :: o_lambda_th    = ctrl_out((/ 10, 10, 10, 10, 10, 10 /),'lambda_th')
    534567  type(ctrl_out),save :: o_ftime_th     = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'ftime_th')
    535568  type(ctrl_out),save :: o_q_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'q_th')
    … …  
    537570  type(ctrl_out),save :: o_d_th         = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'d_th')
    538571  type(ctrl_out),save :: o_f0_th        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'f0_th')
    539   type(ctrl_out),save :: o_zmax_th      = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'zmax_th')
     572  type(ctrl_out),save :: o_zmax_th      = ctrl_out((/ 4,  4,  4,  5, 10, 10 /),'zmax_th')
    540573  type(ctrl_out),save :: o_dqthe        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dqthe')
    541574  type(ctrl_out),save :: o_dtajs        = ctrl_out((/ 4, 10, 10, 10, 10, 10 /),'dtajs')
    … …  
    621654    USE infotrac
    622655    USE ioipsl
     656!    USE phys_cal_mod, only : hour
    623657    USE mod_phys_lmdz_para
    624658    USE aero_mod, only : naero_spc,name_aero
    … …  
    682716    !                 entre [phys_out_lonmin,phys_out_lonmax] et [phys_out_latmin,phys_out_latmax]
    683717
    684     logical, dimension(nfiles), save  :: phys_out_regfkey       = (/ .false., .false., .false., .false., .false., .false. /)
    685     real, dimension(nfiles), save     :: phys_out_lonmin        = (/ -180., -180., -180., -180., -180., -180. /)
    686     real, dimension(nfiles), save     :: phys_out_lonmax        = (/ 180., 180., 180., 180., 180., 180. /)
    687     real, dimension(nfiles), save     :: phys_out_latmin        = (/ -90., -90., -90., -90., -90., -90. /)
    688     real, dimension(nfiles), save     :: phys_out_latmax        = (/ 90., 90., 90., 90., 90., 90. /)
     718    logical, dimension(nfiles), save  :: phys_out_regfkey       = (/ .false., .false., .false.,  .false., .false., .false. /)
     719    real, dimension(nfiles), save     :: phys_out_lonmin        = (/   -180.,   -180.,   -180.,    -180.,   -180.,  -180. /)
     720    real, dimension(nfiles), save     :: phys_out_lonmax        = (/    180.,    180.,    180.,     180.,    180.,    180. /)
     721    real, dimension(nfiles), save     :: phys_out_latmin        = (/    -90.,    -90.,    -90.,     -90.,    -90.,    -90. /)
     722    real, dimension(nfiles), save     :: phys_out_latmax        = (/     90.,     90.,     90.,     90.,     90.,    90. /)
    689723
    690724    write(lunout,*) 'Debut phys_output_mod.F90'
    … …  
    805839
    806840          idayref = day_ref
    807           CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
     841          CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)       
     842! correction pour l heure initiale                               !jyg
     843!                                                                !jyg
     844!      CALL ymds2ju(annee_ref, 1, idayref, hour, zjulian)         !jyg
    808845
    809846!!!!!!!!!!!!!!!!! Traitement dans le cas ou l'on veut stocker sur un domaine limite !!
    … …  
    13181355          ! Couplage conv-CL
    13191356          IF (iflag_con.GE.3) THEN
     1357             IF (iflag_coupl>=1) THEN
    13201358                CALL histdef2d(iff,clef_stations(iff), &
    13211359                     o_ale_bl%flag,o_ale_bl%name, "ALE BL", "m2/s2")
    13221360                CALL histdef2d(iff,clef_stations(iff), &
    13231361                     o_alp_bl%flag,o_alp_bl%name, "ALP BL", "m2/s2")
     1362             ENDIF
    13241363          ENDIF !(iflag_con.GE.3)
    13251364
    … …  
    13751414          CALL histdef3d(iff,clef_stations(iff),o_theta%flag,o_theta%name, "Potential air temperature", "K" )
    13761415          CALL histdef3d(iff,clef_stations(iff),o_ovap%flag,o_ovap%name, "Specific humidity", "kg/kg" )
     1416          CALL histdef3d(iff,clef_stations(iff),o_oliq%flag,o_oliq%name, "Condensed water", "kg/kg" )
    13771417          CALL histdef3d(iff,clef_stations(iff), &
    13781418               o_ovapinit%flag,o_ovapinit%name, "Specific humidity (begin of timestep)", "kg/kg" )
    … …  
    14801520               o_ducon%flag,o_ducon%name, "Convection du", "m/s2")
    14811521          CALL histdef3d(iff,clef_stations(iff), &
     1522               o_dvcon%flag,o_dvcon%name, "Convection dv", "m/s2")
     1523          CALL histdef3d(iff,clef_stations(iff), &
    14821524               o_dqcon%flag,o_dqcon%name, "Convection dQ", "(kg/kg)/s")
    14831525
    … …  
    14891531                CALL histdef2d(iff,clef_stations(iff), &
    14901532                     o_alp_wk%flag,o_alp_wk%name, "ALP WK", "m2/s2")
     1533                CALL histdef2d(iff,clef_stations(iff), &
     1534                     o_ale%flag,o_ale%name, "ALE", "m2/s2")
     1535                CALL histdef2d(iff,clef_stations(iff), &
     1536                     o_alp%flag,o_alp%name, "ALP", "W/m2")
     1537                CALL histdef2d(iff,clef_stations(iff),o_cin%flag,o_cin%name, "Convective INhibition", "m2/s2")
     1538                CALL histdef2d(iff,clef_stations(iff),o_wape%flag,o_WAPE%name, "WAPE", "m2/s2")
    14911539                CALL histdef2d(iff,clef_stations(iff),o_wake_h%flag,o_wake_h%name, "wake_h", "-")
    14921540                CALL histdef2d(iff,clef_stations(iff),o_wake_s%flag,o_wake_s%name, "wake_s", "-")
    … …  
    14961544                CALL histdef3d(iff,clef_stations(iff),o_wake_deltaq%flag,o_wake_deltaq%name, "wake_deltaq", " ")
    14971545                CALL histdef3d(iff,clef_stations(iff),o_wake_omg%flag,o_wake_omg%name, "wake_omg", " ")
    1498                 CALL histdef2d(iff,clef_stations(iff),o_wape%flag,o_WAPE%name, "WAPE", "m2/s2")
    14991546             ENDIF
    1500              CALL histdef2d(iff,clef_stations(iff), &
    1501                      o_ale%flag,o_ale%name, "ALE", "m2/s2")
    1502              CALL histdef2d(iff,clef_stations(iff), &
    1503                      o_alp%flag,o_alp%name, "ALP", "W/m2")
    1504              CALL histdef2d(iff,clef_stations(iff),o_cin%flag,o_cin%name, "Convective INhibition", "m2/s2")
    15051547             CALL histdef3d(iff,clef_stations(iff),o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-")
    15061548             CALL histdef3d(iff,clef_stations(iff),o_ftd%flag,o_ftd%name, "tend temp due aux descentes precip", "-")
    15071549             CALL histdef3d(iff,clef_stations(iff),o_fqd%flag,o_fqd%name,"tend vap eau due aux descentes precip", "-")
    15081550          ENDIF !(iflag_con.EQ.3)
     1551
     1552!!! nrlmd le 10/04/2012
     1553
     1554 CALL histdef2d(iff,clef_stations(iff),o_zlcl_th%flag,o_zlcl_th%name, "Altitude du LCL", "m")
     1555 CALL histdef2d(iff,clef_stations(iff),o_fraca0%flag,o_fraca0%name, "Fraction de Thermique au LCL", "")
     1556 CALL histdef2d(iff,clef_stations(iff),o_w0%flag,o_w0%name, "Vitesse thermique au LCL", "m/s")
     1557 CALL histdef2d(iff,clef_stations(iff),o_w_conv%flag,o_w_conv%name, "Vitesse verticale grande échelle au LCL", "m/s")
     1558 CALL histdef2d(iff,clef_stations(iff),o_therm_tke_max0%flag,o_therm_tke_max0%name, "TKE thermique au LCL", "m2/s2")
     1559 CALL histdef2d(iff,clef_stations(iff),o_env_tke_max0%flag,o_env_tke_max0%name, "TKE environnement au LCL", "m2/s2")
     1560
     1561 CALL histdef2d(iff,clef_stations(iff),o_n2%flag,o_n2%name, "Nombre de panaches de type 2", " ")
     1562 CALL histdef2d(iff,clef_stations(iff),o_s2%flag,o_s2%name, "Surface moyenne des panaches de type 2", "m2")
     1563
     1564 CALL histdef2d(iff,clef_stations(iff),o_proba_notrig%flag,o_proba_notrig%name, "Probabilité de non-déclenchement", " ")
     1565 CALL histdef2d(iff,clef_stations(iff),o_random_notrig%flag,o_random_notrig%name, "Tirage aléatoire de non-déclenchement", " ")
     1566 CALL histdef2d(iff,clef_stations(iff),o_ale_bl_trig%flag,o_ale_bl_trig%name, "ALE_BL_STAT + Condition P>Pseuil", "m2/s2")
     1567 CALL histdef2d(iff,clef_stations(iff),o_ale_bl_stat%flag,o_ale_bl_stat%name, "ALE_BL_STAT", "m2/s2")
     1568
     1569 CALL histdef3d(iff,clef_stations(iff),o_therm_tke_max%flag,o_therm_tke_max%name, "TKE thermique", "m2/s2")
     1570 CALL histdef3d(iff,clef_stations(iff),o_env_tke_max%flag,o_env_tke_max%name, "TKE environnement", "m2/s2")
     1571 CALL histdef2d(iff,clef_stations(iff),o_alp_bl_det%flag,o_alp_bl_det%name, "ALP_BL_DET", "W/m2")
     1572 CALL histdef2d(iff,clef_stations(iff),o_alp_bl_fluct_m%flag,o_alp_bl_fluct_m%name, "ALP_BL_FLUCT_M", "W/m2")
     1573 CALL histdef2d(iff,clef_stations(iff),o_alp_bl_fluct_tke%flag,o_alp_bl_fluct_tke%name, "ALP_BL_FLUCT_TKE", "W/m2")
     1574 CALL histdef2d(iff,clef_stations(iff),o_alp_bl_conv%flag,o_alp_bl_conv%name, "ALP_BL_CONV", "W/m2")
     1575 CALL histdef2d(iff,clef_stations(iff),o_alp_bl_stat%flag,o_alp_bl_stat%name, "ALP_BL_STAT", "W/m2")
     1576
     1577!!! fin nrlmd le 10/04/2012
    15091578
    15101579          CALL histdef3d(iff,clef_stations(iff),o_dtlsc%flag,o_dtlsc%name, "Condensation dT", "K/s")
    … …  
    15191588          CALL histdef3d(iff,clef_stations(iff),o_dtthe%flag,o_dtthe%name, "Thermal dT", "K/s")
    15201589
    1521           if(iflag_thermals.gt.1) THEN
     1590          if(iflag_thermals.ge.1) THEN
    15221591             CALL histdef3d(iff,clef_stations(iff),o_dqlscth%flag,o_dqlscth%name, "dQ therm.", "(kg/kg)/s")
    15231592             CALL histdef3d(iff,clef_stations(iff),o_dqlscst%flag,o_dqlscst%name, "dQ strat.", "(kg/kg)/s")
    … …  
    15311600             CALL histdef3d(iff,clef_stations(iff),o_e_th%flag,o_e_th%name,"Thermal plume entrainment","K/s")
    15321601             CALL histdef3d(iff,clef_stations(iff),o_w_th%flag,o_w_th%name,"Thermal plume vertical velocity","m/s")
    1533              CALL histdef3d(iff,clef_stations(iff), &
    1534                   o_lambda_th%flag,o_lambda_th%name,"Thermal plume vertical velocity","m/s")
    15351602             CALL histdef2d(iff,clef_stations(iff), &
    15361603                  o_ftime_th%flag,o_ftime_th%name,"Fraction of time Shallow convection occurs"," ")
    … …  
    15481615             CALL histdef3d(iff,clef_stations(iff), &
    15491616                  o_dqthe%flag,o_dqthe%name, "Thermal dQ", "(kg/kg)/s")
    1550           endif !iflag_thermals.gt.1
     1617          endif !iflag_thermals.ge.1
    15511618          CALL histdef3d(iff,clef_stations(iff), &
    15521619               o_dtajs%flag,o_dtajs%name, "Dry adjust. dT", "K/s")

  • LMDZ5/trunk/libf/phylmd/phys_output_write.h

    r1633 r1638  
    508508        ENDIF
    509509
    510        if (iflag_pbl>1 .and. lev_histday.gt.10 ) then
     510       if (iflag_pbl>1 .and. lev_files(iff).gt.10 ) then
    511511        IF (o_tke_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    512512        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    … …  
    666666
    667667       IF (o_mc%flag(iff)<=lev_files(iff)) THEN
    668         if(iflag_thermals.gt.1)then
     668        if(iflag_thermals>=1)then
    669669         zx_tmp_fi3d=dnwd+dnwd0+upwd+fm_therm(:,1:klev)
    670670        else
    … …  
    677677      ENDIF !iflag_con .GE. 3
    678678
    679       IF (o_prw%flag(iff) <= lev_files(iff))
    680      $     CALL histwrite_phy(nid_files(iff), clef_stations(iff),
    681      $     o_prw%name, itau_w, prw)
     679        IF (o_prw%flag(iff)<=lev_files(iff)) THEN
     680      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     681     $o_prw%name,itau_w,prw)
     682        ENDIF
    682683
    683684        IF (o_s_pblh%flag(iff)<=lev_files(iff)) THEN
    … …  
    800801! Couplage convection-couche limite
    801802      IF (iflag_con.GE.3) THEN
     803      IF (iflag_coupl>=1) THEN
    802804       IF (o_ale_bl%flag(iff)<=lev_files(iff)) THEN
    803805       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    … …  
    808810     $o_alp_bl%name,itau_w,alp_bl)
    809811       ENDIF
     812      ENDIF !iflag_coupl>=1
    810813      ENDIF !(iflag_con.GE.3)
    811814
    … …  
    822825       ENDIF
    823826
     827       IF (o_ale%flag(iff)<=lev_files(iff)) THEN
     828       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     829     $o_ale%name,itau_w,ale)
     830       ENDIF
     831       IF (o_alp%flag(iff)<=lev_files(iff)) THEN
     832       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     833     $o_alp%name,itau_w,alp)
     834       ENDIF
     835       IF (o_cin%flag(iff)<=lev_files(iff)) THEN
     836       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     837     $o_cin%name,itau_w,cin)
     838       ENDIF
    824839       IF (o_wape%flag(iff)<=lev_files(iff)) THEN
    825840       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    … …  
    868883      ENDIF ! iflag_wake>=1
    869884
    870        IF (o_ale%flag(iff)<=lev_files(iff)) THEN
    871        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    872      $o_ale%name,itau_w,ale)
    873        ENDIF
    874        IF (o_alp%flag(iff)<=lev_files(iff)) THEN
    875        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    876      $o_alp%name,itau_w,alp)
    877        ENDIF
    878        IF (o_cin%flag(iff)<=lev_files(iff)) THEN
    879        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    880      $o_cin%name,itau_w,cin)
    881        ENDIF
    882885        IF (o_Vprecip%flag(iff)<=lev_files(iff)) THEN
    883886       CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    … …  
    896899      ENDIF !(iflag_con.EQ.3)
    897900 
     901!!! nrlmd le 10/04/2012
     902
     903        IF (o_zlcl_th%flag(iff)<=lev_files(iff)) THEN
     904        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     905     s                     o_zlcl_th%name,itau_w,zlcl_th)
     906        ENDIF
     907
     908        IF (o_fraca0%flag(iff)<=lev_files(iff)) THEN
     909        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     910     s                     o_fraca0%name,itau_w,fraca0)
     911        ENDIF
     912
     913        IF (o_w0%flag(iff)<=lev_files(iff)) THEN
     914        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     915     s                     o_w0%name,itau_w,w0)
     916        ENDIF
     917
     918        IF (o_w_conv%flag(iff)<=lev_files(iff)) THEN
     919        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     920     s                     o_w_conv%name,itau_w,w_conv)
     921        ENDIF
     922
     923        IF (o_therm_tke_max0%flag(iff)<=lev_files(iff)) THEN
     924        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     925     s                     o_therm_tke_max0%name,itau_w,therm_tke_max0)
     926        ENDIF
     927
     928        IF (o_env_tke_max0%flag(iff)<=lev_files(iff)) THEN
     929        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     930     s                     o_env_tke_max0%name,itau_w,env_tke_max0)
     931        ENDIF
     932
     933        IF (o_n2%flag(iff)<=lev_files(iff)) THEN
     934      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     935     s                     o_n2%name,itau_w,n2)
     936       ENDIF
     937
     938       IF (o_s2%flag(iff)<=lev_files(iff)) THEN
     939      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     940     s                     o_s2%name,itau_w,s2)
     941       ENDIF
     942
     943        IF (o_proba_notrig%flag(iff)<=lev_files(iff)) THEN
     944      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     945     s                     o_proba_notrig%name,itau_w,proba_notrig)
     946       ENDIF
     947
     948       IF (o_random_notrig%flag(iff)<=lev_files(iff)) THEN
     949      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     950     s                     o_random_notrig%name,itau_w,random_notrig)
     951       ENDIF
     952
     953       IF (o_ale_bl_stat%flag(iff)<=lev_files(iff)) THEN
     954      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     955     s                     o_ale_bl_stat%name,itau_w,ale_bl_stat)
     956       ENDIF
     957
     958       IF (o_ale_bl_trig%flag(iff)<=lev_files(iff)) THEN
     959      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     960     s                     o_ale_bl_trig%name,itau_w,ale_bl_trig)
     961       ENDIF
     962
     963       IF (o_therm_tke_max%flag(iff)<=lev_files(iff)) THEN
     964        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     965     s                     o_therm_tke_max%name,itau_w,therm_tke_max)
     966        ENDIF
     967
     968        IF (o_env_tke_max%flag(iff)<=lev_files(iff)) THEN
     969        CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     970     s                     o_env_tke_max%name,itau_w,env_tke_max)
     971        ENDIF
     972
     973       IF (o_alp_bl_det%flag(iff)<=lev_files(iff)) THEN
     974      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     975     s                     o_alp_bl_det%name,itau_w,alp_bl_det)
     976       ENDIF
     977
     978       IF (o_alp_bl_fluct_m%flag(iff)<=lev_files(iff)) THEN
     979      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     980     s                     o_alp_bl_fluct_m%name,itau_w,alp_bl_fluct_m)
     981       ENDIF
     982
     983       IF (o_alp_bl_fluct_tke%flag(iff)<=lev_files(iff)) THEN
     984      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     985     s                o_alp_bl_fluct_tke%name,itau_w,alp_bl_fluct_tke)
     986       ENDIF
     987
     988       IF (o_alp_bl_conv%flag(iff)<=lev_files(iff)) THEN
     989      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     990     s                     o_alp_bl_conv%name,itau_w,alp_bl_conv)
     991       ENDIF
     992
     993       IF (o_alp_bl_stat%flag(iff)<=lev_files(iff)) THEN
     994      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     995     s                     o_alp_bl_stat%name,itau_w,alp_bl_stat)
     996       ENDIF
     997
     998!!! fin nrlmd le 10/04/2012
     999
    8981000      IF (type_ocean=='slab ') THEN
    8991001      IF ( o_slab_bils%flag(iff)<=lev_files(iff))
    … …  
    14091511      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    14101512     $                   o_ovap%name,itau_w,q_seri)
     1513       ENDIF
     1514                                                               
     1515       IF (o_oliq%flag(iff)<=lev_files(iff)) THEN             
     1516      CALL histwrite_phy(nid_files(iff),clef_stations(iff),   
     1517     $                   o_oliq%name,itau_w,ql_seri)           
    14111518       ENDIF
    14121519
    … …  
    16361743       ENDIF
    16371744
     1745       IF (o_dvcon%flag(iff)<=lev_files(iff)) THEN
     1746      zx_tmp_fi3d(1:klon,1:klev)=d_v_con(1:klon,1:klev)/pdtphys
     1747      CALL histwrite_phy(nid_files(iff),clef_stations(iff),
     1748     $o_dvcon%name,itau_w,zx_tmp_fi3d)
     1749       ENDIF
     1750
    16381751       IF (o_dqcon%flag(iff)<=lev_files(iff)) THEN
    16391752      zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys
    … …  
    16791792!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    16801793! Sorties specifiques a la separation thermiques/non thermiques
    1681        if (iflag_thermals>1) then
     1794       if (iflag_thermals>=1) then
    16821795
    16831796       IF (o_dtlscth%flag(iff)<=lev_files(iff)) THEN
    … …  
    17431856       ENDIF
    17441857
    1745       endif ! iflag_thermals>1
     1858      endif ! iflag_thermals>=1
    17461859
    17471860!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    17901903       ENDIF
    17911904
    1792        IF (iflag_thermals.gt.1) THEN
     1905       IF (iflag_thermals>=1) THEN
    17931906        IF (o_ftime_th%flag(iff)<=lev_files(iff)) THEN
    17941907! Pour l instant 0 a y reflichir pour les thermiques
    … …  
    18191932        ENDIF
    18201933
    1821         IF (o_lambda_th%flag(iff)<=lev_files(iff)) THEN
    1822         CALL histwrite_phy(nid_files(iff),clef_stations(iff),
    1823      s                     o_lambda_th%name,itau_w,lambda_th)
    1824         ENDIF
    18251934
    18261935        IF (o_a_th%flag(iff)<=lev_files(iff)) THEN

  • LMDZ5/trunk/libf/phylmd/phys_state_var_mod.F90

    r1539 r1638  
    346346!$OMP THREADPRIVATE(ccm)
    347347
     348!!! nrlmd le 10/04/2012
     349      REAL,SAVE,ALLOCATABLE :: ale_bl_trig(:)
     350!$OMP THREADPRIVATE(ale_bl_trig)
     351!!! fin nrlmd le 10/04/2012
     352
    348353CONTAINS
    349354
    … …  
    496501      ALLOCATE(tau_aero(klon,klev,naero_grp,nbands),piz_aero(klon,klev,naero_grp,nbands),cg_aero(klon,klev,naero_grp,nbands))
    497502      ALLOCATE(ccm(klon,klev,nbands))
     503
     504!!! nrlmd le 10/04/2012
     505      ALLOCATE(ale_bl_trig(klon))
     506!!! fin nrlmd le 10/04/2012
    498507
    499508END SUBROUTINE phys_state_var_init
    … …  
    603612      deallocate(ccm)
    604613       
     614!!! nrlmd le 10/04/2012
     615      deallocate(ale_bl_trig)
     616!!! fin nrlmd le 10/04/2012
     617
    605618END SUBROUTINE phys_state_var_end
    606619

  • LMDZ5/trunk/libf/phylmd/physiq.F

    r1628 r1638  
    180180      real facteur,zfratqs1,zfratqs2
    181181
    182       REAL lambda_th(klon,klev),zz,znum,zden
     182      REAL zz,znum,zden
    183183      REAL wmax_th(klon)
    184184      REAL zmax_th(klon)
    … …  
    614614      REAL dd_t(klon,klev),dd_q(klon,klev)
    615615
    616       real, save :: alp_bl_prescr=0.1
    617       real, save :: ale_bl_prescr=4.
     616      real, save :: alp_bl_prescr=0.
     617      real, save :: ale_bl_prescr=0.
    618618
    619619      real, save :: ale_max=1000.
    … …  
    689689      REAL ztla(klon,klev)
    690690      REAL zthl(klon,klev)
     691
     692ccc nrlmd le 10/04/2012
     693
     694c--------Stochastic Boundary Layer Triggering: ALE_BL--------
     695c---Propriétés du thermiques au LCL
     696      real zlcl_th(klon)                                     ! Altitude du LCL calculé continument (pcon dans thermcell_main.F90)
     697      real fraca0(klon)                                      ! Fraction des thermiques au LCL
     698      real w0(klon)                                          ! Vitesse des thermiques au LCL
     699      real w_conv(klon)                                      ! Vitesse verticale de grande échelle au LCL
     700      real therm_tke_max0(klon)                              ! TKE dans les thermiques au LCL
     701      real env_tke_max0(klon)                                ! TKE dans l'environnement au LCL
     702
     703c---Spectre de thermiques de type 2 au LCL
     704      real n2(klon),s2(klon)
     705      real ale_bl_stat(klon)
     706
     707c---Déclenchement stochastique
     708      integer :: tau_trig(klon)
     709      real proba_notrig(klon)
     710      real random_notrig(klon)
     711
     712c--------Statistical Boundary Layer Closure: ALP_BL--------
     713c---Profils de TKE dans et hors du thermique
     714      real pbl_tke_input(klon,klev+1,nbsrf)
     715      real therm_tke_max(klon,klev)                          ! Profil de TKE dans les thermiques
     716      real env_tke_max(klon,klev)                            ! Profil de TKE dans l'environnement
     717
     718c---Fermeture statistique
     719      real alp_bl_det(klon)                                     ! ALP déterministe du thermique unique
     720      real alp_bl_fluct_m(klon)                                 ! ALP liée aux fluctuations de flux de masse sous-nuageux
     721      real alp_bl_fluct_tke(klon)                               ! ALP liée aux fluctuations d'énergie cinétique sous-nuageuse
     722      real alp_bl_conv(klon)                                    ! ALP liée à grande échelle
     723      real alp_bl_stat(klon)                                    ! ALP totale
     724
     725ccc fin nrlmd le 10/04/2012
    691726
    692727c Variables locales pour la couche limite (al1):
    … …  
    791826cIM
    792827      EXTERNAL haut2bas  !variables de haut en bas
     828      INTEGER lnblnk1
     829      EXTERNAL lnblnk1   !enleve les blancs a la fin d'une variable de type
     830                         !caracter
    793831      EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
    794832      EXTERNAL undefSTD      !somme les valeurs definies d'1 var a 1 niveau de pression
    … …  
    13541392         solswad(:)=0.
    13551393
    1356          lambda_th(:,:)=0.
    13571394         wmax_th(:)=0.
    13581395         tau_overturning_th(:)=0.
    … …  
    14901527cCR:04.12.07: initialisations poches froides
    14911528c Controle de ALE et ALP pour la fermeture convective (jyg)
    1492          CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr
     1529          if (iflag_wake>=1) then
     1530            CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr
    14931531     s                  ,alp_bl_prescr, ale_bl_prescr)
    14941532c 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
    14951533c        print*,'apres ini_wake iflag_cldcon=', iflag_cldcon
     1534          endif
    14961535
    14971536        do i = 1,klon
    … …  
    15161555       print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
    15171556      ENDIF
     1557
    15181558c
    15191559      ALLOCATE(tabCFMIP(nCFMIP))
    … …  
    17351775!
    17361776      itap   = itap + 1
     1777c
    17371778!
    17381779! Update fraction of the sub-surfaces (pctsrf) and
    … …  
    20422083c
    20432084
    2044       if (iflag_pbl/=0) then 
    2045 
    2046         CALL pbl_surface(
    2047      e       dtime,     date0,     itap,    days_elapsed+1,
    2048      e       debut,     lafin,
    2049      e       rlon,      rlat,      rugoro,  rmu0,     
    2050      e       rain_fall, snow_fall, solsw,   sollw,   
    2051      e       t_seri,    q_seri,    u_seri,  v_seri,   
    2052      e       pplay,     paprs,     pctsrf,           
    2053      +       ftsol,     falb1,     falb2,   u10m,   v10m,
    2054      s       sollwdown, cdragh,    cdragm,  u1,    v1,
    2055      s       albsol1,   albsol2,   sens,    evap, 
    2056      s       zxtsol,    zxfluxlat, zt2m,    qsat2m,
    2057      s       d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf,
    2058      s       coefh,     coefm,     slab_wfbils,               
    2059      d       qsol,      zq2m,      s_pblh,  s_lcl,
    2060      d       s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
    2061      d       s_therm,   s_trmb1,   s_trmb2, s_trmb3,
    2062      d       zxrugs,    zu10m,     zv10m,   fder,
    2063      d       zxqsurf,   rh2m,      zxfluxu, zxfluxv,
    2064      d       frugs,     agesno,    fsollw,  fsolsw,
    2065      d       d_ts,      fevap,     fluxlat, t2m,
    2066      d       wfbils,    wfbilo,    fluxt,   fluxu,  fluxv,
    2067      -       dsens,     devap,     zxsnow,
    2068      -       zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke )
     2085      if (iflag_pbl/=0) then
     2086
     2087      CALL pbl_surface(
     2088     e     dtime,     date0,     itap,    days_elapsed+1,
     2089     e     debut,     lafin,
     2090     e     rlon,      rlat,      rugoro,  rmu0,     
     2091     e     rain_fall, snow_fall, solsw,   sollw,   
     2092     e     t_seri,    q_seri,    u_seri,  v_seri,   
     2093     e     pplay,     paprs,     pctsrf,           
     2094     +     ftsol,     falb1,     falb2,   u10m,   v10m,
     2095     s     sollwdown, cdragh,    cdragm,  u1,    v1,
     2096     s     albsol1,   albsol2,   sens,    evap, 
     2097     s     zxtsol,    zxfluxlat, zt2m,    qsat2m,
     2098     s     d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf,
     2099     s     coefh,     coefm,     slab_wfbils,               
     2100     d     qsol,      zq2m,      s_pblh,  s_lcl,
     2101     d     s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
     2102     d     s_therm,   s_trmb1,   s_trmb2, s_trmb3,
     2103     d     zxrugs,    zu10m,     zv10m,   fder,
     2104     d     zxqsurf,   rh2m,      zxfluxu, zxfluxv,
     2105     d     frugs,     agesno,    fsollw,  fsolsw,
     2106     d     d_ts,      fevap,     fluxlat, t2m,
     2107     d     wfbils,    wfbilo,    fluxt,   fluxu,  fluxv,
     2108     -     dsens,     devap,     zxsnow,
     2109     -     zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke )
    20692110
    20702111
    20712112!-----------------------------------------------------------------------------------------
    20722113! ajout des tendances de la diffusion turbulente
    2073         CALL add_phys_tend(d_u_vdf,d_v_vdf,d_t_vdf,d_q_vdf,dql0,'vdf')
     2114      CALL add_phys_tend(d_u_vdf,d_v_vdf,d_t_vdf,d_q_vdf,dql0,'vdf')
    20742115!-----------------------------------------------------------------------------------------
    20752116
    2076         if (mydebug) then
    2077           call writefield_phy('u_seri',u_seri,llm)
    2078           call writefield_phy('v_seri',v_seri,llm)
    2079           call writefield_phy('t_seri',t_seri,llm)
    2080           call writefield_phy('q_seri',q_seri,llm)
    2081         endif
    2082 
    2083 
    2084         IF (ip_ebil_phy.ge.2) THEN
    2085           ztit='after surface_main'
    2086           CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
     2117      if (mydebug) then
     2118        call writefield_phy('u_seri',u_seri,llm)
     2119        call writefield_phy('v_seri',v_seri,llm)
     2120        call writefield_phy('t_seri',t_seri,llm)
     2121        call writefield_phy('q_seri',q_seri,llm)
     2122      endif
     2123
     2124
     2125      IF (ip_ebil_phy.ge.2) THEN
     2126        ztit='after surface_main'
     2127        CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime
    20872128     e      , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay
    20882129     s      , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2089           call diagphy(airephy,ztit,ip_ebil_phy
     2130         call diagphy(airephy,ztit,ip_ebil_phy
    20902131     e      , zero_v, zero_v, zero_v, zero_v, sens
    20912132     e      , evap  , zero_v, zero_v, ztsol
    20922133     e      , d_h_vcol, d_qt, d_ec
    20932134     s      , fs_bound, fq_bound )
    2094         END IF
     2135      END IF
    20952136
    20962137      ENDIF
    2097 
    20982138c =================================================================== c
    20992139c   Calcul de Qsat
    … …  
    22442284cdans le thermique sinon
    22452285       if (iflag_coupl.eq.0) then
    2246           if (debut.and.prt_level.gt.9)WRITE(lunout,*) 'ALE&ALP imposes'
    2247           Ale_bl(1:klon) = ale_bl_prescr
    2248           Alp_bl(1:klon) = alp_bl_prescr
     2286          if (debut.and.prt_level.gt.9)
     2287     $                     WRITE(lunout,*)'ALE et ALP imposes'
     2288          do i = 1,klon
     2289con ne couple que ale
     2290c           ALE(i) = max(ale_wake(i),Ale_bl(i))
     2291            ALE(i) = max(ale_wake(i),ale_bl_prescr)
     2292con ne couple que alp
     2293c           ALP(i) = alp_wake(i) + Alp_bl(i)
     2294            ALP(i) = alp_wake(i) + alp_bl_prescr
     2295          enddo
    22492296       else
    22502297         IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique'
    2251        endif
     2298!         do i = 1,klon
     2299!             ALE(i) = max(ale_wake(i),Ale_bl(i))
     2300! avant        ALP(i) = alp_wake(i) + Alp_bl(i)
     2301!             ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
     2302!         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
     2303!         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
     2304!         enddo
    22522305
    22532306!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    22562309! w si <0
    22572310!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2258 
    22592311       do i = 1,klon
    22602312          ALE(i) = max(ale_wake(i),Ale_bl(i))
     2313ccc nrlmd le 10/04/2012----------Stochastic triggering--------------
     2314          if (iflag_trig_bl.ge.1) then
     2315             ALE(i) = max(ale_wake(i),Ale_bl_trig(i))
     2316          endif
     2317ccc fin nrlmd le 10/04/2012
    22612318          if (alp_offset>=0.) then
    22622319            ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
    … …  
    22692326          endif
    22702327       enddo
    2271 
    22722328!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    22732329
     2330       endif
    22742331       do i=1,klon
    22752332          if (alp(i)>alp_max) then
    … …  
    25862643
    25872644
    2588          if (iflag_thermals.gt.1) then
     2645ccc nrlmd le 10/04/2012
     2646         DO k=1,klev+1
     2647           DO i=1,klon
     2648           pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce)
     2649           pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter)
     2650           pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic)
     2651           pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic)
     2652           ENDDO
     2653         ENDDO
     2654ccc fin nrlmd le 10/04/2012
     2655
     2656         if (iflag_thermals>=1) then
    25892657         call calltherm(pdtphys
    25902658     s      ,pplay,paprs,pphi,weak_inversion
    … …  
    25962664con rajoute ale et alp, et les caracteristiques de la couche alim
    25972665     s      ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca
    2598      s      ,ztv,zpspsk,ztla,zthl)
     2666     s      ,ztv,zpspsk,ztla,zthl
     2667ccc nrlmd le 10/04/2012
     2668     e      ,pbl_tke_input,pctsrf,omega,airephy
     2669     s      ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0
     2670     s      ,n2,s2,ale_bl_stat
     2671     s      ,therm_tke_max,env_tke_max
     2672     s      ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke
     2673     s      ,alp_bl_conv,alp_bl_stat
     2674ccc fin nrlmd le 10/04/2012
     2675     s                 )
     2676
     2677ccc nrlmd le 10/04/2012
     2678c-----------Stochastic triggering-----------
     2679      if (iflag_trig_bl.ge.1) then
     2680c
     2681        IF (prt_level .GE. 10) THEN
     2682         print *,'cin, ale_bl_stat, alp_bl_stat ',
     2683     $            cin, ale_bl_stat, alp_bl_stat
     2684        ENDIF
     2685
     2686c----Initialisations
     2687      do i=1,klon
     2688      proba_notrig(i)=1.
     2689      random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
     2690        if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then
     2691        tau_trig(i)=tau_trig_shallow
     2692        else
     2693        tau_trig(i)=tau_trig_deep
     2694        endif
     2695      enddo
     2696c
     2697        IF (prt_level .GE. 10) THEN
     2698         print *,'random_notrig, tau_trig ',
     2699     $            random_notrig, tau_trig
     2700          print *,'s_trig,s2,n2 ',
     2701     $             s_trig,s2,n2
     2702        ENDIF
     2703
     2704c----Tirage aléatoire et calcul de ale_bl_trig
     2705      do i=1,klon
     2706        if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) )  then
     2707        proba_notrig(i)=(1.-exp(-s_trig/s2(i)))**
     2708     $                  (n2(i)*dtime/tau_trig(i))
     2709c        print *, 'proba_notrig(i) ',proba_notrig(i)
     2710          if (random_notrig(i) .ge. proba_notrig(i)) then
     2711          ale_bl_trig(i)=ale_bl_stat(i)
     2712          else
     2713          ale_bl_trig(i)=0.
     2714          endif
     2715        else
     2716        proba_notrig(i)=1.
     2717        random_notrig(i)=0.
     2718        ale_bl_trig(i)=0.
     2719        endif
     2720      enddo
     2721c
     2722        IF (prt_level .GE. 10) THEN
     2723         print *,'proba_notrig, ale_bl_trig ',
     2724     $            proba_notrig, ale_bl_trig
     2725        ENDIF
     2726
     2727      endif !(iflag_trig_bl)
     2728
     2729c-----------Statistical closure-----------
     2730      if (iflag_clos_bl.ge.1) then
     2731
     2732        do i=1,klon
     2733        alp_bl(i)=alp_bl_stat(i)
     2734        enddo
     2735
     2736      else
     2737
     2738      alp_bl_stat(:)=0.
     2739
     2740      endif !(iflag_clos_bl)
     2741
     2742        IF (prt_level .GE. 10) THEN
     2743         print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat
     2744        ENDIF
     2745
     2746ccc fin nrlmd le 10/04/2012
    25992747
    26002748! ----------------------------------------------------------------------
    … …  
    26272775c  ==============
    26282776
    2629 ! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
     2777! Dans le cas où on active les thermiques, on fait partir l'ajustement
    26302778! a partir du sommet des thermiques.
    26312779! Dans le cas contraire, on demarre au niveau 1.
    … …  
    28142962! FH 22/09/2009
    28152963! La ligne ci-dessous faisait osciller le modele et donnait une solution
    2816 ! asymptotique bidon et d\'ependant fortement du pas de temps.
     2964! assymptotique bidon et dépendant fortement du pas de temps.
    28172965!        ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2)
    28182966!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    28422990c Appeler le processus de condensation a grande echelle
    28432991c et le processus de precipitation
     2992c-------------------------------------------------------------------------
     2993      IF (prt_level .GE.10) THEN
     2994       print *,' ->fisrtilp '
     2995      ENDIF
    28442996c-------------------------------------------------------------------------
    28452997      CALL fisrtilp(dtime,paprs,pplay,
    … …  
    33513503       RCFC12 = RCFC12_act
    33523504c
     3505      IF (prt_level .GE.10) THEN
     3506       print *,' ->radlwsw, number 1 '
     3507      ENDIF
     3508c
    33533509         CALL radlwsw
    33543510     e        (dist, rmu0, fract,
    … …  
    33883544       RCFC12 = RCFC12_per
    33893545c
     3546      IF (prt_level .GE.10) THEN
     3547       print *,' ->radlwsw, number 2 '
     3548      ENDIF
     3549c
    33903550         CALL radlwsw
    33913551     e        (dist, rmu0, fract,
    … …  
    34803640c a l'echelle sous-maille:
    34813641c
     3642      IF (prt_level .GE.10) THEN
     3643       print *,' call orography ? ', ok_orodr
     3644      ENDIF
     3645c
    34823646      IF (ok_orodr) THEN
    34833647c
    … …  
    35693733
    35703734       IF (ok_hines) then
     3735
    35713736         CALL hines_gwd(klon,klev,dtime,paprs,pplay,
    35723737     i                  rlat,t_seri,u_seri,v_seri,
    … …  
    35763741c  ajout des tendances
    35773742        CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,'hin')
     3743
    35783744      ENDIF
    3579 
     3745c
     3746
     3747c
     3748cIM cf. FLott BEG
    35803749C STRESS NECESSAIRES: TOUTE LA PHYSIQUE
    35813750
    … …  
    36023771cIM calcul composantes axiales du moment angulaire et couple des montagnes
    36033772c
    3604       IF (is_sequential .and. ok_orodr) THEN
    3605      
     3773      IF (is_sequential .and. ok_orodr) THEN
    36063774        CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur,
    36073775     C                 ra,rg,romega,
    … …  
    38984066c Convertir les incrementations en tendances
    38994067c
     4068      IF (prt_level .GE.10) THEN
     4069        print *,'Convertir les incrementations en tendances '
     4070      ENDIF
     4071c
    39004072      if (mydebug) then
    39014073        call writefield_phy('u_seri',u_seri,llm)
    … …  
    40164188c=============================================================
    40174189
    4018       if (iflag_thermals>1) then
     4190      if (iflag_thermals>=1) then
    40194191      d_t_lscth=0.
    40204192      d_t_lscst=0.

  • LMDZ5/trunk/libf/phylmd/thermcell.h

    r1496 r1638  
    11      integer            :: iflag_thermals,nsplit_thermals
     2
     3!!! nrlmd le 10/04/2012
     4      integer            :: iflag_trig_bl,iflag_clos_bl
     5      integer            :: tau_trig_shallow,tau_trig_deep
     6      real               :: s_trig
     7!!! fin nrlmd le 10/04/2012
     8
    29      real,parameter     :: r_aspect_thermals=2.,l_mix_thermals=30.
    310      real               :: alp_bl_k
    411      real               :: tau_thermals
    5       integer,parameter  :: w2di_thermals=1
     12      integer,parameter  :: w2di_thermals=0
    613      integer            :: isplit
    714
    … …  
    1421      common/ctherm5/iflag_thermals_ed,iflag_thermals_optflux
    1522
    16 !$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm4/,/ctherm5/)
     23!!! nrlmd le 10/04/2012
     24      common/ctherm6/iflag_trig_bl,iflag_clos_bl
     25      common/ctherm7/tau_trig_shallow,tau_trig_deep
     26      common/ctherm8/s_trig
     27!!! fin nrlmd le 10/04/2012
     28
     29!$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm4/,/ctherm5/,/ctherm6/,/ctherm7/,,/ctherm6/,/ctherm8/)

  • LMDZ5/trunk/libf/phylmd/thermcell_main.F90

    r1525 r1638  
    1010     &                  ,Ale_bl,Alp_bl,lalim_conv,wght_th &
    1111     &                  ,zmax0, f0,zw2,fraca,ztv &
    12      &                  ,zpspsk,ztla,zthl)
     12     &                  ,zpspsk,ztla,zthl &
     13!!! nrlmd le 10/04/2012
     14     &                  ,pbl_tke,pctsrf,omega,airephy &
     15     &                  ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
     16     &                  ,n2,s2,ale_bl_stat &
     17     &                  ,therm_tke_max,env_tke_max &
     18     &                  ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
     19     &                  ,alp_bl_conv,alp_bl_stat &
     20!!! fin nrlmd le 10/04/2012
     21     &                         )
    1322
    1423      USE dimphy
    … …  
    4756#include "iniprint.h"
    4857#include "thermcell.h"
     58!!! nrlmd le 10/04/2012
     59#include "indicesol.h"
     60!!! fin nrlmd le 10/04/2012
    4961
    5062!   arguments:
    … …  
    7789      integer,save :: lev_out=10
    7890!$OMP THREADPRIVATE(lev_out)
     91
     92      REAL susqr2pi, Reuler
    7993
    8094      INTEGER ig,k,l,ll,ierr
    … …  
    155169       real seuil
    156170      real csc(klon,klev)
     171
     172!!! nrlmd le 10/04/2012
     173
     174!------Entrées
     175      real pbl_tke(klon,klev+1,nbsrf)
     176      real pctsrf(klon,nbsrf)
     177      real omega(klon,klev)
     178      real airephy(klon)
     179!------Sorties
     180      real zlcl(klon),fraca0(klon),w0(klon),w_conv(klon)
     181      real therm_tke_max0(klon),env_tke_max0(klon)
     182      real n2(klon),s2(klon)
     183      real ale_bl_stat(klon)
     184      real therm_tke_max(klon,klev),env_tke_max(klon,klev)
     185      real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
     186!------Local
     187      integer nsrf
     188      real rhobarz0(klon)                    ! Densité au LCL
     189      logical ok_lcl(klon)                   ! Existence du LCL des thermiques
     190      integer klcl(klon)                     ! Niveau du LCL
     191      real interp(klon)                      ! Coef d'interpolation pour le LCL
     192!--Triggering
     193      real Su                                ! Surface unité: celle d'un updraft élémentaire
     194      parameter(Su=4e4)
     195      real hcoef                             ! Coefficient directeur pour le calcul de s2
     196      parameter(hcoef=1)
     197      real hmincoef                          ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2
     198      parameter(hmincoef=0.3)
     199      real eps1                              ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
     200      parameter(eps1=0.3)
     201      real hmin(ngrid)                       ! Ordonnée à l'origine pour le calcul de s2
     202      real zmax_moy(ngrid)                   ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
     203      real zmax_moy_coef
     204      parameter(zmax_moy_coef=0.33)
     205      real depth(klon)                       ! Epaisseur moyenne du cumulus
     206      real w_max(klon)                       ! Vitesse max statistique
     207      real s_max(klon)
     208!--Closure
     209      real pbl_tke_max(klon,klev)            ! Profil de TKE moyenne
     210      real pbl_tke_max0(klon)                ! TKE moyenne au LCL
     211      real w_ls(klon,klev)                   ! Vitesse verticale grande échelle (m/s)
     212      real coef_m                            ! On considère un rendement pour alp_bl_fluct_m
     213      parameter(coef_m=1.)
     214      real coef_tke                          ! On considère un rendement pour alp_bl_fluct_tke
     215      parameter(coef_tke=1.)
     216
     217!!! fin nrlmd le 10/04/2012
    157218
    158219!
    … …  
    679740      enddo
    680741!
     742
     743!!! nrlmd le 10/04/2012
     744
     745!------------Test sur le LCL des thermiques
     746    do ig=1,ngrid
     747      ok_lcl(ig)=.false.
     748      if ( (pcon(ig) .gt. pplay(ig,klev-1)) .and. (pcon(ig) .lt. pplay(ig,1)) ) ok_lcl(ig)=.true.
     749    enddo
     750
     751!------------Localisation des niveaux entourant le LCL et du coef d'interpolation
     752    do l=1,nlay-1
     753      do ig=1,ngrid
     754        if (ok_lcl(ig)) then
     755          if ((pplay(ig,l) .ge. pcon(ig)) .and. (pplay(ig,l+1) .le. pcon(ig))) then
     756          klcl(ig)=l
     757          interp(ig)=(pcon(ig)-pplay(ig,klcl(ig)))/(pplay(ig,klcl(ig)+1)-pplay(ig,klcl(ig)))
     758          endif
     759        endif
     760      enddo
     761    enddo
     762
     763!------------Hauteur des thermiques
     764!!jyg le 27/04/2012
     765!!    do ig =1,ngrid
     766!!    rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
     767!! &               -rhobarz(ig,klcl(ig)))*interp(ig)
     768!!    zlcl(ig)=(pplev(ig,1)-pcon(ig))/(rhobarz0(ig)*RG)
     769!!    zmax(ig)=pphi(ig,lmax(ig))/rg
     770!!      if ( (.not.ok_lcl(ig)) .or. (zlcl(ig).gt.zmax(ig)) ) zlcl(ig)=zmax(ig) ! Si zclc > zmax alors on pose zlcl = zmax
     771!!    enddo
     772    do ig =1,ngrid
     773     zmax(ig)=pphi(ig,lmax(ig))/rg
     774     if (ok_lcl(ig)) then
     775      rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
     776 &               -rhobarz(ig,klcl(ig)))*interp(ig)
     777      zlcl(ig)=(pplev(ig,1)-pcon(ig))/(rhobarz0(ig)*RG)
     778      zlcl(ig)=min(zlcl(ig),zmax(ig))   ! Si zlcl > zmax alors on pose zlcl = zmax
     779     else
     780      rhobarz0(ig)=0.
     781      zlcl(ig)=zmax(ig)
     782     endif
     783    enddo
     784!!jyg fin
     785
     786!------------Calcul des propriétés du thermique au LCL
     787  IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) THEN
     788
     789  !-----Initialisation de la TKE moyenne
     790   do l=1,nlay
     791    do ig=1,ngrid
     792     pbl_tke_max(ig,l)=0.
     793    enddo
     794   enddo
     795
     796!-----Calcul de la TKE moyenne
     797   do nsrf=1,nbsrf
     798    do l=1,nlay
     799     do ig=1,ngrid
     800     pbl_tke_max(ig,l)=pctsrf(ig,nsrf)*pbl_tke(ig,l,nsrf)+pbl_tke_max(ig,l)
     801     enddo
     802    enddo
     803   enddo
     804
     805!-----Initialisations des TKE dans et hors des thermiques
     806   do l=1,nlay
     807    do ig=1,ngrid
     808    therm_tke_max(ig,l)=pbl_tke_max(ig,l)
     809    env_tke_max(ig,l)=pbl_tke_max(ig,l)
     810    enddo
     811   enddo
     812
     813!-----Calcul de la TKE transportée par les thermiques : therm_tke_max
     814   call thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &
     815  &           rg,pplev,therm_tke_max)
     816!   print *,' thermcell_tke_transport -> '   !!jyg
     817
     818!-----Calcul des profils verticaux de TKE hors thermiques : env_tke_max, et de la vitesse verticale grande échelle : W_ls
     819   do l=1,nlay
     820    do ig=1,ngrid
     821     pbl_tke_max(ig,l)=fraca(ig,l)*therm_tke_max(ig,l)+(1.-fraca(ig,l))*env_tke_max(ig,l)         !  Recalcul de TKE moyenne aprés transport de TKE_TH
     822     env_tke_max(ig,l)=(pbl_tke_max(ig,l)-fraca(ig,l)*therm_tke_max(ig,l))/(1.-fraca(ig,l))       !  Recalcul de TKE dans  l'environnement aprés transport de TKE_TH
     823     w_ls(ig,l)=-1.*omega(ig,l)/(RG*rhobarz(ig,l))                                                !  Vitesse verticale de grande échelle
     824    enddo
     825   enddo
     826!    print *,' apres w_ls = '   !!jyg
     827
     828  do ig=1,ngrid
     829   if (ok_lcl(ig)) then
     830     fraca0(ig)=fraca(ig,klcl(ig))+(fraca(ig,klcl(ig)+1) &
     831 &             -fraca(ig,klcl(ig)))*interp(ig)
     832     w0(ig)=zw2(ig,klcl(ig))+(zw2(ig,klcl(ig)+1) &
     833 &         -zw2(ig,klcl(ig)))*interp(ig)
     834     w_conv(ig)=w_ls(ig,klcl(ig))+(w_ls(ig,klcl(ig)+1) &
     835 &             -w_ls(ig,klcl(ig)))*interp(ig)
     836     therm_tke_max0(ig)=therm_tke_max(ig,klcl(ig)) &
     837 &                     +(therm_tke_max(ig,klcl(ig)+1)-therm_tke_max(ig,klcl(ig)))*interp(ig)
     838     env_tke_max0(ig)=env_tke_max(ig,klcl(ig))+(env_tke_max(ig,klcl(ig)+1) &
     839 &                   -env_tke_max(ig,klcl(ig)))*interp(ig)
     840     pbl_tke_max0(ig)=pbl_tke_max(ig,klcl(ig))+(pbl_tke_max(ig,klcl(ig)+1) &
     841 &                   -pbl_tke_max(ig,klcl(ig)))*interp(ig)
     842     if (therm_tke_max0(ig).ge.20.) therm_tke_max0(ig)=20.
     843     if (env_tke_max0(ig).ge.20.) env_tke_max0(ig)=20.
     844     if (pbl_tke_max0(ig).ge.20.) pbl_tke_max0(ig)=20.
     845   else
     846     fraca0(ig)=0.
     847     w0(ig)=0.
     848!!jyg le 27/04/2012
     849!!     zlcl(ig)=0.
     850!!
     851   endif
     852  enddo
     853
     854  ENDIF ! IF ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) )
     855!  print *,'ENDIF  ( (iflag_trig_bl.ge.1) .or. (iflag_clos_bl.ge.1) ) '    !!jyg
     856
     857!------------Triggering------------------
     858  IF (iflag_trig_bl.ge.1) THEN
     859
     860!-----Initialisations
     861   depth(:)=0.
     862   n2(:)=0.
     863   s2(:)=0.
     864   s_max(:)=0.
     865
     866!-----Epaisseur du nuage (depth) et détermination de la queue du spectre de panaches (n2,s2) et du panache le plus gros (s_max)
     867   do ig=1,ngrid
     868     zmax_moy(ig)=zlcl(ig)+zmax_moy_coef*(zmax(ig)-zlcl(ig))
     869     depth(ig)=zmax_moy(ig)-zlcl(ig)
     870     hmin(ig)=hmincoef*zlcl(ig)
     871     if (depth(ig).ge.10.) then
     872       s2(ig)=(hcoef*depth(ig)+hmin(ig))**2
     873       n2(ig)=(1.-eps1)*fraca0(ig)*airephy(ig)/s2(ig)
     874!!
     875!!jyg le 27/04/2012
     876!!       s_max(ig)=s2(ig)*log(n2(ig))
     877!!       if (n2(ig) .lt. 1) s_max(ig)=0.
     878       s_max(ig)=s2(ig)*log(max(n2(ig),1.))
     879!!fin jyg
     880     else
     881       s2(ig)=0.
     882       n2(ig)=0.
     883       s_max(ig)=0.
     884     endif
     885   enddo
     886!   print *,'avant Calcul de Wmax '    !!jyg
     887
     888!-----Calcul de Wmax et ALE_BL_STAT associée
     889!!jyg le 30/04/2012
     890!!   do ig=1,ngrid
     891!!     if ( (depth(ig).ge.10.) .and. (s_max(ig).gt.1.) ) then
     892!!     w_max(ig)=w0(ig)*(1.+sqrt(2.*log(s_max(ig)/su)-log(2.*3.14)-log(2.*log(s_max(ig)/su)-log(2.*3.14))))
     893!!     ale_bl_stat(ig)=0.5*w_max(ig)**2
     894!!     else
     895!!     w_max(ig)=0.
     896!!     ale_bl_stat(ig)=0.
     897!!     endif
     898!!   enddo
     899   susqr2pi=su*sqrt(2.*Rpi)
     900   Reuler=exp(1.)
     901   do ig=1,ngrid
     902     if ( (depth(ig).ge.10.) .and. (s_max(ig).gt.susqr2pi*Reuler) ) then
     903      w_max(ig)=w0(ig)*(1.+sqrt(2.*log(s_max(ig)/susqr2pi)-log(2.*log(s_max(ig)/susqr2pi))))
     904      ale_bl_stat(ig)=0.5*w_max(ig)**2
     905     else
     906      w_max(ig)=0.
     907      ale_bl_stat(ig)=0.
     908     endif
     909   enddo
     910
     911  ENDIF ! iflag_trig_bl
     912!  print *,'ENDIF  iflag_trig_bl'    !!jyg
     913
     914!------------Closure------------------
     915
     916  IF (iflag_clos_bl.ge.1) THEN
     917
     918!-----Calcul de ALP_BL_STAT
     919  do ig=1,ngrid
     920  alp_bl_det(ig)=0.5*coef_m*rhobarz0(ig)*(w0(ig)**3)*fraca0(ig)*(1.-2.*fraca0(ig))/((1.-fraca0(ig))**2)
     921  alp_bl_fluct_m(ig)=1.5*rhobarz0(ig)*fraca0(ig)*(w_conv(ig)+coef_m*w0(ig))* &
     922 &                   (w0(ig)**2)
     923  alp_bl_fluct_tke(ig)=3.*coef_m*rhobarz0(ig)*w0(ig)*fraca0(ig)*(therm_tke_max0(ig)-env_tke_max0(ig)) &
     924 &                    +3.*rhobarz0(ig)*w_conv(ig)*pbl_tke_max0(ig)
     925    if (iflag_clos_bl.ge.2) then
     926    alp_bl_conv(ig)=1.5*coef_m*rhobarz0(ig)*fraca0(ig)*(fraca0(ig)/(1.-fraca0(ig)))*w_conv(ig)* &
     927 &                   (w0(ig)**2)
     928    else
     929    alp_bl_conv(ig)=0.
     930    endif
     931  alp_bl_stat(ig)=alp_bl_det(ig)+alp_bl_fluct_m(ig)+alp_bl_fluct_tke(ig)+alp_bl_conv(ig)
     932  enddo
     933
     934!-----Sécurité ALP infinie
     935  do ig=1,ngrid
     936   if (fraca0(ig).gt.0.98) alp_bl_stat(ig)=2.
     937  enddo
     938
     939  ENDIF ! (iflag_clos_bl.ge.1)
     940
     941!!! fin nrlmd le 10/04/2012
     942
    681943      if (prt_level.ge.10) then
    682944         ig=igout
    … …  
    8581120      end
    8591121
     1122!!! nrlmd le 10/04/2012                          Transport de la TKE par le thermique moyen pour la fermeture en ALP
     1123!                                                         On transporte pbl_tke pour donner therm_tke
     1124!                                          Copie conforme de la subroutine DTKE dans physiq.F écrite par Frederic Hourdin
     1125      subroutine thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &
     1126     &           rg,pplev,therm_tke_max)
     1127      implicit none
     1128
     1129#include "iniprint.h"
     1130!=======================================================================
     1131!
     1132!   Calcul du transport verticale dans la couche limite en presence
     1133!   de "thermiques" explicitement representes
     1134!   calcul du dq/dt une fois qu'on connait les ascendances
     1135!
     1136!=======================================================================
     1137
     1138      integer ngrid,nlay,nsrf
     1139
     1140      real ptimestep
     1141      real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1)
     1142      real entr0(ngrid,nlay),rg
     1143      real therm_tke_max(ngrid,nlay)
     1144      real detr0(ngrid,nlay)
     1145
     1146
     1147      real masse(ngrid,nlay),fm(ngrid,nlay+1)
     1148      real entr(ngrid,nlay)
     1149      real q(ngrid,nlay)
     1150      integer lev_out                           ! niveau pour les print
     1151
     1152      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
     1153
     1154      real zzm
     1155
     1156      integer ig,k
     1157      integer isrf
     1158
     1159
     1160      lev_out=0
     1161
     1162
     1163      if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0'
     1164
     1165!   calcul du detrainement
     1166      do k=1,nlay
     1167         detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k)
     1168         masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG
     1169      enddo
     1170
     1171
     1172! Decalage vertical des entrainements et detrainements.
     1173      masse(:,1)=0.5*masse0(:,1)
     1174      entr(:,1)=0.5*entr0(:,1)
     1175      detr(:,1)=0.5*detr0(:,1)
     1176      fm(:,1)=0.
     1177      do k=1,nlay-1
     1178         masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1))
     1179         entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1))
     1180         detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1))
     1181         fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k)
     1182      enddo
     1183      fm(:,nlay+1)=0.
     1184
     1185!!! nrlmd le 16/09/2010
     1186!   calcul de la valeur dans les ascendances
     1187!       do ig=1,ngrid
     1188!          qa(ig,1)=q(ig,1)
     1189!       enddo
     1190!!!
     1191
     1192!do isrf=1,nsrf
     1193
     1194!   q(:,:)=therm_tke(:,:,isrf)
     1195   q(:,:)=therm_tke_max(:,:)
     1196!!! nrlmd le 16/09/2010
     1197      do ig=1,ngrid
     1198         qa(ig,1)=q(ig,1)
     1199      enddo
     1200!!!
     1201
     1202    if (1==1) then
     1203      do k=2,nlay
     1204         do ig=1,ngrid
     1205            if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt.  &
     1206     &         1.e-5*masse(ig,k)) then
     1207         qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k))  &
     1208     &         /(fm(ig,k+1)+detr(ig,k))
     1209            else
     1210               qa(ig,k)=q(ig,k)
     1211            endif
     1212            if (qa(ig,k).lt.0.) then
     1213!               print*,'qa<0!!!'
     1214            endif
     1215            if (q(ig,k).lt.0.) then
     1216!               print*,'q<0!!!'
     1217            endif
     1218         enddo
     1219      enddo
     1220
     1221! Calcul du flux subsident
     1222
     1223      do k=2,nlay
     1224         do ig=1,ngrid
     1225            wqd(ig,k)=fm(ig,k)*q(ig,k)
     1226            if (wqd(ig,k).lt.0.) then
     1227!               print*,'wqd<0!!!'
     1228            endif
     1229         enddo
     1230      enddo
     1231      do ig=1,ngrid
     1232         wqd(ig,1)=0.
     1233         wqd(ig,nlay+1)=0.
     1234      enddo
     1235
     1236! Calcul des tendances
     1237      do k=1,nlay
     1238         do ig=1,ngrid
     1239            q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k)  &
     1240     &               -wqd(ig,k)+wqd(ig,k+1))  &
     1241     &               *ptimestep/masse(ig,k)
     1242         enddo
     1243      enddo
     1244
     1245 endif
     1246
     1247   therm_tke_max(:,:)=q(:,:)
     1248
     1249      return
     1250!!! fin nrlmd le 10/04/2012
     1251     end
     1252
Note: See TracChangeset for help on using the changeset viewer.