Changeset 2513 for LMDZ5/trunk/libf/phylmd/physiq_mod.F90
- Timestamp:
- May 12, 2016, 6:21:10 PM (8 years ago)
- File:
-
- 1 edited
-
LMDZ5/trunk/libf/phylmd/physiq_mod.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/physiq_mod.F90
r2501 r2513 368 368 real, save :: ale_bl_prescr=0. 369 369 370 real, save :: ale_max=1000.371 real, save :: alp_max=2.372 373 370 real, save :: wake_s_min_lsp=0.1 374 371 375 372 !$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr) 376 !$OMP THREADPRIVATE(ale_max,alp_max)377 373 !$OMP THREADPRIVATE(wake_s_min_lsp) 378 374 … … 438 434 LOGICAL,SAVE :: ok_adjwk=.FALSE. 439 435 !$OMP THREADPRIVATE(ok_adjwk) 440 REAL, dimension(klon) :: www441 436 REAL, SAVE :: alp_offset 442 437 !$OMP THREADPRIVATE(alp_offset) … … 2288 2283 !>jyg 2289 2284 ! 2290 2291 ! Calcul de l'energie disponible ALE (J/kg) et de la puissance 2292 ! disponible ALP (W/m2) pour le soulevement des particules dans 2293 ! le modele convectif 2294 ! 2295 do i = 1,klon 2296 ALE(i) = 0. 2297 ALP(i) = 0. 2298 enddo 2299 ! 2300 !calcul de ale_wake et alp_wake 2301 if (iflag_wake>=1) then 2302 if (itap .le. it_wape_prescr) then 2303 do i = 1,klon 2304 ale_wake(i) = wape_prescr 2305 alp_wake(i) = fip_prescr 2306 enddo 2307 else 2308 do i = 1,klon 2309 !jyg ALE=WAPE au lieu de ALE = 1/2 Cstar**2 2310 !cc ale_wake(i) = 0.5*wake_cstar(i)**2 2311 ale_wake(i) = wake_pe(i) 2312 alp_wake(i) = wake_fip(i) 2313 enddo 2314 endif 2315 else 2316 do i = 1,klon 2317 ale_wake(i) = 0. 2318 alp_wake(i) = 0. 2319 enddo 2320 endif 2321 !combinaison avec ale et alp de couche limite: constantes si pas 2322 !de couplage, valeurs calculees dans le thermique sinon 2323 if (iflag_coupl.eq.0) then 2324 if (debut.and.prt_level.gt.9) & 2325 WRITE(lunout,*)'ALE et ALP imposes' 2326 do i = 1,klon 2327 !on ne couple que ale 2328 ! ALE(i) = max(ale_wake(i),Ale_bl(i)) 2329 ALE(i) = max(ale_wake(i),ale_bl_prescr) 2330 !on ne couple que alp 2331 ! ALP(i) = alp_wake(i) + Alp_bl(i) 2332 ALP(i) = alp_wake(i) + alp_bl_prescr 2333 enddo 2334 else 2335 IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique' 2336 ! do i = 1,klon 2337 ! ALE(i) = max(ale_wake(i),Ale_bl(i)) 2338 ! avant ALP(i) = alp_wake(i) + Alp_bl(i) 2339 ! ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb 2340 ! write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i) 2341 ! write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i) 2342 ! enddo 2343 2344 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2345 ! Modif FH 2010/04/27. Sans doute temporaire. 2346 ! Deux options pour le alp_offset : constant si >?? 0 ou 2347 ! proportionnel ??a w si <0 2348 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2349 ! Estimation d'une vitesse verticale effective pour ALP 2350 if (1==0) THEN 2351 www(1:klon)=0. 2352 do k=2,klev-1 2353 do i=1,klon 2354 www(i)=max(www(i),-omega(i,k)*RD*t_seri(i,k) & 2355 /(RG*paprs(i,k)) *zw2(i,k)*zw2(i,k)) 2356 ! if (paprs(i,k)>pbase(i)) then 2357 ! calcul approche de la vitesse verticale en m/s 2358 ! www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k)) 2359 ! endif 2360 ! Le 0.1 est en gros H / ps = 1e5 / 1e4 2361 enddo 2362 enddo 2363 do i=1,klon 2364 if (www(i)>0. .and. ale_bl(i)>0. ) www(i)=www(i)/ale_bl(i) 2365 enddo 2366 ENDIF 2367 2368 2369 do i = 1,klon 2370 ALE(i) = max(ale_wake(i),Ale_bl(i)) 2371 !cc nrlmd le 10/04/2012----------Stochastic triggering------------ 2372 if (iflag_trig_bl.ge.1) then 2373 ALE(i) = max(ale_wake(i),Ale_bl_trig(i)) 2374 endif 2375 !cc fin nrlmd le 10/04/2012 2376 if (alp_offset>=0.) then 2377 ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb 2378 else 2379 abort_message ='Ne pas passer la car www non calcule' 2380 CALL abort_physic (modname,abort_message,1) 2381 2382 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2383 ! _ _ 2384 ! Ajout d'une composante 3 * A * w w'2 a w'3 avec 2385 ! w=www : w max sous pbase ou A est la fraction 2386 ! couverte par les ascendances w' on utilise le fait 2387 ! que A * w'3 = ALP et donc A * w'2 ~ ALP / sqrt(ALE) 2388 ! (on ajoute 0.1 pour les singularites) 2389 ALP(i)=alp_wake(i)*(1.+3.*www(i)/( sqrt(ale_wake(i))+0.1) ) & 2390 +alp_bl(i) *(1.+3.*www(i)/( sqrt(ale_bl(i)) +0.1) ) 2391 ! ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.) 2392 ! if (alp(i)<0.) then 2393 ! print*,'ALP ',alp(i),alp_wake(i) & 2394 ! ,Alp_bl(i),alp_offset*min(omega(i,6),0.) 2395 ! endif 2396 endif 2397 enddo 2398 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2399 2400 endif 2401 do i=1,klon 2402 if (alp(i)>alp_max) then 2403 IF(prt_level>9)WRITE(lunout,*) & 2404 'WARNING SUPER ALP (seuil=',alp_max, & 2405 '): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i) 2406 alp(i)=alp_max 2407 endif 2408 if (ale(i)>ale_max) then 2409 IF(prt_level>9)WRITE(lunout,*) & 2410 'WARNING SUPER ALE (seuil=',ale_max, & 2411 '): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i) 2412 ale(i)=ale_max 2413 endif 2414 enddo 2415 2416 !fin calcul ale et alp 2417 !======================================================================= 2418 2419 2285 !jyg< 2286 CALL alpale( debut, itap, dtime, paprs, omega, t_seri, & 2287 alp_offset, it_wape_prescr, wape_prescr, fip_prescr, & 2288 ale_bl_prescr, alp_bl_prescr, & 2289 wake_pe, wake_fip, & 2290 Ale_bl, Ale_bl_trig, Alp_bl, & 2291 Ale, Alp ) 2292 !>jyg 2293 ! 2420 2294 ! sb, oct02: 2421 2295 ! Schema de convection modularise et vectorise: … … 2895 2769 ENDIF 2896 2770 !>jyg 2897 2898 !cc nrlmd le 10/04/2012 2899 !-----------Stochastic triggering----------- 2900 if (iflag_trig_bl.ge.1) then 2901 ! 2902 IF (prt_level .GE. 10) THEN 2903 print *,'cin, ale_bl_stat, alp_bl_stat ', & 2904 cin, ale_bl_stat, alp_bl_stat 2905 ENDIF 2906 2907 2908 !----Initialisations 2909 do i=1,klon 2910 proba_notrig(i)=1. 2911 random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i)) 2912 if ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0. 2913 if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then 2914 tau_trig(i)=tau_trig_shallow 2915 else 2916 tau_trig(i)=tau_trig_deep 2917 endif 2918 enddo 2919 ! 2920 IF (prt_level .GE. 10) THEN 2921 print *,'random_notrig, tau_trig ', & 2922 random_notrig, tau_trig 2923 print *,'s_trig,s2,n2 ', & 2924 s_trig,s2,n2 2925 ENDIF 2926 2927 !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2) 2928 IF (iflag_trig_bl.eq.1) then 2929 2930 !----Tirage al\'eatoire et calcul de ale_bl_trig 2931 do i=1,klon 2932 if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) ) then 2933 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** & 2934 (n2(i)*dtime/tau_trig(i)) 2935 ! print *, 'proba_notrig(i) ',proba_notrig(i) 2936 if (random_notrig(i) .ge. proba_notrig(i)) then 2937 ale_bl_trig(i)=ale_bl_stat(i) 2938 else 2939 ale_bl_trig(i)=0. 2940 endif 2941 else 2942 proba_notrig(i)=1. 2943 random_notrig(i)=0. 2944 ale_bl_trig(i)=0. 2945 endif 2946 enddo 2947 2948 ELSE IF (iflag_trig_bl.ge.2) then 2949 2950 do i=1,klon 2951 if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) ) then 2952 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** & 2953 (n2(i)*dtime/tau_trig(i)) 2954 ! print *, 'proba_notrig(i) ',proba_notrig(i) 2955 if (random_notrig(i) .ge. proba_notrig(i)) then 2956 ale_bl_trig(i)=Ale_bl(i) 2957 else 2958 ale_bl_trig(i)=0. 2959 endif 2960 else 2961 proba_notrig(i)=1. 2962 random_notrig(i)=0. 2963 ale_bl_trig(i)=0. 2964 endif 2965 enddo 2966 2967 ENDIF 2968 2969 ! 2970 IF (prt_level .GE. 10) THEN 2971 print *,'proba_notrig, ale_bl_trig ', & 2972 proba_notrig, ale_bl_trig 2973 ENDIF 2974 2975 endif !(iflag_trig_bl) 2976 2977 !-----------Statistical closure----------- 2978 if (iflag_clos_bl.eq.1) then 2979 2980 do i=1,klon 2981 !CR: alp probabiliste 2982 if (ale_bl_trig(i).gt.0.) then 2983 alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999)) 2984 endif 2985 enddo 2986 2987 else if (iflag_clos_bl.eq.2) then 2988 2989 !CR: alp calculee dans thermcell_main 2990 do i=1,klon 2991 alp_bl(i)=alp_bl_stat(i) 2992 enddo 2993 2994 else 2995 2996 alp_bl_stat(:)=0. 2997 2998 endif !(iflag_clos_bl) 2999 3000 IF (prt_level .GE. 10) THEN 3001 print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat 3002 ENDIF 3003 3004 !cc fin nrlmd le 10/04/2012 3005 3006 ! ------------------------------------------------------------------ 3007 ! Transport de la TKE par les panaches thermiques. 3008 ! FH : 2010/02/01 3009 ! if (iflag_pbl.eq.10) then 3010 ! call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm, 3011 ! s rg,paprs,pbl_tke) 3012 ! endif 3013 ! ------------------------------------------------------------------- 3014 !IM/FH: 2011/02/23 3015 ! Couplage Thermiques/Emanuel seulement si T<0 3016 if (iflag_coupl==2) then 3017 IF (prt_level .GE. 10) THEN 3018 print*,'Couplage Thermiques/Emanuel seulement si T<0' 3019 ENDIF 3020 do i=1,klon 3021 if (t_seri(i,lmax_th(i))>273.) then 3022 Ale_bl(i)=0. 3023 endif 3024 enddo 3025 endif 2771 !jyg< 2772 ! 2773 CALL alpale_th( dtime, lmax_th, t_seri, & 2774 cin, s2, n2, & 2775 ale_bl_trig, ale_bl_stat, ale_bl, & 2776 alp_bl, alp_bl_stat ) 3026 2777 3027 2778 do i=1,klon
Note: See TracChangeset
for help on using the changeset viewer.
