Changeset 4089


Ignore:
Timestamp:
Mar 10, 2022, 7:23:47 PM (3 years ago)
Author:
fhourdin
Message:

Reecriture des thermiques

Location:
LMDZ6/trunk/libf
Files:
32 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90

    r4086 r4089  
    130130
    131131  INCLUDE "compbl.h"
    132   INCLUDE "thermcell.h"
     132  INCLUDE "alpale.h"
    133133 
    134134  deg2rad= pi/180.0

  • LMDZ6/trunk/libf/phylmd/alpale.F90

    r2554 r4089  
    4848  REAL, DIMENSION(klon), INTENT(OUT)                         :: Ale_wake, Alp_wake
    4949
    50   include "thermcell.h"
     50  include "alpale.h"
    5151  include "YOMCST.h"
    5252  include "YOETHF.h"

  • LMDZ6/trunk/libf/phylmd/alpale_th.F90

    r3531 r4089  
    4747  REAL, DIMENSION(klon), INTENT(OUT)                         :: birth_rate
    4848
    49   include "thermcell.h"
     49  include "alpale.h"
    5050
    5151! Local variables

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

    r2346 r4089  
    77     &      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs  &
    88     &      ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth,  &
    9      &       ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, &
     9     &       ratqsdiff,zqsatth,ale_bl,alp_bl,lalim_conv,wght_th, &
    1010     &       zmax0,f0,zw2,fraca,ztv,zpspsk,ztla,zthl &
    1111!!! nrlmd le 10/04/2012
    … …  
    1717     &      ,alp_bl_conv,alp_bl_stat &
    1818!!! fin nrlmd le 10/04/2012
    19      &      ,zqla,ztva )
     19     &      ,zqla,ztva &
     20#ifdef ISO         
     21     &      ,xt_seri,d_xt_ajs &
     22#ifdef DIAGISO         
     23     &      ,q_the,xt_the &
     24#endif
     25#endif         
     26     &   )
    2027
    2128      USE dimphy
    2229      USE indice_sol_mod
    2330      USE print_control_mod, ONLY: prt_level,lunout
     31#ifdef ISO
     32      use infotrac_phy, ONLY: ntraciso
     33#ifdef ISOVERIF
     34      USE isotopes_mod, ONLY: iso_eau,iso_HDO
     35      USE isotopes_verif_mod, ONLY: iso_verif_aberrant_enc_vect2D, &
     36        iso_verif_egalite_vect2D
     37#endif   
     38#endif
    2439
    2540      implicit none
    26       include "thermcell.h"
     41      include "clesphys.h"
     42      include "thermcell_old.h"
    2743
    2844
    … …  
    7995      real zqsatth(klon,klev) 
    8096!nouvelles variables pour la convection
    81       real Ale_bl(klon)
    82       real Alp_bl(klon)
    83       real Ale(klon)
    84       real Alp(klon)
     97      real ale_bl(klon)
     98      real alp_bl(klon)
     99      real ale(klon)
     100      real alp(klon)
    85101!RC
    86102      !on garde le zmax du pas de temps precedent
    … …  
    102118!********************************************************
    103119
     120      real, dimension(klon) :: pcon
     121      real, dimension(klon,klev) :: rhobarz,wth3
     122      integer,dimension(klon) :: lalim
     123      real, dimension(klon,klev+1) :: fm
     124      real, dimension(klon,klev) :: alim_star
     125      real, dimension(klon) :: zmax
     126
     127
     128
    104129
    105130! variables locales
    … …  
    115140      character (len=80) :: abort_message
    116141
    117       integer i,k
     142      integer i,k,isplit
    118143      logical, save :: first=.true.
     144      logical :: new_thermcell
     145
     146#ifdef ISO
     147      REAL xt_seri(ntraciso,klon,klev),xtmemoire(ntraciso,klon,klev)
     148      REAL d_xt_ajs(ntraciso,klon,klev)
     149      real d_xt_the(ntraciso,klon,klev)
     150#ifdef DIAGISO
     151      real q_the(klon,klev)
     152      real xt_the(ntraciso,klon,klev)
     153#endif
     154      real qprec(klon,klev)
     155      integer ixt
     156#endif
     157
     158
    119159!$OMP THREADPRIVATE(first)
    120160!********************************************************
    … …  
    144184         detr_therm(:,:)=0.
    145185
    146          Ale_bl(:)=0.
    147          Alp_bl(:)=0.
     186         ale_bl(:)=0.
     187         alp_bl(:)=0.
    148188         if (prt_level.ge.10) then
    149189          print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
    … …  
    159199                logexpr2(i,k)=.not.q_seri(i,k).ge.1.e-15
    160200               if (logexpr2(i,k)) then
     201#ifdef ISO
     202                qprec(i,k)=q_seri(i,k)
     203#endif
    161204                q_seri(i,k)=1.e-15
    162205                nbptspb=nbptspb+1
     206#ifdef ISO
     207                do ixt=1,ntraciso
     208                  xt_seri(ixt,i,k)=1.e-15*(xt_seri(ixt,i,k)/qprec(i,k))
     209                  ! xt_seri(ixt,i,k)=1.e-15*(Rdefault(index_iso(ixt)))
     210                enddo
     211#endif
    163212               endif
    164213!               if (logexpr0) &
    … …  
    169218         if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb   
    170219
     220
     221         new_thermcell=iflag_thermals>=15.and.iflag_thermals<=18
     222#ifdef ISO
     223      if (.not.new_thermcell) then
     224           CALL abort_gcm('calltherm 234','isos pas prevus ici',1)
     225      endif
     226#ifdef ISOVERIF
     227      if (iso_eau.gt.0) then
     228       call iso_verif_egalite_vect2D( &
     229     &           xt_seri,q_seri, &
     230     &           'calltherm 174',ntraciso,klon,klev)
     231      endif !if (iso_eau.gt.0) then
     232#endif   
     233#endif
    171234         zdt=dtime/REAL(nsplit_thermals)
     235
     236
    172237         do isplit=1,nsplit_thermals
    173238
    … …  
    207272              abort_message = 'cas non prevu dans calltherm'
    208273              CALL abort_physic (modname,abort_message,1)
    209 
    210 !           CALL thermcell_pluie(klon,klev,zdt  &
    211 !   &      ,pplay,paprs,pphi,zlev  &
    212 !    &      ,u_seri,v_seri,t_seri,q_seri  &
    213 !    &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
    214 !    &      ,zfm_therm,zentr_therm,zqla  &
    215 !    &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    216 !    &      ,tau_thermals,3)
    217274          else if (iflag_thermals.eq.12) then
    218275            CALL calcul_sec(klon,klev,zdt  &
    … …  
    223280     &      ,tau_thermals)
    224281          else if (iflag_thermals==13.or.iflag_thermals==14) then
    225             CALL thermcellV0_main(itap,klon,klev,zdt  &
    226      &      ,pplay,paprs,pphi,debut  &
    227      &      ,u_seri,v_seri,t_seri,q_seri  &
    228      &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
    229      &      ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax  &
    230      &      ,ratqscth,ratqsdiff,zqsatth  &
    231      &      ,r_aspect_thermals,l_mix_thermals  &
    232      &      ,tau_thermals,Ale,Alp,lalim_conv,wght_th &
    233      &      ,zmax0,f0,zw2,fraca)
    234           else if (iflag_thermals>=15.and.iflag_thermals<=18) then
    235 
    236 !            print*,'THERM iflag_thermas_ed=',iflag_thermals_ed
     282              abort_message = 'thermcellV0_main enleve svn>2084'
     283              CALL abort_physic (modname,abort_message,1)
     284          else if (new_thermcell) then
    237285            CALL thermcell_main(itap,klon,klev,zdt  &
    238286     &      ,pplay,paprs,pphi,debut  &
    … …  
    241289     &      ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax  &
    242290     &      ,ratqscth,ratqsdiff,zqsatth  &
    243 !    &      ,r_aspect_thermals,l_mix_thermals &
    244 !    &      ,tau_thermals,iflag_thermals_ed,iflag_coupl &
    245      &      ,Ale,Alp,lalim_conv,wght_th &
    246291     &      ,zmax0,f0,zw2,fraca,ztv,zpspsk &
    247      &      ,ztla,zthl &
    248 !!! nrlmd le 10/04/2012
    249      &      ,pbl_tke,pctsrf,omega,airephy &
    250      &      ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
    251      &      ,n2,s2,ale_bl_stat &
    252      &      ,therm_tke_max,env_tke_max &
    253      &      ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
    254      &      ,alp_bl_conv,alp_bl_stat &
    255 !!! fin nrlmd le 10/04/2012
    256      &      ,ztva )
     292     &      ,ztla,zthl,ztva &
     293     &      ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
     294#ifdef ISO         
     295     &      ,xt_seri,d_xt_the &
     296#endif         
     297     &   )
     298
     299            CALL thermcell_alp(klon,klev,zdt  &                      ! in
     300     &        ,pplay,paprs  &                                        ! in
     301     &        ,zfm_therm,zentr_therm,lmax  &                         ! in
     302     &        ,pbl_tke,pctsrf,omega,airephy &                        ! in
     303     &        ,zw2,fraca &                                           ! in
     304     &        ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &  ! in
     305     &        ,ale,alp,lalim_conv,wght_th &                          ! out
     306     &        ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &! out
     307     &        ,n2,s2,ale_bl_stat &                                   ! out
     308     &        ,therm_tke_max,env_tke_max &                           ! out
     309     &        ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &          ! out
     310     &        ,alp_bl_conv,alp_bl_stat &                             ! out
     311     &        )
     312
    257313           if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK'
    258314         else
    … …  
    303359            detr_therm(:,k)=detr_therm(:,k)  &
    304360     &       +zdetr_therm(:,k)*fact(:)
     361#ifdef ISO
     362            do ixt=1,ntraciso
     363              d_xt_the(ixt,:,k)=d_xt_the(ixt,:,k)*dtime*fact(:)
     364            enddo
     365#endif
    305366      ENDDO
    306367       fm_therm(:,klev+1)=0.
    … …  
    313374            d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)
    314375            d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:)
     376#ifdef ISO
     377            d_xt_ajs(:,:,:)=d_xt_ajs(:,:,:)+d_xt_the(:,:,:)
     378#endif
    315379
    316380!  incrementation des variables meteo
    … …  
    320384            qmemoire(:,:)=q_seri(:,:)
    321385            q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)
     386#ifdef ISO
     387            xtmemoire(:,:,:)=xt_seri(:,:,:)
     388            xt_seri(:,:,:) = xt_seri(:,:,:) + d_xt_the(:,:,:)
     389#ifdef ISOVERIF
     390!      write(*,*) 'calltherm 350 tmp: ajout d_xt_the'
     391      if (iso_HDO.gt.0) then
     392!      i=479
     393!      k=4
     394!      write(*,*) 'xt_seri(iso_hdo,i,k),q_seri(i,k)=', &
     395!     &   xt_seri(iso_hdo,i,k),q_seri(i,k)
     396!      write(*,*) 'd_xt_the(iso_hdo,i,k),d_q_the(i,k)=', &
     397!     &   d_xt_the(iso_hdo,i,k),d_q_the(i,k)
     398      call iso_verif_aberrant_enc_vect2D( &
     399     &        xt_seri,q_seri, &
     400     &        'calltherm 353, apres ajout d_xt_the',ntraciso,klon,klev)
     401      endif     
     402#endif
     403#endif
    322404           if (prt_level.gt.10) write(lunout,*)'Apres apres thermcell_main OK'
    323405
    324406       DO i=1,klon
    325407            fm_therm(i,klev+1)=0.
    326             Ale_bl(i)=Ale_bl(i)+Ale(i)/REAL(nsplit_thermals)
    327 !            write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i)
    328             Alp_bl(i)=Alp_bl(i)+Alp(i)/REAL(nsplit_thermals)
    329 !            write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i)
    330         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)
     408            ale_bl(i)=ale_bl(i)+ale(i)/REAL(nsplit_thermals)
     409!            write(22,*)'ALE CALLTHERM',ale_bl(i),ale(i)
     410            alp_bl(i)=alp_bl(i)+alp(i)/REAL(nsplit_thermals)
     411!            write(23,*)'ALP CALLTHERM',alp_bl(i),alp(i)
     412        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)
    331413       ENDDO
    332414
    … …  
    341423                q_seri(i,k)=1.e-15
    342424                nbptspb=nbptspb+1
     425#ifdef ISO
     426                do ixt=1,ntraciso
     427                  xt_seri(ixt,i,k)=1.e-15*(xtmemoire(ixt,i,k)/qmemoire(i,k))
     428                enddo
     429#endif
    343430!                if (prt_level.ge.10) then
    344431!                  print*,'WARN eau<0 apres therm i=',i,'  k=',k  &
    … …  
    348435            ENDDO
    349436            ENDDO
     437#ifdef ISO
     438#ifdef ISOVERIF
     439      if (iso_HDO.gt.0) then
     440      call iso_verif_aberrant_enc_vect2D( &
     441     &        xt_seri,q_seri, &
     442     &        'calltherm 393, apres bidouille q<0',ntraciso,klon,klev)
     443      endif     
     444#endif
     445#endif
     446
    350447        IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb   
    351448! tests sur les valeurs de la temperature

  • LMDZ6/trunk/libf/phylmd/calwake.F90

    r4085 r4089  
    210210
    211211
     212! SUBROUTINE wake(klon,klev,znatsurf, p, ph, pi, dtime, &
     213!                 tenv0, qe0, omgb, &
     214!                 dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
     215!                 sigd_con, Cin, &
     216!                 deltatw, deltaqw, sigmaw, awdens, wdens, &                  ! state variables
     217!                 dth, hw, wape, fip, gfl, &
     218!                 dtls, dqls, ktopw, omgbdth, dp_omgb, tu, qu, &
     219!                 dtke, dqke, omg, dp_deltomg, wkspread, cstar, &
     220!                 d_deltat_gw, &
     221!                 d_deltatw2, d_deltaqw2, d_sigmaw2, d_awdens2, d_wdens2)     ! tendencies
     222!
     223  ! retour a un Pupper fixe                                *
    212224  CALL wake(klon,klev,znatsurf, p, ph, pi, dtime, &
    213225    te, qe, omgbe, &

  • LMDZ6/trunk/libf/phylmd/clesphys.h

    r4062 r4089  
    1515       INTEGER nbapp_rad, iflag_con, nbapp_cv, nbapp_wk, iflag_ener_conserv
    1616       REAL co2_ppm, co2_ppm0, solaire
     17       INTEGER iflag_thermals,nsplit_thermals
     18       REAL tau_thermals
     19
    1720!FC
    1821       REAL Cd_frein
    … …  
    145148     &     , ok_chlorophyll,ok_conserv_q, adjust_tropopause             &
    146149     &     , ok_daily_climoz, ok_all_xml, ok_lwoff                      &
    147      &     , iflag_phytrac, ok_new_lscp
    148      
     150     &     , iflag_phytrac, ok_new_lscp                                 &
     151     &     ,  iflag_thermals,nsplit_thermals, tau_thermals   
    149152       save /clesphys/
    150153!$OMP THREADPRIVATE(/clesphys/)

  • LMDZ6/trunk/libf/phylmd/cloudth_mod.F90

    r4072 r4089  
    2424#include "YOETHF.h"
    2525#include "FCTTRE.h"
    26 #include "thermcell.h"
    2726#include "nuage.h"
    2827
    … …  
    269268#include "YOETHF.h"
    270269#include "FCTTRE.h"
    271 #include "thermcell.h"
    272270#include "nuage.h"
    273271     
    … …  
    609607#include "YOETHF.h"
    610608#include "FCTTRE.h"
    611 #include "thermcell.h"
    612609#include "nuage.h"
    613610
    … …  
    833830#include "YOETHF.h"
    834831#include "FCTTRE.h"
    835 #include "thermcell.h"
    836832#include "nuage.h"
    837833     
    … …  
    12951291#include "YOETHF.h"
    12961292#include "FCTTRE.h"
    1297 #include "thermcell.h"
    12981293#include "nuage.h"
    12991294
    … …  
    15621557#include "YOETHF.h"
    15631558#include "FCTTRE.h"
    1564 #include "thermcell.h"
    15651559#include "nuage.h"
    15661560     

  • LMDZ6/trunk/libf/phylmd/conf_phys_m.F90

    r4072 r4089  
    3939    INCLUDE "YOMCST.h"
    4040    INCLUDE "YOMCST2.h"
    41     INCLUDE "thermcell.h"
     41    INCLUDE "alpale.h"
    4242
    4343    !IM : on inclut/initialise les taux de CH4, N2O, CFC11 et CFC12
    … …  
    142142    REAL,SAVE :: seuil_inversion_omp
    143143
    144     INTEGER,SAVE :: iflag_thermals_ed_omp,iflag_thermals_optflux_omp,iflag_thermals_closure_omp
    145     REAL, SAVE :: fact_thermals_ed_dz_omp
    146144    INTEGER,SAVE :: iflag_thermals_omp,nsplit_thermals_omp
    147145    REAL,SAVE :: tau_thermals_omp,alp_bl_k_omp
    … …  
    17181716    CALL getin('iflag_thermals',iflag_thermals_omp)
    17191717    !
    1720     !Config Key  = iflag_thermals_ed
    1721     !Config Desc =
    1722     !Config Def  = 0
    1723     !Config Help =
    1724     !
    1725     fact_thermals_ed_dz_omp = 0.1
    1726 
    1727     CALL getin('fact_thermals_ed_dz',fact_thermals_ed_dz_omp)
    1728     !
    1729     !
    1730     !Config Key  = iflag_thermals_ed
    1731     !Config Desc =
    1732     !Config Def  = 0
    1733     !Config Help =
    1734     !
    1735     iflag_thermals_ed_omp = 0
    1736     CALL getin('iflag_thermals_ed',iflag_thermals_ed_omp)
    1737     !
    1738     !
    1739     !Config Key  = iflag_thermals_optflux
    1740     !Config Desc =
    1741     !Config Def  = 0
    1742     !Config Help =
    1743     !
    1744     iflag_thermals_optflux_omp = 0
    1745     CALL getin('iflag_thermals_optflux',iflag_thermals_optflux_omp)
    1746     !
    1747     !Config Key  = iflag_thermals_closure
    1748     !Config Desc =
    1749     !Config Def  = 0
    1750     !Config Help =
    1751     !
    1752     iflag_thermals_closure_omp = 1
    1753     CALL getin('iflag_thermals_closure',iflag_thermals_closure_omp)
    1754     !
    17551718    !Config Key  = nsplit_thermals
    17561719    !Config Desc =
    1757     !Config Def  = 1
     1720    !Config Def  = 0
    17581721    !Config Help =
    17591722    !
    … …  
    26332596    ip_ebil_phy = ip_ebil_phy_omp
    26342597    iflag_thermals = iflag_thermals_omp
    2635     iflag_thermals_ed = iflag_thermals_ed_omp
    2636     fact_thermals_ed_dz = fact_thermals_ed_dz_omp
    2637     iflag_thermals_optflux = iflag_thermals_optflux_omp
    2638     iflag_thermals_closure = iflag_thermals_closure_omp
    26392598    nsplit_thermals = nsplit_thermals_omp
    26402599    tau_thermals = tau_thermals_omp
    … …  
    30022961    WRITE(lunout,*) ' iflag_order2_sollw = ', iflag_order2_sollw
    30032962    WRITE(lunout,*) ' iflag_thermals = ', iflag_thermals
    3004     WRITE(lunout,*) ' iflag_thermals_ed = ', iflag_thermals_ed
    3005     WRITE(lunout,*) ' fact_thermals_ed_dz = ', fact_thermals_ed_dz
    3006     WRITE(lunout,*) ' iflag_thermals_optflux = ', iflag_thermals_optflux
    3007     WRITE(lunout,*) ' iflag_thermals_closure = ', iflag_thermals_closure
    30082963    WRITE(lunout,*) ' iflag_clos = ', iflag_clos
    30092964    WRITE(lunout,*) ' coef_clos_ls = ', coef_clos_ls

  • LMDZ6/trunk/libf/phylmd/phyetat0.F90

    r4071 r4089  
    4343  include "dimsoil.h"
    4444  include "clesphys.h"
    45   include "thermcell.h"
     45  include "alpale.h"
    4646  include "compbl.h"
    4747  include "YOMCST.h"

  • LMDZ6/trunk/libf/phylmd/phyredem.F90

    r4071 r4089  
    4747  include "dimsoil.h"
    4848  include "clesphys.h"
    49   include "thermcell.h"
     49  include "alpale.h"
    5050  include "compbl.h"
    5151  !======================================================================

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

    r4071 r4089  
    5353    IMPLICIT NONE
    5454    include "clesphys.h"
    55     include "thermcell.h"
    5655    include "YOMCST.h"
    5756

  • LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90

    r4071 r4089  
    426426
    427427    INCLUDE "clesphys.h"
    428     INCLUDE "thermcell.h"
     428    INCLUDE "alpale.h"
    429429    INCLUDE "compbl.h"
    430430    INCLUDE "YOMCST.h"

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r4085 r4089  
    7979    USE lscp_mod, ONLY : lscp
    8080    USE wake_ini_mod, ONLY : wake_ini
     81    USE thermcell_ini_mod, ONLY : thermcell_ini
    8182
    8283    !USE cmp_seri_mod
    … …  
    355356    include "dimsoil.h"
    356357    include "clesphys.h"
    357     include "thermcell.h"
     358    include "alpale.h"
    358359    include "dimpft.h"
    359360    !======================================================================
    … …  
    17321733!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    17331734       CALL wake_ini(rg,rd,rv,prt_level)
     1735       CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, &
     1736   &    RG,RD,RCPD,RKAPPA,RLVTT,RETV)
     1737
    17341738!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    17351739

  • LMDZ6/trunk/libf/phylmd/phytrac_mod.F90

    r4056 r4089  
    153153    INCLUDE "YOMCST.h"
    154154    INCLUDE "clesphys.h"
    155     INCLUDE "thermcell.h"
    156155    !==========================================================================
    157156    !                   -- ARGUMENT DESCRIPTION --

  • LMDZ6/trunk/libf/phylmd/thermcell_alim.F90

    r2406 r4089  
    1111!--------------------------------------------------------------------------
    1212
    13 #include "YOMCST.h"
    14 #include "YOETHF.h"
    15 #include "FCTTRE.h"
    16 #include "thermcell.h"
    17 
    18 !      fort(10) ptimestep,ztv,zthl,po,zl,rhobarz,zlev,pplev,pphi,zpspsk,f0
    1913      INTEGER, INTENT(IN) :: ngrid,klev
    2014      REAL, INTENT(IN) :: ztv(ngrid,klev)
    … …  
    4135
    4236!-------------------------------------------------------------------------
    43 ! Definition de l'alimentation a l'origine dans thermcell_init
     37! Definition de l'alimentation
    4438!-------------------------------------------------------------------------
    4539   IF (flag==0) THEN ! CMIP5 version

  • LMDZ6/trunk/libf/phylmd/thermcell_alp.F90

    r2387 r4089  
    11! $Id: thermcell_main.F90 2351 2015-08-25 15:14:59Z emillour $
    22!
    3       SUBROUTINE thermcell_alp(ngrid,nlay,ptimestep  &
    4      &                  ,pplay,pplev  &
    5      &                  ,fm0,entr0,lmax  &
    6      &                  ,ale_bl,alp_bl,lalim_conv,wght_th &
    7      &                  ,zw2,fraca &
    8 !!! ncessaire en plus
    9      &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
    10 !!! nrlmd le 10/04/2012
    11      &                  ,pbl_tke,pctsrf,omega,airephy &
    12      &                  ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
    13      &                  ,n2,s2,ale_bl_stat &
    14      &                  ,therm_tke_max,env_tke_max &
    15      &                  ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
    16      &                  ,alp_bl_conv,alp_bl_stat &
    17 !!! fin nrlmd le 10/04/2012
     3      SUBROUTINE thermcell_alp(ngrid,nlay,ptimestep  &                         ! in
     4     &                  ,pplay,pplev  &                                        ! in
     5     &                  ,fm0,entr0,lmax  &                                     ! in
     6     &                  ,pbl_tke,pctsrf,omega,airephy &                        ! in
     7     &                  ,zw2,fraca &                                           ! in
     8     &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &  ! in
     9!
     10     &                  ,ale_bl,alp_bl,lalim_conv,wght_th &                    ! out
     11     &                  ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &   ! out
     12     &                  ,n2,s2,ale_bl_stat &                                   ! out
     13     &                  ,therm_tke_max,env_tke_max &                           ! out
     14     &                  ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &          ! out
     15     &                  ,alp_bl_conv,alp_bl_stat &                             ! out
    1816     &)
    1917
    20       USE dimphy
    2118      USE indice_sol_mod
    2219      IMPLICIT NONE
    2320
    2421!=======================================================================
    25 !   Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu
    26 !   Version du 09.02.07
    27 !   Calcul du transport vertical dans la couche limite en presence
    28 !   de "thermiques" explicitement representes avec processus nuageux
    2922!
    30 !   Reecriture a partir d'un listing papier a Habas, le 14/02/00
    31 !
    32 !   le thermique est suppose homogene et dissipe par melange avec
    33 !   son environnement. la longueur l_mix controle l'efficacite du
    34 !   melange
    35 !
    36 !   Le calcul du transport des differentes especes se fait en prenant
    37 !   en compte:
    38 !     1. un flux de masse montant
    39 !     2. un flux de masse descendant
    40 !     3. un entrainement
    41 !     4. un detrainement
    42 !
    43 ! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr)
    44 !    Introduction of an implicit computation of vertical advection in
    45 !    the environment of thermal plumes in thermcell_dq
    46 !    impl =     0 : explicit, 1 : implicit, -1 : old version
    47 !    controled by iflag_thermals =
    48 !       15, 16 run with impl=-1 : numerical convergence with NPv3
    49 !       17, 18 run with impl=1  : more stable
    50 !    15 and 17 correspond to the activation of the stratocumulus "bidouille"
    51 !
     23!   Auteurs: Catherine Rio
     24!   Modifications :
     25!   Nicolas Rochetin et Jean-Yves Grandpeix
     26!         pour la fermeture stochastique. 2012
     27!   Frédéric Hourdin :
     28!         netoyage informatique. 2022
     29!   
    5230!=======================================================================
    5331!-----------------------------------------------------------------------
    … …  
    5836#include "YOETHF.h"
    5937#include "FCTTRE.h"
    60 #include "thermcell.h"
     38#include "alpale.h"
    6139
    6240!   arguments:
    6341!   ----------
    6442
    65 !IM 140508
    66 
    67       INTEGER ngrid,nlay
    68       real ptimestep
    69       REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
    70 
    71 !   local:
    72 !   ------
    73 
     43!------Entrees
     44      integer, intent(in) :: ngrid,nlay
     45      real, intent(in) :: ptimestep
     46      real, intent(in) :: pplay(ngrid,nlay),pplev(ngrid,nlay+1)
     47      integer, intent(in), dimension(ngrid) ::lmax,lalim
     48      real, intent(in), dimension(ngrid) :: zmax
     49      real, intent(in), dimension(ngrid,nlay+1) :: zw2
     50      real, intent(in), dimension(ngrid,nlay+1) :: fraca
     51      real, intent(in), dimension(ngrid,nlay) :: wth3
     52      real, intent(in), dimension(ngrid,nlay) :: rhobarz
     53      real, intent(in), dimension(ngrid) :: wmax_sec
     54      real, intent(in), dimension(ngrid,nlay) :: entr0
     55      real, intent(in), dimension(ngrid,nlay+1) :: fm0,fm
     56      real, intent(in), dimension(ngrid) :: pcon
     57      real, intent(in), dimension(ngrid,nlay) :: alim_star
     58      real, intent(in), dimension(ngrid,nlay+1,nbsrf) :: pbl_tke
     59      real, intent(in), dimension(ngrid,nbsrf) :: pctsrf
     60      real, intent(in), dimension(ngrid,nlay) :: omega
     61      real, intent(in), dimension(ngrid) :: airephy
     62!------Sorties
     63      real, intent(out), dimension(ngrid) :: ale_bl,alp_bl
     64      real, intent(out), dimension(ngrid,nlay) :: wght_th
     65      integer, intent(out), dimension(ngrid) :: lalim_conv
     66      real, intent(out), dimension(ngrid) :: zlcl,fraca0,w0,w_conv
     67      real, intent(out), dimension(ngrid) :: therm_tke_max0,env_tke_max0,n2,s2,ale_bl_stat
     68      real, intent(out), dimension(ngrid,nlay) :: therm_tke_max,env_tke_max
     69      real, intent(out), dimension(ngrid) :: alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke
     70      real, intent(out), dimension(ngrid) :: alp_bl_conv,alp_bl_stat
     71
     72!=============================================================================================
     73!------Local
     74!=============================================================================================
    7475
    7576      REAL susqr2pi, reuler
    76 
    7777      INTEGER ig,k,l
    78       INTEGER lmax(klon),lalim(klon)
    79       real zmax(klon),zw2(klon,klev+1)
    80 
    81 !on garde le zmax du pas de temps precedent
    82 
    83 
    84       real fraca(klon,klev+1)
    85       real wth3(klon,klev)
    86 ! FH probleme de dimensionnement avec l'allocation dynamique
    87 !     common/comtherm/thetath2,wth2
    88       real rhobarz(klon,klev)
    89 
    90       real wmax_sec(klon)
    91       real fm0(klon,klev+1),entr0(klon,klev)
    92       real fm(klon,klev+1)
    93 
    94 !niveau de condensation
    95       real pcon(klon)
    96 
    97       real alim_star(klon,klev)
    98 
    99 !!! nrlmd le 10/04/2012
    100 
    101 !------Entrées
    102       real pbl_tke(klon,klev+1,nbsrf)
    103       real pctsrf(klon,nbsrf)
    104       real omega(klon,klev)
    105       real airephy(klon)
    106 !------Sorties
    107       real zlcl(klon),fraca0(klon),w0(klon),w_conv(klon)
    108       real therm_tke_max0(klon),env_tke_max0(klon)
    109       real n2(klon),s2(klon)
    110       real ale_bl_stat(klon)
    111       real therm_tke_max(klon,klev),env_tke_max(klon,klev)
    112       real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
    113 !------Local
    11478      integer nsrf
    115       real rhobarz0(klon)                    ! Densité au LCL
    116       logical ok_lcl(klon)                   ! Existence du LCL des thermiques
    117       integer klcl(klon)                     ! Niveau du LCL
    118       real interp(klon)                      ! Coef d'interpolation pour le LCL
     79      real rhobarz0(ngrid)                    ! Densité au LCL
     80      logical ok_lcl(ngrid)                   ! Existence du LCL des thermiques
     81      integer klcl(ngrid)                     ! Niveau du LCL
     82      real interp(ngrid)                      ! Coef d'interpolation pour le LCL
    11983!--Triggering
    120       real Su                                ! Surface unité: celle d'un updraft élémentaire
    121       parameter(Su=4e4)
    122       real hcoef                             ! Coefficient directeur pour le calcul de s2
    123       parameter(hcoef=1)
    124       real hmincoef                          ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2
    125       parameter(hmincoef=0.3)
    126       real eps1                              ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
    127       parameter(eps1=0.3)
    128       real hmin(ngrid)                       ! Ordonnée à l'origine pour le calcul de s2
    129       real zmax_moy(ngrid)                   ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
    130       real zmax_moy_coef
    131       parameter(zmax_moy_coef=0.33)
    132       real depth(klon)                       ! Epaisseur moyenne du cumulus
    133       real w_max(klon)                       ! Vitesse max statistique
    134       real s_max(klon)
     84      real, parameter :: su_cst=4e4              ! Surface unite: celle d'un updraft élémentaire
     85      real, parameter :: hcoef=1             ! Coefficient directeur pour le calcul de s2
     86      real, parameter :: hmincoef=0.3        ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2
     87      real, parameter :: eps1=0.3            ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
     88      real, dimension(ngrid) :: hmin         ! Ordonnée à l'origine pour le calcul de s2
     89      real, dimension(ngrid) :: zmax_moy     ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
     90      real, parameter :: zmax_moy_coef=0.33
     91      real, dimension(ngrid) :: depth        ! Epaisseur moyenne du cumulus
     92      real, dimension(ngrid) ::  w_max                 ! Vitesse max statistique
     93      real, dimension(ngrid) ::  s_max(ngrid)
    13594!--Closure
    136       real pbl_tke_max(klon,klev)            ! Profil de TKE moyenne
    137       real pbl_tke_max0(klon)                ! TKE moyenne au LCL
    138       real w_ls(klon,klev)                   ! Vitesse verticale grande échelle (m/s)
    139       real coef_m                            ! On considère un rendement pour alp_bl_fluct_m
    140       parameter(coef_m=1.)
    141       real coef_tke                          ! On considère un rendement pour alp_bl_fluct_tke
    142       parameter(coef_tke=1.)
    143 
    144 !!! fin nrlmd le 10/04/2012
    145 
    146 !
    147       !nouvelles variables pour la convection
    148       real ale_bl(klon)
    149       real alp_bl(klon)
    150       real alp_int(klon),dp_int(klon),zdp
    151       real fm_tot(klon)
    152       real wght_th(klon,klev)
    153       integer lalim_conv(klon)
    154 !v1d     logical therm
    155 !v1d     save therm
    156 
     95      real, dimension(ngrid,nlay) :: pbl_tke_max       ! Profil de TKE moyenne
     96      real, dimension(ngrid) :: pbl_tke_max0           ! TKE moyenne au LCL
     97      real, dimension(ngrid,nlay) :: w_ls              ! Vitesse verticale grande échelle (m/s)
     98      real, parameter :: coef_m=1.            ! On considère un rendement pour alp_bl_fluct_m
     99      real, parameter :: coef_tke=1.          ! On considère un rendement pour alp_bl_fluct_tke
     100      real :: zdp
     101      real, dimension(ngrid) :: alp_int,dp_int
     102      real, dimension(ngrid) :: fm_tot
    157103
    158104!------------------------------------------------------------
    159105!  Initialize output arrays related to stochastic triggering
    160106!------------------------------------------------------------
    161   DO ig = 1,klon
     107  DO ig = 1,ngrid
    162108     zlcl(ig) = 0.
    163109     fraca0(ig) = 0.
    … …  
    175121     alp_bl_stat(ig) = 0.
    176122  ENDDO
    177   DO l = 1,klev
    178     DO ig = 1,klon
     123  DO l = 1,nlay
     124    DO ig = 1,ngrid
    179125     therm_tke_max(ig,l) = 0.
    180126     env_tke_max(ig,l) = 0.
    181127    ENDDO
    182128  ENDDO
    183 !------------------------------------------------------------
    184 
    185129
    186130!------------Test sur le LCL des thermiques
    187131    do ig=1,ngrid
    188132      ok_lcl(ig)=.false.
    189       if ( (pcon(ig) .gt. pplay(ig,klev-1)) .and. (pcon(ig) .lt. pplay(ig,1)) ) ok_lcl(ig)=.true.
     133      if ( (pcon(ig) .gt. pplay(ig,nlay-1)) .and. (pcon(ig) .lt. pplay(ig,1)) ) ok_lcl(ig)=.true.
    190134    enddo
    191135
    … …  
    207151    enddo
    208152
    209 !------------Hauteur des thermiques
    210 !!jyg le 27/04/2012
    211 !!    do ig =1,ngrid
    212 !!    rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &
    213 !! &               -rhobarz(ig,klcl(ig)))*interp(ig)
    214 !!    zlcl(ig)=(pplev(ig,1)-pcon(ig))/(rhobarz0(ig)*RG)
    215 !!      if ( (.not.ok_lcl(ig)) .or. (zlcl(ig).gt.zmax(ig)) ) zlcl(ig)=zmax(ig) ! Si zclc > zmax alors on pose zlcl = zmax
    216 !!    enddo
    217153    do ig =1,ngrid
    218154!CR:REHABILITATION ZMAX CONTINU
    … …  
    257193
    258194!-----Calcul de la TKE transportée par les thermiques : therm_tke_max
    259    call thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &
    260   &           rg,pplev,therm_tke_max)
     195   call thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &  ! in
     196  &           rg,pplev,therm_tke_max)                               ! out
    261197!   print *,' thermcell_tke_transport -> '   !!jyg
    262198
    … …  
    330266!   print *,'avant Calcul de Wmax '    !!jyg
    331267
    332 !-----Calcul de Wmax et ALE_BL_STAT associée
    333 !!jyg le 30/04/2012
    334 !!   do ig=1,ngrid
    335 !!     if ( (depth(ig).ge.10.) .and. (s_max(ig).gt.1.) ) then
    336 !!     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))))
    337 !!     ale_bl_stat(ig)=0.5*w_max(ig)**2
    338 !!     else
    339 !!     w_max(ig)=0.
    340 !!     ale_bl_stat(ig)=0.
    341 !!     endif
    342 !!   enddo
    343    susqr2pi=su*sqrt(2.*Rpi)
     268   susqr2pi=su_cst*sqrt(2.*Rpi)
    344269   reuler=exp(1.)
    345270   do ig=1,ngrid
    … …  
    409334      lalim_conv(:)=lalim(:)
    410335
    411       do k=1,klev
     336      do k=1,nlay
    412337         do ig=1,ngrid
    413338            if (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k)
    … …  
    417342! assez bizarre car, si on est dans la couche d'alim et que alim_star et
    418343! plus petit que 1.e-10, on prend wght_th=1.
    419       do k=1,klev
     344      do k=1,nlay
    420345         do ig=1,ngrid
    421346            if (k<=lalim_conv(ig).and.alim_star(ig,k)>1.e-10) then

  • LMDZ6/trunk/libf/phylmd/thermcell_closure.F90

    r2311 r4089  
    1717      IMPLICIT NONE
    1818
    19 #include "thermcell.h"
    2019INTEGER ngrid,nlay
    2120INTEGER ig,k       

  • LMDZ6/trunk/libf/phylmd/thermcell_env.F90

    r2311 r4089  
    1       SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
     1   SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
    22     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
    33
    … …  
    77!--------------------------------------------------------------
    88
    9       USE print_control_mod, ONLY: prt_level
    10       IMPLICIT NONE
    119
    12 #include "YOMCST.h"
    13 #include "YOETHF.h"
    14 #include "FCTTRE.h"     
     10   USE thermcell_ini_mod, ONLY : prt_level,RLvCp,RKAPPA,RETV
     11   IMPLICIT NONE
    1512
    16       INTEGER ngrid,nlay
    17       REAL po(ngrid,nlay)
    18       REAL pt(ngrid,nlay)
    19       REAL pu(ngrid,nlay)
    20       REAL pv(ngrid,nlay)
    21       REAL pplay(ngrid,nlay)
    22       REAL pplev(ngrid,nlay+1)
    23       integer lev_out                           ! niveau pour les print
     13! arguments
    2414
    25       REAL zo(ngrid,nlay)
    26       REAL zl(ngrid,nlay)
    27       REAL zh(ngrid,nlay)
    28       REAL ztv(ngrid,nlay)
    29       REAL zthl(ngrid,nlay)
    30       REAL zpspsk(ngrid,nlay)
    31       REAL zu(ngrid,nlay)
    32       REAL zv(ngrid,nlay)
    33       REAL pqsat(ngrid,nlay)
     15   integer,intent(in) :: ngrid,nlay,lev_out
     16   real,intent(in), dimension(ngrid,nlay) :: po,pt,pu,pv,pplay
     17   real,intent(in), dimension(ngrid,nlay+1) :: pplev
     18   real,intent(out), dimension(ngrid,nlay) :: zo,zl,zh,ztv,zthl
     19   real,intent(out), dimension(ngrid,nlay) :: zpspsk,zu,zv,pqsat
     20   
     21! Local
    3422
    35       INTEGER ig,ll
    36 
    37       real dqsat_dT
    38       real RLvCp
    39 
    40 logical mask(ngrid,nlay)
     23   integer ig,ll
     24   real dqsat_dT
     25   logical mask(ngrid,nlay)
    4126
    4227
    … …  
    4530!------------------
    4631
    47 mask(:,:)=.true.
    48 RLvCp = RLVTT/RCPD
     32   mask(:,:)=.true.
    4933
    5034!
    5135! calcul des caracteristiques de l environnement
    52        DO  ll=1,nlay
    53          DO ig=1,ngrid
    54             zo(ig,ll)=po(ig,ll)
    55             zl(ig,ll)=0.
    56             zh(ig,ll)=pt(ig,ll)
    57          EndDO
    58        EndDO
    59 !
    60 !
     36   DO  ll=1,nlay
     37     DO ig=1,ngrid
     38        zo(ig,ll)=po(ig,ll)
     39        zl(ig,ll)=0.
     40        zh(ig,ll)=pt(ig,ll)
     41     enddo
     42   enddo
     43
    6144! Condensation :
    6245!---------------
    6346! Calcul de l'humidite a saturation et de la condensation
    6447
    65 call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
    66 DO ll=1,nlay
    67    DO ig=1,ngrid
    68       zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
    69       zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
    70       zo(ig,ll) = po(ig,ll)-zl(ig,ll)
    71    ENDDO
    72 ENDDO
    73 !
    74 !
     48   call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
     49   do ll=1,nlay
     50      do ig=1,ngrid
     51         zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
     52         zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
     53         zo(ig,ll) = po(ig,ll)-zl(ig,ll)
     54      enddo
     55   enddo
     56
    7557!-----------------------------------------------------------------------
     58   if (prt_level.ge.1) print*,'0 OK convect8'
    7659
    77       if (prt_level.ge.1) print*,'0 OK convect8'
    78 
    79       DO ll=1,nlay
    80          DO ig=1,ngrid
    81              zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
    82              zu(ig,ll)=pu(ig,ll)
    83              zv(ig,ll)=pv(ig,ll)
     60   do ll=1,nlay
     61      do ig=1,ngrid
     62          zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
     63          zu(ig,ll)=pu(ig,ll)
     64          zv(ig,ll)=pv(ig,ll)
    8465!attention zh est maintenant le profil de T et plus le profil de theta !
    8566! Quelle horreur ! A eviter.
    86 !
    8767!   T-> Theta
    8868            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
    … …  
    9272            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
    9373!           
    94          ENDDO
    95       ENDDO
     74      enddo
     75   enddo
    9676 
    97       RETURN
    98       END
     77   RETURN
     78   END

  • LMDZ6/trunk/libf/phylmd/thermcell_flux2.F90

    r3102 r4089  
    1313!---------------------------------------------------------------------------
    1414
    15       USE print_control_mod, ONLY: prt_level
     15      USE thermcell_ini_mod, ONLY : prt_level,iflag_thermals_optflux
    1616      IMPLICIT NONE
    17 #include "thermcell.h"
    1817     
    1918      INTEGER ig,l

  • LMDZ6/trunk/libf/phylmd/thermcell_height.F90

    r2311 r4089  
    66!-----------------------------------------------------------------------------
    77      IMPLICIT NONE
    8 #include "thermcell.h"
    98
    109      INTEGER ig,l

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

    r3451 r4089  
    1 !
     1
    22! $Id$
    33!
    4       SUBROUTINE thermcell_main(itap,ngrid,nlay,ptimestep  &
     4      subroutine thermcell_main(itap,ngrid,nlay,ptimestep  &
    55     &                  ,pplay,pplev,pphi,debut  &
    66     &                  ,pu,pv,pt,po  &
    … …  
    88     &                  ,fm0,entr0,detr0,zqta,zqla,lmax  &
    99     &                  ,ratqscth,ratqsdiff,zqsatth  &
    10      &                  ,Ale_bl,Alp_bl,lalim_conv,wght_th &
    1110     &                  ,zmax0, f0,zw2,fraca,ztv &
    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      &                  ,ztva  )
    22 
    23       USE dimphy
    24       USE ioipsl
    25       USE indice_sol_mod
    26       USE print_control_mod, ONLY: lunout,prt_level
     11     &                  ,zpspsk,ztla,zthl,ztva &
     12     &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
     13#ifdef ISO         
     14     &      ,xtpo,xtpdoadj &
     15#endif         
     16     &   )
     17
     18
     19      USE thermcell_ini_mod, ONLY: thermcell_ini,dqimpl,dvdq,prt_level,lunout,prt_level
     20      USE thermcell_ini_mod, ONLY: iflag_thermals_closure,iflag_thermals_ed,tau_thermals,r_aspect_thermals
     21      USE thermcell_ini_mod, ONLY: RD,RG
     22
     23#ifdef ISO
     24  USE infotrac_phy, ONLY : ntraciso
     25#ifdef ISOVERIF
     26  USE isotopes_mod, ONLY : iso_eau,iso_HDO
     27  USE isotopes_verif_mod, ONLY: iso_verif_egalite, &
     28        iso_verif_aberrant_encadre
     29#endif
     30#endif
     31
     32
    2733      IMPLICIT NONE
    2834
    … …  
    6268!   -------------
    6369
    64 #include "YOMCST.h"
    65 #include "YOETHF.h"
    66 #include "FCTTRE.h"
    67 #include "thermcell.h"
    6870
    6971!   arguments:
    7072!   ----------
    71 
    72 !IM 140508
    73       INTEGER itap
    74 
    75       INTEGER ngrid,nlay
    76       real ptimestep
    77       REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
    78       REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
    79       REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
    80       REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
    81       REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
    82       real pphi(ngrid,nlay)
    83       LOGICAL debut
     73      integer, intent(in) :: itap,ngrid,nlay
     74      real, intent(in) ::  ptimestep
     75      real, intent(in), dimension(ngrid,nlay)    :: pt,pu,pv,po,pplay,pphi,zpspsk
     76      real, intent(in), dimension(ngrid,nlay+1)  :: pplev
     77      real, intent(out), dimension(ngrid,nlay)   :: pdtadj,pduadj,pdvadj,pdoadj,entr0,detr0
     78      real, intent(out), dimension(ngrid,nlay)   :: ztla,zqla,zqta,zqsatth,zthl
     79      real, intent(out), dimension(ngrid,nlay+1) :: fm0,zw2,fraca
     80      real, intent(out), dimension(ngrid) :: zmax0,f0
     81      real, intent(out), dimension(ngrid,nlay) :: ztva,ztv
     82      logical, intent(in) :: debut
     83
     84      real, intent(out), dimension(ngrid) :: pcon
     85      real, intent(out), dimension(ngrid,nlay) :: rhobarz,wth3
     86      real, intent(out), dimension(ngrid) :: wmax_sec
     87      integer,intent(out), dimension(ngrid) :: lalim
     88      real, intent(out), dimension(ngrid,nlay+1) :: fm
     89      real, intent(out), dimension(ngrid,nlay) :: alim_star
     90      real, intent(out), dimension(ngrid) :: zmax
    8491
    8592!   local:
    8693!   ------
    8794
    88       integer icount
    89 
    90       integer, save :: dvdq=1,dqimpl=-1
    91 !$OMP THREADPRIVATE(dvdq,dqimpl)
    92       data icount/0/
    93       save icount
    94 !$OMP THREADPRIVATE(icount)
    9595
    9696      integer,save :: igout=1
    … …  
    101101!$OMP THREADPRIVATE(lev_out)
    102102
    103       REAL susqr2pi, Reuler
    104 
    105       INTEGER ig,k,l,ll,ierr
    106       real zsortie1d(klon)
    107       INTEGER lmax(klon),lmin(klon),lalim(klon)
    108       INTEGER lmix(klon)
    109       INTEGER lmix_bis(klon)
    110       real linter(klon)
    111       real zmix(klon)
    112       real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1),ztva_est(klon,klev)
    113 !      real fraca(klon,klev)
    114 
    115       real zmax_sec(klon)
    116 !on garde le zmax du pas de temps precedent
    117       real zmax0(klon)
    118 !FH/IM     save zmax0
    119 
    120       real lambda
    121 
    122       real zlev(klon,klev+1),zlay(klon,klev)
    123       real deltaz(klon,klev)
    124       REAL zh(klon,klev)
    125       real zthl(klon,klev),zdthladj(klon,klev)
    126       REAL ztv(klon,klev)
    127       real zu(klon,klev),zv(klon,klev),zo(klon,klev)
    128       real zl(klon,klev)
    129       real zsortie(klon,klev)
    130       real zva(klon,klev)
    131       real zua(klon,klev)
    132       real zoa(klon,klev)
    133 
    134       real zta(klon,klev)
    135       real zha(klon,klev)
    136       real fraca(klon,klev+1)
    137       real zf,zf2
    138       real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev)
    139       real q2(klon,klev)
    140 ! FH probleme de dimensionnement avec l'allocation dynamique
    141 !     common/comtherm/thetath2,wth2
    142       real wq(klon,klev)
    143       real wthl(klon,klev)
    144       real wthv(klon,klev)
    145    
    146       real ratqscth(klon,klev)
    147       real var
    148       real vardiff
    149       real ratqsdiff(klon,klev)
    150 
     103      real lambda, zf,zf2,var,vardiff,CHI
     104      integer ig,k,l,ierr,ll
    151105      logical sorties
    152       real rho(klon,klev),rhobarz(klon,klev),masse(klon,klev)
    153       real zpspsk(klon,klev)
    154 
    155       real wmax(klon)
    156       real wmax_tmp(klon)
    157       real wmax_sec(klon)
    158       real fm0(klon,klev+1),entr0(klon,klev),detr0(klon,klev)
    159       real fm(klon,klev+1),entr(klon,klev),detr(klon,klev)
    160 
    161       real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev)
    162 !niveau de condensation
    163       integer nivcon(klon)
    164       real zcon(klon)
    165       REAL CHI
    166       real zcon2(klon)
    167       real pcon(klon)
    168       real zqsat(klon,klev)
    169       real zqsatth(klon,klev)
    170 
    171       real f_star(klon,klev+1),entr_star(klon,klev)
    172       real detr_star(klon,klev)
    173       real alim_star_tot(klon)
    174       real alim_star(klon,klev)
    175       real alim_star_clos(klon,klev)
    176       real f(klon), f0(klon)
    177 !FH/IM     save f0
    178       real zlevinter(klon)
    179        real seuil
    180       real csc(klon,klev)
    181 
    182 !!! nrlmd le 10/04/2012
    183 
    184 !------Entrées
    185       real pbl_tke(klon,klev+1,nbsrf)
    186       real pctsrf(klon,nbsrf)
    187       real omega(klon,klev)
    188       real airephy(klon)
    189 !------Sorties
    190       real zlcl(klon),fraca0(klon),w0(klon),w_conv(klon)
    191       real therm_tke_max0(klon),env_tke_max0(klon)
    192       real n2(klon),s2(klon)
    193       real ale_bl_stat(klon)
    194       real therm_tke_max(klon,klev),env_tke_max(klon,klev)
    195       real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
    196 !------Local
    197       integer nsrf
    198       real rhobarz0(klon)                    ! Densité au LCL
    199       logical ok_lcl(klon)                   ! Existence du LCL des thermiques
    200       integer klcl(klon)                     ! Niveau du LCL
    201       real interp(klon)                      ! Coef d'interpolation pour le LCL
    202 !--Triggering
    203       real Su                                ! Surface unité: celle d'un updraft élémentaire
    204       parameter(Su=4e4)
    205       real hcoef                             ! Coefficient directeur pour le calcul de s2
    206       parameter(hcoef=1)
    207       real hmincoef                          ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2
    208       parameter(hmincoef=0.3)
    209       real eps1                              ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
    210       parameter(eps1=0.3)
    211       real hmin(ngrid)                       ! Ordonnée à l'origine pour le calcul de s2
    212       real zmax_moy(ngrid)                   ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
    213       real zmax_moy_coef
    214       parameter(zmax_moy_coef=0.33)
    215       real depth(klon)                       ! Epaisseur moyenne du cumulus
    216       real w_max(klon)                       ! Vitesse max statistique
    217       real s_max(klon)
    218 !--Closure
    219       real pbl_tke_max(klon,klev)            ! Profil de TKE moyenne
    220       real pbl_tke_max0(klon)                ! TKE moyenne au LCL
    221       real w_ls(klon,klev)                   ! Vitesse verticale grande échelle (m/s)
    222       real coef_m                            ! On considère un rendement pour alp_bl_fluct_m
    223       parameter(coef_m=1.)
    224       real coef_tke                          ! On considère un rendement pour alp_bl_fluct_tke
    225       parameter(coef_tke=1.)
    226 
    227 !!! fin nrlmd le 10/04/2012
    228 
    229 !
    230       !nouvelles variables pour la convection
    231       real Ale_bl(klon)
    232       real Alp_bl(klon)
    233       real alp_int(klon),dp_int(klon),zdp
    234       real ale_int(klon)
    235       integer n_int(klon)
    236       real fm_tot(klon)
    237       real wght_th(klon,klev)
    238       integer lalim_conv(klon)
    239 !v1d     logical therm
    240 !v1d     save therm
    241 
    242       character*2 str2
    243       character*10 str10
     106      real, dimension(ngrid) :: linter,zmix, zmax_sec
     107      integer,dimension(ngrid) :: lmax,lmin,lmix,lmix_bis,nivcon
     108      real, dimension(ngrid,nlay) :: ztva_est
     109      real, dimension(ngrid,nlay) :: deltaz,zlay,zh,zdthladj,zu,zv,zo,zl,zva,zua,zoa
     110      real, dimension(ngrid,nlay) :: zta,zha,q2,wq,wthl,wthv,thetath2,wth2
     111      real, dimension(ngrid,nlay) :: ratqscth,ratqsdiff,rho,masse
     112      real, dimension(ngrid,nlay+1) :: zw_est,zlev
     113      real, dimension(ngrid) :: wmax,wmax_tmp
     114      real, dimension(ngrid,nlay+1) :: f_star
     115      real, dimension(ngrid,nlay) :: entr,detr,entr_star,detr_star,alim_star_clos
     116      real, dimension(ngrid,nlay) :: zqsat,csc
     117      real, dimension(ngrid) :: zcon,zcon2,alim_star_tot,f
    244118
    245119      character (len=20) :: modname='thermcell_main'
    246120      character (len=80) :: abort_message
    247121
    248       EXTERNAL SCOPY
     122
     123#ifdef ISO
     124      REAL xtpo(ntraciso,ngrid,nlay),xtpdoadj(ntraciso,ngrid,nlay)
     125      REAL xtzo(ntraciso,ngrid,nlay)
     126      REAL xtpdoadj_tmp(ngrid,nlay)
     127      REAL xtpo_tmp(ngrid,nlay)
     128      REAL xtzo_tmp(ngrid,nlay)
     129      integer ixt
     130#endif
     131
    249132!
    250133
    … …  
    253136!   ---------------
    254137!
    255 
    256    seuil=0.25
    257 
    258    if (debut) then
    259       if (iflag_thermals==15.or.iflag_thermals==16) then
    260          dvdq=0
    261          dqimpl=-1
    262       else
    263          dvdq=1
    264          dqimpl=1
    265       endif
    266 
    267       fm0=0.
    268       entr0=0.
    269       detr0=0.
    270    endif
     138    print*,'NEW THERMCELL cool'
     139
     140
    271141   fm=0. ; entr=0. ; detr=0.
    272    icount=icount+1
    273 
    274 !IM 090508 beg
    275 !print*,'====================================================================='
    276 !print*,'====================================================================='
    277 !print*,' PAS ',icount,' PAS ',icount,' PAS ',icount,' PAS ',icount
    278 !print*,'====================================================================='
    279 !print*,'====================================================================='
    280 !IM 090508 end
    281142
    282143      if (prt_level.ge.1) print*,'thermcell_main V4'
    283144
    284145       sorties=.true.
    285       IF(ngrid.NE.klon) THEN
     146      IF(ngrid.NE.ngrid) THEN
    286147         PRINT*
    287148         PRINT*,'STOP dans convadj'
    288149         PRINT*,'ngrid    =',ngrid
    289          PRINT*,'klon  =',klon
     150         PRINT*,'ngrid  =',ngrid
    290151      ENDIF
    291152!
    292153!     write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
    293      do ig=1,klon
     154     do ig=1,ngrid
    294155         f0(ig)=max(f0(ig),1.e-2)
    295156         zmax0(ig)=max(zmax0(ig),40.)
    … …  
    336197         zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG
    337198      enddo
    338          zlev(:,1)=0.
    339          zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG
     199      zlev(:,1)=0.
     200      zlev(:,nlay+1)=(2.*pphi(:,nlay)-pphi(:,nlay-1))/RG
    340201      do l=1,nlay
    341202         zlay(:,l)=pphi(:,l)/RG
    342203      enddo
    343 !calcul de l epaisseur des couches
    344204      do l=1,nlay
    345205         deltaz(:,l)=zlev(:,l+1)-zlev(:,l)
    346206      enddo
    347207
    348 !     print*,'2 OK convect8'
    349208!-----------------------------------------------------------------------
    350 !   Calcul des densites
     209!   Calcul des densites et masses
    351210!-----------------------------------------------------------------------
    352211
    353      rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:))
    354 
    355      if (prt_level.ge.10)write(lunout,*)                                &
    356     &    'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
     212      rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:))
     213      if (prt_level.ge.10) write(lunout,*) 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
    357214      rhobarz(:,1)=rho(:,1)
    358 
    359215      do l=2,nlay
    360216         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
    361217      enddo
    362 
    363 !calcul de la masse
    364218      do l=1,nlay
    365219         masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG
    366220      enddo
    367 
    368221      if (prt_level.ge.1) print*,'thermcell_main apres initialisation'
    369222
    … …  
    480333      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
    481334
    482       call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
    483       call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
     335      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
     336      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
    484337
    485338      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
    … …  
    509362
    510363
    511       call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
    512       call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
    513       call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
    514       call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
     364      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
     365      call test_ltherm(ngrid,nlay,pplay,lmin ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
     366      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
     367      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
    515368
    516369      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
    … …  
    526379
    527380 
    528 call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
    529 call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
     381call test_ltherm(ngrid,nlay,pplay,lmin,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
     382call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
    530383
    531384      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry'
    … …  
    582435!-------------------------------------------------------------------------------
    583436!deduction des flux
    584 !-------------------------------------------------------------------------------
    585437
    586438      CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, &
    … …  
    591443
    592444      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux'
    593       call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
    594       call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
     445      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
     446      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
    595447
    596448!------------------------------------------------------------------
    … …  
    620472     &                   po,pdoadj,zoa,lev_out)
    621473
     474#ifdef ISO
     475        ! C Risi: on utilise directement la même routine
     476        do ixt=1,ntraciso
     477          do ll=1,nlay
     478            DO ig=1,ngrid
     479                xtpo_tmp(ig,ll)=xtpo(ixt,ig,ll)
     480                xtzo_tmp(ig,ll)=xtzo(ixt,ig,ll)
     481            enddo
     482          enddo
     483          call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
     484     &                   xtpo_tmp,xtpdoadj_tmp,xtzo_tmp,lev_out)
     485          do ll=1,nlay
     486            DO ig=1,ngrid
     487                xtpdoadj(ixt,ig,ll)=xtpdoadj_tmp(ig,ll)
     488            enddo
     489          enddo
     490        enddo !do ixt=1,ntraciso
     491#endif
     492
     493#ifdef ISO     
     494#ifdef ISOVERIF
     495      DO  ll=1,nlay
     496        DO ig=1,ngrid
     497          if (iso_eau.gt.0) then
     498              call iso_verif_egalite(xtpo(iso_eau,ig,ll), &
     499     &          po(ig,ll),'thermcell_main 594')
     500              call iso_verif_egalite(xtpdoadj(iso_eau,ig,ll), &
     501     &          pdoadj(ig,ll),'thermcell_main 596')
     502          endif
     503          if (iso_HDO.gt.0) then
     504              call iso_verif_aberrant_encadre(xtpo(iso_hdo,ig,ll) &
     505     &           /po(ig,ll),'thermcell_main 610')
     506          endif
     507        enddo
     508      enddo !DO  ll=1,nlay
     509      write(*,*) 'thermcell_main 600 tmp: apres thermcell_dq'
     510#endif     
     511#endif
     512
     513
     514
    622515!------------------------------------------------------------------
    623516! Calcul de la fraction de l'ascendance
    624517!------------------------------------------------------------------
    625       do ig=1,klon
     518      do ig=1,ngrid
    626519         fraca(ig,1)=0.
    627520         fraca(ig,nlay+1)=0.
    628521      enddo
    629522      do l=2,nlay
    630          do ig=1,klon
     523         do ig=1,ngrid
    631524            if (zw2(ig,l).gt.1.e-10) then
    632525            fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
    … …  
    760653         enddo
    761654      enddo
    762 !
    763 ! $Id$
    764 !
    765       CALL thermcell_alp(ngrid,nlay,ptimestep  &
    766      &                  ,pplay,pplev  &
    767      &                  ,fm0,entr0,lmax  &
    768      &                  ,Ale_bl,Alp_bl,lalim_conv,wght_th &
    769      &                  ,zw2,fraca &
    770 !!! necessire en plus
    771      &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
    772 !!! nrlmd le 10/04/2012
    773      &                  ,pbl_tke,pctsrf,omega,airephy &
    774      &                  ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
    775      &                  ,n2,s2,ale_bl_stat &
    776      &                  ,therm_tke_max,env_tke_max &
    777      &                  ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
    778      &                  ,alp_bl_conv,alp_bl_stat &
    779 !!! fin nrlmd le 10/04/2012
    780      &                   )
    781 
    782 
    783655
    784656!calcul du ratqscdiff
    … …  
    788660      ratqsdiff(:,:)=0.
    789661
    790       do l=1,klev
     662      do l=1,nlay
    791663         do ig=1,ngrid
    792664            if (l<=lalim(ig)) then
    … …  
    798670      if (prt_level.ge.1) print*,'14f OK convect8'
    799671
    800       do l=1,klev
     672      do l=1,nlay
    801673         do ig=1,ngrid
    802674            if (l<=lalim(ig)) then
    … …  
    809681
    810682      if (prt_level.ge.1) print*,'14g OK convect8'
    811       do l=1,nlay
    812          do ig=1,ngrid
    813             ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
    814 !           write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
    815          enddo
    816       enddo
    817 !--------------------------------------------------------------------   
    818 !
    819 !ecriture des fichiers sortie
    820 !     print*,'15 OK convect8 CCCCCCCCCCCCCCCCCCc'
    821 
     683         do l=1,nlay
     684            do ig=1,ngrid
     685               ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
     686            enddo
     687         enddo
    822688      endif
    823689
    … …  
    825691
    826692      return
    827       end
    828 
    829 !-----------------------------------------------------------------------------
    830 
    831       subroutine test_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment)
    832       USE print_control_mod, ONLY: prt_level
     693      end subroutine thermcell_main
     694
     695!=============================================================================
     696!/////////////////////////////////////////////////////////////////////////////
     697!=============================================================================
     698      subroutine test_ltherm(ngrid,nlay,pplay,long,ztv,po,ztva, &  ! in
     699    &            zqla,f_star,zw2,comment)                          ! in
     700!=============================================================================
     701      USE thermcell_ini_mod, ONLY: prt_level
    833702      IMPLICIT NONE
    834703
    835       integer i, k, klon,klev
    836       real pplev(klon,klev+1),pplay(klon,klev)
    837       real ztv(klon,klev)
    838       real po(klon,klev)
    839       real ztva(klon,klev)
    840       real zqla(klon,klev)
    841       real f_star(klon,klev)
    842       real zw2(klon,klev)
    843       integer long(klon)
     704      integer i, k, ngrid,nlay
     705      real, intent(in), dimension(ngrid,nlay) :: pplay,ztv,po,ztva,zqla
     706      real, intent(in), dimension(ngrid,nlay) :: f_star,zw2
     707      integer, intent(in), dimension(ngrid) :: long
    844708      real seuil
    845709      character*21 comment
     710      seuil=0.25
    846711
    847712      if (prt_level.ge.1) THEN
    … …  
    851716
    852717!  test sur la hauteur des thermiques ...
    853          do i=1,klon
     718         do i=1,ngrid
    854719!IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
    855720           if (prt_level.ge.10) then
    856721               print*,'WARNING ',comment,' au point ',i,' K= ',long(i)
    857722               print*,'  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
    858                do k=1,klev
     723               do k=1,nlay
    859724                  write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
    860725               enddo
    … …  
    866731      end
    867732
    868 !!! nrlmd le 10/04/2012                          Transport de la TKE par le thermique moyen pour la fermeture en ALP
    869 !                                                         On transporte pbl_tke pour donner therm_tke
    870 !                                          Copie conforme de la subroutine DTKE dans physiq.F écrite par Frederic Hourdin
    871       subroutine thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &
    872      &           rg,pplev,therm_tke_max)
    873       USE print_control_mod, ONLY: prt_level
     733! nrlmd le 10/04/2012   Transport de la TKE par le thermique moyen pour la fermeture en ALP
     734!                       On transporte pbl_tke pour donner therm_tke
     735!                       Copie conforme de la subroutine DTKE dans physiq.F écrite par Frederic Hourdin
     736
     737!=======================================================================
     738!///////////////////////////////////////////////////////////////////////
     739!=======================================================================
     740
     741      subroutine thermcell_tke_transport( &
     742     &     ngrid,nlay,ptimestep,fm0,entr0,rg,pplev,  &   ! in
     743     &     therm_tke_max)                                ! out
     744      USE thermcell_ini_mod, ONLY: prt_level
    874745      implicit none
    875746
    … …  
    882753!=======================================================================
    883754
    884       integer ngrid,nlay,nsrf
    885 
    886       real ptimestep
    887       real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1)
    888       real entr0(ngrid,nlay),rg
    889       real therm_tke_max(ngrid,nlay)
     755      integer ngrid,nlay
     756
     757      real, intent(in) :: ptimestep
     758      real, intent(in), dimension(ngrid,nlay+1) :: fm0,pplev
     759      real, intent(in), dimension(ngrid,nlay) :: entr0
     760      real, intent(in) :: rg
     761      real, intent(out), dimension(ngrid,nlay) :: therm_tke_max
     762
    890763      real detr0(ngrid,nlay)
    891 
    892 
     764      real masse0(ngrid,nlay)
    893765      real masse(ngrid,nlay),fm(ngrid,nlay+1)
    894766      real entr(ngrid,nlay)
    … …  
    897769
    898770      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
    899 
    900       real zzm
    901 
    902771      integer ig,k
    903       integer isrf
    904772
    905773
    … …  
    929797      fm(:,nlay+1)=0.
    930798
    931 !!! nrlmd le 16/09/2010
    932 !   calcul de la valeur dans les ascendances
    933 !       do ig=1,ngrid
    934 !          qa(ig,1)=q(ig,1)
    935 !       enddo
    936 !!!
    937 
    938 !do isrf=1,nsrf
    939 
    940 !   q(:,:)=therm_tke(:,:,isrf)
     799
    941800   q(:,:)=therm_tke_max(:,:)
    942801!!! nrlmd le 16/09/2010

  • LMDZ6/trunk/libf/phylmd/thermcell_plume.F90

    r3451 r4089  
    2121!   = 29 : an other way to compute the modified buoyancy (to be tested)
    2222!--------------------------------------------------------------------------
    23 USE IOIPSL, ONLY : getin
    24 USE ioipsl_getin_p_mod, ONLY : getin_p
    25 
    26        USE print_control_mod, ONLY: prt_level
     23       USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
     24       USE thermcell_ini_mod, ONLY: fact_epsilon, betalpha, afact, fact_shell
     25       USE thermcell_ini_mod, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
     26       USE thermcell_ini_mod, ONLY: mix0, thermals_flag_alim
     27
     28
    2729       IMPLICIT NONE
    28 
    29 #include "YOMCST.h"
    30 #include "YOETHF.h"
    31 #include "FCTTRE.h"
    32 #include "thermcell.h"
    3330
    3431      INTEGER itap
    … …  
    10198      real zbetalpha, coefzlmel
    10299      real eps
    103       REAL REPS,RLvCp,DDT0
    104       PARAMETER (DDT0=.01)
    105100      logical Zsat
    106101      LOGICAL active(ngrid),activetmp(ngrid)
    107102      REAL fact_gamma,fact_gamma2,fact_epsilon2
    108103
    109       REAL, SAVE :: fact_epsilon=0.002
    110       REAL, SAVE :: betalpha=0.9
    111       REAL, SAVE :: afact=2./3.
    112       REAL, SAVE :: fact_shell=1.
    113       REAL,SAVE :: detr_min=1.e-5
    114       REAL,SAVE :: entr_min=1.e-5
    115       REAL,SAVE :: detr_q_coef=0.012
    116       REAL,SAVE :: detr_q_power=0.5
    117       REAL,SAVE :: mix0=0.
    118       INTEGER,SAVE :: thermals_flag_alim=0
    119 
    120 !$OMP THREADPRIVATE(fact_epsilon, betalpha, afact, fact_shell)
    121 !$OMP THREADPRIVATE(detr_min, entr_min, detr_q_coef, detr_q_power)
    122 !$OMP THREADPRIVATE( mix0, thermals_flag_alim)
    123 
    124       LOGICAL, SAVE :: first=.true.
    125   !$OMP THREADPRIVATE(first)
    126 
    127104
    128105      REAL c2(ngrid,klev)
    … …  
    132109! Initialisation
    133110
    134       RLvCp = RLVTT/RCPD
    135       IF (first) THEN
    136 
    137      CALL getin_p('thermals_fact_epsilon',fact_epsilon)
    138      CALL getin_p('thermals_betalpha',betalpha)
    139      CALL getin_p('thermals_afact',afact)
    140      CALL getin_p('thermals_fact_shell',fact_shell)
    141      CALL getin_p('thermals_detr_min',detr_min)
    142      CALL getin_p('thermals_entr_min',entr_min)
    143      CALL getin_p('thermals_detr_q_coef',detr_q_coef)
    144      CALL getin_p('thermals_detr_q_power',detr_q_power)
    145      CALL getin_p('thermals_mix0',mix0)
    146      CALL getin_p('thermals_flag_alim',thermals_flag_alim)
    147 
    148 
    149       first=.false.
    150       ENDIF
    151111
    152112      zbetalpha=betalpha/(1.+betalpha)

  • LMDZ6/trunk/libf/phylmd/thermcell_plume_6A.F90

    r3451 r4089  
    1111!thermcell_plume: calcule les valeurs de qt, thetal et w dans l ascendance
    1212!--------------------------------------------------------------------------
    13 USE IOIPSL, ONLY : getin
    14 USE ioipsl_getin_p_mod, ONLY : getin_p
    15 
    16        USE print_control_mod, ONLY: prt_level
     13
     14       USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
     15       USE thermcell_ini_mod, ONLY: fact_epsilon, betalpha, afact, fact_shell
     16       USE thermcell_ini_mod, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
     17       USE thermcell_ini_mod, ONLY: mix0, thermals_flag_alim
     18
    1719       IMPLICIT NONE
    1820
    19 #include "YOMCST.h"
    20 #include "YOETHF.h"
    21 #include "FCTTRE.h"
    22 #include "thermcell.h"
    23 
    24       INTEGER itap
    25       INTEGER lunout1,igout
    26       INTEGER ngrid,klev
    27       REAL ptimestep
    28       REAL ztv(ngrid,klev)
    29       REAL zthl(ngrid,klev)
    30       REAL po(ngrid,klev)
    31       REAL zl(ngrid,klev)
    32       REAL rhobarz(ngrid,klev)
    33       REAL zlev(ngrid,klev+1)
    34       REAL pplev(ngrid,klev+1)
    35       REAL pphi(ngrid,klev)
    36       REAL zpspsk(ngrid,klev)
    37       REAL alim_star(ngrid,klev)
    38       REAL f0(ngrid)
    39       INTEGER lalim(ngrid)
    40       integer lev_out                           ! niveau pour les print
    41       integer nbpb
    42    
    43       real alim_star_tot(ngrid)
    44 
    45       REAL ztva(ngrid,klev)
    46       REAL ztla(ngrid,klev)
    47       REAL zqla(ngrid,klev)
    48       REAL zqta(ngrid,klev)
    49       REAL zha(ngrid,klev)
    50 
    51       REAL detr_star(ngrid,klev)
    52       REAL coefc
    53       REAL entr_star(ngrid,klev)
    54       REAL detr(ngrid,klev)
    55       REAL entr(ngrid,klev)
    56 
    57       REAL csc(ngrid,klev)
    58 
    59       REAL zw2(ngrid,klev+1)
    60       REAL w_est(ngrid,klev+1)
    61       REAL f_star(ngrid,klev+1)
    62       REAL wa_moy(ngrid,klev+1)
    63 
    64       REAL ztva_est(ngrid,klev)
    65       REAL ztv_est(ngrid,klev)
    66       REAL zqla_est(ngrid,klev)
    67       REAL zqsatth(ngrid,klev)
    68       REAL zta_est(ngrid,klev)
    69       REAL ztemp(ngrid),zqsat(ngrid)
     21      integer,intent(in) :: itap,lev_out,lunout1,igout,ngrid,klev
     22      real,intent(in) :: ptimestep
     23      real,intent(in),dimension(ngrid,klev) :: ztv
     24      real,intent(in),dimension(ngrid,klev) :: zthl
     25      real,intent(in),dimension(ngrid,klev) :: po
     26      real,intent(in),dimension(ngrid,klev) :: zl
     27      real,intent(in),dimension(ngrid,klev) :: rhobarz
     28      real,intent(in),dimension(ngrid,klev+1) :: zlev
     29      real,intent(in),dimension(ngrid,klev+1) :: pplev
     30      real,intent(in),dimension(ngrid,klev) :: pphi
     31      real,intent(in),dimension(ngrid,klev) :: zpspsk
     32      real,intent(in),dimension(ngrid) :: f0
     33
     34      integer,intent(out) :: lalim(ngrid)
     35      real,intent(out),dimension(ngrid,klev) :: alim_star
     36      real,intent(out),dimension(ngrid) :: alim_star_tot
     37      real,intent(out),dimension(ngrid,klev) :: detr_star
     38      real,intent(out),dimension(ngrid,klev) :: entr_star
     39      real,intent(out),dimension(ngrid,klev+1) :: f_star
     40      real,intent(out),dimension(ngrid,klev) :: csc
     41      real,intent(out),dimension(ngrid,klev) :: ztva
     42      real,intent(out),dimension(ngrid,klev) :: ztla
     43      real,intent(out),dimension(ngrid,klev) :: zqla
     44      real,intent(out),dimension(ngrid,klev) :: zqta
     45      real,intent(out),dimension(ngrid,klev) :: zha
     46      real,intent(out),dimension(ngrid,klev+1) :: zw2
     47      real,intent(out),dimension(ngrid,klev+1) :: w_est
     48      real,intent(out),dimension(ngrid,klev) :: ztva_est
     49      real,intent(out),dimension(ngrid,klev) :: zqsatth
     50      integer,intent(out),dimension(ngrid) :: lmix(ngrid)
     51      integer,intent(out),dimension(ngrid) :: lmix_bis(ngrid)
     52      real,intent(out),dimension(ngrid) :: linter(ngrid)
     53
    7054      REAL zdw2,zdw2bis
    7155      REAL zw2modif
    … …  
    7357      REAL zeps(ngrid,klev)
    7458
    75       REAL linter(ngrid)
    76       INTEGER lmix(ngrid)
    77       INTEGER lmix_bis(ngrid)
    7859      REAL    wmaxa(ngrid)
    7960
    8061      INTEGER ig,l,k,lt,it,lm
     62      integer nbpb
     63
     64      real,dimension(ngrid,klev) :: detr
     65      real,dimension(ngrid,klev) :: entr
     66      real,dimension(ngrid,klev+1) :: wa_moy
     67      real,dimension(ngrid,klev) :: ztv_est
     68      real,dimension(ngrid) :: ztemp,zqsat
     69      real,dimension(ngrid,klev) :: zqla_est
     70      real,dimension(ngrid,klev) :: zta_est
    8171
    8272      real zdz,zbuoy(ngrid,klev),zalpha,gamma(ngrid,klev),zdqt(ngrid,klev),zw2m
    … …  
    9181      real zbetalpha, coefzlmel
    9282      real eps
    93       REAL REPS,RLvCp,DDT0
    94       PARAMETER (DDT0=.01)
    9583      logical Zsat
    9684      LOGICAL active(ngrid),activetmp(ngrid)
    9785      REAL fact_gamma,fact_gamma2,fact_epsilon2
    98 
    99       REAL, SAVE :: fact_epsilon=0.002
    100       REAL, SAVE :: betalpha=0.9
    101       REAL, SAVE :: afact=2./3.
    102       REAL, SAVE :: fact_shell=1.
    103       REAL,SAVE :: detr_min=1.e-5
    104       REAL,SAVE :: entr_min=1.e-5
    105       REAL,SAVE :: detr_q_coef=0.012
    106       REAL,SAVE :: detr_q_power=0.5
    107       REAL,SAVE :: mix0=0.
    108       INTEGER,SAVE :: thermals_flag_alim=0
    109 
    110 !$OMP THREADPRIVATE(fact_epsilon, betalpha, afact, fact_shell)
    111 !$OMP THREADPRIVATE(detr_min, entr_min, detr_q_coef, detr_q_power)
    112 !$OMP THREADPRIVATE( mix0, thermals_flag_alim)
    113 
    114       LOGICAL, SAVE :: first=.true.
    115   !$OMP THREADPRIVATE(first)
    116 
    117 
     86      REAL coefc
    11887      REAL c2(ngrid,klev)
    11988
    … …  
    12291! Initialisation
    12392
    124       RLvCp = RLVTT/RCPD
    125       IF (first) THEN
    126 
    127      CALL getin_p('thermals_fact_epsilon',fact_epsilon)
    128      CALL getin_p('thermals_betalpha',betalpha)
    129      CALL getin_p('thermals_afact',afact)
    130      CALL getin_p('thermals_fact_shell',fact_shell)
    131      CALL getin_p('thermals_detr_min',detr_min)
    132      CALL getin_p('thermals_entr_min',entr_min)
    133      CALL getin_p('thermals_detr_q_coef',detr_q_coef)
    134      CALL getin_p('thermals_detr_q_power',detr_q_power)
    135      CALL getin_p('thermals_mix0',mix0)
    136      CALL getin_p('thermals_flag_alim',thermals_flag_alim)
    137 
    138 
    139       first=.false.
    140       ENDIF
    14193
    14294      zbetalpha=betalpha/(1.+betalpha)
    … …  
    786738!--------------------------------------------------------------------------
    787739
    788       USE print_control_mod, ONLY: prt_level
     740      USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
    789741      IMPLICIT NONE
    790 
    791 #include "YOMCST.h"
    792 #include "YOETHF.h"
    793 #include "FCTTRE.h"
    794 #include "thermcell.h"
    795742
    796743      INTEGER itap
    … …  
    857804      real betalpha,zbetalpha
    858805      real eps, afact
    859       REAL REPS,RLvCp,DDT0
    860       PARAMETER (DDT0=.01)
    861806      logical Zsat
    862807      LOGICAL active(ngrid),activetmp(ngrid)
    … …  
    866811! Initialisation
    867812
    868       RLvCp = RLVTT/RCPD
    869813      fact_epsilon=0.002
    870814      betalpha=0.9
    … …  
    923867
    924868!-------------------------------------------------------------------------
    925 ! Definition de l'alimentation a l'origine dans thermcell_init
     869! Definition de l'alimentation
    926870!-------------------------------------------------------------------------
    927871      do l=1,klev-1

  • LMDZ6/trunk/libf/phylmd/wake.F90

    r4085 r4089  
    280280  ! Initialisations
    281281  ! -------------------------------------------------------------------------
     282  ! ALON = 3.e5
     283  ! alon = 1.E6
     284
    282285  !  Provisionnal; to be suppressed when f_shear is parameterized
    283286  f_shear(:) = 1.       ! 0. for strong shear, 1. for weak shear

  • LMDZ6/trunk/libf/phylmdiso/calltherm.F90

    r4036 r4089  
    77     &      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs  &
    88     &      ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth,  &
    9      &       ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, &
     9     &       ratqsdiff,zqsatth,ale_bl,alp_bl,lalim_conv,wght_th, &
    1010     &       zmax0,f0,zw2,fraca,ztv,zpspsk,ztla,zthl &
    1111!!! nrlmd le 10/04/2012
    … …  
    3939
    4040      implicit none
    41       include "thermcell.h"
     41      include "clesphys.h"
     42      include "thermcell_old.h"
    4243
    4344
    … …  
    9495      real zqsatth(klon,klev) 
    9596!nouvelles variables pour la convection
    96       real Ale_bl(klon)
    97       real Alp_bl(klon)
    98       real Ale(klon)
    99       real Alp(klon)
     97      real ale_bl(klon)
     98      real alp_bl(klon)
     99      real ale(klon)
     100      real alp(klon)
    100101!RC
    101102      !on garde le zmax du pas de temps precedent
    … …  
    117118!********************************************************
    118119
     120      real, dimension(klon) :: pcon
     121      real, dimension(klon,klev) :: rhobarz,wth3
     122      integer,dimension(klon) :: lalim
     123      real, dimension(klon,klev+1) :: fm
     124      real, dimension(klon,klev) :: alim_star
     125      real, dimension(klon) :: zmax
     126
     127
     128
    119129
    120130! variables locales
    … …  
    130140      character (len=80) :: abort_message
    131141
    132       integer i,k
     142      integer i,k,isplit
    133143      logical, save :: first=.true.
     144      logical :: new_thermcell
    134145
    135146#ifdef ISO
    … …  
    173184         detr_therm(:,:)=0.
    174185
    175          Ale_bl(:)=0.
    176          Alp_bl(:)=0.
     186         ale_bl(:)=0.
     187         alp_bl(:)=0.
    177188         if (prt_level.ge.10) then
    178189          print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
    … …  
    207218         if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb   
    208219
    209 #ifdef ISO
     220
     221         new_thermcell=iflag_thermals>=15.and.iflag_thermals<=18
     222#ifdef ISO
     223      if (.not.new_thermcell) then
     224           CALL abort_gcm('calltherm 234','isos pas prevus ici',1)
     225      endif
    210226#ifdef ISOVERIF
    211227      if (iso_eau.gt.0) then
    … …  
    217233#endif
    218234         zdt=dtime/REAL(nsplit_thermals)
     235
     236
    219237         do isplit=1,nsplit_thermals
    220238
    221239          if (iflag_thermals>=1000) then
    222 #ifdef ISO
    223               CALL abort_gcm('calltherm 173','isos pas prevus ici',1)
    224 #endif
    225240            CALL thermcell_2002(klon,klev,zdt,iflag_thermals   &
    226241     &      ,pplay,paprs,pphi  &
    … …  
    231246     &      ,tau_thermals)
    232247          else if (iflag_thermals.eq.2) then
    233 #ifdef ISO
    234               CALL abort_gcm('calltherm 186','isos pas prevus ici',1) 
    235 #endif
    236248            CALL thermcell_sec(klon,klev,zdt  &
    237249     &      ,pplay,paprs,pphi,zlev  &
    … …  
    242254     &      ,tau_thermals)
    243255          else if (iflag_thermals.eq.3) then
    244 #ifdef ISO
    245               write(*,*) 'calltherm 199: isos pas prévus ici'
    246               stop
    247 #endif
    248256            CALL thermcell(klon,klev,zdt  &
    249257     &      ,pplay,paprs,pphi  &
    … …  
    254262     &      ,tau_thermals)
    255263          else if (iflag_thermals.eq.10) then
    256 #ifdef ISO
    257               CALL abort_gcm('calltherm 212','isos pas prevus ici',1) 
    258 #endif
    259264            CALL thermcell_eau(klon,klev,zdt  &
    260265     &      ,pplay,paprs,pphi  &
    … …  
    264269     &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    265270     &      ,tau_thermals)
    266 #ifdef ISO
    267               CALL abort_gcm('calltherm 267','isos pas prevus ici',1) 
    268 #endif
    269271          else if (iflag_thermals.eq.11) then
    270272              abort_message = 'cas non prevu dans calltherm'
    271273              CALL abort_physic (modname,abort_message,1)
    272 
    273 !           CALL thermcell_pluie(klon,klev,zdt  &
    274 !   &      ,pplay,paprs,pphi,zlev  &
    275 !    &      ,u_seri,v_seri,t_seri,q_seri  &
    276 !    &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
    277 !    &      ,zfm_therm,zentr_therm,zqla  &
    278 !    &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    279 !    &      ,tau_thermals,3)
    280274          else if (iflag_thermals.eq.12) then
    281 #ifdef ISO
    282               CALL abort_gcm('calltherm 282','isos pas prevus ici',1) 
    283 #endif
    284275            CALL calcul_sec(klon,klev,zdt  &
    285276     &      ,pplay,paprs,pphi,zlev  &
    … …  
    289280     &      ,tau_thermals)
    290281          else if (iflag_thermals==13.or.iflag_thermals==14) then
    291 #ifdef ISO
    292               CALL abort_gcm('calltherm 292','isos pas prevus ici',1) 
    293 #endif
    294             CALL thermcellV0_main(itap,klon,klev,zdt  &
    295      &      ,pplay,paprs,pphi,debut  &
    296      &      ,u_seri,v_seri,t_seri,q_seri  &
    297      &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
    298      &      ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax  &
    299      &      ,ratqscth,ratqsdiff,zqsatth  &
    300      &      ,r_aspect_thermals,l_mix_thermals  &
    301      &      ,tau_thermals,Ale,Alp,lalim_conv,wght_th &
    302      &      ,zmax0,f0,zw2,fraca)
    303           else if (iflag_thermals>=15.and.iflag_thermals<=18) then
    304 
    305 !            print*,'THERM iflag_thermas_ed=',iflag_thermals_ed
     282              abort_message = 'thermcellV0_main enleve svn>2084'
     283              CALL abort_physic (modname,abort_message,1)
     284          else if (new_thermcell) then
    306285            CALL thermcell_main(itap,klon,klev,zdt  &
    307286     &      ,pplay,paprs,pphi,debut  &
    … …  
    310289     &      ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax  &
    311290     &      ,ratqscth,ratqsdiff,zqsatth  &
    312 !    &      ,r_aspect_thermals,l_mix_thermals &
    313 !    &      ,tau_thermals,iflag_thermals_ed,iflag_coupl &
    314      &      ,Ale,Alp,lalim_conv,wght_th &
    315291     &      ,zmax0,f0,zw2,fraca,ztv,zpspsk &
    316      &      ,ztla,zthl &
    317 !!! nrlmd le 10/04/2012
    318      &      ,pbl_tke,pctsrf,omega,airephy &
    319      &      ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
    320      &      ,n2,s2,ale_bl_stat &
    321      &      ,therm_tke_max,env_tke_max &
    322      &      ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
    323      &      ,alp_bl_conv,alp_bl_stat &
    324 !!! fin nrlmd le 10/04/2012
    325      &      ,ztva &
     292     &      ,ztla,zthl,ztva &
     293     &      ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
    326294#ifdef ISO         
    327295     &      ,xt_seri,d_xt_the &
    328296#endif         
    329297     &   )
     298
     299            CALL thermcell_alp(klon,klev,zdt  &                      ! in
     300     &        ,pplay,paprs  &                                        ! in
     301     &        ,zfm_therm,zentr_therm,lmax  &                         ! in
     302     &        ,pbl_tke,pctsrf,omega,airephy &                        ! in
     303     &        ,zw2,fraca &                                           ! in
     304     &        ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &  ! in
     305     &        ,ale,alp,lalim_conv,wght_th &                          ! out
     306     &        ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &! out
     307     &        ,n2,s2,ale_bl_stat &                                   ! out
     308     &        ,therm_tke_max,env_tke_max &                           ! out
     309     &        ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &          ! out
     310     &        ,alp_bl_conv,alp_bl_stat &                             ! out
     311     &        )
     312
    330313           if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK'
    331314         else
    … …  
    423406       DO i=1,klon
    424407            fm_therm(i,klev+1)=0.
    425             Ale_bl(i)=Ale_bl(i)+Ale(i)/REAL(nsplit_thermals)
    426 !            write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i)
    427             Alp_bl(i)=Alp_bl(i)+Alp(i)/REAL(nsplit_thermals)
    428 !            write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i)
    429         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)
     408            ale_bl(i)=ale_bl(i)+ale(i)/REAL(nsplit_thermals)
     409!            write(22,*)'ALE CALLTHERM',ale_bl(i),ale(i)
     410            alp_bl(i)=alp_bl(i)+alp(i)/REAL(nsplit_thermals)
     411!            write(23,*)'ALP CALLTHERM',alp_bl(i),alp(i)
     412        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)
    430413       ENDDO
    431414

  • LMDZ6/trunk/libf/phylmdiso/isotopes_routines_mod.F90

    r4036 r4089  
    1601616016#include "dimsoil.h"
    1601716017#include "clesphys.h"
    16018 #include "thermcell.h"
    1601916018#include "compbl.h"     
    1602016019
    … …  
    1620116200#include "dimsoil.h"
    1620216201#include "clesphys.h"
    16203 #include "thermcell.h"
     16202!  #include "thermcell.h"
    1620416203#include "compbl.h"
    1620516204
    … …  
    1658916588#include "dimsoil.h"
    1659016589#include "clesphys.h"
    16591 #include "thermcell.h"
     16590! #include "thermcell.h"
    1659216591#include "compbl.h"   
    1659316592

  • LMDZ6/trunk/libf/phylmdiso/phyetat0.F90

    r4071 r4089  
    5959  include "dimsoil.h"
    6060  include "clesphys.h"
    61   include "thermcell.h"
     61  include "alpale.h"
    6262  include "compbl.h"
    6363  include "YOMCST.h"

  • LMDZ6/trunk/libf/phylmdiso/phyredem.F90

    r4071 r4089  
    5656  include "dimsoil.h"
    5757  include "clesphys.h"
    58   include "thermcell.h"
     58  include "alpale.h"
    5959  include "compbl.h"
    6060  !======================================================================
    … …  
    504504#include "dimsoil.h"
    505505#include "clesphys.h"
    506 #include "thermcell.h"
     506#include "alpale.h"
    507507#include "compbl.h"     
    508508      ! inputs

  • LMDZ6/trunk/libf/phylmdiso/phys_output_mod.F90

    r4071 r4089  
    5959    IMPLICIT NONE
    6060    include "clesphys.h"
    61     include "thermcell.h"
     61    include "alpale.h"
    6262    include "YOMCST.h"
    6363

  • LMDZ6/trunk/libf/phylmdiso/phys_state_var_mod.F90

    r4088 r4089  
    11!
    2 ! $Id: phys_state_var_mod.F90 3888 2021-05-05 10:50:37Z jyg $
     2! $Id: phys_state_var_mod.F90 4088 2022-03-10 07:03:20Z fhourdin $
    33!
    44      MODULE phys_state_var_mod

  • LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90

    r4084 r4089  
    7878    USE write_field_phy
    7979    USE lscp_mod, ONLY : lscp
     80    USE thermcell_ini_mod, ONLY : thermcell_ini
    8081
    8182    !USE cmp_seri_mod
    … …  
    421422    include "dimsoil.h"
    422423    include "clesphys.h"
    423     include "thermcell.h"
     424    include "alpale.h"
    424425    include "dimpft.h"
    425426    !======================================================================
    … …  
    18681869
    18691870       CALL iniradia(klon,klev,paprs(1,1:klev+1))
     1871
     1872
     1873!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1874       CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, &
     1875   &    RG,RD,RCPD,RKAPPA,RLVTT,RETV)
    18701876       !
    18711877!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  • LMDZ6/trunk/libf/phylmdiso/thermcell_main.F90

    r3940 r4089  
    1 !
     1
    22! $Id: thermcell_main.F90 3451 2019-01-27 11:07:30Z fhourdin $
    33!
    4       SUBROUTINE thermcell_main(itap,ngrid,nlay,ptimestep  &
     4      subroutine thermcell_main(itap,ngrid,nlay,ptimestep  &
    55     &                  ,pplay,pplev,pphi,debut  &
    66     &                  ,pu,pv,pt,po  &
    … …  
    88     &                  ,fm0,entr0,detr0,zqta,zqla,lmax  &
    99     &                  ,ratqscth,ratqsdiff,zqsatth  &
    10      &                  ,Ale_bl,Alp_bl,lalim_conv,wght_th &
    1110     &                  ,zmax0, f0,zw2,fraca,ztv &
    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      &                  ,ztva &
     11     &                  ,zpspsk,ztla,zthl,ztva &
     12     &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
    2213#ifdef ISO         
    2314     &      ,xtpo,xtpdoadj &
    … …  
    2516     &   )
    2617
    27       USE dimphy
    28       USE ioipsl
    29       USE indice_sol_mod
    30       USE print_control_mod, ONLY: lunout,prt_level
     18
     19      USE thermcell_ini_mod, ONLY: thermcell_ini,dqimpl,dvdq,prt_level,lunout,prt_level
     20      USE thermcell_ini_mod, ONLY: iflag_thermals_closure,iflag_thermals_ed,tau_thermals,r_aspect_thermals
     21      USE thermcell_ini_mod, ONLY: RD,RG
     22
    3123#ifdef ISO
    3224  USE infotrac_phy, ONLY : ntraciso
    … …  
    3729#endif
    3830#endif
     31
     32
    3933      IMPLICIT NONE
    4034
    … …  
    7468!   -------------
    7569
    76 #include "YOMCST.h"
    77 #include "YOETHF.h"
    78 #include "FCTTRE.h"
    79 #include "thermcell.h"
    8070
    8171!   arguments:
    8272!   ----------
    83 
    84 !IM 140508
    85       INTEGER itap
    86 
    87       INTEGER ngrid,nlay
    88       real ptimestep
    89       REAL pt(ngrid,nlay),pdtadj(ngrid,nlay)
    90       REAL pu(ngrid,nlay),pduadj(ngrid,nlay)
    91       REAL pv(ngrid,nlay),pdvadj(ngrid,nlay)
    92       REAL po(ngrid,nlay),pdoadj(ngrid,nlay)
    93       REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1)
    94       real pphi(ngrid,nlay)
    95       LOGICAL debut
     73      integer, intent(in) :: itap,ngrid,nlay
     74      real, intent(in) ::  ptimestep
     75      real, intent(in), dimension(ngrid,nlay)    :: pt,pu,pv,po,pplay,pphi,zpspsk
     76      real, intent(in), dimension(ngrid,nlay+1)  :: pplev
     77      real, intent(out), dimension(ngrid,nlay)   :: pdtadj,pduadj,pdvadj,pdoadj,entr0,detr0
     78      real, intent(out), dimension(ngrid,nlay)   :: ztla,zqla,zqta,zqsatth,zthl
     79      real, intent(out), dimension(ngrid,nlay+1) :: fm0,zw2,fraca
     80      real, intent(out), dimension(ngrid) :: zmax0,f0
     81      real, intent(out), dimension(ngrid,nlay) :: ztva,ztv
     82      logical, intent(in) :: debut
     83
     84      real, intent(out), dimension(ngrid) :: pcon
     85      real, intent(out), dimension(ngrid,nlay) :: rhobarz,wth3
     86      real, intent(out), dimension(ngrid) :: wmax_sec
     87      integer,intent(out), dimension(ngrid) :: lalim
     88      real, intent(out), dimension(ngrid,nlay+1) :: fm
     89      real, intent(out), dimension(ngrid,nlay) :: alim_star
     90      real, intent(out), dimension(ngrid) :: zmax
    9691
    9792!   local:
    9893!   ------
    9994
    100       integer icount
    101 
    102       integer, save :: dvdq=1,dqimpl=-1
    103 !$OMP THREADPRIVATE(dvdq,dqimpl)
    104       data icount/0/
    105       save icount
    106 !$OMP THREADPRIVATE(icount)
    10795
    10896      integer,save :: igout=1
    … …  
    113101!$OMP THREADPRIVATE(lev_out)
    114102
    115       REAL susqr2pi, Reuler
    116 
    117       INTEGER ig,k,l,ll,ierr
    118       real zsortie1d(klon)
    119       INTEGER lmax(klon),lmin(klon),lalim(klon)
    120       INTEGER lmix(klon)
    121       INTEGER lmix_bis(klon)
    122       real linter(klon)
    123       real zmix(klon)
    124       real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1),ztva_est(klon,klev)
    125 !      real fraca(klon,klev)
    126 
    127       real zmax_sec(klon)
    128 !on garde le zmax du pas de temps precedent
    129       real zmax0(klon)
    130 !FH/IM     save zmax0
    131 
    132       real lambda
    133 
    134       real zlev(klon,klev+1),zlay(klon,klev)
    135       real deltaz(klon,klev)
    136       REAL zh(klon,klev)
    137       real zthl(klon,klev),zdthladj(klon,klev)
    138       REAL ztv(klon,klev)
    139       real zu(klon,klev),zv(klon,klev),zo(klon,klev)
    140       real zl(klon,klev)
    141       real zsortie(klon,klev)
    142       real zva(klon,klev)
    143       real zua(klon,klev)
    144       real zoa(klon,klev)
    145 
    146       real zta(klon,klev)
    147       real zha(klon,klev)
    148       real fraca(klon,klev+1)
    149       real zf,zf2
    150       real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev)
    151       real q2(klon,klev)
    152 ! FH probleme de dimensionnement avec l'allocation dynamique
    153 !     common/comtherm/thetath2,wth2
    154       real wq(klon,klev)
    155       real wthl(klon,klev)
    156       real wthv(klon,klev)
    157    
    158       real ratqscth(klon,klev)
    159       real var
    160       real vardiff
    161       real ratqsdiff(klon,klev)
    162 
     103      real lambda, zf,zf2,var,vardiff,CHI
     104      integer ig,k,l,ierr,ll
    163105      logical sorties
    164       real rho(klon,klev),rhobarz(klon,klev),masse(klon,klev)
    165       real zpspsk(klon,klev)
    166 
    167       real wmax(klon)
    168       real wmax_tmp(klon)
    169       real wmax_sec(klon)
    170       real fm0(klon,klev+1),entr0(klon,klev),detr0(klon,klev)
    171       real fm(klon,klev+1),entr(klon,klev),detr(klon,klev)
    172 
    173       real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev)
    174 !niveau de condensation
    175       integer nivcon(klon)
    176       real zcon(klon)
    177       REAL CHI
    178       real zcon2(klon)
    179       real pcon(klon)
    180       real zqsat(klon,klev)
    181       real zqsatth(klon,klev)
    182 
    183       real f_star(klon,klev+1),entr_star(klon,klev)
    184       real detr_star(klon,klev)
    185       real alim_star_tot(klon)
    186       real alim_star(klon,klev)
    187       real alim_star_clos(klon,klev)
    188       real f(klon), f0(klon)
    189 !FH/IM     save f0
    190       real zlevinter(klon)
    191        real seuil
    192       real csc(klon,klev)
    193 
    194 !!! nrlmd le 10/04/2012
    195 
    196 !------Entrées
    197       real pbl_tke(klon,klev+1,nbsrf)
    198       real pctsrf(klon,nbsrf)
    199       real omega(klon,klev)
    200       real airephy(klon)
    201 !------Sorties
    202       real zlcl(klon),fraca0(klon),w0(klon),w_conv(klon)
    203       real therm_tke_max0(klon),env_tke_max0(klon)
    204       real n2(klon),s2(klon)
    205       real ale_bl_stat(klon)
    206       real therm_tke_max(klon,klev),env_tke_max(klon,klev)
    207       real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)
    208 !------Local
    209       integer nsrf
    210       real rhobarz0(klon)                    ! Densité au LCL
    211       logical ok_lcl(klon)                   ! Existence du LCL des thermiques
    212       integer klcl(klon)                     ! Niveau du LCL
    213       real interp(klon)                      ! Coef d'interpolation pour le LCL
    214 !--Triggering
    215       real Su                                ! Surface unité: celle d'un updraft élémentaire
    216       parameter(Su=4e4)
    217       real hcoef                             ! Coefficient directeur pour le calcul de s2
    218       parameter(hcoef=1)
    219       real hmincoef                          ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2
    220       parameter(hmincoef=0.3)
    221       real eps1                              ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd)
    222       parameter(eps1=0.3)
    223       real hmin(ngrid)                       ! Ordonnée à l'origine pour le calcul de s2
    224       real zmax_moy(ngrid)                   ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl)
    225       real zmax_moy_coef
    226       parameter(zmax_moy_coef=0.33)
    227       real depth(klon)                       ! Epaisseur moyenne du cumulus
    228       real w_max(klon)                       ! Vitesse max statistique
    229       real s_max(klon)
    230 !--Closure
    231       real pbl_tke_max(klon,klev)            ! Profil de TKE moyenne
    232       real pbl_tke_max0(klon)                ! TKE moyenne au LCL
    233       real w_ls(klon,klev)                   ! Vitesse verticale grande échelle (m/s)
    234       real coef_m                            ! On considère un rendement pour alp_bl_fluct_m
    235       parameter(coef_m=1.)
    236       real coef_tke                          ! On considère un rendement pour alp_bl_fluct_tke
    237       parameter(coef_tke=1.)
    238 
    239 !!! fin nrlmd le 10/04/2012
    240 
    241 !
    242       !nouvelles variables pour la convection
    243       real Ale_bl(klon)
    244       real Alp_bl(klon)
    245       real alp_int(klon),dp_int(klon),zdp
    246       real ale_int(klon)
    247       integer n_int(klon)
    248       real fm_tot(klon)
    249       real wght_th(klon,klev)
    250       integer lalim_conv(klon)
    251 !v1d     logical therm
    252 !v1d     save therm
    253 
    254       character*2 str2
    255       character*10 str10
     106      real, dimension(ngrid) :: linter,zmix, zmax_sec
     107      integer,dimension(ngrid) :: lmax,lmin,lmix,lmix_bis,nivcon
     108      real, dimension(ngrid,nlay) :: ztva_est
     109      real, dimension(ngrid,nlay) :: deltaz,zlay,zh,zdthladj,zu,zv,zo,zl,zva,zua,zoa
     110      real, dimension(ngrid,nlay) :: zta,zha,q2,wq,wthl,wthv,thetath2,wth2
     111      real, dimension(ngrid,nlay) :: ratqscth,ratqsdiff,rho,masse
     112      real, dimension(ngrid,nlay+1) :: zw_est,zlev
     113      real, dimension(ngrid) :: wmax,wmax_tmp
     114      real, dimension(ngrid,nlay+1) :: f_star
     115      real, dimension(ngrid,nlay) :: entr,detr,entr_star,detr_star,alim_star_clos
     116      real, dimension(ngrid,nlay) :: zqsat,csc
     117      real, dimension(ngrid) :: zcon,zcon2,alim_star_tot,f
    256118
    257119      character (len=20) :: modname='thermcell_main'
    258120      character (len=80) :: abort_message
    259121
    260       EXTERNAL SCOPY
    261122
    262123#ifdef ISO
    263124      REAL xtpo(ntraciso,ngrid,nlay),xtpdoadj(ntraciso,ngrid,nlay)
    264       REAL xtzo(ntraciso,klon,klev)
     125      REAL xtzo(ntraciso,ngrid,nlay)
    265126      REAL xtpdoadj_tmp(ngrid,nlay)
    266       REAL xtpo_tmp(klon,klev)
    267       REAL xtzo_tmp(klon,klev)
     127      REAL xtpo_tmp(ngrid,nlay)
     128      REAL xtzo_tmp(ngrid,nlay)
    268129      integer ixt
    269130#endif
     131
    270132!
    271133
    … …  
    274136!   ---------------
    275137!
    276 
    277    seuil=0.25
    278 
    279    if (debut) then
    280       if (iflag_thermals==15.or.iflag_thermals==16) then
    281          dvdq=0
    282          dqimpl=-1
    283       else
    284          dvdq=1
    285          dqimpl=1
    286       endif
    287 
    288       fm0=0.
    289       entr0=0.
    290       detr0=0.
    291    endif
     138    print*,'NEW THERMCELL cool'
     139
     140
    292141   fm=0. ; entr=0. ; detr=0.
    293    icount=icount+1
    294 
    295 !IM 090508 beg
    296 !print*,'====================================================================='
    297 !print*,'====================================================================='
    298 !print*,' PAS ',icount,' PAS ',icount,' PAS ',icount,' PAS ',icount
    299 !print*,'====================================================================='
    300 !print*,'====================================================================='
    301 !IM 090508 end
    302142
    303143      if (prt_level.ge.1) print*,'thermcell_main V4'
    304144
    305145       sorties=.true.
    306       IF(ngrid.NE.klon) THEN
     146      IF(ngrid.NE.ngrid) THEN
    307147         PRINT*
    308148         PRINT*,'STOP dans convadj'
    309149         PRINT*,'ngrid    =',ngrid
    310          PRINT*,'klon  =',klon
     150         PRINT*,'ngrid  =',ngrid
    311151      ENDIF
    312152!
    313153!     write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)'
    314      do ig=1,klon
     154     do ig=1,ngrid
    315155         f0(ig)=max(f0(ig),1.e-2)
    316156         zmax0(ig)=max(zmax0(ig),40.)
    … …  
    357197         zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG
    358198      enddo
    359          zlev(:,1)=0.
    360          zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG
     199      zlev(:,1)=0.
     200      zlev(:,nlay+1)=(2.*pphi(:,nlay)-pphi(:,nlay-1))/RG
    361201      do l=1,nlay
    362202         zlay(:,l)=pphi(:,l)/RG
    363203      enddo
    364 !calcul de l epaisseur des couches
    365204      do l=1,nlay
    366205         deltaz(:,l)=zlev(:,l+1)-zlev(:,l)
    367206      enddo
    368207
    369 !     print*,'2 OK convect8'
    370208!-----------------------------------------------------------------------
    371 !   Calcul des densites
     209!   Calcul des densites et masses
    372210!-----------------------------------------------------------------------
    373211
    374      rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:))
    375 
    376      if (prt_level.ge.10)write(lunout,*)                                &
    377     &    'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
     212      rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:))
     213      if (prt_level.ge.10) write(lunout,*) 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
    378214      rhobarz(:,1)=rho(:,1)
    379 
    380215      do l=2,nlay
    381216         rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1))
    382217      enddo
    383 
    384 !calcul de la masse
    385218      do l=1,nlay
    386219         masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG
    387220      enddo
    388 
    389221      if (prt_level.ge.1) print*,'thermcell_main apres initialisation'
    390222
    … …  
    501333      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
    502334
    503       call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
    504       call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
     335      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
     336      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
    505337
    506338      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
    … …  
    530362
    531363
    532       call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
    533       call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
    534       call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
    535       call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
     364      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
     365      call test_ltherm(ngrid,nlay,pplay,lmin ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
     366      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
     367      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
    536368
    537369      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
    … …  
    547379
    548380 
    549 call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
    550 call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
     381call test_ltherm(ngrid,nlay,pplay,lmin,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
     382call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
    551383
    552384      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry'
    … …  
    603435!-------------------------------------------------------------------------------
    604436!deduction des flux
    605 !-------------------------------------------------------------------------------
    606437
    607438      CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, &
    … …  
    612443
    613444      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux'
    614       call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
    615       call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
     445      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
     446      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
    616447
    617448!------------------------------------------------------------------
    … …  
    640471      call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
    641472     &                   po,pdoadj,zoa,lev_out)
     473
    642474#ifdef ISO
    643475        ! C Risi: on utilise directement la même routine
    … …  
    675507        enddo
    676508      enddo !DO  ll=1,nlay
    677       write(*,*) 'thermcell_main 600 tmp: apres thermcell_dq' 
     509      write(*,*) 'thermcell_main 600 tmp: apres thermcell_dq'
    678510#endif     
    679511#endif
    680512
     513
     514
    681515!------------------------------------------------------------------
    682516! Calcul de la fraction de l'ascendance
    683517!------------------------------------------------------------------
    684       do ig=1,klon
     518      do ig=1,ngrid
    685519         fraca(ig,1)=0.
    686520         fraca(ig,nlay+1)=0.
    687521      enddo
    688522      do l=2,nlay
    689          do ig=1,klon
     523         do ig=1,ngrid
    690524            if (zw2(ig,l).gt.1.e-10) then
    691525            fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l))
    … …  
    819653         enddo
    820654      enddo
    821 !
    822 ! $Id: thermcell_main.F90 3451 2019-01-27 11:07:30Z fhourdin $
    823 !
    824       CALL thermcell_alp(ngrid,nlay,ptimestep  &
    825      &                  ,pplay,pplev  &
    826      &                  ,fm0,entr0,lmax  &
    827      &                  ,Ale_bl,Alp_bl,lalim_conv,wght_th &
    828      &                  ,zw2,fraca &
    829 !!! necessire en plus
    830      &                  ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
    831 !!! nrlmd le 10/04/2012
    832      &                  ,pbl_tke,pctsrf,omega,airephy &
    833      &                  ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
    834      &                  ,n2,s2,ale_bl_stat &
    835      &                  ,therm_tke_max,env_tke_max &
    836      &                  ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
    837      &                  ,alp_bl_conv,alp_bl_stat &
    838 !!! fin nrlmd le 10/04/2012
    839      &                   )
    840 
    841 
    842655
    843656!calcul du ratqscdiff
    … …  
    847660      ratqsdiff(:,:)=0.
    848661
    849       do l=1,klev
     662      do l=1,nlay
    850663         do ig=1,ngrid
    851664            if (l<=lalim(ig)) then
    … …  
    857670      if (prt_level.ge.1) print*,'14f OK convect8'
    858671
    859       do l=1,klev
     672      do l=1,nlay
    860673         do ig=1,ngrid
    861674            if (l<=lalim(ig)) then
    … …  
    868681
    869682      if (prt_level.ge.1) print*,'14g OK convect8'
    870       do l=1,nlay
    871          do ig=1,ngrid
    872             ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
    873 !           write(11,*)'ratqsdiff=',ratqsdiff(ig,l)
    874          enddo
    875       enddo
    876 !--------------------------------------------------------------------   
    877 !
    878 !ecriture des fichiers sortie
    879 !     print*,'15 OK convect8 CCCCCCCCCCCCCCCCCCc'
    880 
     683         do l=1,nlay
     684            do ig=1,ngrid
     685               ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
     686            enddo
     687         enddo
    881688      endif
    882689
    … …  
    884691
    885692      return
    886       end
    887 
    888 !-----------------------------------------------------------------------------
    889 
    890       subroutine test_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment)
    891       USE print_control_mod, ONLY: prt_level
     693      end subroutine thermcell_main
     694
     695!=============================================================================
     696!/////////////////////////////////////////////////////////////////////////////
     697!=============================================================================
     698      subroutine test_ltherm(ngrid,nlay,pplay,long,ztv,po,ztva, &  ! in
     699    &            zqla,f_star,zw2,comment)                          ! in
     700!=============================================================================
     701      USE thermcell_ini_mod, ONLY: prt_level
    892702      IMPLICIT NONE
    893703
    894       integer i, k, klon,klev
    895       real pplev(klon,klev+1),pplay(klon,klev)
    896       real ztv(klon,klev)
    897       real po(klon,klev)
    898       real ztva(klon,klev)
    899       real zqla(klon,klev)
    900       real f_star(klon,klev)
    901       real zw2(klon,klev)
    902       integer long(klon)
     704      integer i, k, ngrid,nlay
     705      real, intent(in), dimension(ngrid,nlay) :: pplay,ztv,po,ztva,zqla
     706      real, intent(in), dimension(ngrid,nlay) :: f_star,zw2
     707      integer, intent(in), dimension(ngrid) :: long
    903708      real seuil
    904709      character*21 comment
     710      seuil=0.25
    905711
    906712      if (prt_level.ge.1) THEN
    … …  
    910716
    911717!  test sur la hauteur des thermiques ...
    912          do i=1,klon
     718         do i=1,ngrid
    913719!IMtemp           if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then
    914720           if (prt_level.ge.10) then
    915721               print*,'WARNING ',comment,' au point ',i,' K= ',long(i)
    916722               print*,'  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
    917                do k=1,klev
     723               do k=1,nlay
    918724                  write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
    919725               enddo
    … …  
    925731      end
    926732
    927 !!! nrlmd le 10/04/2012                          Transport de la TKE par le thermique moyen pour la fermeture en ALP
    928 !                                                         On transporte pbl_tke pour donner therm_tke
    929 !                                          Copie conforme de la subroutine DTKE dans physiq.F écrite par Frederic Hourdin
    930       subroutine thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0,  &
    931      &           rg,pplev,therm_tke_max)
    932       USE print_control_mod, ONLY: prt_level
     733! nrlmd le 10/04/2012   Transport de la TKE par le thermique moyen pour la fermeture en ALP
     734!                       On transporte pbl_tke pour donner therm_tke
     735!                       Copie conforme de la subroutine DTKE dans physiq.F écrite par Frederic Hourdin
     736
     737!=======================================================================
     738!///////////////////////////////////////////////////////////////////////
     739!=======================================================================
     740
     741      subroutine thermcell_tke_transport( &
     742     &     ngrid,nlay,ptimestep,fm0,entr0,rg,pplev,  &   ! in
     743     &     therm_tke_max)                                ! out
     744      USE thermcell_ini_mod, ONLY: prt_level
    933745      implicit none
    934746
    … …  
    941753!=======================================================================
    942754
    943       integer ngrid,nlay,nsrf
    944 
    945       real ptimestep
    946       real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1)
    947       real entr0(ngrid,nlay),rg
    948       real therm_tke_max(ngrid,nlay)
     755      integer ngrid,nlay
     756
     757      real, intent(in) :: ptimestep
     758      real, intent(in), dimension(ngrid,nlay+1) :: fm0,pplev
     759      real, intent(in), dimension(ngrid,nlay) :: entr0
     760      real, intent(in) :: rg
     761      real, intent(out), dimension(ngrid,nlay) :: therm_tke_max
     762
    949763      real detr0(ngrid,nlay)
    950 
    951 
     764      real masse0(ngrid,nlay)
    952765      real masse(ngrid,nlay),fm(ngrid,nlay+1)
    953766      real entr(ngrid,nlay)
    … …  
    956769
    957770      real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1)
    958 
    959       real zzm
    960 
    961771      integer ig,k
    962       integer isrf
    963772
    964773
    … …  
    988797      fm(:,nlay+1)=0.
    989798
    990 !!! nrlmd le 16/09/2010
    991 !   calcul de la valeur dans les ascendances
    992 !       do ig=1,ngrid
    993 !          qa(ig,1)=q(ig,1)
    994 !       enddo
    995 !!!
    996 
    997 !do isrf=1,nsrf
    998 
    999 !   q(:,:)=therm_tke(:,:,isrf)
     799
    1000800   q(:,:)=therm_tke_max(:,:)
    1001801!!! nrlmd le 16/09/2010
Note: See TracChangeset for help on using the changeset viewer.