Changeset 4590


Ignore:
Timestamp:
Jun 29, 2023, 3:03:15 AM (11 months ago)
Author:
fhourdin
Message:

Passage des thermiques a la nouvelle norme.

Location:
LMDZ6/trunk/libf/phylmd
Files:
1 deleted
3 edited
17 moved

Legend:

Unmodified
Added
Removed

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

    r4143 r4590  
    2929      USE indice_sol_mod
    3030      USE print_control_mod, ONLY: prt_level,lunout
     31      USE lmdz_thermcell_alp, ONLY: thermcell_alp
     32      USE lmdz_thermcell_main, ONLY: thermcell_main
     33      USE lmdz_thermcell_old, ONLY: thermcell, thermcell_2002, thermcell_eau, calcul_sec, thermcell_sec
    3134#ifdef ISO
    3235      use infotrac_phy, ONLY: ntiso

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

    r4589 r4590  
     1MODULE lmdz_thermcell_alim
    12!
    23! $Id: thermcell_plume.F90 2311 2015-06-25 07:45:24Z emillour $
    34!
     5CONTAINS
     6
    47      SUBROUTINE thermcell_alim(flag,ngrid,klev,ztv,d_temp,zlev,alim_star,lalim)
    58IMPLICIT NONE
    … …  
    122125RETURN
    123126END
     127END MODULE lmdz_thermcell_alim

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

    r4589 r4590  
     1MODULE lmdz_thermcell_alp
    12! $Id: thermcell_main.F90 2351 2015-08-25 15:14:59Z emillour $
    23!
     4CONTAINS
     5
    36      SUBROUTINE thermcell_alp(ngrid,nlay,ptimestep  &                         ! in
    47     &                  ,pplay,pplev  &                                        ! in
    … …  
    1720
    1821      USE indice_sol_mod
     22      USE lmdz_thermcell_main, ONLY : thermcell_tke_transport
    1923      IMPLICIT NONE
    2024
    … …  
    399403      return
    400404      end
     405END MODULE lmdz_thermcell_alp

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

    r4589 r4590  
     1MODULE lmdz_thermcell_closure
    12!
    23! $Header$
    34!
     5CONTAINS
     6
    47      SUBROUTINE thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho,  &
    58     &   zlev,lalim,alim_star,zmax,wmax,f)
    … …  
    7073 RETURN
    7174      end
     75END MODULE lmdz_thermcell_closure

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

    r4589 r4590  
     1MODULE lmdz_thermcell_down
     2CONTAINS
     3
    14SUBROUTINE thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,eup,dup,edn,ddn,masse,trac,dtrac)
    25
    3 USE thermcell_ini_mod, ONLY: iflag_thermals_down
     6USE lmdz_thermcell_ini, ONLY: iflag_thermals_down
    47
    58
    … …  
    223226
    224227
    225    USE thermcell_ini_mod, ONLY : prt_level,RLvCp,RKAPPA,RETV,fact_thermals_down
     228   USE lmdz_thermcell_ini, ONLY : prt_level,RLvCp,RKAPPA,RETV,fact_thermals_down
    226229   IMPLICIT NONE
    227230
    … …  
    299302 RETURN
    300303   END
     304END MODULE lmdz_thermcell_down

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

    r4589 r4590  
     1MODULE lmdz_thermcell_dq
     2CONTAINS
     3
    14      subroutine thermcell_dq(ngrid,nlay,impl,ptimestep,fm,entr,  &
    25     &           masse,q,dq,qa,lev_out)
    36      USE print_control_mod, ONLY: prt_level
     7
    48      implicit none
    59
    … …  
    325329      return
    326330      end
     331END MODULE lmdz_thermcell_dq

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

    r4589 r4590  
     1MODULE lmdz_thermcell_dry
    12!
    23! $Id$
    34!
     5CONTAINS
     6
    47       SUBROUTINE thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star,  &
    58     &                            lalim,lmin,zmax,wmax)
    … …  
    1417! la temperature potentielle virtuelle pondérée par alim_star.
    1518!--------------------------------------------------------------------------
    16        USE thermcell_ini_mod, ONLY: prt_level, RG
     19       USE lmdz_thermcell_ini, ONLY: prt_level, RG
    1720       IMPLICIT NONE
    1821
    … …  
    164167 RETURN
    165168      END
     169END MODULE lmdz_thermcell_dry

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

    r4589 r4590  
     1MODULE lmdz_thermcell_dtke
     2CONTAINS
     3
    14      subroutine thermcell_dtke(ngrid,nlay,nsrf,ptimestep,fm0,entr0,  &
    25     &           rg,pplev,tke)
    … …  
    122125      return
    123126      end
     127END MODULE lmdz_thermcell_dtke

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

    r4589 r4590  
     1MODULE lmdz_thermcell_dv2
     2CONTAINS
     3
    14      subroutine thermcell_dv2(ngrid,nlay,ptimestep,fm,entr,masse  &
    25     &    ,fraca,larga  &
    … …  
    192195      return
    193196      end
     197END MODULE lmdz_thermcell_dv2

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

    r4589 r4590  
     1MODULE lmdz_thermcell_env
     2CONTAINS
     3
    14   SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
    25     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
    … …  
    811
    912
    10    USE thermcell_ini_mod, ONLY : prt_level,RLvCp,RKAPPA,RETV
     13   USE lmdz_thermcell_ini, ONLY : prt_level,RLvCp,RKAPPA,RETV
     14   USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
    1115   IMPLICIT NONE
    1216
    … …  
    7781 RETURN
    7882   END
     83END MODULE lmdz_thermcell_env

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

    r4589 r4590  
     1MODULE lmdz_thermcell_flux2
    12!
    23! $Id$
    34!
     5CONTAINS
     6
    47      SUBROUTINE thermcell_flux2(ngrid,nlay,ptimestep,masse, &
    58     &       lalim,lmax,alim_star,  &
    … …  
    1316!---------------------------------------------------------------------------
    1417
    15       USE thermcell_ini_mod, ONLY : prt_level,iflag_thermals_optflux
     18      USE lmdz_thermcell_ini, ONLY : prt_level,iflag_thermals_optflux
    1619      IMPLICIT NONE
    1720     
    … …  
    510513 RETURN
    511514      end
     515END MODULE lmdz_thermcell_flux2

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

    r4589 r4590  
     1MODULE lmdz_thermcell_height
     2CONTAINS
     3
    14      SUBROUTINE thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,  &
    25     &           zw2,zlev,lmax,zmax,zmax0,zmix,wmax)
    … …  
    158161 RETURN
    159162      end
     163END MODULE lmdz_thermcell_height

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

    r4589 r4590  
    1 MODULE thermcell_ini_mod
     1MODULE lmdz_thermcell_ini
     2
    23IMPLICIT NONE
    34
    … …  
    111112
    112113END SUBROUTINE thermcell_ini
    113 END MODULE thermcell_ini_mod
     114END MODULE lmdz_thermcell_ini

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

    r4589 r4590  
     1MODULE lmdz_thermcell_main
    12! $Id$
    23!
     4CONTAINS
     5
    36      subroutine thermcell_main(itap,ngrid,nlay,ptimestep  &
    47     &                  ,pplay,pplev,pphi,debut  &
    … …  
    1619
    1720
    18       USE thermcell_ini_mod, ONLY: thermcell_ini,dqimpl,dvdq,prt_level,lunout,prt_level
    19       USE thermcell_ini_mod, ONLY: iflag_thermals_closure,iflag_thermals_ed,tau_thermals,r_aspect_thermals
    20       USE thermcell_ini_mod, ONLY: iflag_thermals_down, fact_thermals_down
    21       USE thermcell_ini_mod, ONLY: RD,RG
     21      USE lmdz_thermcell_ini, ONLY: thermcell_ini,dqimpl,dvdq,prt_level,lunout,prt_level
     22      USE lmdz_thermcell_ini, ONLY: iflag_thermals_closure,iflag_thermals_ed,tau_thermals,r_aspect_thermals
     23      USE lmdz_thermcell_ini, ONLY: iflag_thermals_down,fact_thermals_down
     24      USE lmdz_thermcell_ini, ONLY: RD,RG
     25
     26      USE lmdz_thermcell_down, ONLY: thermcell_updown_dq
     27      USE lmdz_thermcell_closure, ONLY: thermcell_closure
     28      USE lmdz_thermcell_dq, ONLY: thermcell_dq
     29      USE lmdz_thermcell_dry, ONLY: thermcell_dry
     30      USE lmdz_thermcell_dv2, ONLY: thermcell_dv2
     31      USE lmdz_thermcell_env, ONLY: thermcell_env
     32      USE lmdz_thermcell_flux2, ONLY: thermcell_flux2
     33      USE lmdz_thermcell_height, ONLY: thermcell_height
     34      USE lmdz_thermcell_plume, ONLY: thermcell_plume
     35      USE lmdz_thermcell_plume_6A, ONLY: thermcell_plume_6A,thermcell_plume_5B
    2236
    2337#ifdef ISO
    … …  
    89103      integer, intent(in) :: itap,ngrid,nlay
    90104      real, intent(in) ::  ptimestep
    91       real, intent(in), dimension(ngrid,nlay)    :: pt,pu,pv,po,pplay,pphi,zpspsk
     105      real, intent(in), dimension(ngrid,nlay)    :: pt,pu,pv,pplay,pphi
     106! ATTENTION : po et zpspsk sont inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023)
     107      real, intent(inout), dimension(ngrid,nlay)    :: po
     108      real, intent(out), dimension(ngrid,nlay)    :: zpspsk
    92109      real, intent(in), dimension(ngrid,nlay+1)  :: pplev
    93110      integer, intent(out), dimension(ngrid) :: lmax
    … …  
    727744    &            zqla,f_star,zw2,comment)                          ! in
    728745!=============================================================================
    729       USE thermcell_ini_mod, ONLY: prt_level
     746      USE lmdz_thermcell_ini, ONLY: prt_level
    730747      IMPLICIT NONE
    731748
    … …  
    771788     &     ngrid,nlay,ptimestep,fm0,entr0,rg,pplev,  &   ! in
    772789     &     therm_tke_max)                                ! out
    773       USE thermcell_ini_mod, ONLY: prt_level
     790      USE lmdz_thermcell_ini, ONLY: prt_level
    774791      implicit none
    775792
    … …  
    885902     end
    886903
     904END MODULE lmdz_thermcell_main

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

    r4589 r4590  
     1MODULE lmdz_thermcell_old
     2CONTAINS
     3
    14SUBROUTINE thermcell_2002(ngrid, nlay, ptimestep, iflag_thermals, pplay, &
    25    pplev, pphi, pu, pv, pt, po, pduadj, pdvadj, pdtadj, pdoadj, fm0, entr0, &
    … …  
    58  USE dimphy
    69  USE write_field_phy
     10  USE lmdz_thermcell_dv2, ONLY : thermcell_dv2
     11  USE lmdz_thermcell_dq, ONLY : thermcell_dq
    712  IMPLICIT NONE
    813
    … …  
    53405345END SUBROUTINE thermcell_sec
    53415346
     5347SUBROUTINE calcul_sec(ngrid, nlay, ptimestep, pplay, pplev, pphi, zlev, pu, &
     5348    pv, pt, po, zmax, wmax, zw2, lmix & ! s
     5349                                        ! ,pu_therm,pv_therm
     5350    , r_aspect, l_mix, w2di, tho)
     5351
     5352  USE dimphy
     5353  IMPLICIT NONE
     5354
     5355  ! =======================================================================
     5356
     5357  ! Calcul du transport verticale dans la couche limite en presence
     5358  ! de "thermiques" explicitement representes
     5359
     5360  ! Réécriture à partir d'un listing papier à Habas, le 14/02/00
     5361
     5362  ! le thermique est supposé homogène et dissipé par mélange avec
     5363  ! son environnement. la longueur l_mix contrôle l'efficacité du
     5364  ! mélange
     5365
     5366  ! Le calcul du transport des différentes espèces se fait en prenant
     5367  ! en compte:
     5368  ! 1. un flux de masse montant
     5369  ! 2. un flux de masse descendant
     5370  ! 3. un entrainement
     5371  ! 4. un detrainement
     5372
     5373  ! =======================================================================
     5374
     5375  ! -----------------------------------------------------------------------
     5376  ! declarations:
     5377  ! -------------
     5378
     5379  include "YOMCST.h"
     5380
     5381  ! arguments:
     5382  ! ----------
     5383
     5384  INTEGER ngrid, nlay, w2di
     5385  REAL tho
     5386  REAL ptimestep, l_mix, r_aspect
     5387  REAL pt(ngrid, nlay), pdtadj(ngrid, nlay)
     5388  REAL pu(ngrid, nlay), pduadj(ngrid, nlay)
     5389  REAL pv(ngrid, nlay), pdvadj(ngrid, nlay)
     5390  REAL po(ngrid, nlay), pdoadj(ngrid, nlay)
     5391  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
     5392  REAL pphi(ngrid, nlay)
     5393
     5394  INTEGER idetr
     5395  SAVE idetr
     5396  DATA idetr/3/
     5397  !$OMP THREADPRIVATE(idetr)
     5398  ! local:
     5399  ! ------
     5400
     5401  INTEGER ig, k, l, lmaxa(klon), lmix(klon)
     5402  REAL zsortie1d(klon)
     5403  ! CR: on remplace lmax(klon,klev+1)
     5404  INTEGER lmax(klon), lmin(klon), lentr(klon)
     5405  REAL linter(klon)
     5406  REAL zmix(klon), fracazmix(klon)
     5407  ! RC
     5408  REAL zmax(klon), zw, zw2(klon, klev+1), ztva(klon, klev)
     5409
     5410  REAL zlev(klon, klev+1), zlay(klon, klev)
     5411  REAL zh(klon, klev), zdhadj(klon, klev)
     5412  REAL ztv(klon, klev)
     5413  REAL zu(klon, klev), zv(klon, klev), zo(klon, klev)
     5414  REAL wh(klon, klev+1)
     5415  REAL wu(klon, klev+1), wv(klon, klev+1), wo(klon, klev+1)
     5416  REAL zla(klon, klev+1)
     5417  REAL zwa(klon, klev+1)
     5418  REAL zld(klon, klev+1)
     5419  ! real zwd(klon,klev+1)
     5420  REAL zsortie(klon, klev)
     5421  REAL zva(klon, klev)
     5422  REAL zua(klon, klev)
     5423  REAL zoa(klon, klev)
     5424
     5425  REAL zha(klon, klev)
     5426  REAL wa_moy(klon, klev+1)
     5427  REAL fraca(klon, klev+1)
     5428  REAL fracc(klon, klev+1)
     5429  REAL zf, zf2
     5430  REAL thetath2(klon, klev), wth2(klon, klev)
     5431  ! common/comtherm/thetath2,wth2
     5432
     5433  REAL count_time
     5434  ! integer isplit,nsplit
     5435  INTEGER isplit, nsplit, ialt
     5436  PARAMETER (nsplit=10)
     5437  DATA isplit/0/
     5438  SAVE isplit
     5439  !$OMP THREADPRIVATE(isplit)
     5440
     5441  LOGICAL sorties
     5442  REAL rho(klon, klev), rhobarz(klon, klev+1), masse(klon, klev)
     5443  REAL zpspsk(klon, klev)
     5444
     5445  ! real wmax(klon,klev),wmaxa(klon)
     5446  REAL wmax(klon), wmaxa(klon)
     5447  REAL wa(klon, klev, klev+1)
     5448  REAL wd(klon, klev+1)
     5449  REAL larg_part(klon, klev, klev+1)
     5450  REAL fracd(klon, klev+1)
     5451  REAL xxx(klon, klev+1)
     5452  REAL larg_cons(klon, klev+1)
     5453  REAL larg_detr(klon, klev+1)
     5454  REAL fm0(klon, klev+1), entr0(klon, klev), detr(klon, klev)
     5455  REAL pu_therm(klon, klev), pv_therm(klon, klev)
     5456  REAL fm(klon, klev+1), entr(klon, klev)
     5457  REAL fmc(klon, klev+1)
     5458
     5459  ! CR:nouvelles variables
     5460  REAL f_star(klon, klev+1), entr_star(klon, klev)
     5461  REAL entr_star_tot(klon), entr_star2(klon)
     5462  REAL zalim(klon)
     5463  INTEGER lalim(klon)
     5464  REAL norme(klon)
     5465  REAL f(klon), f0(klon)
     5466  REAL zlevinter(klon)
     5467  LOGICAL therm
     5468  LOGICAL first
     5469  DATA first/.FALSE./
     5470  SAVE first
     5471  !$OMP THREADPRIVATE(first)
     5472  ! RC
     5473
     5474  CHARACTER *2 str2
     5475  CHARACTER *10 str10
     5476
     5477  CHARACTER (LEN=20) :: modname = 'calcul_sec'
     5478  CHARACTER (LEN=80) :: abort_message
     5479
     5480
     5481  ! LOGICAL vtest(klon),down
     5482
     5483  EXTERNAL scopy
     5484
     5485  INTEGER ncorrec
     5486  SAVE ncorrec
     5487  DATA ncorrec/0/
     5488  !$OMP THREADPRIVATE(ncorrec)
     5489
     5490
     5491  ! -----------------------------------------------------------------------
     5492  ! initialisation:
     5493  ! ---------------
     5494
     5495  sorties = .TRUE.
     5496  IF (ngrid/=klon) THEN
     5497    PRINT *
     5498    PRINT *, 'STOP dans convadj'
     5499    PRINT *, 'ngrid    =', ngrid
     5500    PRINT *, 'klon  =', klon
     5501  END IF
     5502
     5503  ! -----------------------------------------------------------------------
     5504  ! incrementation eventuelle de tendances precedentes:
     5505  ! ---------------------------------------------------
     5506
     5507  ! print*,'0 OK convect8'
     5508
     5509  DO l = 1, nlay
     5510    DO ig = 1, ngrid
     5511      zpspsk(ig, l) = (pplay(ig,l)/pplev(ig,1))**rkappa
     5512      zh(ig, l) = pt(ig, l)/zpspsk(ig, l)
     5513      zu(ig, l) = pu(ig, l)
     5514      zv(ig, l) = pv(ig, l)
     5515      zo(ig, l) = po(ig, l)
     5516      ztv(ig, l) = zh(ig, l)*(1.+0.61*zo(ig,l))
     5517    END DO
     5518  END DO
     5519
     5520  ! print*,'1 OK convect8'
     5521  ! --------------------
     5522
     5523
     5524  ! + + + + + + + + + + +
     5525
     5526
     5527  ! wa, fraca, wd, fracd --------------------   zlev(2), rhobarz
     5528  ! wh,wt,wo ...
     5529
     5530  ! + + + + + + + + + + +  zh,zu,zv,zo,rho
     5531
     5532
     5533  ! --------------------   zlev(1)
     5534  ! \\\\\\\\\\\\\\\\\\\\
     5535
     5536
     5537
     5538  ! -----------------------------------------------------------------------
     5539  ! Calcul des altitudes des couches
     5540  ! -----------------------------------------------------------------------
     5541
     5542  DO l = 2, nlay
     5543    DO ig = 1, ngrid
     5544      zlev(ig, l) = 0.5*(pphi(ig,l)+pphi(ig,l-1))/rg
     5545    END DO
     5546  END DO
     5547  DO ig = 1, ngrid
     5548    zlev(ig, 1) = 0.
     5549    zlev(ig, nlay+1) = (2.*pphi(ig,klev)-pphi(ig,klev-1))/rg
     5550  END DO
     5551  DO l = 1, nlay
     5552    DO ig = 1, ngrid
     5553      zlay(ig, l) = pphi(ig, l)/rg
     5554    END DO
     5555  END DO
     5556
     5557  ! print*,'2 OK convect8'
     5558  ! -----------------------------------------------------------------------
     5559  ! Calcul des densites
     5560  ! -----------------------------------------------------------------------
     5561
     5562  DO l = 1, nlay
     5563    DO ig = 1, ngrid
     5564      rho(ig, l) = pplay(ig, l)/(zpspsk(ig,l)*rd*zh(ig,l))
     5565    END DO
     5566  END DO
     5567
     5568  DO l = 2, nlay
     5569    DO ig = 1, ngrid
     5570      rhobarz(ig, l) = 0.5*(rho(ig,l)+rho(ig,l-1))
     5571    END DO
     5572  END DO
     5573
     5574  DO k = 1, nlay
     5575    DO l = 1, nlay + 1
     5576      DO ig = 1, ngrid
     5577        wa(ig, k, l) = 0.
     5578      END DO
     5579    END DO
     5580  END DO
     5581
     5582  ! print*,'3 OK convect8'
     5583  ! ------------------------------------------------------------------
     5584  ! Calcul de w2, quarre de w a partir de la cape
     5585  ! a partir de w2, on calcule wa, vitesse de l'ascendance
     5586
     5587  ! ATTENTION: Dans cette version, pour cause d'economie de memoire,
     5588  ! w2 est stoke dans wa
     5589
     5590  ! ATTENTION: dans convect8, on n'utilise le calcule des wa
     5591  ! independants par couches que pour calculer l'entrainement
     5592  ! a la base et la hauteur max de l'ascendance.
     5593
     5594  ! Indicages:
     5595  ! l'ascendance provenant du niveau k traverse l'interface l avec
     5596  ! une vitesse wa(k,l).
     5597
     5598  ! --------------------
     5599
     5600  ! + + + + + + + + + +
     5601
     5602  ! wa(k,l)   ----       --------------------    l
     5603  ! /\
     5604  ! /||\       + + + + + + + + + +
     5605  ! ||
     5606  ! ||        --------------------
     5607  ! ||
     5608  ! ||        + + + + + + + + + +
     5609  ! ||
     5610  ! ||        --------------------
     5611  ! ||__
     5612  ! |___      + + + + + + + + + +     k
     5613
     5614  ! --------------------
     5615
     5616
     5617
     5618  ! ------------------------------------------------------------------
     5619
     5620  ! CR: ponderation entrainement des couches instables
     5621  ! def des entr_star tels que entr=f*entr_star
     5622  DO l = 1, klev
     5623    DO ig = 1, ngrid
     5624      entr_star(ig, l) = 0.
     5625    END DO
     5626  END DO
     5627  ! determination de la longueur de la couche d entrainement
     5628  DO ig = 1, ngrid
     5629    lentr(ig) = 1
     5630  END DO
     5631
     5632  ! on ne considere que les premieres couches instables
     5633  therm = .FALSE.
     5634  DO k = nlay - 2, 1, -1
     5635    DO ig = 1, ngrid
     5636      IF (ztv(ig,k)>ztv(ig,k+1) .AND. ztv(ig,k+1)<=ztv(ig,k+2)) THEN
     5637        lentr(ig) = k + 1
     5638        therm = .TRUE.
     5639      END IF
     5640    END DO
     5641  END DO
     5642  ! limitation de la valeur du lentr
     5643  ! do ig=1,ngrid
     5644  ! lentr(ig)=min(5,lentr(ig))
     5645  ! enddo
     5646  ! determination du lmin: couche d ou provient le thermique
     5647  DO ig = 1, ngrid
     5648    lmin(ig) = 1
     5649  END DO
     5650  DO ig = 1, ngrid
     5651    DO l = nlay, 2, -1
     5652      IF (ztv(ig,l-1)>ztv(ig,l)) THEN
     5653        lmin(ig) = l - 1
     5654      END IF
     5655    END DO
     5656  END DO
     5657  ! initialisations
     5658  DO ig = 1, ngrid
     5659    zalim(ig) = 0.
     5660    norme(ig) = 0.
     5661    lalim(ig) = 1
     5662  END DO
     5663  DO k = 1, klev - 1
     5664    DO ig = 1, ngrid
     5665      zalim(ig) = zalim(ig) + zlev(ig, k)*max(0., (ztv(ig,k)-ztv(ig, &
     5666        k+1))/(zlev(ig,k+1)-zlev(ig,k)))
     5667      ! s         *(zlev(ig,k+1)-zlev(ig,k))
     5668      norme(ig) = norme(ig) + max(0., (ztv(ig,k)-ztv(ig,k+1))/(zlev(ig, &
     5669        k+1)-zlev(ig,k)))
     5670      ! s          *(zlev(ig,k+1)-zlev(ig,k))
     5671    END DO
     5672  END DO
     5673  DO ig = 1, ngrid
     5674    IF (norme(ig)>1.E-10) THEN
     5675      zalim(ig) = max(10.*zalim(ig)/norme(ig), zlev(ig,2))
     5676      ! zalim(ig)=min(zalim(ig),zlev(ig,lentr(ig)))
     5677    END IF
     5678  END DO
     5679  ! détermination du lalim correspondant
     5680  DO k = 1, klev - 1
     5681    DO ig = 1, ngrid
     5682      IF ((zalim(ig)>zlev(ig,k)) .AND. (zalim(ig)<=zlev(ig,k+1))) THEN
     5683        lalim(ig) = k
     5684      END IF
     5685    END DO
     5686  END DO
     5687
     5688  ! definition de l'entrainement des couches
     5689  DO l = 1, klev - 1
     5690    DO ig = 1, ngrid
     5691      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<lentr(ig)) THEN
     5692        entr_star(ig, l) = max((ztv(ig,l)-ztv(ig,l+1)), 0.) & ! s
     5693                                                              ! *(zlev(ig,l+1)-zlev(ig,l))
     5694          *sqrt(zlev(ig,l+1))
     5695        ! autre def
     5696        ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
     5697        ! s                         /zlev(ig,lentr(ig)+2)))**(3./2.)
     5698      END IF
     5699    END DO
     5700  END DO
     5701  ! nouveau test
     5702  ! if (therm) then
     5703  DO l = 1, klev - 1
     5704    DO ig = 1, ngrid
     5705      IF (ztv(ig,l)>ztv(ig,l+1) .AND. l>=lmin(ig) .AND. l<=lalim(ig) .AND. &
     5706          zalim(ig)>1.E-10) THEN
     5707        ! if (l.le.lentr(ig)) then
     5708        ! entr_star(ig,l)=zlev(ig,l+1)*(1.-(zlev(ig,l+1)
     5709        ! s                         /zalim(ig)))**(3./2.)
     5710        ! write(10,*)zlev(ig,l),entr_star(ig,l)
     5711      END IF
     5712    END DO
     5713  END DO
     5714  ! endif
     5715  ! pas de thermique si couche 1 stable
     5716  DO ig = 1, ngrid
     5717    IF (lmin(ig)>5) THEN
     5718      DO l = 1, klev
     5719        entr_star(ig, l) = 0.
     5720      END DO
     5721    END IF
     5722  END DO
     5723  ! calcul de l entrainement total
     5724  DO ig = 1, ngrid
     5725    entr_star_tot(ig) = 0.
     5726  END DO
     5727  DO ig = 1, ngrid
     5728    DO k = 1, klev
     5729      entr_star_tot(ig) = entr_star_tot(ig) + entr_star(ig, k)
     5730    END DO
     5731  END DO
     5732  ! Calcul entrainement normalise
     5733  DO ig = 1, ngrid
     5734    IF (entr_star_tot(ig)>1.E-10) THEN
     5735      ! do l=1,lentr(ig)
     5736      DO l = 1, klev
     5737        ! def possibles pour entr_star: zdthetadz, dthetadz, zdtheta
     5738        entr_star(ig, l) = entr_star(ig, l)/entr_star_tot(ig)
     5739      END DO
     5740    END IF
     5741  END DO
     5742
     5743  ! print*,'fin calcul entr_star'
     5744  DO k = 1, klev
     5745    DO ig = 1, ngrid
     5746      ztva(ig, k) = ztv(ig, k)
     5747    END DO
     5748  END DO
     5749  ! RC
     5750  ! print*,'7 OK convect8'
     5751  DO k = 1, klev + 1
     5752    DO ig = 1, ngrid
     5753      zw2(ig, k) = 0.
     5754      fmc(ig, k) = 0.
     5755      ! CR
     5756      f_star(ig, k) = 0.
     5757      ! RC
     5758      larg_cons(ig, k) = 0.
     5759      larg_detr(ig, k) = 0.
     5760      wa_moy(ig, k) = 0.
     5761    END DO
     5762  END DO
     5763
     5764  ! print*,'8 OK convect8'
     5765  DO ig = 1, ngrid
     5766    linter(ig) = 1.
     5767    lmaxa(ig) = 1
     5768    lmix(ig) = 1
     5769    wmaxa(ig) = 0.
     5770  END DO
     5771
     5772  ! CR:
     5773  DO l = 1, nlay - 2
     5774    DO ig = 1, ngrid
     5775      IF (ztv(ig,l)>ztv(ig,l+1) .AND. entr_star(ig,l)>1.E-10 .AND. &
     5776          zw2(ig,l)<1E-10) THEN
     5777        f_star(ig, l+1) = entr_star(ig, l)
     5778        ! test:calcul de dteta
     5779        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
     5780          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
     5781        larg_detr(ig, l) = 0.
     5782      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+entr_star(ig, &
     5783          l)>1.E-10)) THEN
     5784        f_star(ig, l+1) = f_star(ig, l) + entr_star(ig, l)
     5785        ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+entr_star(ig,l)*ztv(ig,l))/ &
     5786          f_star(ig, l+1)
     5787        zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/f_star(ig,l+1))**2 + &
     5788          2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, l)*(zlev(ig,l+1)-zlev(ig,l))
     5789      END IF
     5790      ! determination de zmax continu par interpolation lineaire
     5791      IF (zw2(ig,l+1)<0.) THEN
     5792        ! test
     5793        IF (abs(zw2(ig,l+1)-zw2(ig,l))<1E-10) THEN
     5794          ! print*,'pb linter'
     5795        END IF
     5796        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
     5797          ig,l))
     5798        zw2(ig, l+1) = 0.
     5799        lmaxa(ig) = l
     5800      ELSE
     5801        IF (zw2(ig,l+1)<0.) THEN
     5802          ! print*,'pb1 zw2<0'
     5803        END IF
     5804        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
     5805      END IF
     5806      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
     5807        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
     5808        lmix(ig) = l + 1
     5809        wmaxa(ig) = wa_moy(ig, l+1)
     5810      END IF
     5811    END DO
     5812  END DO
     5813  ! print*,'fin calcul zw2'
     5814
     5815  ! Calcul de la couche correspondant a la hauteur du thermique
     5816  DO ig = 1, ngrid
     5817    lmax(ig) = lentr(ig)
     5818    ! lmax(ig)=lalim(ig)
     5819  END DO
     5820  DO ig = 1, ngrid
     5821    DO l = nlay, lentr(ig) + 1, -1
     5822      ! do l=nlay,lalim(ig)+1,-1
     5823      IF (zw2(ig,l)<=1.E-10) THEN
     5824        lmax(ig) = l - 1
     5825      END IF
     5826    END DO
     5827  END DO
     5828  ! pas de thermique si couche 1 stable
     5829  DO ig = 1, ngrid
     5830    IF (lmin(ig)>5) THEN
     5831      lmax(ig) = 1
     5832      lmin(ig) = 1
     5833      lentr(ig) = 1
     5834      lalim(ig) = 1
     5835    END IF
     5836  END DO
     5837
     5838  ! Determination de zw2 max
     5839  DO ig = 1, ngrid
     5840    wmax(ig) = 0.
     5841  END DO
     5842
     5843  DO l = 1, nlay
     5844    DO ig = 1, ngrid
     5845      IF (l<=lmax(ig)) THEN
     5846        IF (zw2(ig,l)<0.) THEN
     5847          ! print*,'pb2 zw2<0'
     5848        END IF
     5849        zw2(ig, l) = sqrt(zw2(ig,l))
     5850        wmax(ig) = max(wmax(ig), zw2(ig,l))
     5851      ELSE
     5852        zw2(ig, l) = 0.
     5853      END IF
     5854    END DO
     5855  END DO
     5856
     5857  ! Longueur caracteristique correspondant a la hauteur des thermiques.
     5858  DO ig = 1, ngrid
     5859    zmax(ig) = 0.
     5860    zlevinter(ig) = zlev(ig, 1)
     5861  END DO
     5862  DO ig = 1, ngrid
     5863    ! calcul de zlevinter
     5864    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
     5865      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
     5866    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,lmin(ig)))
     5867  END DO
     5868  DO ig = 1, ngrid
     5869    ! write(8,*)zmax(ig),lmax(ig),lentr(ig),lmin(ig)
     5870  END DO
     5871  ! on stope après les calculs de zmax et wmax
     5872  RETURN
     5873
     5874  ! print*,'avant fermeture'
     5875  ! Fermeture,determination de f
     5876  ! Attention! entrainement normalisé ou pas?
     5877  DO ig = 1, ngrid
     5878    entr_star2(ig) = 0.
     5879  END DO
     5880  DO ig = 1, ngrid
     5881    IF (entr_star_tot(ig)<1.E-10) THEN
     5882      f(ig) = 0.
     5883    ELSE
     5884      DO k = lmin(ig), lentr(ig)
     5885        ! do k=lmin(ig),lalim(ig)
     5886        entr_star2(ig) = entr_star2(ig) + entr_star(ig, k)**2/(rho(ig,k)*( &
     5887          zlev(ig,k+1)-zlev(ig,k)))
     5888      END DO
     5889      ! Nouvelle fermeture
     5890      f(ig) = wmax(ig)/(max(500.,zmax(ig))*r_aspect*entr_star2(ig))
     5891      ! s            *entr_star_tot(ig)
     5892      ! test
     5893      ! if (first) then
     5894      f(ig) = f(ig) + (f0(ig)-f(ig))*exp(-ptimestep/zmax(ig)*wmax(ig))
     5895      ! endif
     5896    END IF
     5897    f0(ig) = f(ig)
     5898    ! first=.true.
     5899  END DO
     5900  ! print*,'apres fermeture'
     5901  ! on stoppe après la fermeture
     5902  RETURN
     5903  ! Calcul de l'entrainement
     5904  DO k = 1, klev
     5905    DO ig = 1, ngrid
     5906      entr(ig, k) = f(ig)*entr_star(ig, k)
     5907    END DO
     5908  END DO
     5909  ! on stoppe après le calcul de entr
     5910  ! RETURN
     5911  ! CR:test pour entrainer moins que la masse
     5912  ! do ig=1,ngrid
     5913  ! do l=1,lentr(ig)
     5914  ! if ((entr(ig,l)*ptimestep).gt.(0.9*masse(ig,l))) then
     5915  ! entr(ig,l+1)=entr(ig,l+1)+entr(ig,l)
     5916  ! s                       -0.9*masse(ig,l)/ptimestep
     5917  ! entr(ig,l)=0.9*masse(ig,l)/ptimestep
     5918  ! endif
     5919  ! enddo
     5920  ! enddo
     5921  ! CR: fin test
     5922  ! Calcul des flux
     5923  DO ig = 1, ngrid
     5924    DO l = 1, lmax(ig) - 1
     5925      fmc(ig, l+1) = fmc(ig, l) + entr(ig, l)
     5926    END DO
     5927  END DO
     5928
     5929  ! RC
     5930
     5931
     5932  ! print*,'9 OK convect8'
     5933  ! print*,'WA1 ',wa_moy
     5934
     5935  ! determination de l'indice du debut de la mixed layer ou w decroit
     5936
     5937  ! calcul de la largeur de chaque ascendance dans le cas conservatif.
     5938  ! dans ce cas simple, on suppose que la largeur de l'ascendance provenant
     5939  ! d'une couche est égale à la hauteur de la couche alimentante.
     5940  ! La vitesse maximale dans l'ascendance est aussi prise comme estimation
     5941  ! de la vitesse d'entrainement horizontal dans la couche alimentante.
     5942
     5943  DO l = 2, nlay
     5944    DO ig = 1, ngrid
     5945      IF (l<=lmaxa(ig)) THEN
     5946        zw = max(wa_moy(ig,l), 1.E-10)
     5947        larg_cons(ig, l) = zmax(ig)*r_aspect*fmc(ig, l)/(rhobarz(ig,l)*zw)
     5948      END IF
     5949    END DO
     5950  END DO
     5951
     5952  DO l = 2, nlay
     5953    DO ig = 1, ngrid
     5954      IF (l<=lmaxa(ig)) THEN
     5955        ! if (idetr.eq.0) then
     5956        ! cette option est finalement en dur.
     5957        IF ((l_mix*zlev(ig,l))<0.) THEN
     5958          ! print*,'pb l_mix*zlev<0'
     5959        END IF
     5960        ! CR: test: nouvelle def de lambda
     5961        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
     5962        IF (zw2(ig,l)>1.E-10) THEN
     5963          larg_detr(ig, l) = sqrt((l_mix/zw2(ig,l))*zlev(ig,l))
     5964        ELSE
     5965          larg_detr(ig, l) = sqrt(l_mix*zlev(ig,l))
     5966        END IF
     5967        ! RC
     5968        ! else if (idetr.eq.1) then
     5969        ! larg_detr(ig,l)=larg_cons(ig,l)
     5970        ! s            *sqrt(l_mix*zlev(ig,l))/larg_cons(ig,lmix(ig))
     5971        ! else if (idetr.eq.2) then
     5972        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
     5973        ! s            *sqrt(wa_moy(ig,l))
     5974        ! else if (idetr.eq.4) then
     5975        ! larg_detr(ig,l)=sqrt(l_mix*zlev(ig,l))
     5976        ! s            *wa_moy(ig,l)
     5977        ! endif
     5978      END IF
     5979    END DO
     5980  END DO
     5981
     5982  ! print*,'10 OK convect8'
     5983  ! print*,'WA2 ',wa_moy
     5984  ! calcul de la fraction de la maille concernée par l'ascendance en tenant
     5985  ! compte de l'epluchage du thermique.
     5986
     5987  ! CR def de  zmix continu (profil parabolique des vitesses)
     5988  DO ig = 1, ngrid
     5989    IF (lmix(ig)>1.) THEN
     5990      ! test
     5991      IF (((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
     5992          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
     5993          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))- &
     5994          (zlev(ig,lmix(ig)))))>1E-10) THEN
     5995
     5996        zmix(ig) = ((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)) &
     5997          )**2-(zlev(ig,lmix(ig)+1))**2)-(zw2(ig,lmix(ig))-zw2(ig, &
     5998          lmix(ig)+1))*((zlev(ig,lmix(ig)-1))**2-(zlev(ig,lmix(ig)))**2))/ &
     5999          (2.*((zw2(ig,lmix(ig)-1)-zw2(ig,lmix(ig)))*((zlev(ig,lmix(ig)))- &
     6000          (zlev(ig,lmix(ig)+1)))-(zw2(ig,lmix(ig))- &
     6001          zw2(ig,lmix(ig)+1))*((zlev(ig,lmix(ig)-1))-(zlev(ig,lmix(ig))))))
     6002      ELSE
     6003        zmix(ig) = zlev(ig, lmix(ig))
     6004        ! print*,'pb zmix'
     6005      END IF
     6006    ELSE
     6007      zmix(ig) = 0.
     6008    END IF
     6009    ! test
     6010    IF ((zmax(ig)-zmix(ig))<0.) THEN
     6011      zmix(ig) = 0.99*zmax(ig)
     6012      ! print*,'pb zmix>zmax'
     6013    END IF
     6014  END DO
     6015
     6016  ! calcul du nouveau lmix correspondant
     6017  DO ig = 1, ngrid
     6018    DO l = 1, klev
     6019      IF (zmix(ig)>=zlev(ig,l) .AND. zmix(ig)<zlev(ig,l+1)) THEN
     6020        lmix(ig) = l
     6021      END IF
     6022    END DO
     6023  END DO
     6024
     6025  DO l = 2, nlay
     6026    DO ig = 1, ngrid
     6027      IF (larg_cons(ig,l)>1.) THEN
     6028        ! print*,ig,l,lmix(ig),lmaxa(ig),larg_cons(ig,l),'  KKK'
     6029        fraca(ig, l) = (larg_cons(ig,l)-larg_detr(ig,l))/(r_aspect*zmax(ig))
     6030        ! test
     6031        fraca(ig, l) = max(fraca(ig,l), 0.)
     6032        fraca(ig, l) = min(fraca(ig,l), 0.5)
     6033        fracd(ig, l) = 1. - fraca(ig, l)
     6034        fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
     6035      ELSE
     6036        ! wa_moy(ig,l)=0.
     6037        fraca(ig, l) = 0.
     6038        fracc(ig, l) = 0.
     6039        fracd(ig, l) = 1.
     6040      END IF
     6041    END DO
     6042  END DO
     6043  ! CR: calcul de fracazmix
     6044  DO ig = 1, ngrid
     6045    fracazmix(ig) = (fraca(ig,lmix(ig)+1)-fraca(ig,lmix(ig)))/ &
     6046      (zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))*zmix(ig) + &
     6047      fraca(ig, lmix(ig)) - zlev(ig, lmix(ig))*(fraca(ig,lmix(ig)+1)-fraca(ig &
     6048      ,lmix(ig)))/(zlev(ig,lmix(ig)+1)-zlev(ig,lmix(ig)))
     6049  END DO
     6050
     6051  DO l = 2, nlay
     6052    DO ig = 1, ngrid
     6053      IF (larg_cons(ig,l)>1.) THEN
     6054        IF (l>lmix(ig)) THEN
     6055          ! test
     6056          IF (zmax(ig)-zmix(ig)<1.E-10) THEN
     6057            ! print*,'pb xxx'
     6058            xxx(ig, l) = (lmaxa(ig)+1.-l)/(lmaxa(ig)+1.-lmix(ig))
     6059          ELSE
     6060            xxx(ig, l) = (zmax(ig)-zlev(ig,l))/(zmax(ig)-zmix(ig))
     6061          END IF
     6062          IF (idetr==0) THEN
     6063            fraca(ig, l) = fracazmix(ig)
     6064          ELSE IF (idetr==1) THEN
     6065            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)
     6066          ELSE IF (idetr==2) THEN
     6067            fraca(ig, l) = fracazmix(ig)*(1.-(1.-xxx(ig,l))**2)
     6068          ELSE
     6069            fraca(ig, l) = fracazmix(ig)*xxx(ig, l)**2
     6070          END IF
     6071          ! print*,ig,l,lmix(ig),lmaxa(ig),xxx(ig,l),'LLLLLLL'
     6072          fraca(ig, l) = max(fraca(ig,l), 0.)
     6073          fraca(ig, l) = min(fraca(ig,l), 0.5)
     6074          fracd(ig, l) = 1. - fraca(ig, l)
     6075          fracc(ig, l) = larg_cons(ig, l)/(r_aspect*zmax(ig))
     6076        END IF
     6077      END IF
     6078    END DO
     6079  END DO
     6080
     6081  ! print*,'fin calcul fraca'
     6082  ! print*,'11 OK convect8'
     6083  ! print*,'Ea3 ',wa_moy
     6084  ! ------------------------------------------------------------------
     6085  ! Calcul de fracd, wd
     6086  ! somme wa - wd = 0
     6087  ! ------------------------------------------------------------------
     6088
     6089
     6090  DO ig = 1, ngrid
     6091    fm(ig, 1) = 0.
     6092    fm(ig, nlay+1) = 0.
     6093  END DO
     6094
     6095  DO l = 2, nlay
     6096    DO ig = 1, ngrid
     6097      fm(ig, l) = fraca(ig, l)*wa_moy(ig, l)*rhobarz(ig, l)
     6098      ! CR:test
     6099      IF (entr(ig,l-1)<1E-10 .AND. fm(ig,l)>fm(ig,l-1) .AND. l>lmix(ig)) THEN
     6100        fm(ig, l) = fm(ig, l-1)
     6101        ! write(1,*)'ajustement fm, l',l
     6102      END IF
     6103      ! write(1,*)'ig,l,fm(ig,l)',ig,l,fm(ig,l)
     6104      ! RC
     6105    END DO
     6106    DO ig = 1, ngrid
     6107      IF (fracd(ig,l)<0.1) THEN
     6108        abort_message = 'fracd trop petit'
     6109        CALL abort_physic(modname, abort_message, 1)
     6110
     6111      ELSE
     6112        ! vitesse descendante "diagnostique"
     6113        wd(ig, l) = fm(ig, l)/(fracd(ig,l)*rhobarz(ig,l))
     6114      END IF
     6115    END DO
     6116  END DO
     6117
     6118  DO l = 1, nlay
     6119    DO ig = 1, ngrid
     6120      ! masse(ig,l)=rho(ig,l)*(zlev(ig,l+1)-zlev(ig,l))
     6121      masse(ig, l) = (pplev(ig,l)-pplev(ig,l+1))/rg
     6122    END DO
     6123  END DO
     6124
     6125  ! print*,'12 OK convect8'
     6126  ! print*,'WA4 ',wa_moy
     6127  ! c------------------------------------------------------------------
     6128  ! calcul du transport vertical
     6129  ! ------------------------------------------------------------------
     6130
     6131  GO TO 4444
     6132  ! print*,'XXXXXXXXXXXXXXX ptimestep= ',ptimestep
     6133  DO l = 2, nlay - 1
     6134    DO ig = 1, ngrid
     6135      IF (fm(ig,l+1)*ptimestep>masse(ig,l) .AND. fm(ig,l+1)*ptimestep>masse( &
     6136          ig,l+1)) THEN
     6137        ! print*,'WARN!!! FM>M ig=',ig,' l=',l,'  FM='
     6138        ! s         ,fm(ig,l+1)*ptimestep
     6139        ! s         ,'   M=',masse(ig,l),masse(ig,l+1)
     6140      END IF
     6141    END DO
     6142  END DO
     6143
     6144  DO l = 1, nlay
     6145    DO ig = 1, ngrid
     6146      IF (entr(ig,l)*ptimestep>masse(ig,l)) THEN
     6147        ! print*,'WARN!!! E>M ig=',ig,' l=',l,'  E=='
     6148        ! s         ,entr(ig,l)*ptimestep
     6149        ! s         ,'   M=',masse(ig,l)
     6150      END IF
     6151    END DO
     6152  END DO
     6153
     6154  DO l = 1, nlay
     6155    DO ig = 1, ngrid
     6156      IF (.NOT. fm(ig,l)>=0. .OR. .NOT. fm(ig,l)<=10.) THEN
     6157        ! print*,'WARN!!! fm exagere ig=',ig,'   l=',l
     6158        ! s         ,'   FM=',fm(ig,l)
     6159      END IF
     6160      IF (.NOT. masse(ig,l)>=1.E-10 .OR. .NOT. masse(ig,l)<=1.E4) THEN
     6161        ! print*,'WARN!!! masse exagere ig=',ig,'   l=',l
     6162        ! s         ,'   M=',masse(ig,l)
     6163        ! print*,'rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)',
     6164        ! s                 rho(ig,l),pplay(ig,l),zpspsk(ig,l),RD,zh(ig,l)
     6165        ! print*,'zlev(ig,l+1),zlev(ig,l)'
     6166        ! s                ,zlev(ig,l+1),zlev(ig,l)
     6167        ! print*,'pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)'
     6168        ! s                ,pphi(ig,l-1),pphi(ig,l),pphi(ig,l+1)
     6169      END IF
     6170      IF (.NOT. entr(ig,l)>=0. .OR. .NOT. entr(ig,l)<=10.) THEN
     6171        ! print*,'WARN!!! entr exagere ig=',ig,'   l=',l
     6172        ! s         ,'   E=',entr(ig,l)
     6173      END IF
     6174    END DO
     6175  END DO
     6176
     61774444 CONTINUE
     6178
     6179  ! CR:redefinition du entr
     6180  DO l = 1, nlay
     6181    DO ig = 1, ngrid
     6182      detr(ig, l) = fm(ig, l) + entr(ig, l) - fm(ig, l+1)
     6183      IF (detr(ig,l)<0.) THEN
     6184        ! entr(ig,l)=entr(ig,l)-detr(ig,l)
     6185        fm(ig, l+1) = fm(ig, l) + entr(ig, l)
     6186        detr(ig, l) = 0.
     6187        ! print*,'WARNING !!! detrainement negatif ',ig,l
     6188      END IF
     6189    END DO
     6190  END DO
     6191  ! RC
     6192  IF (w2di==1) THEN
     6193    fm0 = fm0 + ptimestep*(fm-fm0)/tho
     6194    entr0 = entr0 + ptimestep*(entr-entr0)/tho
     6195  ELSE
     6196    fm0 = fm
     6197    entr0 = entr
     6198  END IF
     6199
     6200  IF (1==1) THEN
     6201    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zh, zdhadj, &
     6202      zha)
     6203    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zo, pdoadj, &
     6204      zoa)
     6205  ELSE
     6206    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zh, &
     6207      zdhadj, zha)
     6208    CALL dqthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zo, &
     6209      pdoadj, zoa)
     6210  END IF
     6211
     6212  IF (1==0) THEN
     6213    CALL dvthermcell2(ngrid, nlay, ptimestep, fm0, entr0, masse, fraca, zmax, &
     6214      zu, zv, pduadj, pdvadj, zua, zva)
     6215  ELSE
     6216    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zu, pduadj, &
     6217      zua)
     6218    CALL dqthermcell(ngrid, nlay, ptimestep, fm0, entr0, masse, zv, pdvadj, &
     6219      zva)
     6220  END IF
     6221
     6222  DO l = 1, nlay
     6223    DO ig = 1, ngrid
     6224      zf = 0.5*(fracc(ig,l)+fracc(ig,l+1))
     6225      zf2 = zf/(1.-zf)
     6226      thetath2(ig, l) = zf2*(zha(ig,l)-zh(ig,l))**2
     6227      wth2(ig, l) = zf2*(0.5*(wa_moy(ig,l)+wa_moy(ig,l+1)))**2
     6228    END DO
     6229  END DO
     6230
     6231
     6232
     6233  ! print*,'13 OK convect8'
     6234  ! print*,'WA5 ',wa_moy
     6235  DO l = 1, nlay
     6236    DO ig = 1, ngrid
     6237      pdtadj(ig, l) = zdhadj(ig, l)*zpspsk(ig, l)
     6238    END DO
     6239  END DO
     6240
     6241
     6242  ! do l=1,nlay
     6243  ! do ig=1,ngrid
     6244  ! if(abs(pdtadj(ig,l))*86400..gt.500.) then
     6245  ! print*,'WARN!!! ig=',ig,'  l=',l
     6246  ! s         ,'   pdtadj=',pdtadj(ig,l)
     6247  ! endif
     6248  ! if(abs(pdoadj(ig,l))*86400..gt.1.) then
     6249  ! print*,'WARN!!! ig=',ig,'  l=',l
     6250  ! s         ,'   pdoadj=',pdoadj(ig,l)
     6251  ! endif
     6252  ! enddo
     6253  ! enddo
     6254
     6255  ! print*,'14 OK convect8'
     6256  ! ------------------------------------------------------------------
     6257  ! Calculs pour les sorties
     6258  ! ------------------------------------------------------------------
     6259
     6260  IF (sorties) THEN
     6261    DO l = 1, nlay
     6262      DO ig = 1, ngrid
     6263        zla(ig, l) = (1.-fracd(ig,l))*zmax(ig)
     6264        zld(ig, l) = fracd(ig, l)*zmax(ig)
     6265        IF (1.-fracd(ig,l)>1.E-10) zwa(ig, l) = wd(ig, l)*fracd(ig, l)/ &
     6266          (1.-fracd(ig,l))
     6267      END DO
     6268    END DO
     6269
     6270    ! deja fait
     6271    ! do l=1,nlay
     6272    ! do ig=1,ngrid
     6273    ! detr(ig,l)=fm(ig,l)+entr(ig,l)-fm(ig,l+1)
     6274    ! if (detr(ig,l).lt.0.) then
     6275    ! entr(ig,l)=entr(ig,l)-detr(ig,l)
     6276    ! detr(ig,l)=0.
     6277    ! print*,'WARNING !!! detrainement negatif ',ig,l
     6278    ! endif
     6279    ! enddo
     6280    ! enddo
     6281
     6282    ! print*,'15 OK convect8'
     6283
     6284    isplit = isplit + 1
     6285
     6286
     6287    ! #define und
     6288    GO TO 123
     6289#ifdef und
     6290    CALL writeg1d(1, nlay, wd, 'wd      ', 'wd      ')
     6291    CALL writeg1d(1, nlay, zwa, 'wa      ', 'wa      ')
     6292    CALL writeg1d(1, nlay, fracd, 'fracd      ', 'fracd      ')
     6293    CALL writeg1d(1, nlay, fraca, 'fraca      ', 'fraca      ')
     6294    CALL writeg1d(1, nlay, wa_moy, 'wam         ', 'wam         ')
     6295    CALL writeg1d(1, nlay, zla, 'la      ', 'la      ')
     6296    CALL writeg1d(1, nlay, zld, 'ld      ', 'ld      ')
     6297    CALL writeg1d(1, nlay, pt, 'pt      ', 'pt      ')
     6298    CALL writeg1d(1, nlay, zh, 'zh      ', 'zh      ')
     6299    CALL writeg1d(1, nlay, zha, 'zha      ', 'zha      ')
     6300    CALL writeg1d(1, nlay, zu, 'zu      ', 'zu      ')
     6301    CALL writeg1d(1, nlay, zv, 'zv      ', 'zv      ')
     6302    CALL writeg1d(1, nlay, zo, 'zo      ', 'zo      ')
     6303    CALL writeg1d(1, nlay, wh, 'wh      ', 'wh      ')
     6304    CALL writeg1d(1, nlay, wu, 'wu      ', 'wu      ')
     6305    CALL writeg1d(1, nlay, wv, 'wv      ', 'wv      ')
     6306    CALL writeg1d(1, nlay, wo, 'w15uo     ', 'wXo     ')
     6307    CALL writeg1d(1, nlay, zdhadj, 'zdhadj      ', 'zdhadj      ')
     6308    CALL writeg1d(1, nlay, pduadj, 'pduadj      ', 'pduadj      ')
     6309    CALL writeg1d(1, nlay, pdvadj, 'pdvadj      ', 'pdvadj      ')
     6310    CALL writeg1d(1, nlay, pdoadj, 'pdoadj      ', 'pdoadj      ')
     6311    CALL writeg1d(1, nlay, entr, 'entr        ', 'entr        ')
     6312    CALL writeg1d(1, nlay, detr, 'detr        ', 'detr        ')
     6313    CALL writeg1d(1, nlay, fm, 'fm          ', 'fm          ')
     6314
     6315    CALL writeg1d(1, nlay, pdtadj, 'pdtadj    ', 'pdtadj    ')
     6316    CALL writeg1d(1, nlay, pplay, 'pplay     ', 'pplay     ')
     6317    CALL writeg1d(1, nlay, pplev, 'pplev     ', 'pplev     ')
     6318
     6319    ! recalcul des flux en diagnostique...
     6320    ! print*,'PAS DE TEMPS ',ptimestep
     6321    CALL dt2f(pplev, pplay, pt, pdtadj, wh)
     6322    CALL writeg1d(1, nlay, wh, 'wh2     ', 'wh2     ')
     6323#endif
     6324123 CONTINUE
     6325
     6326  END IF
     6327
     6328  ! if(wa_moy(1,4).gt.1.e-10) stop
     6329
     6330  ! print*,'19 OK convect8'
     6331  RETURN
     6332END SUBROUTINE calcul_sec
     6333
     6334SUBROUTINE fermeture_seche(ngrid, nlay, pplay, pplev, pphi, zlev, rhobarz, &
     6335    f0, zpspsk, alim_star, zh, zo, lentr, lmin, nu_min, nu_max, r_aspect, &
     6336    zmax, wmax)
     6337
     6338  USE dimphy
     6339  IMPLICIT NONE
     6340
     6341  include "YOMCST.h"
     6342
     6343  INTEGER ngrid, nlay
     6344  REAL pplay(ngrid, nlay), pplev(ngrid, nlay+1)
     6345  REAL pphi(ngrid, nlay)
     6346  REAL zlev(klon, klev+1)
     6347  REAL alim_star(klon, klev)
     6348  REAL f0(klon)
     6349  INTEGER lentr(klon)
     6350  INTEGER lmin(klon)
     6351  REAL zmax(klon)
     6352  REAL wmax(klon)
     6353  REAL nu_min
     6354  REAL nu_max
     6355  REAL r_aspect
     6356  REAL rhobarz(klon, klev+1)
     6357  REAL zh(klon, klev)
     6358  REAL zo(klon, klev)
     6359  REAL zpspsk(klon, klev)
     6360
     6361  INTEGER ig, l
     6362
     6363  REAL f_star(klon, klev+1)
     6364  REAL detr_star(klon, klev)
     6365  REAL entr_star(klon, klev)
     6366  REAL zw2(klon, klev+1)
     6367  REAL linter(klon)
     6368  INTEGER lmix(klon)
     6369  INTEGER lmax(klon)
     6370  REAL zlevinter(klon)
     6371  REAL wa_moy(klon, klev+1)
     6372  REAL wmaxa(klon)
     6373  REAL ztv(klon, klev)
     6374  REAL ztva(klon, klev)
     6375  REAL nu(klon, klev)
     6376  ! real zmax0_sec(klon)
     6377  ! save zmax0_sec
     6378  REAL, SAVE, ALLOCATABLE :: zmax0_sec(:)
     6379  !$OMP THREADPRIVATE(zmax0_sec)
     6380  LOGICAL, SAVE :: first = .TRUE.
     6381  !$OMP THREADPRIVATE(first)
     6382
     6383  IF (first) THEN
     6384    ALLOCATE (zmax0_sec(klon))
     6385    first = .FALSE.
     6386  END IF
     6387
     6388  DO l = 1, nlay
     6389    DO ig = 1, ngrid
     6390      ztv(ig, l) = zh(ig, l)/zpspsk(ig, l)
     6391      ztv(ig, l) = ztv(ig, l)*(1.+retv*zo(ig,l))
     6392    END DO
     6393  END DO
     6394  DO l = 1, nlay - 2
     6395    DO ig = 1, ngrid
     6396      IF (ztv(ig,l)>ztv(ig,l+1) .AND. alim_star(ig,l)>1.E-10 .AND. &
     6397          zw2(ig,l)<1E-10) THEN
     6398        f_star(ig, l+1) = alim_star(ig, l)
     6399        ! test:calcul de dteta
     6400        zw2(ig, l+1) = 2.*rg*(ztv(ig,l)-ztv(ig,l+1))/ztv(ig, l+1)* &
     6401          (zlev(ig,l+1)-zlev(ig,l))*0.4*pphi(ig, l)/(pphi(ig,l+1)-pphi(ig,l))
     6402      ELSE IF ((zw2(ig,l)>=1E-10) .AND. (f_star(ig,l)+alim_star(ig, &
     6403          l))>1.E-10) THEN
     6404        ! estimation du detrainement a partir de la geometrie du pas
     6405        ! precedent
     6406        ! tests sur la definition du detr
     6407        nu(ig, l) = (nu_min+nu_max)/2.*(1.-(nu_max-nu_min)/(nu_max+nu_min)* &
     6408          tanh((((ztva(ig,l-1)-ztv(ig,l))/ztv(ig,l))/0.0005)))
     6409
     6410        detr_star(ig, l) = rhobarz(ig, l)*sqrt(zw2(ig,l))/ &
     6411          (r_aspect*zmax0_sec(ig))* & ! s
     6412                                      ! /(r_aspect*zmax0(ig))*
     6413          (sqrt(nu(ig,l)*zlev(ig,l+1)/sqrt(zw2(ig,l)))-sqrt(nu(ig,l)*zlev(ig, &
     6414          l)/sqrt(zw2(ig,l))))
     6415        detr_star(ig, l) = detr_star(ig, l)/f0(ig)
     6416        IF ((detr_star(ig,l))>f_star(ig,l)) THEN
     6417          detr_star(ig, l) = f_star(ig, l)
     6418        END IF
     6419        entr_star(ig, l) = 0.9*detr_star(ig, l)
     6420        IF ((l<lentr(ig))) THEN
     6421          entr_star(ig, l) = 0.
     6422          ! detr_star(ig,l)=0.
     6423        END IF
     6424        ! print*,'ok detr_star'
     6425        ! prise en compte du detrainement dans le calcul du flux
     6426        f_star(ig, l+1) = f_star(ig, l) + alim_star(ig, l) + &
     6427          entr_star(ig, l) - detr_star(ig, l)
     6428        ! test sur le signe de f_star
     6429        IF ((f_star(ig,l+1)+detr_star(ig,l))>1.E-10) THEN
     6430          ! AM on melange Tl et qt du thermique
     6431          ztva(ig, l) = (f_star(ig,l)*ztva(ig,l-1)+(entr_star(ig, &
     6432            l)+alim_star(ig,l))*ztv(ig,l))/(f_star(ig,l+1)+detr_star(ig,l))
     6433          zw2(ig, l+1) = zw2(ig, l)*(f_star(ig,l)/(f_star(ig, &
     6434            l+1)+detr_star(ig,l)))**2 + 2.*rg*(ztva(ig,l)-ztv(ig,l))/ztv(ig, &
     6435            l)*(zlev(ig,l+1)-zlev(ig,l))
     6436        END IF
     6437      END IF
     6438
     6439      IF (zw2(ig,l+1)<0.) THEN
     6440        linter(ig) = (l*(zw2(ig,l+1)-zw2(ig,l))-zw2(ig,l))/(zw2(ig,l+1)-zw2( &
     6441          ig,l))
     6442        zw2(ig, l+1) = 0.
     6443        ! print*,'linter=',linter(ig)
     6444      ELSE
     6445        wa_moy(ig, l+1) = sqrt(zw2(ig,l+1))
     6446      END IF
     6447      IF (wa_moy(ig,l+1)>wmaxa(ig)) THEN
     6448        ! lmix est le niveau de la couche ou w (wa_moy) est maximum
     6449        lmix(ig) = l + 1
     6450        wmaxa(ig) = wa_moy(ig, l+1)
     6451      END IF
     6452    END DO
     6453  END DO
     6454  ! print*,'fin calcul zw2'
     6455
     6456  ! Calcul de la couche correspondant a la hauteur du thermique
     6457  DO ig = 1, ngrid
     6458    lmax(ig) = lentr(ig)
     6459  END DO
     6460  DO ig = 1, ngrid
     6461    DO l = nlay, lentr(ig) + 1, -1
     6462      IF (zw2(ig,l)<=1.E-10) THEN
     6463        lmax(ig) = l - 1
     6464      END IF
     6465    END DO
     6466  END DO
     6467  ! pas de thermique si couche 1 stable
     6468  DO ig = 1, ngrid
     6469    IF (lmin(ig)>1) THEN
     6470      lmax(ig) = 1
     6471      lmin(ig) = 1
     6472      lentr(ig) = 1
     6473    END IF
     6474  END DO
     6475
     6476  ! Determination de zw2 max
     6477  DO ig = 1, ngrid
     6478    wmax(ig) = 0.
     6479  END DO
     6480
     6481  DO l = 1, nlay
     6482    DO ig = 1, ngrid
     6483      IF (l<=lmax(ig)) THEN
     6484        IF (zw2(ig,l)<0.) THEN
     6485          ! print*,'pb2 zw2<0'
     6486        END IF
     6487        zw2(ig, l) = sqrt(zw2(ig,l))
     6488        wmax(ig) = max(wmax(ig), zw2(ig,l))
     6489      ELSE
     6490        zw2(ig, l) = 0.
     6491      END IF
     6492    END DO
     6493  END DO
     6494
     6495  ! Longueur caracteristique correspondant a la hauteur des thermiques.
     6496  DO ig = 1, ngrid
     6497    zmax(ig) = 0.
     6498    zlevinter(ig) = zlev(ig, 1)
     6499  END DO
     6500  DO ig = 1, ngrid
     6501    ! calcul de zlevinter
     6502    zlevinter(ig) = (zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))*linter(ig) + &
     6503      zlev(ig, lmax(ig)) - lmax(ig)*(zlev(ig,lmax(ig)+1)-zlev(ig,lmax(ig)))
     6504    ! pour le cas ou on prend tjs lmin=1
     6505    ! zmax(ig)=max(zmax(ig),zlevinter(ig)-zlev(ig,lmin(ig)))
     6506    zmax(ig) = max(zmax(ig), zlevinter(ig)-zlev(ig,1))
     6507    zmax0_sec(ig) = zmax(ig)
     6508  END DO
     6509
     6510  RETURN
     6511END SUBROUTINE fermeture_seche
     6512
     6513END MODULE lmdz_thermcell_old

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

    r4589 r4590  
     1MODULE lmdz_thermcell_plume
    12!
    23! $Id: thermcell_plume.F90 3074 2017-11-15 13:31:44Z fhourdin $
    34!
     5CONTAINS
     6
    47      SUBROUTINE thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
    58     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
    … …  
    2225!--------------------------------------------------------------------------
    2326
    24        USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
    25        USE thermcell_ini_mod, ONLY: fact_epsilon, betalpha, afact, fact_shell
    26        USE thermcell_ini_mod, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
    27        USE thermcell_ini_mod, ONLY: mix0, thermals_flag_alim
     27       USE lmdz_thermcell_ini, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
     28       USE lmdz_thermcell_ini, ONLY: fact_epsilon, betalpha, afact, fact_shell
     29       USE lmdz_thermcell_ini, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
     30       USE lmdz_thermcell_ini, ONLY: mix0, thermals_flag_alim
     31       USE lmdz_thermcell_alim, ONLY : thermcell_alim
     32       USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
     33
    2834
    2935       IMPLICIT NONE
    … …  
    446452 RETURN
    447453     end
     454END MODULE lmdz_thermcell_plume

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

    r4589 r4590  
     1MODULE lmdz_thermcell_plume_6A
    12!
    23! $Id$
    34!
     5CONTAINS
     6
    47      SUBROUTINE thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,  &
    58     &           zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
    … …  
    1215!--------------------------------------------------------------------------
    1316
    14        USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
    15        USE thermcell_ini_mod, ONLY: fact_epsilon, betalpha, afact, fact_shell
    16        USE thermcell_ini_mod, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
    17        USE thermcell_ini_mod, ONLY: mix0, thermals_flag_alim
     17       USE lmdz_thermcell_ini, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
     18       USE lmdz_thermcell_ini, ONLY: fact_epsilon, betalpha, afact, fact_shell
     19       USE lmdz_thermcell_ini, ONLY: detr_min, entr_min, detr_q_coef, detr_q_power
     20       USE lmdz_thermcell_ini, ONLY: mix0, thermals_flag_alim
     21       USE lmdz_thermcell_alim, ONLY : thermcell_alim
     22       USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
     23
    1824
    1925       IMPLICIT NONE
    … …  
    718724!--------------------------------------------------------------------------
    719725
    720       USE thermcell_ini_mod, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
     726      USE lmdz_thermcell_ini, ONLY: prt_level,fact_thermals_ed_dz,iflag_thermals_ed,RLvCP,RETV,RG
     727       USE lmdz_thermcell_qsat, ONLY : thermcell_qsat
    721728      IMPLICIT NONE
    722729
    … …  
    11091116     return
    11101117     end
     1118END MODULE lmdz_thermcell_plume_6A

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

    r4589 r4590  
     1MODULE lmdz_thermcell_qsat
     2CONTAINS
     3
    14subroutine thermcell_qsat(klon,active,pplev,ztemp,zqta,zqsat)
    25implicit none
    … …  
    9497return
    9598end
     99END MODULE lmdz_thermcell_qsat

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

    r4588 r4590  
    8383    USE yamada_ini_mod, ONLY : yamada_ini
    8484    USE atke_turbulence_ini_mod, ONLY : atke_ini
    85     USE thermcell_ini_mod, ONLY : thermcell_ini
     85    USE lmdz_thermcell_ini, ONLY : thermcell_ini
     86    USE lmdz_thermcell_dtke, ONLY : thermcell_dtke
    8687    USE blowing_snow_ini_mod, ONLY : blowing_snow_ini , qbst_bs
    8788    USE lscp_ini_mod, ONLY : lscp_ini

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

    r4514 r4590  
    135135    USE print_control_mod, ONLY: lunout
    136136    USE aero_mod, ONLY : naero_grp
     137    USE lmdz_thermcell_dq, ONLY : thermcell_dq
    137138
    138139    USE tracco2i_mod
    … …  
    249250    !----------
    250251    REAL,DIMENSION(klon,klev+1),INTENT(IN)   :: fm_therm
    251     REAL,DIMENSION(klon,klev),INTENT(IN)     :: entr_therm
     252    REAL,DIMENSION(klon,klev),INTENT(INOUT)     :: entr_therm
    252253    !
    253254    !Couche limite:
Note: See TracChangeset for help on using the changeset viewer.