Changeset 4171 for LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/calltherm.F90
- Timestamp:
- Jun 17, 2022, 4:24:49 PM (2 years ago)
- Location:
- LMDZ6/branches/LMDZ-ECRAD
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/LMDZ-ECRAD
- Property svn:mergeinfo changed
-
LMDZ6/branches/LMDZ-ECRAD/libf/phylmd/calltherm.F90
r2346 r4171 7 7 & ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs & 8 8 & ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth, & 9 & ratqsdiff,zqsatth, Ale_bl,Alp_bl,lalim_conv,wght_th, &9 & ratqsdiff,zqsatth,ale_bl,alp_bl,lalim_conv,wght_th, & 10 10 & zmax0,f0,zw2,fraca,ztv,zpspsk,ztla,zthl & 11 11 !!! nrlmd le 10/04/2012 … … 17 17 & ,alp_bl_conv,alp_bl_stat & 18 18 !!! fin nrlmd le 10/04/2012 19 & ,zqla,ztva ) 19 & ,zqla,ztva & 20 #ifdef ISO 21 & ,xt_seri,d_xt_ajs & 22 #ifdef DIAGISO 23 & ,q_the,xt_the & 24 #endif 25 #endif 26 & ) 20 27 21 28 USE dimphy 22 29 USE indice_sol_mod 23 30 USE print_control_mod, ONLY: prt_level,lunout 31 #ifdef ISO 32 use infotrac_phy, ONLY: ntiso 33 #ifdef ISOVERIF 34 USE isotopes_mod, ONLY: iso_eau,iso_HDO 35 USE isotopes_verif_mod, ONLY: iso_verif_aberrant_enc_vect2D, & 36 iso_verif_egalite_vect2D 37 #endif 38 #endif 24 39 25 40 implicit none 26 include "thermcell.h" 41 include "clesphys.h" 42 include "thermcell_old.h" 27 43 28 44 … … 79 95 real zqsatth(klon,klev) 80 96 !nouvelles variables pour la convection 81 real Ale_bl(klon)82 real Alp_bl(klon)83 real Ale(klon)84 real Alp(klon)97 real ale_bl(klon) 98 real alp_bl(klon) 99 real ale(klon) 100 real alp(klon) 85 101 !RC 86 102 !on garde le zmax du pas de temps precedent … … 102 118 !******************************************************** 103 119 120 real, dimension(klon) :: pcon 121 real, dimension(klon,klev) :: rhobarz,wth3 122 integer,dimension(klon) :: lalim 123 real, dimension(klon,klev+1) :: fm 124 real, dimension(klon,klev) :: alim_star 125 real, dimension(klon) :: zmax 126 127 128 104 129 105 130 ! variables locales … … 115 140 character (len=80) :: abort_message 116 141 117 integer i,k 142 integer i,k,isplit 118 143 logical, save :: first=.true. 144 logical :: new_thermcell 145 146 #ifdef ISO 147 REAL xt_seri(ntiso,klon,klev),xtmemoire(ntiso,klon,klev) 148 REAL d_xt_ajs(ntiso,klon,klev) 149 real d_xt_the(ntiso,klon,klev) 150 #ifdef DIAGISO 151 real q_the(klon,klev) 152 real xt_the(ntiso,klon,klev) 153 #endif 154 real qprec(klon,klev) 155 integer ixt 156 #endif 157 158 119 159 !$OMP THREADPRIVATE(first) 120 160 !******************************************************** … … 144 184 detr_therm(:,:)=0. 145 185 146 Ale_bl(:)=0.147 Alp_bl(:)=0.186 ale_bl(:)=0. 187 alp_bl(:)=0. 148 188 if (prt_level.ge.10) then 149 189 print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion' … … 159 199 logexpr2(i,k)=.not.q_seri(i,k).ge.1.e-15 160 200 if (logexpr2(i,k)) then 201 #ifdef ISO 202 qprec(i,k)=q_seri(i,k) 203 #endif 161 204 q_seri(i,k)=1.e-15 162 205 nbptspb=nbptspb+1 206 #ifdef ISO 207 do ixt=1,ntiso 208 xt_seri(ixt,i,k)=1.e-15*(xt_seri(ixt,i,k)/qprec(i,k)) 209 ! xt_seri(ixt,i,k)=1.e-15*(Rdefault(index_iso(ixt))) 210 enddo 211 #endif 163 212 endif 164 213 ! if (logexpr0) & … … 169 218 if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb 170 219 220 221 new_thermcell=iflag_thermals>=15.and.iflag_thermals<=18 222 #ifdef ISO 223 if (.not.new_thermcell) then 224 CALL abort_gcm('calltherm 234','isos pas prevus ici',1) 225 endif 226 #ifdef ISOVERIF 227 if (iso_eau.gt.0) then 228 call iso_verif_egalite_vect2D( & 229 & xt_seri,q_seri, & 230 & 'calltherm 174',ntiso,klon,klev) 231 endif !if (iso_eau.gt.0) then 232 #endif 233 #endif 171 234 zdt=dtime/REAL(nsplit_thermals) 235 236 172 237 do isplit=1,nsplit_thermals 173 238 … … 207 272 abort_message = 'cas non prevu dans calltherm' 208 273 CALL abort_physic (modname,abort_message,1) 209 210 ! CALL thermcell_pluie(klon,klev,zdt &211 ! & ,pplay,paprs,pphi,zlev &212 ! & ,u_seri,v_seri,t_seri,q_seri &213 ! & ,d_u_the,d_v_the,d_t_the,d_q_the &214 ! & ,zfm_therm,zentr_therm,zqla &215 ! & ,r_aspect_thermals,l_mix_thermals,w2di_thermals &216 ! & ,tau_thermals,3)217 274 else if (iflag_thermals.eq.12) then 218 275 CALL calcul_sec(klon,klev,zdt & … … 223 280 & ,tau_thermals) 224 281 else if (iflag_thermals==13.or.iflag_thermals==14) then 225 CALL thermcellV0_main(itap,klon,klev,zdt & 226 & ,pplay,paprs,pphi,debut & 227 & ,u_seri,v_seri,t_seri,q_seri & 228 & ,d_u_the,d_v_the,d_t_the,d_q_the & 229 & ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax & 230 & ,ratqscth,ratqsdiff,zqsatth & 231 & ,r_aspect_thermals,l_mix_thermals & 232 & ,tau_thermals,Ale,Alp,lalim_conv,wght_th & 233 & ,zmax0,f0,zw2,fraca) 234 else if (iflag_thermals>=15.and.iflag_thermals<=18) then 235 236 ! print*,'THERM iflag_thermas_ed=',iflag_thermals_ed 282 abort_message = 'thermcellV0_main enleve svn>2084' 283 CALL abort_physic (modname,abort_message,1) 284 else if (new_thermcell) then 237 285 CALL thermcell_main(itap,klon,klev,zdt & 238 286 & ,pplay,paprs,pphi,debut & … … 241 289 & ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax & 242 290 & ,ratqscth,ratqsdiff,zqsatth & 243 ! & ,r_aspect_thermals,l_mix_thermals &244 ! & ,tau_thermals,iflag_thermals_ed,iflag_coupl &245 & ,Ale,Alp,lalim_conv,wght_th &246 291 & ,zmax0,f0,zw2,fraca,ztv,zpspsk & 247 & ,ztla,zthl & 248 !!! nrlmd le 10/04/2012 249 & ,pbl_tke,pctsrf,omega,airephy & 250 & ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 & 251 & ,n2,s2,ale_bl_stat & 252 & ,therm_tke_max,env_tke_max & 253 & ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke & 254 & ,alp_bl_conv,alp_bl_stat & 255 !!! fin nrlmd le 10/04/2012 256 & ,ztva ) 292 & ,ztla,zthl,ztva & 293 & ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax & 294 #ifdef ISO 295 & ,xt_seri,d_xt_the & 296 #endif 297 & ) 298 299 CALL thermcell_alp(klon,klev,zdt & ! in 300 & ,pplay,paprs & ! in 301 & ,zfm_therm,zentr_therm,lmax & ! in 302 & ,pbl_tke,pctsrf,omega,airephy & ! in 303 & ,zw2,fraca & ! in 304 & ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax & ! in 305 & ,ale,alp,lalim_conv,wght_th & ! out 306 & ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &! out 307 & ,n2,s2,ale_bl_stat & ! out 308 & ,therm_tke_max,env_tke_max & ! out 309 & ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke & ! out 310 & ,alp_bl_conv,alp_bl_stat & ! out 311 & ) 312 257 313 if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK' 258 314 else … … 303 359 detr_therm(:,k)=detr_therm(:,k) & 304 360 & +zdetr_therm(:,k)*fact(:) 361 #ifdef ISO 362 do ixt=1,ntiso 363 d_xt_the(ixt,:,k)=d_xt_the(ixt,:,k)*dtime*fact(:) 364 enddo 365 #endif 305 366 ENDDO 306 367 fm_therm(:,klev+1)=0. … … 313 374 d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:) 314 375 d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:) 376 #ifdef ISO 377 d_xt_ajs(:,:,:)=d_xt_ajs(:,:,:)+d_xt_the(:,:,:) 378 #endif 315 379 316 380 ! incrementation des variables meteo … … 320 384 qmemoire(:,:)=q_seri(:,:) 321 385 q_seri(:,:) = q_seri(:,:) + d_q_the(:,:) 386 #ifdef ISO 387 xtmemoire(:,:,:)=xt_seri(:,:,:) 388 xt_seri(:,:,:) = xt_seri(:,:,:) + d_xt_the(:,:,:) 389 #ifdef ISOVERIF 390 ! write(*,*) 'calltherm 350 tmp: ajout d_xt_the' 391 if (iso_HDO.gt.0) then 392 ! i=479 393 ! k=4 394 ! write(*,*) 'xt_seri(iso_hdo,i,k),q_seri(i,k)=', & 395 ! & xt_seri(iso_hdo,i,k),q_seri(i,k) 396 ! write(*,*) 'd_xt_the(iso_hdo,i,k),d_q_the(i,k)=', & 397 ! & d_xt_the(iso_hdo,i,k),d_q_the(i,k) 398 call iso_verif_aberrant_enc_vect2D( & 399 & xt_seri,q_seri, & 400 & 'calltherm 353, apres ajout d_xt_the',ntiso,klon,klev) 401 endif 402 #endif 403 #endif 322 404 if (prt_level.gt.10) write(lunout,*)'Apres apres thermcell_main OK' 323 405 324 406 DO i=1,klon 325 407 fm_therm(i,klev+1)=0. 326 Ale_bl(i)=Ale_bl(i)+Ale(i)/REAL(nsplit_thermals)327 ! write(22,*)'ALE CALLTHERM', Ale_bl(i),Ale(i)328 Alp_bl(i)=Alp_bl(i)+Alp(i)/REAL(nsplit_thermals)329 ! write(23,*)'ALP CALLTHERM', Alp_bl(i),Alp(i)330 if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i)408 ale_bl(i)=ale_bl(i)+ale(i)/REAL(nsplit_thermals) 409 ! write(22,*)'ALE CALLTHERM',ale_bl(i),ale(i) 410 alp_bl(i)=alp_bl(i)+alp(i)/REAL(nsplit_thermals) 411 ! write(23,*)'ALP CALLTHERM',alp_bl(i),alp(i) 412 if(prt_level.GE.10) print*,'calltherm i alp_bl alp ale_bl ale',i,alp_bl(i),alp(i),ale_bl(i),ale(i) 331 413 ENDDO 332 414 … … 341 423 q_seri(i,k)=1.e-15 342 424 nbptspb=nbptspb+1 425 #ifdef ISO 426 do ixt=1,ntiso 427 xt_seri(ixt,i,k)=1.e-15*(xtmemoire(ixt,i,k)/qmemoire(i,k)) 428 enddo 429 #endif 343 430 ! if (prt_level.ge.10) then 344 431 ! print*,'WARN eau<0 apres therm i=',i,' k=',k & … … 348 435 ENDDO 349 436 ENDDO 437 #ifdef ISO 438 #ifdef ISOVERIF 439 if (iso_HDO.gt.0) then 440 call iso_verif_aberrant_enc_vect2D( & 441 & xt_seri,q_seri, & 442 & 'calltherm 393, apres bidouille q<0',ntiso,klon,klev) 443 endif 444 #endif 445 #endif 446 350 447 IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb 351 448 ! tests sur les valeurs de la temperature
Note: See TracChangeset
for help on using the changeset viewer.