Changeset 4089 for LMDZ6/trunk/libf/phylmd/thermcell_alp.F90
- Timestamp:
- Mar 10, 2022, 7:23:47 PM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/thermcell_alp.F90
r2387 r4089 1 1 ! $Id: thermcell_main.F90 2351 2015-08-25 15:14:59Z emillour $ 2 2 ! 3 SUBROUTINE thermcell_alp(ngrid,nlay,ptimestep & 4 & ,pplay,pplev & 5 & ,fm0,entr0,lmax & 6 & ,ale_bl,alp_bl,lalim_conv,wght_th & 7 & ,zw2,fraca & 8 !!! ncessaire en plus 9 & ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax & 10 !!! nrlmd le 10/04/2012 11 & ,pbl_tke,pctsrf,omega,airephy & 12 & ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 & 13 & ,n2,s2,ale_bl_stat & 14 & ,therm_tke_max,env_tke_max & 15 & ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke & 16 & ,alp_bl_conv,alp_bl_stat & 17 !!! fin nrlmd le 10/04/2012 3 SUBROUTINE thermcell_alp(ngrid,nlay,ptimestep & ! in 4 & ,pplay,pplev & ! in 5 & ,fm0,entr0,lmax & ! in 6 & ,pbl_tke,pctsrf,omega,airephy & ! in 7 & ,zw2,fraca & ! in 8 & ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax & ! in 9 ! 10 & ,ale_bl,alp_bl,lalim_conv,wght_th & ! out 11 & ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 & ! out 12 & ,n2,s2,ale_bl_stat & ! out 13 & ,therm_tke_max,env_tke_max & ! out 14 & ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke & ! out 15 & ,alp_bl_conv,alp_bl_stat & ! out 18 16 &) 19 17 20 USE dimphy21 18 USE indice_sol_mod 22 19 IMPLICIT NONE 23 20 24 21 !======================================================================= 25 ! Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu26 ! Version du 09.02.0727 ! Calcul du transport vertical dans la couche limite en presence28 ! de "thermiques" explicitement representes avec processus nuageux29 22 ! 30 ! Reecriture a partir d'un listing papier a Habas, le 14/02/00 31 ! 32 ! le thermique est suppose homogene et dissipe par melange avec 33 ! son environnement. la longueur l_mix controle l'efficacite du 34 ! melange 35 ! 36 ! Le calcul du transport des differentes especes se fait en prenant 37 ! en compte: 38 ! 1. un flux de masse montant 39 ! 2. un flux de masse descendant 40 ! 3. un entrainement 41 ! 4. un detrainement 42 ! 43 ! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr) 44 ! Introduction of an implicit computation of vertical advection in 45 ! the environment of thermal plumes in thermcell_dq 46 ! impl = 0 : explicit, 1 : implicit, -1 : old version 47 ! controled by iflag_thermals = 48 ! 15, 16 run with impl=-1 : numerical convergence with NPv3 49 ! 17, 18 run with impl=1 : more stable 50 ! 15 and 17 correspond to the activation of the stratocumulus "bidouille" 51 ! 23 ! Auteurs: Catherine Rio 24 ! Modifications : 25 ! Nicolas Rochetin et Jean-Yves Grandpeix 26 ! pour la fermeture stochastique. 2012 27 ! Frédéric Hourdin : 28 ! netoyage informatique. 2022 29 ! 52 30 !======================================================================= 53 31 !----------------------------------------------------------------------- … … 58 36 #include "YOETHF.h" 59 37 #include "FCTTRE.h" 60 #include " thermcell.h"38 #include "alpale.h" 61 39 62 40 ! arguments: 63 41 ! ---------- 64 42 65 !IM 140508 66 67 INTEGER ngrid,nlay 68 real ptimestep 69 REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1) 70 71 ! local: 72 ! ------ 73 43 !------Entrees 44 integer, intent(in) :: ngrid,nlay 45 real, intent(in) :: ptimestep 46 real, intent(in) :: pplay(ngrid,nlay),pplev(ngrid,nlay+1) 47 integer, intent(in), dimension(ngrid) ::lmax,lalim 48 real, intent(in), dimension(ngrid) :: zmax 49 real, intent(in), dimension(ngrid,nlay+1) :: zw2 50 real, intent(in), dimension(ngrid,nlay+1) :: fraca 51 real, intent(in), dimension(ngrid,nlay) :: wth3 52 real, intent(in), dimension(ngrid,nlay) :: rhobarz 53 real, intent(in), dimension(ngrid) :: wmax_sec 54 real, intent(in), dimension(ngrid,nlay) :: entr0 55 real, intent(in), dimension(ngrid,nlay+1) :: fm0,fm 56 real, intent(in), dimension(ngrid) :: pcon 57 real, intent(in), dimension(ngrid,nlay) :: alim_star 58 real, intent(in), dimension(ngrid,nlay+1,nbsrf) :: pbl_tke 59 real, intent(in), dimension(ngrid,nbsrf) :: pctsrf 60 real, intent(in), dimension(ngrid,nlay) :: omega 61 real, intent(in), dimension(ngrid) :: airephy 62 !------Sorties 63 real, intent(out), dimension(ngrid) :: ale_bl,alp_bl 64 real, intent(out), dimension(ngrid,nlay) :: wght_th 65 integer, intent(out), dimension(ngrid) :: lalim_conv 66 real, intent(out), dimension(ngrid) :: zlcl,fraca0,w0,w_conv 67 real, intent(out), dimension(ngrid) :: therm_tke_max0,env_tke_max0,n2,s2,ale_bl_stat 68 real, intent(out), dimension(ngrid,nlay) :: therm_tke_max,env_tke_max 69 real, intent(out), dimension(ngrid) :: alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke 70 real, intent(out), dimension(ngrid) :: alp_bl_conv,alp_bl_stat 71 72 !============================================================================================= 73 !------Local 74 !============================================================================================= 74 75 75 76 REAL susqr2pi, reuler 76 77 77 INTEGER ig,k,l 78 INTEGER lmax(klon),lalim(klon)79 real zmax(klon),zw2(klon,klev+1)80 81 !on garde le zmax du pas de temps precedent82 83 84 real fraca(klon,klev+1)85 real wth3(klon,klev)86 ! FH probleme de dimensionnement avec l'allocation dynamique87 ! common/comtherm/thetath2,wth288 real rhobarz(klon,klev)89 90 real wmax_sec(klon)91 real fm0(klon,klev+1),entr0(klon,klev)92 real fm(klon,klev+1)93 94 !niveau de condensation95 real pcon(klon)96 97 real alim_star(klon,klev)98 99 !!! nrlmd le 10/04/2012100 101 !------Entrées102 real pbl_tke(klon,klev+1,nbsrf)103 real pctsrf(klon,nbsrf)104 real omega(klon,klev)105 real airephy(klon)106 !------Sorties107 real zlcl(klon),fraca0(klon),w0(klon),w_conv(klon)108 real therm_tke_max0(klon),env_tke_max0(klon)109 real n2(klon),s2(klon)110 real ale_bl_stat(klon)111 real therm_tke_max(klon,klev),env_tke_max(klon,klev)112 real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon)113 !------Local114 78 integer nsrf 115 real rhobarz0( klon) ! Densité au LCL116 logical ok_lcl( klon) ! Existence du LCL des thermiques117 integer klcl( klon) ! Niveau du LCL118 real interp( klon) ! Coef d'interpolation pour le LCL79 real rhobarz0(ngrid) ! Densité au LCL 80 logical ok_lcl(ngrid) ! Existence du LCL des thermiques 81 integer klcl(ngrid) ! Niveau du LCL 82 real interp(ngrid) ! Coef d'interpolation pour le LCL 119 83 !--Triggering 120 real Su ! Surface unité: celle d'un updraft élémentaire 121 parameter(Su=4e4) 122 real hcoef ! Coefficient directeur pour le calcul de s2 123 parameter(hcoef=1) 124 real hmincoef ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2 125 parameter(hmincoef=0.3) 126 real eps1 ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd) 127 parameter(eps1=0.3) 128 real hmin(ngrid) ! Ordonnée à l'origine pour le calcul de s2 129 real zmax_moy(ngrid) ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl) 130 real zmax_moy_coef 131 parameter(zmax_moy_coef=0.33) 132 real depth(klon) ! Epaisseur moyenne du cumulus 133 real w_max(klon) ! Vitesse max statistique 134 real s_max(klon) 84 real, parameter :: su_cst=4e4 ! Surface unite: celle d'un updraft élémentaire 85 real, parameter :: hcoef=1 ! Coefficient directeur pour le calcul de s2 86 real, parameter :: hmincoef=0.3 ! Coefficient directeur pour l'ordonnée à l'origine pour le calcul de s2 87 real, parameter :: eps1=0.3 ! Fraction de surface occupée par la population 1 : eps1=n1*s1/(fraca0*Sd) 88 real, dimension(ngrid) :: hmin ! Ordonnée à l'origine pour le calcul de s2 89 real, dimension(ngrid) :: zmax_moy ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl) 90 real, parameter :: zmax_moy_coef=0.33 91 real, dimension(ngrid) :: depth ! Epaisseur moyenne du cumulus 92 real, dimension(ngrid) :: w_max ! Vitesse max statistique 93 real, dimension(ngrid) :: s_max(ngrid) 135 94 !--Closure 136 real pbl_tke_max(klon,klev) ! Profil de TKE moyenne 137 real pbl_tke_max0(klon) ! TKE moyenne au LCL 138 real w_ls(klon,klev) ! Vitesse verticale grande échelle (m/s) 139 real coef_m ! On considère un rendement pour alp_bl_fluct_m 140 parameter(coef_m=1.) 141 real coef_tke ! On considère un rendement pour alp_bl_fluct_tke 142 parameter(coef_tke=1.) 143 144 !!! fin nrlmd le 10/04/2012 145 146 ! 147 !nouvelles variables pour la convection 148 real ale_bl(klon) 149 real alp_bl(klon) 150 real alp_int(klon),dp_int(klon),zdp 151 real fm_tot(klon) 152 real wght_th(klon,klev) 153 integer lalim_conv(klon) 154 !v1d logical therm 155 !v1d save therm 156 95 real, dimension(ngrid,nlay) :: pbl_tke_max ! Profil de TKE moyenne 96 real, dimension(ngrid) :: pbl_tke_max0 ! TKE moyenne au LCL 97 real, dimension(ngrid,nlay) :: w_ls ! Vitesse verticale grande échelle (m/s) 98 real, parameter :: coef_m=1. ! On considère un rendement pour alp_bl_fluct_m 99 real, parameter :: coef_tke=1. ! On considère un rendement pour alp_bl_fluct_tke 100 real :: zdp 101 real, dimension(ngrid) :: alp_int,dp_int 102 real, dimension(ngrid) :: fm_tot 157 103 158 104 !------------------------------------------------------------ 159 105 ! Initialize output arrays related to stochastic triggering 160 106 !------------------------------------------------------------ 161 DO ig = 1, klon107 DO ig = 1,ngrid 162 108 zlcl(ig) = 0. 163 109 fraca0(ig) = 0. … … 175 121 alp_bl_stat(ig) = 0. 176 122 ENDDO 177 DO l = 1, klev178 DO ig = 1, klon123 DO l = 1,nlay 124 DO ig = 1,ngrid 179 125 therm_tke_max(ig,l) = 0. 180 126 env_tke_max(ig,l) = 0. 181 127 ENDDO 182 128 ENDDO 183 !------------------------------------------------------------184 185 129 186 130 !------------Test sur le LCL des thermiques 187 131 do ig=1,ngrid 188 132 ok_lcl(ig)=.false. 189 if ( (pcon(ig) .gt. pplay(ig, klev-1)) .and. (pcon(ig) .lt. pplay(ig,1)) ) ok_lcl(ig)=.true.133 if ( (pcon(ig) .gt. pplay(ig,nlay-1)) .and. (pcon(ig) .lt. pplay(ig,1)) ) ok_lcl(ig)=.true. 190 134 enddo 191 135 … … 207 151 enddo 208 152 209 !------------Hauteur des thermiques210 !!jyg le 27/04/2012211 !! do ig =1,ngrid212 !! rhobarz0(ig)=rhobarz(ig,klcl(ig))+(rhobarz(ig,klcl(ig)+1) &213 !! & -rhobarz(ig,klcl(ig)))*interp(ig)214 !! zlcl(ig)=(pplev(ig,1)-pcon(ig))/(rhobarz0(ig)*RG)215 !! if ( (.not.ok_lcl(ig)) .or. (zlcl(ig).gt.zmax(ig)) ) zlcl(ig)=zmax(ig) ! Si zclc > zmax alors on pose zlcl = zmax216 !! enddo217 153 do ig =1,ngrid 218 154 !CR:REHABILITATION ZMAX CONTINU … … 257 193 258 194 !-----Calcul de la TKE transportée par les thermiques : therm_tke_max 259 call thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0, & 260 & rg,pplev,therm_tke_max) 195 call thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0, & ! in 196 & rg,pplev,therm_tke_max) ! out 261 197 ! print *,' thermcell_tke_transport -> ' !!jyg 262 198 … … 330 266 ! print *,'avant Calcul de Wmax ' !!jyg 331 267 332 !-----Calcul de Wmax et ALE_BL_STAT associée 333 !!jyg le 30/04/2012 334 !! do ig=1,ngrid 335 !! if ( (depth(ig).ge.10.) .and. (s_max(ig).gt.1.) ) then 336 !! w_max(ig)=w0(ig)*(1.+sqrt(2.*log(s_max(ig)/su)-log(2.*3.14)-log(2.*log(s_max(ig)/su)-log(2.*3.14)))) 337 !! ale_bl_stat(ig)=0.5*w_max(ig)**2 338 !! else 339 !! w_max(ig)=0. 340 !! ale_bl_stat(ig)=0. 341 !! endif 342 !! enddo 343 susqr2pi=su*sqrt(2.*Rpi) 268 susqr2pi=su_cst*sqrt(2.*Rpi) 344 269 reuler=exp(1.) 345 270 do ig=1,ngrid … … 409 334 lalim_conv(:)=lalim(:) 410 335 411 do k=1, klev336 do k=1,nlay 412 337 do ig=1,ngrid 413 338 if (k<=lalim_conv(ig)) fm_tot(ig)=fm_tot(ig)+fm(ig,k) … … 417 342 ! assez bizarre car, si on est dans la couche d'alim et que alim_star et 418 343 ! plus petit que 1.e-10, on prend wght_th=1. 419 do k=1, klev344 do k=1,nlay 420 345 do ig=1,ngrid 421 346 if (k<=lalim_conv(ig).and.alim_star(ig,k)>1.e-10) then
Note: See TracChangeset
for help on using the changeset viewer.