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

Reecriture des thermiques

Location:
LMDZ6/trunk/libf/phylmdiso
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • 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.