Changeset 1399
- Timestamp:
- Jun 8, 2010, 10:29:11 AM (14 years ago)
- Location:
- LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd
- Files:
-
- 1 added
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/calltherm.F90
r1311 r1399 8 8 & ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth, & 9 9 & ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, & 10 & zmax0,f0,zw2,fraca )10 & zmax0,f0,zw2,fraca,ztv,zpspsk,ztla,zthl) 11 11 12 12 USE dimphy … … 49 49 real zqla(klon,klev) 50 50 real zqta(klon,klev) 51 real ztv(klon,klev) 52 real zpspsk(klon,klev) 53 real ztla(klon,klev) 54 real zthl(klon,klev) 51 55 real wmax_sec(klon) 52 56 real zmax_sec(klon) … … 214 218 & ,r_aspect_thermals,l_mix_thermals & 215 219 & ,tau_thermals,iflag_thermals_ed,Ale,Alp,lalim_conv,wght_th & 216 & ,zmax0,f0,zw2,fraca) 220 & ,zmax0,f0,zw2,fraca,ztv,zpspsk & 221 & ,ztla,zthl) 217 222 if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK' 218 223 else -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/fisrtilp.F
r1299 r1399 7 7 s pfrac_impa, pfrac_nucl, pfrac_1nucl, 8 8 s frac_impa, frac_nucl, 9 s prfl, psfl, rhcl) 9 s prfl, psfl, rhcl, zqta, fraca, 10 s ztv, zpspsk, ztla, zthl, iflag_cldcon) 10 11 11 12 c … … 41 42 REAL snow(klon) ! neige (mm/s) 42 43 REAL prfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s) 43 REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s) 44 REAL psfl(klon,klev+1) ! flux d'eau precipitante aux interfaces (kg/m2/s) 45 REAL ztv(klon,klev) 46 REAL zqta(klon,klev),fraca(klon,klev) 47 REAL sigma1(klon,klev),sigma2(klon,klev) 48 REAL qltot(klon,klev),ctot(klon,klev) 49 REAL zpspsk(klon,klev),ztla(klon,klev) 50 REAL zthl(klon,klev) 51 44 52 cAA 45 53 c Coeffients de fraction lessivee : pour OFF-LINE … … 63 71 64 72 INTEGER ninter ! sous-intervals pour la precipitation 65 INTEGER ncoreczq 73 INTEGER ncoreczq 74 INTEGER iflag_cldcon 66 75 PARAMETER (ninter=5) 67 76 LOGICAL evap_prec ! evaporation de la pluie … … 72 81 real zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon) 73 82 real Zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon) 74 real erf 83 real erf 84 REAL qcloud(klon) 75 85 c 76 86 LOGICAL cpartiel ! condensation partielle … … 82 92 c 83 93 INTEGER i, k, n, kk 84 REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5 94 REAL zqs(klon), zdqs(klon), zdelta, zcor, zcvm5 85 95 REAL zrfl(klon), zrfln(klon), zqev, zqevt 86 96 REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq … … 130 140 zdelq=0.0 131 141 142 print*,'CLOUDTH4 A. JAM' 132 143 IF (appel1er) THEN 133 144 c … … 322 333 c de l'eau condensee: 323 334 c 335 324 336 IF (cpartiel) THEN 325 337 … … 351 363 zq(i)=1.e-15 352 364 endif 353 enddo 354 do i=1,klon 365 enddo 366 367 if (iflag_cldcon.eq.5) then 368 369 call cloudth(klon,klev,k,ztv, 370 . zq,zqta,fraca, 371 . qcloud,ctot,zpspsk,paprs,ztla,zthl, 372 . ratqs,zqs,t) 373 374 do i=1,klon 375 rneb(i,k)=ctot(i,k) 376 zqn(i)=qcloud(i) 377 enddo 378 379 else 380 381 do i=1,klon 355 382 zpdf_sig(i)=ratqs(i,k)*zq(i) 356 383 zpdf_k(i)=-sqrt(log(1.+(zpdf_sig(i)/zq(i))**2)) … … 372 399 endif 373 400 374 enddo 401 enddo 402 403 endif ! iflag_cldcon 375 404 376 405 endif ! iflag_pdf -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/physiq.F
r1392 r1399 669 669 670 670 REAL zw2(klon,klev+1) 671 REAL fraca(klon,klev+1) 671 REAL fraca(klon,klev+1) 672 REAL ztv(klon,klev) 673 REAL zpspsk(klon,klev) 674 REAL ztla(klon,klev) 675 REAL zthl(klon,klev) 672 676 673 677 c Variables locales pour la couche limite (al1): … … 2440 2444 s ,ratqsdiff,zqsatth 2441 2445 con rajoute ale et alp, et les caracteristiques de la couche alim 2442 s ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca) 2446 s ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca 2447 s ,ztv,zpspsk,ztla,zthl) 2443 2448 2444 2449 ! ---------------------------------------------------------------------- … … 2702 2707 . pfrac_impa, pfrac_nucl, pfrac_1nucl, 2703 2708 . frac_impa, frac_nucl, 2704 . prfl, psfl, rhcl) 2709 . prfl, psfl, rhcl, 2710 . zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cldcon ) 2705 2711 2706 2712 WHERE (rain_lsc < 0) rain_lsc = 0. -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_main.F90
r1377 r1399 10 10 & ,r_aspect,l_mix,tau_thermals,iflag_thermals_ed & 11 11 & ,Ale_bl,Alp_bl,lalim_conv,wght_th & 12 & ,zmax0, f0,zw2,fraca) 12 & ,zmax0, f0,zw2,fraca,ztv & 13 & ,zpspsk,ztla,zthl) 13 14 14 15 USE dimphy … … 389 390 ! print*,'THERM thermcell_main iflag_thermals_ed=',iflag_thermals_ed 390 391 if (iflag_thermals_ed<=9) then 391 ! print*,'THERM NO VUELLE/NOUVELLE/ANCIENNE'392 ! print*,'THERM NOUVELLE/NOUVELLE Arnaud' 392 393 CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& 393 394 & zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot, & … … 396 397 & ,lev_out,lunout1,igout) 397 398 398 elseif (iflag_thermals_ed <=19) then399 elseif (iflag_thermals_ed>9) then 399 400 ! print*,'THERM RIO et al 2010, version d Arnaud' 400 401 CALL thermcellV1_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,& -
LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_plume.F90
r1373 r1399 64 64 REAL zqsatth(ngrid,klev) 65 65 REAL zta_est(ngrid,klev) 66 REAL ztemp(ngrid),zqsat(ngrid)67 66 REAL zdw2 68 67 REAL zw2modif … … 76 75 INTEGER ig,l,k 77 76 78 real zdz,zfact,zbuoy,zalpha 77 real zdz,zfact,zbuoy,zalpha,zdrag 79 78 real zcor,zdelta,zcvm5,qlbef 79 real Tbef,qsatbef 80 real dqsat_dT,DT,num,denom 80 81 REAL REPS,RLvCp,DDT0 81 82 PARAMETER (DDT0=.01) … … 84 85 REAL fact_gamma,fact_epsilon,fact_gamma2 85 86 REAL c2(ngrid,klev) 87 REAL a1,m 86 88 87 89 REAL zw2fact,expa … … 90 92 RLvCp = RLVTT/RCPD 91 93 92 if (iflag_thermals_ed==0) then 93 fact_gamma=1. 94 fact_epsilon=1. 95 else if (iflag_thermals_ed==1) then 96 ! Valeurs au moment de la premiere soumission des papiers 97 fact_gamma=1. 94 98 95 fact_epsilon=0.002 99 fact_gamma2=0.6 100 ! Suggestions des Fleurs, Septembre 2009 101 fact_epsilon=0.015 102 !test cr 103 ! fact_epsilon=0.002 96 a1=2./3. 104 97 fact_gamma=0.9 105 fact_gamma2=0.7 106 107 else if (iflag_thermals_ed==2) then 108 fact_gamma=1. 109 fact_epsilon=2. 110 else if (iflag_thermals_ed==3) then 111 fact_gamma=3./4. 112 fact_epsilon=3. 113 endif 114 115 ! write(lunout,*)'THERM 31H ' 116 117 print*,'THERMCELL_PLUME OPTIMISE V0 ' 98 zfact=fact_gamma/(1+fact_gamma) 99 fact_gamma2=zfact 100 expa=0. 101 102 print*,'THERM 31H ' 103 118 104 ! Initialisations des variables reeles 119 if (1== 0) then105 if (1==1) then 120 106 ztva(:,:)=ztv(:,:) 121 107 ztva_est(:,:)=ztva(:,:) … … 168 154 alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.) & 169 155 & *sqrt(zlev(ig,l+1)) 170 lalim( ig)=l+1156 lalim(:)=l+1 171 157 alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l) 172 158 endif … … 187 173 ! On decide dans cette version que le thermique n'est actif que si la premiere 188 174 ! couche est instable. 189 ! Pourrait etre change si on veut que le thermiques puisse se d éclencher175 ! Pourrait etre change si on veut que le thermiques puisse se déclencher 190 176 ! dans une couche l>1 191 177 !------------------------------------------------------------------------------ … … 239 225 ! sans tenir compte du detrainement et de l'entrainement dans cette 240 226 ! couche 241 ! C'est a dire qu'on suppose242 ! ztla(l)=ztla(l-1) et zqta(l)=zqta(l-1)243 227 ! Ici encore, on doit pouvoir ajouter entr_star (qui peut etre calculer 244 228 ! avant) a l'alimentation pour avoir un calcul plus propre 245 229 !--------------------------------------------------------------------------- 246 230 247 ztemp(:)=zpspsk(:,l)*ztla(:,l-1) 248 call thermcell_qsat(ngrid,active,pplev(:,l),ztemp,zqta(:,l-1),zqsat) 249 231 call thermcell_condens(ngrid,active, & 232 & zpspsk(:,l),pplev(:,l),ztla(:,l-1),zqta(:,l-1),zqla_est(:,l)) 250 233 251 234 do ig=1,ngrid 252 235 if(active(ig)) then 253 zqla_est(ig,l) = max(0.,zqta(ig,l-1)-zqsat(ig))254 236 ztva_est(ig,l) = ztla(ig,l-1)*zpspsk(ig,l)+RLvCp*zqla_est(ig,l) 255 237 zta_est(ig,l)=ztva_est(ig,l) … … 258 240 & -zqla_est(ig,l))-zqla_est(ig,l)) 259 241 242 if (1.eq.0) then 243 !calcul de w_est sans prendre en compte le drag 260 244 w_est(ig,l+1)=zw2(ig,l)* & 261 245 & ((f_star(ig,l))**2) & … … 263 247 & 2.*RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) & 264 248 & *(zlev(ig,l+1)-zlev(ig,l)) 249 else 250 251 zdz=zlev(ig,l+1)-zlev(ig,l) 252 zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l))/rhobarz(ig,l) 253 zbuoy=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) 254 zdrag=fact_epsilon/(zalpha**expa) 255 zw2fact=zbuoy/zdrag*a1 256 w_est(ig,l+1)=(w_est(ig,l)-zw2fact)*exp(-2.*zdrag/(1+fact_gamma)*zdz) & 257 & +zw2fact 258 259 endif 260 265 261 if (w_est(ig,l+1).lt.0.) then 266 262 w_est(ig,l+1)=zw2(ig,l) … … 277 273 zdz=zlev(ig,l+1)-zlev(ig,l) 278 274 zbuoy=RG*(ztva_est(ig,l)-ztv(ig,l))/ztv(ig,l) 279 zfact=fact_gamma/(1.+fact_gamma)280 275 281 276 ! estimation de la fraction couverte par les thermiques 282 277 zalpha=f0(ig)*f_star(ig,l)/sqrt(w_est(ig,l))/rhobarz(ig,l) 283 278 284 !calcul de la soumission papier 285 if (1.eq.1) then 286 fact_epsilon=0.0007 287 ! zfact=0.9/(1.+0.9) 288 zfact=0.3 289 fact_gamma=0.7 290 fact_gamma2=0.6 291 expa=0.25 279 !calcul de la soumission papier 292 280 ! Calcul du taux d'entrainement entr_star (epsilon) 293 281 entr_star(ig,l)=f_star(ig,l)*zdz * ( zfact * MAX(0., & 294 & zbuoy/w_est(ig,l+1) )& 295 !- fact_epsilon/zalpha**0.25 ) & 296 & +0.000 ) 297 298 ! entr_star(ig,l)=f_star(ig,l)*zdz * ( 1./3 * MAX(0., & 299 ! & zbuoy/w_est(ig,l+1) - 1./zalpha**0.25 ) & 300 ! & +0.000 ) 301 ! Calcul du taux de detrainement detr_star (delta) 302 ! if (zqla_est(ig,l).lt.1.e-10) then 282 & a1*zbuoy/w_est(ig,l+1) & 283 & - fact_epsilon/zalpha**expa ) & 284 & +0. ) 285 286 !calcul du taux de detrainment (delta) 303 287 ! detr_star(ig,l)=f_star(ig,l)*zdz * ( & 304 ! & fact_gamma2 * MAX(0.,fact_epsilon-zbuoy/w_est(ig,l+1) ) & 305 ! & +0.0006 ) 306 ! else 288 ! & MAX(1.e-3, & 289 ! & -fact_gamma2*a1*zbuoy/w_est(ig,l+1) & 290 ! & +0.01*(max(zqta(ig,l-1)-po(ig,l),0.)/(po(ig,l))/(w_est(ig,l+1)))**0.5 & 291 ! & +0. )) 292 293 m=0.5 294 295 detr_star(ig,l)=1.*f_star(ig,l)*zdz * & 296 & MAX(5.e-4,-fact_gamma2*a1*(1./w_est(ig,l+1))*((1.-(1.-m)/(1.+70*zqta(ig,l-1)))*zbuoy & 297 & -40*(1.-m)*(max(zqta(ig,l-1)-po(ig,l),0.))/(1.+70*zqta(ig,l-1)) ) ) 298 307 299 ! detr_star(ig,l)=f_star(ig,l)*zdz * ( & 308 ! & fact_gamma2 * MAX(0.,fact_epsilon-zbuoy/w_est(ig,l+1) ) & 309 ! & +0.002 ) 310 ! endif 311 detr_star(ig,l)=f_star(ig,l)*zdz * ( & 312 & fact_gamma2 * MAX(0., & 313 !fact_epsilon/zalpha**0.25 314 & -zbuoy/w_est(ig,l+1) ) & 315 ! & + 0.002*(max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l))**0.6 & 316 !test 317 & + 0.006*(max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l))**0.6 & 318 & +0.0000 ) 319 else 320 321 ! Calcul du taux d'entrainement entr_star (epsilon) 322 entr_star(ig,l)=f_star(ig,l)*zdz * ( zfact * MAX(0., & 323 & zbuoy/w_est(ig,l+1) - fact_epsilon ) & 324 & +0.0000 ) 325 326 ! Calcul du taux de detrainement detr_star (delta) 327 detr_star(ig,l)=f_star(ig,l)*zdz * ( & 328 & fact_gamma2 * MAX(0.,fact_epsilon-zbuoy/w_est(ig,l+1) ) & 329 & + 0.002*(max(zqta(ig,l-1)-po(ig,l),0.)/po(ig,l))**0.6 & 330 & +0.0000 ) 331 332 endif 333 !endif choix du calcul de E* et D* 334 335 !cr test 336 ! entr_star(ig,l)=entr_star(ig,l)+0.2*detr_star(ig,l) 337 338 ! Prise en compte de la fraction 339 ! detr_star(ig,l)=detr_star(ig,l)*sqrt(0.01/max(zalpha,1.e-5)) 300 ! & MAX(0.0, & 301 ! & -fact_gamma2*a1*zbuoy/w_est(ig,l+1) & 302 ! & +20*(max(zqta(ig,l-1)-po(ig,l),0.))**1*(zalpha/w_est(ig,l+1))**0.5 & 303 ! & +0. )) 304 340 305 341 306 ! En dessous de lalim, on prend le max de alim_star et entr_star pour … … 346 311 endif 347 312 313 !attention test 314 ! if (detr_star(ig,l).gt.(f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l))) then 315 ! detr_star(ig,l)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l) 316 ! endif 348 317 ! Calcul du flux montant normalise 349 318 f_star(ig,l+1)=f_star(ig,l)+alim_star(ig,l)+entr_star(ig,l) & … … 370 339 enddo 371 340 372 ztemp(:)=zpspsk(:,l)*ztla(:,l)373 call thermcell_qsat(ngrid,activetmp,pplev(:,l),ztemp,zqta(:,l),zqsatth(:,l)) 341 call thermcell_condens(ngrid,activetmp,zpspsk(:,l),pplev(:,l),ztla(:,l),zqta(:,l),zqla(:,l)) 342 374 343 375 344 do ig=1,ngrid … … 377 346 if (prt_level.ge.20) print*,'coucou calcul detr 4512: ig, l', ig, l 378 347 ! on ecrit de maniere conservative (sat ou non) 379 zqla(ig,l) = max(0.,zqta(ig,l)-zqsatth(ig,l))380 348 ! T = Tl +Lv/Cp ql 381 349 ztva(ig,l) = ztla(ig,l)*zpspsk(ig,l)+RLvCp*zqla(ig,l) … … 387 355 388 356 !on ecrit zqsat 357 zqsatth(ig,l)=qsatbef 389 358 390 359 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 407 376 zw2(ig,l+1)=zw2modif+zdw2 408 377 else 409 ! Tentative de reecriture de l'equation de w2. A reprendre ... 410 ! zdw2=2*zdz*zbuoy 411 ! zw2modif=zw2(ig,l)*(1.-2.*zdz*(zeps+fact_epsilon)) 412 !!!!! zw2(ig,l+1)=(zw2(ig,l)+zdw2)/(1.+2.*zfactw2(ig,l)) 413 !formulation Arnaud 414 ! zw2fact=zbuoy*zalpha**expa/fact_epsilon 415 ! zw2(ig,l+1)=(zw2(ig,l)-zw2fact)*exp(-2.*fact_epsilon/(zalpha**expa*(1+fact_gamma))*zdz) & 416 ! & +zw2fact 417 if (zbuoy.gt.1.e-10) then 418 zw2fact=zbuoy*zalpha**expa/fact_epsilon*(fact_gamma-zfact) 419 zw2(ig,l+1)=(zw2(ig,l)-zw2fact)*exp(-2.*fact_epsilon/(zalpha**expa)*zdz) & 378 zdrag=fact_epsilon/(zalpha**expa) 379 zw2fact=zbuoy/zdrag*a1 380 zw2(ig,l+1)=(zw2(ig,l)-zw2fact)*exp(-2.*zdrag/(1+fact_gamma)*zdz) & 420 381 & +zw2fact 421 else 422 zw2fact=zbuoy*zalpha**expa/fact_epsilon*(fact_gamma) 423 zw2(ig,l+1)=(zw2(ig,l)-zw2fact)*exp(-2.*fact_epsilon/(zalpha**expa)*zdz) & 424 & +zw2fact 425 426 endif 382 427 383 428 384 endif 429 ! zw2(ig,l+1)=zw2modif+zdw2 385 430 386 endif 431 387 enddo … … 440 396 if (zw2(ig,l+1)>0. .and. zw2(ig,l+1).lt.1.e-10) then 441 397 ! stop'On tombe sur le cas particulier de thermcell_dry' 442 write(lunout,*) & 443 & 'On tombe sur le cas particulier de thermcell_plume' 398 print*,'On tombe sur le cas particulier de thermcell_plume' 444 399 zw2(ig,l+1)=0. 445 400 linter(ig)=l+1 … … 487 442 return 488 443 end 489 490 444 491 445 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Note: See TracChangeset
for help on using the changeset viewer.