| Directory: | ./ |
|---|---|
| File: | phys/thermcell_main.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 245 | 284 | 86.3% |
| Branches: | 257 | 320 | 80.3% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | ! | ||
| 2 | ! $Id: thermcell_main.F90 3451 2019-01-27 11:07:30Z fhourdin $ | ||
| 3 | ! | ||
| 4 | 479521 | SUBROUTINE thermcell_main(itap,ngrid,nlay,ptimestep & | |
| 5 | & ,pplay,pplev,pphi,debut & | ||
| 6 | 480 | & ,pu,pv,pt,po & | |
| 7 | & ,pduadj,pdvadj,pdtadj,pdoadj & | ||
| 8 | 480 | & ,fm0,entr0,detr0,zqta,zqla,lmax & | |
| 9 | & ,ratqscth,ratqsdiff,zqsatth & | ||
| 10 | & ,Ale_bl,Alp_bl,lalim_conv,wght_th & | ||
| 11 | 480 | & ,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 | ||
| 27 | IMPLICIT NONE | ||
| 28 | |||
| 29 | !======================================================================= | ||
| 30 | ! Auteurs: Frederic Hourdin, Catherine Rio, Anne Mathieu | ||
| 31 | ! Version du 09.02.07 | ||
| 32 | ! Calcul du transport vertical dans la couche limite en presence | ||
| 33 | ! de "thermiques" explicitement representes avec processus nuageux | ||
| 34 | ! | ||
| 35 | ! Reecriture a partir d'un listing papier a Habas, le 14/02/00 | ||
| 36 | ! | ||
| 37 | ! le thermique est suppose homogene et dissipe par melange avec | ||
| 38 | ! son environnement. la longueur l_mix controle l'efficacite du | ||
| 39 | ! melange | ||
| 40 | ! | ||
| 41 | ! Le calcul du transport des differentes especes se fait en prenant | ||
| 42 | ! en compte: | ||
| 43 | ! 1. un flux de masse montant | ||
| 44 | ! 2. un flux de masse descendant | ||
| 45 | ! 3. un entrainement | ||
| 46 | ! 4. un detrainement | ||
| 47 | ! | ||
| 48 | ! Modif 2013/01/04 (FH hourdin@lmd.jussieu.fr) | ||
| 49 | ! Introduction of an implicit computation of vertical advection in | ||
| 50 | ! the environment of thermal plumes in thermcell_dq | ||
| 51 | ! impl = 0 : explicit, 1 : implicit, -1 : old version | ||
| 52 | ! controled by iflag_thermals = | ||
| 53 | ! 15, 16 run with impl=-1 : numerical convergence with NPv3 | ||
| 54 | ! 17, 18 run with impl=1 : more stable | ||
| 55 | ! 15 and 17 correspond to the activation of the stratocumulus "bidouille" | ||
| 56 | ! | ||
| 57 | !======================================================================= | ||
| 58 | |||
| 59 | |||
| 60 | !----------------------------------------------------------------------- | ||
| 61 | ! declarations: | ||
| 62 | ! ------------- | ||
| 63 | |||
| 64 | ! | ||
| 65 | ! $Header$ | ||
| 66 | ! | ||
| 67 | ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre | ||
| 68 | ! veillez � n'utiliser que des ! pour les commentaires | ||
| 69 | ! et � bien positionner les & des lignes de continuation | ||
| 70 | ! (les placer en colonne 6 et en colonne 73) | ||
| 71 | ! | ||
| 72 | ! | ||
| 73 | ! A1.0 Fundamental constants | ||
| 74 | REAL RPI,RCLUM,RHPLA,RKBOL,RNAVO | ||
| 75 | ! A1.1 Astronomical constants | ||
| 76 | REAL RDAY,REA,REPSM,RSIYEA,RSIDAY,ROMEGA | ||
| 77 | ! A1.1.bis Constantes concernant l'orbite de la Terre: | ||
| 78 | REAL R_ecc, R_peri, R_incl | ||
| 79 | ! A1.2 Geoide | ||
| 80 | REAL RA,RG,R1SA | ||
| 81 | ! A1.3 Radiation | ||
| 82 | ! REAL RSIGMA,RI0 | ||
| 83 | REAL RSIGMA | ||
| 84 | ! A1.4 Thermodynamic gas phase | ||
| 85 | REAL RMO3,RMCO2,RMC,RMCH4,RMN2O,RMCFC11,RMCFC12 | ||
| 86 | REAL R,RMD,RMV,RD,RV,RCPD,RCPV,RCVD,RCVV | ||
| 87 | REAL RKAPPA,RETV, eps_w | ||
| 88 | ! A1.5,6 Thermodynamic liquid,solid phases | ||
| 89 | REAL RCW,RCS | ||
| 90 | ! A1.7 Thermodynamic transition of phase | ||
| 91 | REAL RLVTT,RLSTT,RLMLT,RTT,RATM | ||
| 92 | ! A1.8 Curve of saturation | ||
| 93 | REAL RESTT,RALPW,RBETW,RGAMW,RALPS,RBETS,RGAMS | ||
| 94 | REAL RALPD,RBETD,RGAMD | ||
| 95 | ! | ||
| 96 | COMMON/YOMCST/RPI ,RCLUM ,RHPLA ,RKBOL ,RNAVO & | ||
| 97 | & ,RDAY ,REA ,REPSM ,RSIYEA,RSIDAY,ROMEGA & | ||
| 98 | & ,R_ecc, R_peri, R_incl & | ||
| 99 | & ,RA ,RG ,R1SA & | ||
| 100 | & ,RSIGMA & | ||
| 101 | & ,R ,RMD ,RMV ,RD ,RV ,RCPD & | ||
| 102 | & ,RMO3 ,RMCO2 ,RMC ,RMCH4 ,RMN2O ,RMCFC11 ,RMCFC12 & | ||
| 103 | & ,RCPV ,RCVD ,RCVV ,RKAPPA,RETV, eps_w & | ||
| 104 | & ,RCW ,RCS & | ||
| 105 | & ,RLVTT ,RLSTT ,RLMLT ,RTT ,RATM & | ||
| 106 | & ,RESTT ,RALPW ,RBETW ,RGAMW ,RALPS ,RBETS ,RGAMS & | ||
| 107 | & ,RALPD ,RBETD ,RGAMD | ||
| 108 | ! ------------------------------------------------------------------ | ||
| 109 | !$OMP THREADPRIVATE(/YOMCST/) | ||
| 110 | ! | ||
| 111 | ! $Id: YOETHF.h 2799 2017-02-24 18:50:33Z jyg $ | ||
| 112 | ! | ||
| 113 | ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre | ||
| 114 | ! veillez n'utiliser que des ! pour les commentaires | ||
| 115 | ! et bien positionner les & des lignes de continuation | ||
| 116 | ! (les placer en colonne 6 et en colonne 73) | ||
| 117 | ! | ||
| 118 | !* COMMON *YOETHF* DERIVED CONSTANTS SPECIFIC TO ECMWF THERMODYNAMICS | ||
| 119 | ! | ||
| 120 | ! *R__ES* *CONSTANTS USED FOR COMPUTATION OF SATURATION | ||
| 121 | ! MIXING RATIO OVER LIQUID WATER(*R_LES*) OR | ||
| 122 | ! ICE(*R_IES*). | ||
| 123 | ! *RVTMP2* *RVTMP2=RCPV/RCPD-1. | ||
| 124 | ! *RHOH2O* *DENSITY OF LIQUID WATER. (RATM/100.) | ||
| 125 | ! | ||
| 126 | REAL R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES | ||
| 127 | REAL RVTMP2, RHOH2O | ||
| 128 | REAL R5ALVCP,R5ALSCP,RALVDCP,RALSDCP,RALFDCP,RTWAT,RTBER,RTBERCU | ||
| 129 | REAL RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,RKOOP2 | ||
| 130 | LOGICAL OK_BAD_ECMWF_THERMO ! If TRUE, then variables set by rrtm/suphec.F90 | ||
| 131 | ! If FALSE, then variables set by suphel.F90 | ||
| 132 | COMMON /YOETHF/R2ES, R3LES, R3IES, R4LES, R4IES, R5LES, R5IES, & | ||
| 133 | & RVTMP2, RHOH2O, & | ||
| 134 | & R5ALVCP,R5ALSCP,RALVDCP,RALSDCP, & | ||
| 135 | & RALFDCP,RTWAT,RTBER,RTBERCU, & | ||
| 136 | & RTICE,RTICECU,RTWAT_RTICE_R,RTWAT_RTICECU_R,RKOOP1,& | ||
| 137 | & RKOOP2, & | ||
| 138 | & OK_BAD_ECMWF_THERMO | ||
| 139 | |||
| 140 | !$OMP THREADPRIVATE(/YOETHF/) | ||
| 141 | ! | ||
| 142 | ! $Header$ | ||
| 143 | ! | ||
| 144 | ! | ||
| 145 | ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre | ||
| 146 | ! veillez n'utiliser que des ! pour les commentaires | ||
| 147 | ! et bien positionner les & des lignes de continuation | ||
| 148 | ! (les placer en colonne 6 et en colonne 73) | ||
| 149 | ! | ||
| 150 | ! ------------------------------------------------------------------ | ||
| 151 | ! This COMDECK includes the Thermodynamical functions for the cy39 | ||
| 152 | ! ECMWF Physics package. | ||
| 153 | ! Consistent with YOMCST Basic physics constants, assuming the | ||
| 154 | ! partial pressure of water vapour is given by a first order | ||
| 155 | ! Taylor expansion of Qs(T) w.r.t. to Temperature, using constants | ||
| 156 | ! in YOETHF | ||
| 157 | ! ------------------------------------------------------------------ | ||
| 158 | REAL PTARG, PDELARG, P5ARG, PQSARG, PCOARG | ||
| 159 | REAL FOEEW, FOEDE, qsats, qsatl, dqsats, dqsatl | ||
| 160 | LOGICAL thermcep | ||
| 161 | PARAMETER (thermcep=.TRUE.) | ||
| 162 | ! | ||
| 163 | FOEEW ( PTARG,PDELARG ) = EXP ( & | ||
| 164 | & (R3LES*(1.-PDELARG)+R3IES*PDELARG) * (PTARG-RTT) & | ||
| 165 | & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG)) ) | ||
| 166 | ! | ||
| 167 | FOEDE ( PTARG,PDELARG,P5ARG,PQSARG,PCOARG ) = PQSARG*PCOARG*P5ARG & | ||
| 168 | & / (PTARG-(R4LES*(1.-PDELARG)+R4IES*PDELARG))**2 | ||
| 169 | ! | ||
| 170 | qsats(ptarg) = 100.0 * 0.622 * 10.0 & | ||
| 171 | & ** (2.07023 - 0.00320991 * ptarg & | ||
| 172 | & - 2484.896 / ptarg + 3.56654 * LOG10(ptarg)) | ||
| 173 | qsatl(ptarg) = 100.0 * 0.622 * 10.0 & | ||
| 174 | & ** (23.8319 - 2948.964 / ptarg & | ||
| 175 | & - 5.028 * LOG10(ptarg) & | ||
| 176 | & - 29810.16 * EXP( - 0.0699382 * ptarg) & | ||
| 177 | & + 25.21935 * EXP( - 2999.924 / ptarg)) | ||
| 178 | ! | ||
| 179 | dqsats(ptarg,pqsarg) = RLVTT/RCPD*pqsarg * (3.56654/ptarg & | ||
| 180 | & +2484.896*LOG(10.)/ptarg**2 & | ||
| 181 | & -0.00320991*LOG(10.)) | ||
| 182 | dqsatl(ptarg,pqsarg) = RLVTT/RCPD*pqsarg*LOG(10.)* & | ||
| 183 | & (2948.964/ptarg**2-5.028/LOG(10.)/ptarg & | ||
| 184 | & +25.21935*2999.924/ptarg**2*EXP(-2999.924/ptarg) & | ||
| 185 | & +29810.16*0.0699382*EXP(-0.0699382*ptarg)) | ||
| 186 | integer :: iflag_thermals,nsplit_thermals | ||
| 187 | |||
| 188 | !!! nrlmd le 10/04/2012 | ||
| 189 | integer :: iflag_trig_bl,iflag_clos_bl | ||
| 190 | integer :: tau_trig_shallow,tau_trig_deep | ||
| 191 | real :: s_trig | ||
| 192 | !!! fin nrlmd le 10/04/2012 | ||
| 193 | |||
| 194 | real,parameter :: r_aspect_thermals=2.,l_mix_thermals=30. | ||
| 195 | real :: alp_bl_k | ||
| 196 | real :: tau_thermals,fact_thermals_ed_dz | ||
| 197 | integer,parameter :: w2di_thermals=0 | ||
| 198 | integer :: isplit | ||
| 199 | |||
| 200 | integer :: iflag_coupl,iflag_clos,iflag_wake | ||
| 201 | integer :: iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure | ||
| 202 | |||
| 203 | common/ctherm1/iflag_thermals,nsplit_thermals,iflag_thermals_closure | ||
| 204 | common/ctherm2/tau_thermals,alp_bl_k,fact_thermals_ed_dz | ||
| 205 | common/ctherm4/iflag_coupl,iflag_clos,iflag_wake | ||
| 206 | common/ctherm5/iflag_thermals_ed,iflag_thermals_optflux | ||
| 207 | |||
| 208 | !!! nrlmd le 10/04/2012 | ||
| 209 | common/ctherm6/iflag_trig_bl,iflag_clos_bl | ||
| 210 | common/ctherm7/tau_trig_shallow,tau_trig_deep | ||
| 211 | common/ctherm8/s_trig | ||
| 212 | !!! fin nrlmd le 10/04/2012 | ||
| 213 | |||
| 214 | !$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm4/,/ctherm5/) | ||
| 215 | !$OMP THREADPRIVATE(/ctherm6/,/ctherm7/,/ctherm8/) | ||
| 216 | |||
| 217 | ! arguments: | ||
| 218 | ! ---------- | ||
| 219 | |||
| 220 | !IM 140508 | ||
| 221 | INTEGER itap | ||
| 222 | |||
| 223 | INTEGER ngrid,nlay | ||
| 224 | real ptimestep | ||
| 225 | REAL pt(ngrid,nlay),pdtadj(ngrid,nlay) | ||
| 226 | REAL pu(ngrid,nlay),pduadj(ngrid,nlay) | ||
| 227 | REAL pv(ngrid,nlay),pdvadj(ngrid,nlay) | ||
| 228 | REAL po(ngrid,nlay),pdoadj(ngrid,nlay) | ||
| 229 | REAL pplay(ngrid,nlay),pplev(ngrid,nlay+1) | ||
| 230 | real pphi(ngrid,nlay) | ||
| 231 | LOGICAL debut | ||
| 232 | |||
| 233 | ! local: | ||
| 234 | ! ------ | ||
| 235 | |||
| 236 | integer icount | ||
| 237 | |||
| 238 | integer, save :: dvdq=1,dqimpl=-1 | ||
| 239 | !$OMP THREADPRIVATE(dvdq,dqimpl) | ||
| 240 | data icount/0/ | ||
| 241 | save icount | ||
| 242 | !$OMP THREADPRIVATE(icount) | ||
| 243 | |||
| 244 | integer,save :: igout=1 | ||
| 245 | !$OMP THREADPRIVATE(igout) | ||
| 246 | integer,save :: lunout1=6 | ||
| 247 | !$OMP THREADPRIVATE(lunout1) | ||
| 248 | integer,save :: lev_out=10 | ||
| 249 | !$OMP THREADPRIVATE(lev_out) | ||
| 250 | |||
| 251 | REAL susqr2pi, Reuler | ||
| 252 | |||
| 253 | INTEGER ig,k,l,ll,ierr | ||
| 254 | real zsortie1d(klon) | ||
| 255 | 960 | INTEGER lmax(klon),lmin(klon),lalim(klon) | |
| 256 | 960 | INTEGER lmix(klon) | |
| 257 | 960 | INTEGER lmix_bis(klon) | |
| 258 | 960 | real linter(klon) | |
| 259 | 960 | real zmix(klon) | |
| 260 | 960 | real zmax(klon),zw2(klon,klev+1),ztva(klon,klev),zw_est(klon,klev+1),ztva_est(klon,klev) | |
| 261 | ! real fraca(klon,klev) | ||
| 262 | |||
| 263 | 960 | real zmax_sec(klon) | |
| 264 | !on garde le zmax du pas de temps precedent | ||
| 265 | real zmax0(klon) | ||
| 266 | !FH/IM save zmax0 | ||
| 267 | |||
| 268 | real lambda | ||
| 269 | |||
| 270 | 960 | real zlev(klon,klev+1),zlay(klon,klev) | |
| 271 | 960 | real deltaz(klon,klev) | |
| 272 | 960 | REAL zh(klon,klev) | |
| 273 | 960 | real zthl(klon,klev),zdthladj(klon,klev) | |
| 274 | REAL ztv(klon,klev) | ||
| 275 | 960 | real zu(klon,klev),zv(klon,klev),zo(klon,klev) | |
| 276 | 960 | real zl(klon,klev) | |
| 277 | real zsortie(klon,klev) | ||
| 278 | 960 | real zva(klon,klev) | |
| 279 | 960 | real zua(klon,klev) | |
| 280 | 960 | real zoa(klon,klev) | |
| 281 | |||
| 282 | 960 | real zta(klon,klev) | |
| 283 | 960 | real zha(klon,klev) | |
| 284 | real fraca(klon,klev+1) | ||
| 285 | real zf,zf2 | ||
| 286 | 960 | real thetath2(klon,klev),wth2(klon,klev),wth3(klon,klev) | |
| 287 | 960 | real q2(klon,klev) | |
| 288 | ! FH probleme de dimensionnement avec l'allocation dynamique | ||
| 289 | ! common/comtherm/thetath2,wth2 | ||
| 290 | 960 | real wq(klon,klev) | |
| 291 | 960 | real wthl(klon,klev) | |
| 292 | 960 | real wthv(klon,klev) | |
| 293 | |||
| 294 | real ratqscth(klon,klev) | ||
| 295 | real var | ||
| 296 | real vardiff | ||
| 297 | real ratqsdiff(klon,klev) | ||
| 298 | |||
| 299 | logical sorties | ||
| 300 | 960 | real rho(klon,klev),rhobarz(klon,klev),masse(klon,klev) | |
| 301 | real zpspsk(klon,klev) | ||
| 302 | |||
| 303 | 960 | real wmax(klon) | |
| 304 | 960 | real wmax_tmp(klon) | |
| 305 | 960 | real wmax_sec(klon) | |
| 306 | real fm0(klon,klev+1),entr0(klon,klev),detr0(klon,klev) | ||
| 307 | 960 | real fm(klon,klev+1),entr(klon,klev),detr(klon,klev) | |
| 308 | |||
| 309 | real ztla(klon,klev),zqla(klon,klev),zqta(klon,klev) | ||
| 310 | !niveau de condensation | ||
| 311 | 960 | integer nivcon(klon) | |
| 312 | 960 | real zcon(klon) | |
| 313 | REAL CHI | ||
| 314 | 960 | real zcon2(klon) | |
| 315 | 960 | real pcon(klon) | |
| 316 | 960 | real zqsat(klon,klev) | |
| 317 | real zqsatth(klon,klev) | ||
| 318 | |||
| 319 | 960 | real f_star(klon,klev+1),entr_star(klon,klev) | |
| 320 | 960 | real detr_star(klon,klev) | |
| 321 | 960 | real alim_star_tot(klon) | |
| 322 | 960 | real alim_star(klon,klev) | |
| 323 | 960 | real alim_star_clos(klon,klev) | |
| 324 | 960 | real f(klon), f0(klon) | |
| 325 | !FH/IM save f0 | ||
| 326 | real zlevinter(klon) | ||
| 327 | real seuil | ||
| 328 | 960 | real csc(klon,klev) | |
| 329 | |||
| 330 | !!! nrlmd le 10/04/2012 | ||
| 331 | |||
| 332 | !------Entr�es | ||
| 333 | real pbl_tke(klon,klev+1,nbsrf) | ||
| 334 | real pctsrf(klon,nbsrf) | ||
| 335 | real omega(klon,klev) | ||
| 336 | real airephy(klon) | ||
| 337 | !------Sorties | ||
| 338 | real zlcl(klon),fraca0(klon),w0(klon),w_conv(klon) | ||
| 339 | real therm_tke_max0(klon),env_tke_max0(klon) | ||
| 340 | real n2(klon),s2(klon) | ||
| 341 | real ale_bl_stat(klon) | ||
| 342 | real therm_tke_max(klon,klev),env_tke_max(klon,klev) | ||
| 343 | real alp_bl_det(klon),alp_bl_fluct_m(klon),alp_bl_fluct_tke(klon),alp_bl_conv(klon),alp_bl_stat(klon) | ||
| 344 | !------Local | ||
| 345 | integer nsrf | ||
| 346 | real rhobarz0(klon) ! Densit� au LCL | ||
| 347 | logical ok_lcl(klon) ! Existence du LCL des thermiques | ||
| 348 | integer klcl(klon) ! Niveau du LCL | ||
| 349 | real interp(klon) ! Coef d'interpolation pour le LCL | ||
| 350 | !--Triggering | ||
| 351 | real Su ! Surface unit�: celle d'un updraft �l�mentaire | ||
| 352 | parameter(Su=4e4) | ||
| 353 | real hcoef ! Coefficient directeur pour le calcul de s2 | ||
| 354 | parameter(hcoef=1) | ||
| 355 | real hmincoef ! Coefficient directeur pour l'ordonn�e � l'origine pour le calcul de s2 | ||
| 356 | parameter(hmincoef=0.3) | ||
| 357 | real eps1 ! Fraction de surface occup�e par la population 1 : eps1=n1*s1/(fraca0*Sd) | ||
| 358 | parameter(eps1=0.3) | ||
| 359 | real hmin(ngrid) ! Ordonn�e � l'origine pour le calcul de s2 | ||
| 360 | real zmax_moy(ngrid) ! Hauteur moyenne des thermiques : zmax_moy = zlcl + 0.33 (zmax-zlcl) | ||
| 361 | real zmax_moy_coef | ||
| 362 | parameter(zmax_moy_coef=0.33) | ||
| 363 | real depth(klon) ! Epaisseur moyenne du cumulus | ||
| 364 | real w_max(klon) ! Vitesse max statistique | ||
| 365 | real s_max(klon) | ||
| 366 | !--Closure | ||
| 367 | real pbl_tke_max(klon,klev) ! Profil de TKE moyenne | ||
| 368 | real pbl_tke_max0(klon) ! TKE moyenne au LCL | ||
| 369 | real w_ls(klon,klev) ! Vitesse verticale grande �chelle (m/s) | ||
| 370 | real coef_m ! On consid�re un rendement pour alp_bl_fluct_m | ||
| 371 | parameter(coef_m=1.) | ||
| 372 | real coef_tke ! On consid�re un rendement pour alp_bl_fluct_tke | ||
| 373 | parameter(coef_tke=1.) | ||
| 374 | |||
| 375 | !!! fin nrlmd le 10/04/2012 | ||
| 376 | |||
| 377 | ! | ||
| 378 | !nouvelles variables pour la convection | ||
| 379 | real Ale_bl(klon) | ||
| 380 | real Alp_bl(klon) | ||
| 381 | real alp_int(klon),dp_int(klon),zdp | ||
| 382 | real ale_int(klon) | ||
| 383 | integer n_int(klon) | ||
| 384 | real fm_tot(klon) | ||
| 385 | real wght_th(klon,klev) | ||
| 386 | integer lalim_conv(klon) | ||
| 387 | !v1d logical therm | ||
| 388 | !v1d save therm | ||
| 389 | |||
| 390 | character*2 str2 | ||
| 391 | character*10 str10 | ||
| 392 | |||
| 393 | character (len=20) :: modname='thermcell_main' | ||
| 394 | character (len=80) :: abort_message | ||
| 395 | |||
| 396 | EXTERNAL SCOPY | ||
| 397 | ! | ||
| 398 | |||
| 399 | !----------------------------------------------------------------------- | ||
| 400 | ! initialisation: | ||
| 401 | ! --------------- | ||
| 402 | ! | ||
| 403 | |||
| 404 | 480 | seuil=0.25 | |
| 405 | |||
| 406 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 479 times.
|
480 | if (debut) then |
| 407 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | if (iflag_thermals==15.or.iflag_thermals==16) then |
| 408 | ✗ | dvdq=0 | |
| 409 | ✗ | dqimpl=-1 | |
| 410 | else | ||
| 411 | 1 | dvdq=1 | |
| 412 | 1 | dqimpl=1 | |
| 413 | endif | ||
| 414 | |||
| 415 |
4/4✓ Branch 0 taken 40 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 39760 times.
✓ Branch 3 taken 40 times.
|
39801 | fm0=0. |
| 416 |
4/4✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
|
38806 | entr0=0. |
| 417 |
4/4✓ Branch 0 taken 1 times.
✓ Branch 1 taken 39 times.
✓ Branch 2 taken 38766 times.
✓ Branch 3 taken 39 times.
|
38806 | detr0=0. |
| 418 | endif | ||
| 419 |
12/12✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
✓ Branch 8 taken 18720 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 18607680 times.
✓ Branch 11 taken 18720 times.
|
56357280 | fm=0. ; entr=0. ; detr=0. |
| 420 | 480 | icount=icount+1 | |
| 421 | |||
| 422 | !IM 090508 beg | ||
| 423 | !print*,'=====================================================================' | ||
| 424 | !print*,'=====================================================================' | ||
| 425 | !print*,' PAS ',icount,' PAS ',icount,' PAS ',icount,' PAS ',icount | ||
| 426 | !print*,'=====================================================================' | ||
| 427 | !print*,'=====================================================================' | ||
| 428 | !IM 090508 end | ||
| 429 | |||
| 430 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main V4' |
| 431 | |||
| 432 | sorties=.true. | ||
| 433 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | IF(ngrid.NE.klon) THEN |
| 434 | ✗ | PRINT* | |
| 435 | ✗ | PRINT*,'STOP dans convadj' | |
| 436 | ✗ | PRINT*,'ngrid =',ngrid | |
| 437 | ✗ | PRINT*,'klon =',klon | |
| 438 | ENDIF | ||
| 439 | ! | ||
| 440 | ! write(lunout,*)'WARNING thermcell_main f0=max(f0,1.e-2)' | ||
| 441 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,klon |
| 442 | 477120 | f0(ig)=max(f0(ig),1.e-2) | |
| 443 | 477600 | zmax0(ig)=max(zmax0(ig),40.) | |
| 444 | !IMmarche pas ?! if (f0(ig)<1.e-2) f0(ig)=1.e-2 | ||
| 445 | enddo | ||
| 446 | |||
| 447 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.20) then |
| 448 | ✗ | do ig=1,ngrid | |
| 449 | ✗ | print*,'th_main ig f0',ig,f0(ig) | |
| 450 | enddo | ||
| 451 | endif | ||
| 452 | !----------------------------------------------------------------------- | ||
| 453 | ! Calcul de T,q,ql a partir de Tl et qT dans l environnement | ||
| 454 | ! -------------------------------------------------------------------- | ||
| 455 | ! | ||
| 456 | CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay, & | ||
| 457 | 480 | & pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out) | |
| 458 | |||
| 459 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env' |
| 460 | |||
| 461 | !------------------------------------------------------------------------ | ||
| 462 | ! -------------------- | ||
| 463 | ! | ||
| 464 | ! | ||
| 465 | ! + + + + + + + + + + + | ||
| 466 | ! | ||
| 467 | ! | ||
| 468 | ! wa, fraca, wd, fracd -------------------- zlev(2), rhobarz | ||
| 469 | ! wh,wt,wo ... | ||
| 470 | ! | ||
| 471 | ! + + + + + + + + + + + zh,zu,zv,zo,rho | ||
| 472 | ! | ||
| 473 | ! | ||
| 474 | ! -------------------- zlev(1) | ||
| 475 | ! \\\\\\\\\\\\\\\\\\\! | ||
| 476 | ! | ||
| 477 | |||
| 478 | !----------------------------------------------------------------------- | ||
| 479 | ! Calcul des altitudes des couches | ||
| 480 | !----------------------------------------------------------------------- | ||
| 481 | |||
| 482 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do l=2,nlay |
| 483 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | zlev(:,l)=0.5*(pphi(:,l)+pphi(:,l-1))/RG |
| 484 | enddo | ||
| 485 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | zlev(:,1)=0. |
| 486 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | zlev(:,nlay+1)=(2.*pphi(:,klev)-pphi(:,klev-1))/RG |
| 487 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 488 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | zlay(:,l)=pphi(:,l)/RG |
| 489 | enddo | ||
| 490 | !calcul de l epaisseur des couches | ||
| 491 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 492 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | deltaz(:,l)=zlev(:,l+1)-zlev(:,l) |
| 493 | enddo | ||
| 494 | |||
| 495 | ! print*,'2 OK convect8' | ||
| 496 | !----------------------------------------------------------------------- | ||
| 497 | ! Calcul des densites | ||
| 498 | !----------------------------------------------------------------------- | ||
| 499 | |||
| 500 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | rho(:,:)=pplay(:,:)/(zpspsk(:,:)*RD*ztv(:,:)) |
| 501 | |||
| 502 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.10)write(lunout,*) & |
| 503 | ✗ | & 'WARNING thermcell_main rhobarz(:,1)=rho(:,1)' | |
| 504 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | rhobarz(:,1)=rho(:,1) |
| 505 | |||
| 506 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do l=2,nlay |
| 507 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | rhobarz(:,l)=0.5*(rho(:,l)+rho(:,l-1)) |
| 508 | enddo | ||
| 509 | |||
| 510 | !calcul de la masse | ||
| 511 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 512 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | masse(:,l)=(pplev(:,l)-pplev(:,l+1))/RG |
| 513 | enddo | ||
| 514 | |||
| 515 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres initialisation' |
| 516 | |||
| 517 | !------------------------------------------------------------------ | ||
| 518 | ! | ||
| 519 | ! /|! -------- | F_k+1 ------- | ||
| 520 | ! ----> D_k | ||
| 521 | ! /|\ <---- E_k , A_k | ||
| 522 | ! -------- | F_k --------- | ||
| 523 | ! ----> D_k-1 | ||
| 524 | ! <---- E_k-1 , A_k-1 | ||
| 525 | ! | ||
| 526 | ! | ||
| 527 | ! | ||
| 528 | ! | ||
| 529 | ! | ||
| 530 | ! --------------------------- | ||
| 531 | ! | ||
| 532 | ! ----- F_lmax+1=0 ---------- ! lmax (zmax) | | ||
| 533 | ! --------------------------- | | ||
| 534 | ! | | ||
| 535 | ! --------------------------- | | ||
| 536 | ! | | ||
| 537 | ! --------------------------- | | ||
| 538 | ! | | ||
| 539 | ! --------------------------- | | ||
| 540 | ! | | ||
| 541 | ! --------------------------- | | ||
| 542 | ! | E | ||
| 543 | ! --------------------------- | D | ||
| 544 | ! | | ||
| 545 | ! --------------------------- | | ||
| 546 | ! | | ||
| 547 | ! --------------------------- \ | | ||
| 548 | ! lalim | | | ||
| 549 | ! --------------------------- | | | ||
| 550 | ! | | | ||
| 551 | ! --------------------------- | | | ||
| 552 | ! | A | | ||
| 553 | ! --------------------------- | | | ||
| 554 | ! | | | ||
| 555 | ! --------------------------- | | | ||
| 556 | ! lmin (=1 pour le moment) | | | ||
| 557 | ! ----- F_lmin=0 ------------ / / | ||
| 558 | ! | ||
| 559 | ! --------------------------- | ||
| 560 | ! ////////////////////////// | ||
| 561 | ! | ||
| 562 | ! | ||
| 563 | !============================================================================= | ||
| 564 | ! Calculs initiaux ne faisant pas intervenir les changements de phase | ||
| 565 | !============================================================================= | ||
| 566 | |||
| 567 | !------------------------------------------------------------------ | ||
| 568 | ! 1. alim_star est le profil vertical de l'alimentation a la base du | ||
| 569 | ! panache thermique, calcule a partir de la flotabilite de l'air sec | ||
| 570 | ! 2. lmin et lalim sont les indices inferieurs et superieurs de alim_star | ||
| 571 | !------------------------------------------------------------------ | ||
| 572 | ! | ||
| 573 |
14/14✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
✓ Branch 4 taken 18720 times.
✓ Branch 5 taken 480 times.
✓ Branch 6 taken 18607680 times.
✓ Branch 7 taken 18720 times.
✓ Branch 8 taken 18720 times.
✓ Branch 9 taken 480 times.
✓ Branch 10 taken 18607680 times.
✓ Branch 11 taken 18720 times.
✓ Branch 12 taken 477120 times.
✓ Branch 13 taken 480 times.
|
56356800 | entr_star=0. ; detr_star=0. ; alim_star=0. ; alim_star_tot=0. |
| 574 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | lmin=1 |
| 575 | |||
| 576 | !----------------------------------------------------------------------------- | ||
| 577 | ! 3. wmax_sec et zmax_sec sont les vitesses et altitudes maximum d'un | ||
| 578 | ! panache sec conservatif (e=d=0) alimente selon alim_star | ||
| 579 | ! Il s'agit d'un calcul de type CAPE | ||
| 580 | ! zmax_sec est utilise pour determiner la geometrie du thermique. | ||
| 581 | !------------------------------------------------------------------------------ | ||
| 582 | !--------------------------------------------------------------------------------- | ||
| 583 | !calcul du melange et des variables dans le thermique | ||
| 584 | !-------------------------------------------------------------------------------- | ||
| 585 | ! | ||
| 586 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'avant thermcell_plume ',lev_out |
| 587 | |||
| 588 | !===================================================================== | ||
| 589 | ! Old version of thermcell_plume in thermcell_plume_6A.F90 | ||
| 590 | ! It includes both thermcell_plume_6A and thermcell_plume_5B corresponding | ||
| 591 | ! to the 5B and 6A versions used for CMIP5 and CMIP6. | ||
| 592 | ! The latest was previously named thermcellV1_plume. | ||
| 593 | ! The new thermcell_plume is a clean version (removing obsolete | ||
| 594 | ! options) of thermcell_plume_6A. | ||
| 595 | ! The 3 versions are controled by | ||
| 596 | ! flag_thermals_ed <= 9 thermcell_plume_6A | ||
| 597 | ! <= 19 thermcell_plume_5B | ||
| 598 | ! else thermcell_plume (default 20 for convergence with 6A) | ||
| 599 | ! Fredho | ||
| 600 | !===================================================================== | ||
| 601 | |||
| 602 |
1/2✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
|
480 | if (iflag_thermals_ed<=9) then |
| 603 | ! print*,'THERM NOUVELLE/NOUVELLE Arnaud' | ||
| 604 | CALL thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& | ||
| 605 | & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & | ||
| 606 | & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & | ||
| 607 | & ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter & | ||
| 608 | 480 | & ,lev_out,lunout1,igout) | |
| 609 | |||
| 610 | ✗ | elseif (iflag_thermals_ed<=19) then | |
| 611 | ! print*,'THERM RIO et al 2010, version d Arnaud' | ||
| 612 | CALL thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& | ||
| 613 | & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & | ||
| 614 | & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & | ||
| 615 | & ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter & | ||
| 616 | ✗ | & ,lev_out,lunout1,igout) | |
| 617 | else | ||
| 618 | CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& | ||
| 619 | & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & | ||
| 620 | & lalim,f0,detr_star,entr_star,f_star,csc,ztva, & | ||
| 621 | & ztla,zqla,zqta,zha,zw2,zw_est,ztva_est,zqsatth,lmix,lmix_bis,linter & | ||
| 622 | ✗ | & ,lev_out,lunout1,igout) | |
| 623 | endif | ||
| 624 | |||
| 625 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out |
| 626 | |||
| 627 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ') | |
| 628 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix ') | |
| 629 | |||
| 630 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume' |
| 631 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.10) then |
| 632 | ✗ | write(lunout1,*) 'Dans thermcell_main 2' | |
| 633 | ✗ | write(lunout1,*) 'lmin ',lmin(igout) | |
| 634 | ✗ | write(lunout1,*) 'lalim ',lalim(igout) | |
| 635 | ✗ | write(lunout1,*) ' ig l alim_star entr_star detr_star f_star ' | |
| 636 | ✗ | write(lunout1,'(i6,i4,4e15.5)') (igout,l,alim_star(igout,l),entr_star(igout,l),detr_star(igout,l) & | |
| 637 | ✗ | & ,f_star(igout,l+1),l=1,nint(linter(igout))+5) | |
| 638 | endif | ||
| 639 | |||
| 640 | !------------------------------------------------------------------------------- | ||
| 641 | ! Calcul des caracteristiques du thermique:zmax,zmix,wmax | ||
| 642 | !------------------------------------------------------------------------------- | ||
| 643 | ! | ||
| 644 | CALL thermcell_height(ngrid,nlay,lalim,lmin,linter,lmix,zw2, & | ||
| 645 | 480 | & zlev,lmax,zmax,zmax0,zmix,wmax,lev_out) | |
| 646 | ! Attention, w2 est transforme en sa racine carree dans cette routine | ||
| 647 | ! Le probleme vient du fait que linter et lmix sont souvent �gaux � 1. | ||
| 648 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | wmax_tmp=0. |
| 649 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 650 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | wmax_tmp(:)=max(wmax_tmp(:),zw2(:,l)) |
| 651 | enddo | ||
| 652 | ! print*,"ZMAX ",lalim,lmin,linter,lmix,lmax,zmax,zmax0,zmix,wmax | ||
| 653 | |||
| 654 | |||
| 655 | |||
| 656 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ') | |
| 657 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmin ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin ') | |
| 658 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmix ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix ') | |
| 659 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax ') | |
| 660 | |||
| 661 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height' |
| 662 | |||
| 663 | !------------------------------------------------------------------------------- | ||
| 664 | ! Fermeture,determination de f | ||
| 665 | !------------------------------------------------------------------------------- | ||
| 666 | ! | ||
| 667 | ! | ||
| 668 | !! write(lunout,*)'THERM NOUVEAU XXXXX' | ||
| 669 | CALL thermcell_dry(ngrid,nlay,zlev,pphi,ztv,alim_star, & | ||
| 670 | 480 | & lalim,lmin,zmax_sec,wmax_sec,lev_out) | |
| 671 | |||
| 672 | |||
| 673 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmin,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lmin ') | |
| 674 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry lalim ') | |
| 675 | |||
| 676 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry' |
| 677 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.10) then |
| 678 | ✗ | write(lunout1,*) 'Dans thermcell_main 1b' | |
| 679 | ✗ | write(lunout1,*) 'lmin ',lmin(igout) | |
| 680 | ✗ | write(lunout1,*) 'lalim ',lalim(igout) | |
| 681 | ✗ | write(lunout1,*) ' ig l alim_star entr_star detr_star f_star ' | |
| 682 | ✗ | write(lunout1,'(i6,i4,e15.5)') (igout,l,alim_star(igout,l) & | |
| 683 | ✗ | & ,l=1,lalim(igout)+4) | |
| 684 | endif | ||
| 685 | |||
| 686 | |||
| 687 | |||
| 688 | |||
| 689 | ! Choix de la fonction d'alimentation utilisee pour la fermeture. | ||
| 690 | ! Apparemment sans importance | ||
| 691 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | alim_star_clos(:,:)=alim_star(:,:) |
| 692 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | alim_star_clos(:,:)=entr_star(:,:)+alim_star(:,:) |
| 693 | ! | ||
| 694 | !CR Appel de la fermeture seche | ||
| 695 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (iflag_thermals_closure.eq.1) then |
| 696 | |||
| 697 | CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho, & | ||
| 698 | ✗ | & zlev,lalim,alim_star_clos,f_star,zmax_sec,wmax_sec,f,lev_out) | |
| 699 | |||
| 700 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | ||
| 701 | ! Appel avec les zmax et wmax tenant compte de la condensation | ||
| 702 | ! Semble moins bien marcher | ||
| 703 |
1/2✓ Branch 0 taken 480 times.
✗ Branch 1 not taken.
|
480 | else if (iflag_thermals_closure.eq.2) then |
| 704 | |||
| 705 | CALL thermcell_closure(ngrid,nlay,r_aspect_thermals,ptimestep,rho, & | ||
| 706 | 480 | & zlev,lalim,alim_star,f_star,zmax,wmax,f,lev_out) | |
| 707 | |||
| 708 | endif | ||
| 709 | |||
| 710 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | ||
| 711 | |||
| 712 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if(prt_level.ge.1)print*,'thermcell_closure apres thermcell_closure' |
| 713 | |||
| 714 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (tau_thermals>1.) then |
| 715 | ✗ | lambda=exp(-ptimestep/tau_thermals) | |
| 716 | ✗ | f0=(1.-lambda)*f+lambda*f0 | |
| 717 | else | ||
| 718 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | f0=f |
| 719 | endif | ||
| 720 | |||
| 721 | ! Test valable seulement en 1D mais pas genant | ||
| 722 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (.not. (f0(1).ge.0.) ) then |
| 723 | ✗ | abort_message = '.not. (f0(1).ge.0.)' | |
| 724 | ✗ | CALL abort_physic (modname,abort_message,1) | |
| 725 | endif | ||
| 726 | |||
| 727 | !------------------------------------------------------------------------------- | ||
| 728 | !deduction des flux | ||
| 729 | !------------------------------------------------------------------------------- | ||
| 730 | |||
| 731 | CALL thermcell_flux2(ngrid,nlay,ptimestep,masse, & | ||
| 732 | & lalim,lmax,alim_star, & | ||
| 733 | & entr_star,detr_star,f,rhobarz,zlev,zw2,fm,entr, & | ||
| 734 | 480 | & detr,zqla,lev_out,lunout1,igout) | |
| 735 | !IM 060508 & detr,zqla,zmax,lev_out,lunout,igout) | ||
| 736 | |||
| 737 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux' |
| 738 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lalim,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ') | |
| 739 | 480 | call test_ltherm(ngrid,nlay,pplev,pplay,lmax ,seuil,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax ') | |
| 740 | |||
| 741 | !------------------------------------------------------------------ | ||
| 742 | ! On ne prend pas directement les profils issus des calculs precedents | ||
| 743 | ! mais on s'autorise genereusement une relaxation vers ceci avec | ||
| 744 | ! une constante de temps tau_thermals (typiquement 1800s). | ||
| 745 | !------------------------------------------------------------------ | ||
| 746 | |||
| 747 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (tau_thermals>1.) then |
| 748 | ✗ | lambda=exp(-ptimestep/tau_thermals) | |
| 749 | ✗ | fm0=(1.-lambda)*fm+lambda*fm0 | |
| 750 | ✗ | entr0=(1.-lambda)*entr+lambda*entr0 | |
| 751 | ✗ | detr0=(1.-lambda)*detr+lambda*detr0 | |
| 752 | else | ||
| 753 |
4/4✓ Branch 0 taken 19200 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 19084800 times.
✓ Branch 3 taken 19200 times.
|
19104480 | fm0=fm |
| 754 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | entr0=entr |
| 755 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | detr0=detr |
| 756 | endif | ||
| 757 | |||
| 758 | !c------------------------------------------------------------------ | ||
| 759 | ! calcul du transport vertical | ||
| 760 | !------------------------------------------------------------------ | ||
| 761 | |||
| 762 | call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & | ||
| 763 | 480 | & zthl,zdthladj,zta,lev_out) | |
| 764 | call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse, & | ||
| 765 | 480 | & po,pdoadj,zoa,lev_out) | |
| 766 | |||
| 767 | !------------------------------------------------------------------ | ||
| 768 | ! Calcul de la fraction de l'ascendance | ||
| 769 | !------------------------------------------------------------------ | ||
| 770 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,klon |
| 771 | 477120 | fraca(ig,1)=0. | |
| 772 | 477600 | fraca(ig,nlay+1)=0. | |
| 773 | enddo | ||
| 774 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do l=2,nlay |
| 775 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | do ig=1,klon |
| 776 |
2/2✓ Branch 0 taken 1304631 times.
✓ Branch 1 taken 16825929 times.
|
18148800 | if (zw2(ig,l).gt.1.e-10) then |
| 777 | 1304631 | fraca(ig,l)=fm(ig,l)/(rhobarz(ig,l)*zw2(ig,l)) | |
| 778 | else | ||
| 779 | 16825929 | fraca(ig,l)=0. | |
| 780 | endif | ||
| 781 | enddo | ||
| 782 | enddo | ||
| 783 | |||
| 784 | !------------------------------------------------------------------ | ||
| 785 | ! calcul du transport vertical du moment horizontal | ||
| 786 | !------------------------------------------------------------------ | ||
| 787 | |||
| 788 | !IM 090508 | ||
| 789 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (dvdq == 0 ) then |
| 790 | |||
| 791 | ! Calcul du transport de V tenant compte d'echange par gradient | ||
| 792 | ! de pression horizontal avec l'environnement | ||
| 793 | |||
| 794 | call thermcell_dv2(ngrid,nlay,ptimestep,fm0,entr0,masse & | ||
| 795 | ! & ,fraca*dvdq,zmax & | ||
| 796 | & ,fraca,zmax & | ||
| 797 | ✗ | & ,zu,zv,pduadj,pdvadj,zua,zva,lev_out) | |
| 798 | |||
| 799 | else | ||
| 800 | |||
| 801 | ! calcul purement conservatif pour le transport de V | ||
| 802 | call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse & | ||
| 803 | 480 | & ,zu,pduadj,zua,lev_out) | |
| 804 | call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse & | ||
| 805 | 480 | & ,zv,pdvadj,zva,lev_out) | |
| 806 | |||
| 807 | endif | ||
| 808 | |||
| 809 | ! print*,'13 OK convect8' | ||
| 810 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 811 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 812 | 18626400 | pdtadj(ig,l)=zdthladj(ig,l)*zpspsk(ig,l) | |
| 813 | enddo | ||
| 814 | enddo | ||
| 815 | |||
| 816 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14 OK convect8' |
| 817 | !------------------------------------------------------------------ | ||
| 818 | ! Calculs de diagnostiques pour les sorties | ||
| 819 | !------------------------------------------------------------------ | ||
| 820 | !calcul de fraca pour les sorties | ||
| 821 | |||
| 822 | if (sorties) then | ||
| 823 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14a OK convect8' |
| 824 | ! calcul du niveau de condensation | ||
| 825 | ! initialisation | ||
| 826 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 827 | 477120 | nivcon(ig)=0 | |
| 828 | 477600 | zcon(ig)=0. | |
| 829 | enddo | ||
| 830 | !nouveau calcul | ||
| 831 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 832 | 477120 | CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1)) | |
| 833 | 477600 | pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI | |
| 834 | enddo | ||
| 835 | !IM do k=1,nlay | ||
| 836 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do k=1,nlay-1 |
| 837 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | do ig=1,ngrid |
| 838 | if ((pcon(ig).le.pplay(ig,k)) & | ||
| 839 |
4/4✓ Branch 0 taken 1543040 times.
✓ Branch 1 taken 16587520 times.
✓ Branch 2 taken 477120 times.
✓ Branch 3 taken 1065920 times.
|
18148800 | & .and.(pcon(ig).gt.pplay(ig,k+1))) then |
| 840 | 477120 | zcon2(ig)=zlay(ig,k)-(pcon(ig)-pplay(ig,k))/(RG*rho(ig,k))/100. | |
| 841 | endif | ||
| 842 | enddo | ||
| 843 | enddo | ||
| 844 | !IM | ||
| 845 | ierr=0 | ||
| 846 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 847 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 477120 times.
|
477600 | if (pcon(ig).le.pplay(ig,nlay)) then |
| 848 | ✗ | zcon2(ig)=zlay(ig,nlay)-(pcon(ig)-pplay(ig,nlay))/(RG*rho(ig,nlay))/100. | |
| 849 | ierr=1 | ||
| 850 | endif | ||
| 851 | enddo | ||
| 852 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (ierr==1) then |
| 853 | ✗ | abort_message = 'thermcellV0_main: les thermiques vont trop haut ' | |
| 854 | ✗ | CALL abort_physic (modname,abort_message,1) | |
| 855 | endif | ||
| 856 | |||
| 857 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14b OK convect8' |
| 858 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do k=nlay,1,-1 |
| 859 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 860 |
2/2✓ Branch 0 taken 378607 times.
✓ Branch 1 taken 18229073 times.
|
18626400 | if (zqla(ig,k).gt.1e-10) then |
| 861 | 378607 | nivcon(ig)=k | |
| 862 | 378607 | zcon(ig)=zlev(ig,k) | |
| 863 | endif | ||
| 864 | enddo | ||
| 865 | enddo | ||
| 866 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14c OK convect8' |
| 867 | !calcul des moments | ||
| 868 | !initialisation | ||
| 869 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 870 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 871 | 18607680 | q2(ig,l)=0. | |
| 872 | 18607680 | wth2(ig,l)=0. | |
| 873 | 18607680 | wth3(ig,l)=0. | |
| 874 | 18607680 | ratqscth(ig,l)=0. | |
| 875 | 18626400 | ratqsdiff(ig,l)=0. | |
| 876 | enddo | ||
| 877 | enddo | ||
| 878 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14d OK convect8' |
| 879 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.10)write(lunout,*) & |
| 880 | ✗ | & 'WARNING thermcell_main wth2=0. si zw2 > 1.e-10' | |
| 881 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 882 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 883 | 18607680 | zf=fraca(ig,l) | |
| 884 | 18607680 | zf2=zf/(1.-zf) | |
| 885 | ! | ||
| 886 | 18607680 | thetath2(ig,l)=zf2*(ztla(ig,l)-zthl(ig,l))**2 | |
| 887 |
2/2✓ Branch 0 taken 1304631 times.
✓ Branch 1 taken 17303049 times.
|
18607680 | if(zw2(ig,l).gt.1.e-10) then |
| 888 | 1304631 | wth2(ig,l)=zf2*(zw2(ig,l))**2 | |
| 889 | else | ||
| 890 | 17303049 | wth2(ig,l)=0. | |
| 891 | endif | ||
| 892 | wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l)) & | ||
| 893 | 18607680 | & *zw2(ig,l)*zw2(ig,l)*zw2(ig,l) | |
| 894 | 18607680 | q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2 | |
| 895 | !test: on calcul q2/po=ratqsc | ||
| 896 | 18626400 | ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.)) | |
| 897 | enddo | ||
| 898 | enddo | ||
| 899 | !calcul des flux: q, thetal et thetav | ||
| 900 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 901 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 902 | 18607680 | wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-po(ig,l)*1000.) | |
| 903 | 18607680 | wthl(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztla(ig,l)-zthl(ig,l)) | |
| 904 | 18626400 | wthv(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztva(ig,l)-ztv(ig,l)) | |
| 905 | enddo | ||
| 906 | enddo | ||
| 907 | ! | ||
| 908 | ! $Id: thermcell_main.F90 3451 2019-01-27 11:07:30Z fhourdin $ | ||
| 909 | ! | ||
| 910 | CALL thermcell_alp(ngrid,nlay,ptimestep & | ||
| 911 | & ,pplay,pplev & | ||
| 912 | & ,fm0,entr0,lmax & | ||
| 913 | & ,Ale_bl,Alp_bl,lalim_conv,wght_th & | ||
| 914 | & ,zw2,fraca & | ||
| 915 | !!! necessire en plus | ||
| 916 | & ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax & | ||
| 917 | !!! nrlmd le 10/04/2012 | ||
| 918 | & ,pbl_tke,pctsrf,omega,airephy & | ||
| 919 | & ,zlcl,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 & | ||
| 920 | & ,n2,s2,ale_bl_stat & | ||
| 921 | & ,therm_tke_max,env_tke_max & | ||
| 922 | & ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke & | ||
| 923 | & ,alp_bl_conv,alp_bl_stat & | ||
| 924 | !!! fin nrlmd le 10/04/2012 | ||
| 925 | 480 | & ) | |
| 926 | |||
| 927 | |||
| 928 | |||
| 929 | !calcul du ratqscdiff | ||
| 930 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14e OK convect8' |
| 931 | var=0. | ||
| 932 | vardiff=0. | ||
| 933 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | ratqsdiff(:,:)=0. |
| 934 | |||
| 935 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,klev |
| 936 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 937 |
2/2✓ Branch 0 taken 1086781 times.
✓ Branch 1 taken 17520899 times.
|
18626400 | if (l<=lalim(ig)) then |
| 938 | 1086781 | var=var+alim_star(ig,l)*zqta(ig,l)*1000. | |
| 939 | endif | ||
| 940 | enddo | ||
| 941 | enddo | ||
| 942 | |||
| 943 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14f OK convect8' |
| 944 | |||
| 945 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,klev |
| 946 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 947 |
2/2✓ Branch 0 taken 1086781 times.
✓ Branch 1 taken 17520899 times.
|
18626400 | if (l<=lalim(ig)) then |
| 948 | 1086781 | zf=fraca(ig,l) | |
| 949 | zf2=zf/(1.-zf) | ||
| 950 | 1086781 | vardiff=vardiff+alim_star(ig,l)*(zqta(ig,l)*1000.-var)**2 | |
| 951 | endif | ||
| 952 | enddo | ||
| 953 | enddo | ||
| 954 | |||
| 955 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'14g OK convect8' |
| 956 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do l=1,nlay |
| 957 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 958 | 18626400 | ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.) | |
| 959 | ! write(11,*)'ratqsdiff=',ratqsdiff(ig,l) | ||
| 960 | enddo | ||
| 961 | enddo | ||
| 962 | !-------------------------------------------------------------------- | ||
| 963 | ! | ||
| 964 | !ecriture des fichiers sortie | ||
| 965 | ! print*,'15 OK convect8 CCCCCCCCCCCCCCCCCCc' | ||
| 966 | |||
| 967 | endif | ||
| 968 | |||
| 969 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'thermcell_main FIN OK' |
| 970 | |||
| 971 | 480 | return | |
| 972 | end | ||
| 973 | |||
| 974 | !----------------------------------------------------------------------------- | ||
| 975 | |||
| 976 | 4800 | subroutine test_ltherm(klon,klev,pplev,pplay,long,seuil,ztv,po,ztva,zqla,f_star,zw2,comment) | |
| 977 | USE print_control_mod, ONLY: prt_level | ||
| 978 | IMPLICIT NONE | ||
| 979 | |||
| 980 | integer i, k, klon,klev | ||
| 981 | real pplev(klon,klev+1),pplay(klon,klev) | ||
| 982 | real ztv(klon,klev) | ||
| 983 | real po(klon,klev) | ||
| 984 | real ztva(klon,klev) | ||
| 985 | real zqla(klon,klev) | ||
| 986 | real f_star(klon,klev) | ||
| 987 | real zw2(klon,klev) | ||
| 988 | integer long(klon) | ||
| 989 | real seuil | ||
| 990 | character*21 comment | ||
| 991 | |||
| 992 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 4800 times.
|
4800 | if (prt_level.ge.1) THEN |
| 993 | ✗ | print*,'WARNING !!! TEST ',comment | |
| 994 | endif | ||
| 995 | return | ||
| 996 | |||
| 997 | ! test sur la hauteur des thermiques ... | ||
| 998 | do i=1,klon | ||
| 999 | !IMtemp if (pplay(i,long(i)).lt.seuil*pplev(i,1)) then | ||
| 1000 | if (prt_level.ge.10) then | ||
| 1001 | print*,'WARNING ',comment,' au point ',i,' K= ',long(i) | ||
| 1002 | print*,' K P(MB) THV(K) Qenv(g/kg)THVA QLA(g/kg) F* W2' | ||
| 1003 | do k=1,klev | ||
| 1004 | 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) | ||
| 1005 | enddo | ||
| 1006 | endif | ||
| 1007 | enddo | ||
| 1008 | |||
| 1009 | |||
| 1010 | return | ||
| 1011 | end | ||
| 1012 | |||
| 1013 | !!! nrlmd le 10/04/2012 Transport de la TKE par le thermique moyen pour la fermeture en ALP | ||
| 1014 | ! On transporte pbl_tke pour donner therm_tke | ||
| 1015 | ! Copie conforme de la subroutine DTKE dans physiq.F �crite par Frederic Hourdin | ||
| 1016 | 480 | subroutine thermcell_tke_transport(ngrid,nlay,ptimestep,fm0,entr0, & | |
| 1017 | & rg,pplev,therm_tke_max) | ||
| 1018 | USE print_control_mod, ONLY: prt_level | ||
| 1019 | implicit none | ||
| 1020 | |||
| 1021 | !======================================================================= | ||
| 1022 | ! | ||
| 1023 | ! Calcul du transport verticale dans la couche limite en presence | ||
| 1024 | ! de "thermiques" explicitement representes | ||
| 1025 | ! calcul du dq/dt une fois qu'on connait les ascendances | ||
| 1026 | ! | ||
| 1027 | !======================================================================= | ||
| 1028 | |||
| 1029 | integer ngrid,nlay,nsrf | ||
| 1030 | |||
| 1031 | real ptimestep | ||
| 1032 | 960 | real masse0(ngrid,nlay),fm0(ngrid,nlay+1),pplev(ngrid,nlay+1) | |
| 1033 | real entr0(ngrid,nlay),rg | ||
| 1034 | real therm_tke_max(ngrid,nlay) | ||
| 1035 | 960 | real detr0(ngrid,nlay) | |
| 1036 | |||
| 1037 | |||
| 1038 | 960 | real masse(ngrid,nlay),fm(ngrid,nlay+1) | |
| 1039 | 960 | real entr(ngrid,nlay) | |
| 1040 | 960 | real q(ngrid,nlay) | |
| 1041 | integer lev_out ! niveau pour les print | ||
| 1042 | |||
| 1043 | 960 | real qa(ngrid,nlay),detr(ngrid,nlay),wqd(ngrid,nlay+1) | |
| 1044 | |||
| 1045 | real zzm | ||
| 1046 | |||
| 1047 | integer ig,k | ||
| 1048 | integer isrf | ||
| 1049 | |||
| 1050 | |||
| 1051 | lev_out=0 | ||
| 1052 | |||
| 1053 | |||
| 1054 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 480 times.
|
480 | if (prt_level.ge.1) print*,'Q2 THERMCEL_DQ 0' |
| 1055 | |||
| 1056 | ! calcul du detrainement | ||
| 1057 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 18720 times.
|
19200 | do k=1,nlay |
| 1058 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626400 | detr0(:,k)=fm0(:,k)-fm0(:,k+1)+entr0(:,k) |
| 1059 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 18607680 times.
|
18626880 | masse0(:,k)=(pplev(:,k)-pplev(:,k+1))/RG |
| 1060 | enddo | ||
| 1061 | |||
| 1062 | |||
| 1063 | ! Decalage vertical des entrainements et detrainements. | ||
| 1064 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | masse(:,1)=0.5*masse0(:,1) |
| 1065 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | entr(:,1)=0.5*entr0(:,1) |
| 1066 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | detr(:,1)=0.5*detr0(:,1) |
| 1067 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | fm(:,1)=0. |
| 1068 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do k=1,nlay-1 |
| 1069 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
|
18148800 | masse(:,k+1)=0.5*(masse0(:,k)+masse0(:,k+1)) |
| 1070 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
|
18148800 | entr(:,k+1)=0.5*(entr0(:,k)+entr0(:,k+1)) |
| 1071 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
|
18148800 | detr(:,k+1)=0.5*(detr0(:,k)+detr0(:,k+1)) |
| 1072 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 18130560 times.
|
18149280 | fm(:,k+1)=fm(:,k)+entr(:,k)-detr(:,k) |
| 1073 | enddo | ||
| 1074 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | fm(:,nlay+1)=0. |
| 1075 | |||
| 1076 | !!! nrlmd le 16/09/2010 | ||
| 1077 | ! calcul de la valeur dans les ascendances | ||
| 1078 | ! do ig=1,ngrid | ||
| 1079 | ! qa(ig,1)=q(ig,1) | ||
| 1080 | ! enddo | ||
| 1081 | !!! | ||
| 1082 | |||
| 1083 | !do isrf=1,nsrf | ||
| 1084 | |||
| 1085 | ! q(:,:)=therm_tke(:,:,isrf) | ||
| 1086 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | q(:,:)=therm_tke_max(:,:) |
| 1087 | !!! nrlmd le 16/09/2010 | ||
| 1088 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | do ig=1,ngrid |
| 1089 | 477600 | qa(ig,1)=q(ig,1) | |
| 1090 | enddo | ||
| 1091 | !!! | ||
| 1092 | |||
| 1093 | if (1==1) then | ||
| 1094 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do k=2,nlay |
| 1095 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | do ig=1,ngrid |
| 1096 |
2/2✓ Branch 0 taken 1550514 times.
✓ Branch 1 taken 16580046 times.
|
18130560 | if ((fm(ig,k+1)+detr(ig,k))*ptimestep.gt. & |
| 1097 | & 1.e-5*masse(ig,k)) then | ||
| 1098 | qa(ig,k)=(fm(ig,k)*qa(ig,k-1)+entr(ig,k)*q(ig,k)) & | ||
| 1099 | 1550514 | & /(fm(ig,k+1)+detr(ig,k)) | |
| 1100 | else | ||
| 1101 | 16580046 | qa(ig,k)=q(ig,k) | |
| 1102 | endif | ||
| 1103 | if (qa(ig,k).lt.0.) then | ||
| 1104 | ! print*,'qa<0!!!' | ||
| 1105 | endif | ||
| 1106 | 18240 | if (q(ig,k).lt.0.) then | |
| 1107 | ! print*,'q<0!!!' | ||
| 1108 | endif | ||
| 1109 | enddo | ||
| 1110 | enddo | ||
| 1111 | |||
| 1112 | ! Calcul du flux subsident | ||
| 1113 | |||
| 1114 |
2/2✓ Branch 0 taken 18240 times.
✓ Branch 1 taken 480 times.
|
18720 | do k=2,nlay |
| 1115 |
2/2✓ Branch 0 taken 18130560 times.
✓ Branch 1 taken 18240 times.
|
18149280 | do ig=1,ngrid |
| 1116 | 18130560 | wqd(ig,k)=fm(ig,k)*q(ig,k) | |
| 1117 | 18240 | if (wqd(ig,k).lt.0.) then | |
| 1118 | ! print*,'wqd<0!!!' | ||
| 1119 | endif | ||
| 1120 | enddo | ||
| 1121 | enddo | ||
| 1122 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | do ig=1,ngrid |
| 1123 | 477120 | wqd(ig,1)=0. | |
| 1124 | 477600 | wqd(ig,nlay+1)=0. | |
| 1125 | enddo | ||
| 1126 | |||
| 1127 | ! Calcul des tendances | ||
| 1128 |
2/2✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
|
19200 | do k=1,nlay |
| 1129 |
2/2✓ Branch 0 taken 18607680 times.
✓ Branch 1 taken 18720 times.
|
18626880 | do ig=1,ngrid |
| 1130 | q(ig,k)=q(ig,k)+(detr(ig,k)*qa(ig,k)-entr(ig,k)*q(ig,k) & | ||
| 1131 | & -wqd(ig,k)+wqd(ig,k+1)) & | ||
| 1132 | 18626400 | & *ptimestep/masse(ig,k) | |
| 1133 | enddo | ||
| 1134 | enddo | ||
| 1135 | |||
| 1136 | endif | ||
| 1137 | |||
| 1138 |
4/4✓ Branch 0 taken 18720 times.
✓ Branch 1 taken 480 times.
✓ Branch 2 taken 18607680 times.
✓ Branch 3 taken 18720 times.
|
18626880 | therm_tke_max(:,:)=q(:,:) |
| 1139 | |||
| 1140 | 480 | return | |
| 1141 | !!! fin nrlmd le 10/04/2012 | ||
| 1142 | end | ||
| 1143 | |||
| 1144 |