Changeset 1638 for LMDZ5/trunk/libf/phylmd/physiq.F
- Timestamp:
- Jul 23, 2012, 1:11:05 PM (12 years ago)
- File:
-
- 1 edited
-
LMDZ5/trunk/libf/phylmd/physiq.F (modified) (25 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/physiq.F
r1628 r1638 180 180 real facteur,zfratqs1,zfratqs2 181 181 182 REAL lambda_th(klon,klev),zz,znum,zden182 REAL zz,znum,zden 183 183 REAL wmax_th(klon) 184 184 REAL zmax_th(klon) … … 614 614 REAL dd_t(klon,klev),dd_q(klon,klev) 615 615 616 real, save :: alp_bl_prescr=0. 1617 real, save :: ale_bl_prescr= 4.616 real, save :: alp_bl_prescr=0. 617 real, save :: ale_bl_prescr=0. 618 618 619 619 real, save :: ale_max=1000. … … 689 689 REAL ztla(klon,klev) 690 690 REAL zthl(klon,klev) 691 692 ccc nrlmd le 10/04/2012 693 694 c--------Stochastic Boundary Layer Triggering: ALE_BL-------- 695 c---Propriétés du thermiques au LCL 696 real zlcl_th(klon) ! Altitude du LCL calculé continument (pcon dans thermcell_main.F90) 697 real fraca0(klon) ! Fraction des thermiques au LCL 698 real w0(klon) ! Vitesse des thermiques au LCL 699 real w_conv(klon) ! Vitesse verticale de grande échelle au LCL 700 real therm_tke_max0(klon) ! TKE dans les thermiques au LCL 701 real env_tke_max0(klon) ! TKE dans l'environnement au LCL 702 703 c---Spectre de thermiques de type 2 au LCL 704 real n2(klon),s2(klon) 705 real ale_bl_stat(klon) 706 707 c---Déclenchement stochastique 708 integer :: tau_trig(klon) 709 real proba_notrig(klon) 710 real random_notrig(klon) 711 712 c--------Statistical Boundary Layer Closure: ALP_BL-------- 713 c---Profils de TKE dans et hors du thermique 714 real pbl_tke_input(klon,klev+1,nbsrf) 715 real therm_tke_max(klon,klev) ! Profil de TKE dans les thermiques 716 real env_tke_max(klon,klev) ! Profil de TKE dans l'environnement 717 718 c---Fermeture statistique 719 real alp_bl_det(klon) ! ALP déterministe du thermique unique 720 real alp_bl_fluct_m(klon) ! ALP liée aux fluctuations de flux de masse sous-nuageux 721 real alp_bl_fluct_tke(klon) ! ALP liée aux fluctuations d'énergie cinétique sous-nuageuse 722 real alp_bl_conv(klon) ! ALP liée à grande échelle 723 real alp_bl_stat(klon) ! ALP totale 724 725 ccc fin nrlmd le 10/04/2012 691 726 692 727 c Variables locales pour la couche limite (al1): … … 791 826 cIM 792 827 EXTERNAL haut2bas !variables de haut en bas 828 INTEGER lnblnk1 829 EXTERNAL lnblnk1 !enleve les blancs a la fin d'une variable de type 830 !caracter 793 831 EXTERNAL ini_undefSTD !initialise a 0 une variable a 1 niveau de pression 794 832 EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression … … 1354 1392 solswad(:)=0. 1355 1393 1356 lambda_th(:,:)=0.1357 1394 wmax_th(:)=0. 1358 1395 tau_overturning_th(:)=0. … … 1490 1527 cCR:04.12.07: initialisations poches froides 1491 1528 c Controle de ALE et ALP pour la fermeture convective (jyg) 1492 CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr 1529 if (iflag_wake>=1) then 1530 CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr 1493 1531 s ,alp_bl_prescr, ale_bl_prescr) 1494 1532 c 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU) 1495 1533 c print*,'apres ini_wake iflag_cldcon=', iflag_cldcon 1534 endif 1496 1535 1497 1536 do i = 1,klon … … 1516 1555 print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP 1517 1556 ENDIF 1557 1518 1558 c 1519 1559 ALLOCATE(tabCFMIP(nCFMIP)) … … 1735 1775 ! 1736 1776 itap = itap + 1 1777 c 1737 1778 ! 1738 1779 ! Update fraction of the sub-surfaces (pctsrf) and … … 2042 2083 c 2043 2084 2044 if (iflag_pbl/=0) then 2045 2046 2047 e 2048 e 2049 e 2050 e 2051 e 2052 e 2053 + 2054 s 2055 s 2056 s 2057 s 2058 s 2059 d 2060 d 2061 d 2062 d 2063 d 2064 d 2065 d 2066 d 2067 - 2068 - 2085 if (iflag_pbl/=0) then 2086 2087 CALL pbl_surface( 2088 e dtime, date0, itap, days_elapsed+1, 2089 e debut, lafin, 2090 e rlon, rlat, rugoro, rmu0, 2091 e rain_fall, snow_fall, solsw, sollw, 2092 e t_seri, q_seri, u_seri, v_seri, 2093 e pplay, paprs, pctsrf, 2094 + ftsol, falb1, falb2, u10m, v10m, 2095 s sollwdown, cdragh, cdragm, u1, v1, 2096 s albsol1, albsol2, sens, evap, 2097 s zxtsol, zxfluxlat, zt2m, qsat2m, 2098 s d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, 2099 s coefh, coefm, slab_wfbils, 2100 d qsol, zq2m, s_pblh, s_lcl, 2101 d s_capCL, s_oliqCL, s_cteiCL,s_pblT, 2102 d s_therm, s_trmb1, s_trmb2, s_trmb3, 2103 d zxrugs, zu10m, zv10m, fder, 2104 d zxqsurf, rh2m, zxfluxu, zxfluxv, 2105 d frugs, agesno, fsollw, fsolsw, 2106 d d_ts, fevap, fluxlat, t2m, 2107 d wfbils, wfbilo, fluxt, fluxu, fluxv, 2108 - dsens, devap, zxsnow, 2109 - zxfluxt, zxfluxq, q2m, fluxq, pbl_tke ) 2069 2110 2070 2111 2071 2112 !----------------------------------------------------------------------------------------- 2072 2113 ! ajout des tendances de la diffusion turbulente 2073 2114 CALL add_phys_tend(d_u_vdf,d_v_vdf,d_t_vdf,d_q_vdf,dql0,'vdf') 2074 2115 !----------------------------------------------------------------------------------------- 2075 2116 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2117 if (mydebug) then 2118 call writefield_phy('u_seri',u_seri,llm) 2119 call writefield_phy('v_seri',v_seri,llm) 2120 call writefield_phy('t_seri',t_seri,llm) 2121 call writefield_phy('q_seri',q_seri,llm) 2122 endif 2123 2124 2125 IF (ip_ebil_phy.ge.2) THEN 2126 ztit='after surface_main' 2127 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 2087 2128 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay 2088 2129 s , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 2089 2130 call diagphy(airephy,ztit,ip_ebil_phy 2090 2131 e , zero_v, zero_v, zero_v, zero_v, sens 2091 2132 e , evap , zero_v, zero_v, ztsol 2092 2133 e , d_h_vcol, d_qt, d_ec 2093 2134 s , fs_bound, fq_bound ) 2094 2135 END IF 2095 2136 2096 2137 ENDIF 2097 2098 2138 c =================================================================== c 2099 2139 c Calcul de Qsat … … 2244 2284 cdans le thermique sinon 2245 2285 if (iflag_coupl.eq.0) then 2246 if (debut.and.prt_level.gt.9)WRITE(lunout,*) 'ALE&ALP imposes' 2247 Ale_bl(1:klon) = ale_bl_prescr 2248 Alp_bl(1:klon) = alp_bl_prescr 2286 if (debut.and.prt_level.gt.9) 2287 $ WRITE(lunout,*)'ALE et ALP imposes' 2288 do i = 1,klon 2289 con ne couple que ale 2290 c ALE(i) = max(ale_wake(i),Ale_bl(i)) 2291 ALE(i) = max(ale_wake(i),ale_bl_prescr) 2292 con ne couple que alp 2293 c ALP(i) = alp_wake(i) + Alp_bl(i) 2294 ALP(i) = alp_wake(i) + alp_bl_prescr 2295 enddo 2249 2296 else 2250 2297 IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique' 2251 endif 2298 ! do i = 1,klon 2299 ! ALE(i) = max(ale_wake(i),Ale_bl(i)) 2300 ! avant ALP(i) = alp_wake(i) + Alp_bl(i) 2301 ! ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb 2302 ! write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i) 2303 ! write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i) 2304 ! enddo 2252 2305 2253 2306 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 2256 2309 ! w si <0 2257 2310 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2258 2259 2311 do i = 1,klon 2260 2312 ALE(i) = max(ale_wake(i),Ale_bl(i)) 2313 ccc nrlmd le 10/04/2012----------Stochastic triggering-------------- 2314 if (iflag_trig_bl.ge.1) then 2315 ALE(i) = max(ale_wake(i),Ale_bl_trig(i)) 2316 endif 2317 ccc fin nrlmd le 10/04/2012 2261 2318 if (alp_offset>=0.) then 2262 2319 ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb … … 2269 2326 endif 2270 2327 enddo 2271 2272 2328 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2273 2329 2330 endif 2274 2331 do i=1,klon 2275 2332 if (alp(i)>alp_max) then … … 2586 2643 2587 2644 2588 if (iflag_thermals.gt.1) then 2645 ccc nrlmd le 10/04/2012 2646 DO k=1,klev+1 2647 DO i=1,klon 2648 pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce) 2649 pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter) 2650 pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic) 2651 pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic) 2652 ENDDO 2653 ENDDO 2654 ccc fin nrlmd le 10/04/2012 2655 2656 if (iflag_thermals>=1) then 2589 2657 call calltherm(pdtphys 2590 2658 s ,pplay,paprs,pphi,weak_inversion … … 2596 2664 con rajoute ale et alp, et les caracteristiques de la couche alim 2597 2665 s ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca 2598 s ,ztv,zpspsk,ztla,zthl) 2666 s ,ztv,zpspsk,ztla,zthl 2667 ccc nrlmd le 10/04/2012 2668 e ,pbl_tke_input,pctsrf,omega,airephy 2669 s ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 2670 s ,n2,s2,ale_bl_stat 2671 s ,therm_tke_max,env_tke_max 2672 s ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke 2673 s ,alp_bl_conv,alp_bl_stat 2674 ccc fin nrlmd le 10/04/2012 2675 s ) 2676 2677 ccc nrlmd le 10/04/2012 2678 c-----------Stochastic triggering----------- 2679 if (iflag_trig_bl.ge.1) then 2680 c 2681 IF (prt_level .GE. 10) THEN 2682 print *,'cin, ale_bl_stat, alp_bl_stat ', 2683 $ cin, ale_bl_stat, alp_bl_stat 2684 ENDIF 2685 2686 c----Initialisations 2687 do i=1,klon 2688 proba_notrig(i)=1. 2689 random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i)) 2690 if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then 2691 tau_trig(i)=tau_trig_shallow 2692 else 2693 tau_trig(i)=tau_trig_deep 2694 endif 2695 enddo 2696 c 2697 IF (prt_level .GE. 10) THEN 2698 print *,'random_notrig, tau_trig ', 2699 $ random_notrig, tau_trig 2700 print *,'s_trig,s2,n2 ', 2701 $ s_trig,s2,n2 2702 ENDIF 2703 2704 c----Tirage aléatoire et calcul de ale_bl_trig 2705 do i=1,klon 2706 if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) ) then 2707 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** 2708 $ (n2(i)*dtime/tau_trig(i)) 2709 c print *, 'proba_notrig(i) ',proba_notrig(i) 2710 if (random_notrig(i) .ge. proba_notrig(i)) then 2711 ale_bl_trig(i)=ale_bl_stat(i) 2712 else 2713 ale_bl_trig(i)=0. 2714 endif 2715 else 2716 proba_notrig(i)=1. 2717 random_notrig(i)=0. 2718 ale_bl_trig(i)=0. 2719 endif 2720 enddo 2721 c 2722 IF (prt_level .GE. 10) THEN 2723 print *,'proba_notrig, ale_bl_trig ', 2724 $ proba_notrig, ale_bl_trig 2725 ENDIF 2726 2727 endif !(iflag_trig_bl) 2728 2729 c-----------Statistical closure----------- 2730 if (iflag_clos_bl.ge.1) then 2731 2732 do i=1,klon 2733 alp_bl(i)=alp_bl_stat(i) 2734 enddo 2735 2736 else 2737 2738 alp_bl_stat(:)=0. 2739 2740 endif !(iflag_clos_bl) 2741 2742 IF (prt_level .GE. 10) THEN 2743 print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat 2744 ENDIF 2745 2746 ccc fin nrlmd le 10/04/2012 2599 2747 2600 2748 ! ---------------------------------------------------------------------- … … 2627 2775 c ============== 2628 2776 2629 ! Dans le cas o \`uon active les thermiques, on fait partir l'ajustement2777 ! Dans le cas où on active les thermiques, on fait partir l'ajustement 2630 2778 ! a partir du sommet des thermiques. 2631 2779 ! Dans le cas contraire, on demarre au niveau 1. … … 2814 2962 ! FH 22/09/2009 2815 2963 ! La ligne ci-dessous faisait osciller le modele et donnait une solution 2816 ! as ymptotique bidon et d\'ependant fortement du pas de temps.2964 ! assymptotique bidon et dépendant fortement du pas de temps. 2817 2965 ! ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2) 2818 2966 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 2842 2990 c Appeler le processus de condensation a grande echelle 2843 2991 c et le processus de precipitation 2992 c------------------------------------------------------------------------- 2993 IF (prt_level .GE.10) THEN 2994 print *,' ->fisrtilp ' 2995 ENDIF 2844 2996 c------------------------------------------------------------------------- 2845 2997 CALL fisrtilp(dtime,paprs,pplay, … … 3351 3503 RCFC12 = RCFC12_act 3352 3504 c 3505 IF (prt_level .GE.10) THEN 3506 print *,' ->radlwsw, number 1 ' 3507 ENDIF 3508 c 3353 3509 CALL radlwsw 3354 3510 e (dist, rmu0, fract, … … 3388 3544 RCFC12 = RCFC12_per 3389 3545 c 3546 IF (prt_level .GE.10) THEN 3547 print *,' ->radlwsw, number 2 ' 3548 ENDIF 3549 c 3390 3550 CALL radlwsw 3391 3551 e (dist, rmu0, fract, … … 3480 3640 c a l'echelle sous-maille: 3481 3641 c 3642 IF (prt_level .GE.10) THEN 3643 print *,' call orography ? ', ok_orodr 3644 ENDIF 3645 c 3482 3646 IF (ok_orodr) THEN 3483 3647 c … … 3569 3733 3570 3734 IF (ok_hines) then 3735 3571 3736 CALL hines_gwd(klon,klev,dtime,paprs,pplay, 3572 3737 i rlat,t_seri,u_seri,v_seri, … … 3576 3741 c ajout des tendances 3577 3742 CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,'hin') 3743 3578 3744 ENDIF 3579 3745 c 3746 3747 c 3748 cIM cf. FLott BEG 3580 3749 C STRESS NECESSAIRES: TOUTE LA PHYSIQUE 3581 3750 … … 3602 3771 cIM calcul composantes axiales du moment angulaire et couple des montagnes 3603 3772 c 3604 IF (is_sequential .and. ok_orodr) THEN 3605 3773 IF (is_sequential .and. ok_orodr) THEN 3606 3774 CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, 3607 3775 C ra,rg,romega, … … 3898 4066 c Convertir les incrementations en tendances 3899 4067 c 4068 IF (prt_level .GE.10) THEN 4069 print *,'Convertir les incrementations en tendances ' 4070 ENDIF 4071 c 3900 4072 if (mydebug) then 3901 4073 call writefield_phy('u_seri',u_seri,llm) … … 4016 4188 c============================================================= 4017 4189 4018 if (iflag_thermals> 1) then4190 if (iflag_thermals>=1) then 4019 4191 d_t_lscth=0. 4020 4192 d_t_lscst=0.
Note: See TracChangeset
for help on using the changeset viewer.
