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/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
Note: See TracChangeset for help on using the changeset viewer.