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

Reecriture des thermiques

File:
1 edited

Legend:

Unmodified
Added
Removed

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