Changeset 1669 for LMDZ5/branches/testing/libf/phylmd/physiq.F
- Timestamp:
- Oct 16, 2012, 2:41:50 PM (12 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/physiq.F (modified) (33 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 1629-1633,1635,1637-1659,1666-1668
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/phylmd/physiq.F
r1665 r1669 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): … … 1212 1247 LOGICAL, SAVE :: mskocean_beta 1213 1248 c$OMP THREADPRIVATE(mskocean_beta) 1214 REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et cldemirad pour evaluer les retros liees aux CRF 1215 REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique pour radlwsw,COSP 1216 REAL, dimension(klon, klev) :: cldemirad ! emissivite pour radlwsw,COSP 1249 REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et cldemirad pour evaluer les retros liees aux CRF 1250 REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique pour radlwsw,COSP 1251 REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique pour radlwsw,COSP cas pre-industrial 1252 REAL, dimension(klon, klev) :: cldemirad ! emissivite pour radlwsw,COSP 1217 1253 INTEGER :: nbtr_tmp ! Number of tracer inside concvl 1218 1254 REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac … … 1354 1390 solswad(:)=0. 1355 1391 1356 lambda_th(:,:)=0.1357 1392 wmax_th(:)=0. 1358 1393 tau_overturning_th(:)=0. … … 1490 1525 cCR:04.12.07: initialisations poches froides 1491 1526 c Controle de ALE et ALP pour la fermeture convective (jyg) 1492 CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr 1527 if (iflag_wake>=1) then 1528 CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr 1493 1529 s ,alp_bl_prescr, ale_bl_prescr) 1494 1530 c 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU) 1495 1531 c print*,'apres ini_wake iflag_cldcon=', iflag_cldcon 1532 endif 1496 1533 1497 1534 do i = 1,klon … … 1516 1553 print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP 1517 1554 ENDIF 1555 1518 1556 c 1519 1557 ALLOCATE(tabCFMIP(nCFMIP)) … … 1624 1662 1625 1663 #endif 1626 1627 1628 ecrit_hf = ecrit_hf * un_jour1629 cIM1630 IF(ecrit_day.LE.1.) THEN1631 ecrit_day = ecrit_day * un_jour !en secondes1632 ENDIF1633 cIM1634 ecrit_mth = ecrit_mth * un_jour1635 ecrit_ins = ecrit_ins * un_jour1636 1664 ecrit_reg = ecrit_reg * un_jour 1637 1665 ecrit_tra = ecrit_tra * un_jour 1638 ecrit_LES = ecrit_LES * un_jour 1639 c 1640 1666 1641 1667 cXXXPB Positionner date0 pour initialisation de ORCHIDEE 1642 1668 date0 = jD_ref … … 1735 1761 ! 1736 1762 itap = itap + 1 1763 c 1737 1764 ! 1738 1765 ! Update fraction of the sub-surfaces (pctsrf) and … … 2042 2069 c 2043 2070 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 - 2071 if (iflag_pbl/=0) then 2072 2073 CALL pbl_surface( 2074 e dtime, date0, itap, days_elapsed+1, 2075 e debut, lafin, 2076 e rlon, rlat, rugoro, rmu0, 2077 e rain_fall, snow_fall, solsw, sollw, 2078 e t_seri, q_seri, u_seri, v_seri, 2079 e pplay, paprs, pctsrf, 2080 + ftsol, falb1, falb2, u10m, v10m, 2081 s sollwdown, cdragh, cdragm, u1, v1, 2082 s albsol1, albsol2, sens, evap, 2083 s zxtsol, zxfluxlat, zt2m, qsat2m, 2084 s d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, 2085 s coefh, coefm, slab_wfbils, 2086 d qsol, zq2m, s_pblh, s_lcl, 2087 d s_capCL, s_oliqCL, s_cteiCL,s_pblT, 2088 d s_therm, s_trmb1, s_trmb2, s_trmb3, 2089 d zxrugs, zu10m, zv10m, fder, 2090 d zxqsurf, rh2m, zxfluxu, zxfluxv, 2091 d frugs, agesno, fsollw, fsolsw, 2092 d d_ts, fevap, fluxlat, t2m, 2093 d wfbils, wfbilo, fluxt, fluxu, fluxv, 2094 - dsens, devap, zxsnow, 2095 - zxfluxt, zxfluxq, q2m, fluxq, pbl_tke ) 2069 2096 2070 2097 2071 2098 !----------------------------------------------------------------------------------------- 2072 2099 ! ajout des tendances de la diffusion turbulente 2073 2100 CALL add_phys_tend(d_u_vdf,d_v_vdf,d_t_vdf,d_q_vdf,dql0,'vdf') 2074 2101 !----------------------------------------------------------------------------------------- 2075 2102 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2103 if (mydebug) then 2104 call writefield_phy('u_seri',u_seri,llm) 2105 call writefield_phy('v_seri',v_seri,llm) 2106 call writefield_phy('t_seri',t_seri,llm) 2107 call writefield_phy('q_seri',q_seri,llm) 2108 endif 2109 2110 2111 IF (ip_ebil_phy.ge.2) THEN 2112 ztit='after surface_main' 2113 CALL diagetpq(airephy,ztit,ip_ebil_phy,2,2,dtime 2087 2114 e , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay 2088 2115 s , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec) 2089 2116 call diagphy(airephy,ztit,ip_ebil_phy 2090 2117 e , zero_v, zero_v, zero_v, zero_v, sens 2091 2118 e , evap , zero_v, zero_v, ztsol 2092 2119 e , d_h_vcol, d_qt, d_ec 2093 2120 s , fs_bound, fq_bound ) 2094 2121 END IF 2095 2122 2096 2123 ENDIF 2097 2098 2124 c =================================================================== c 2099 2125 c Calcul de Qsat … … 2244 2270 cdans le thermique sinon 2245 2271 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 2272 if (debut.and.prt_level.gt.9) 2273 $ WRITE(lunout,*)'ALE et ALP imposes' 2274 do i = 1,klon 2275 con ne couple que ale 2276 c ALE(i) = max(ale_wake(i),Ale_bl(i)) 2277 ALE(i) = max(ale_wake(i),ale_bl_prescr) 2278 con ne couple que alp 2279 c ALP(i) = alp_wake(i) + Alp_bl(i) 2280 ALP(i) = alp_wake(i) + alp_bl_prescr 2281 enddo 2249 2282 else 2250 2283 IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique' 2251 endif 2284 ! do i = 1,klon 2285 ! ALE(i) = max(ale_wake(i),Ale_bl(i)) 2286 ! avant ALP(i) = alp_wake(i) + Alp_bl(i) 2287 ! ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb 2288 ! write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i) 2289 ! write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i) 2290 ! enddo 2252 2291 2253 2292 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 2256 2295 ! w si <0 2257 2296 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2258 2259 2297 do i = 1,klon 2260 2298 ALE(i) = max(ale_wake(i),Ale_bl(i)) 2299 ccc nrlmd le 10/04/2012----------Stochastic triggering-------------- 2300 if (iflag_trig_bl.ge.1) then 2301 ALE(i) = max(ale_wake(i),Ale_bl_trig(i)) 2302 endif 2303 ccc fin nrlmd le 10/04/2012 2261 2304 if (alp_offset>=0.) then 2262 2305 ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb … … 2269 2312 endif 2270 2313 enddo 2271 2272 2314 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2273 2315 2316 endif 2274 2317 do i=1,klon 2275 2318 if (alp(i)>alp_max) then … … 2586 2629 2587 2630 2588 if (iflag_thermals.gt.1) then 2631 ccc nrlmd le 10/04/2012 2632 DO k=1,klev+1 2633 DO i=1,klon 2634 pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce) 2635 pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter) 2636 pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic) 2637 pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic) 2638 ENDDO 2639 ENDDO 2640 ccc fin nrlmd le 10/04/2012 2641 2642 if (iflag_thermals>=1) then 2589 2643 call calltherm(pdtphys 2590 2644 s ,pplay,paprs,pphi,weak_inversion … … 2596 2650 con rajoute ale et alp, et les caracteristiques de la couche alim 2597 2651 s ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca 2598 s ,ztv,zpspsk,ztla,zthl) 2652 s ,ztv,zpspsk,ztla,zthl 2653 ccc nrlmd le 10/04/2012 2654 e ,pbl_tke_input,pctsrf,omega,airephy 2655 s ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 2656 s ,n2,s2,ale_bl_stat 2657 s ,therm_tke_max,env_tke_max 2658 s ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke 2659 s ,alp_bl_conv,alp_bl_stat 2660 ccc fin nrlmd le 10/04/2012 2661 s ) 2662 2663 ccc nrlmd le 10/04/2012 2664 c-----------Stochastic triggering----------- 2665 if (iflag_trig_bl.ge.1) then 2666 c 2667 IF (prt_level .GE. 10) THEN 2668 print *,'cin, ale_bl_stat, alp_bl_stat ', 2669 $ cin, ale_bl_stat, alp_bl_stat 2670 ENDIF 2671 2672 c----Initialisations 2673 do i=1,klon 2674 proba_notrig(i)=1. 2675 random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i)) 2676 if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then 2677 tau_trig(i)=tau_trig_shallow 2678 else 2679 tau_trig(i)=tau_trig_deep 2680 endif 2681 enddo 2682 c 2683 IF (prt_level .GE. 10) THEN 2684 print *,'random_notrig, tau_trig ', 2685 $ random_notrig, tau_trig 2686 print *,'s_trig,s2,n2 ', 2687 $ s_trig,s2,n2 2688 ENDIF 2689 2690 c----Tirage aléatoire et calcul de ale_bl_trig 2691 do i=1,klon 2692 if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) ) then 2693 proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** 2694 $ (n2(i)*dtime/tau_trig(i)) 2695 c print *, 'proba_notrig(i) ',proba_notrig(i) 2696 if (random_notrig(i) .ge. proba_notrig(i)) then 2697 ale_bl_trig(i)=ale_bl_stat(i) 2698 else 2699 ale_bl_trig(i)=0. 2700 endif 2701 else 2702 proba_notrig(i)=1. 2703 random_notrig(i)=0. 2704 ale_bl_trig(i)=0. 2705 endif 2706 enddo 2707 c 2708 IF (prt_level .GE. 10) THEN 2709 print *,'proba_notrig, ale_bl_trig ', 2710 $ proba_notrig, ale_bl_trig 2711 ENDIF 2712 2713 endif !(iflag_trig_bl) 2714 2715 c-----------Statistical closure----------- 2716 if (iflag_clos_bl.ge.1) then 2717 2718 do i=1,klon 2719 alp_bl(i)=alp_bl_stat(i) 2720 enddo 2721 2722 else 2723 2724 alp_bl_stat(:)=0. 2725 2726 endif !(iflag_clos_bl) 2727 2728 IF (prt_level .GE. 10) THEN 2729 print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat 2730 ENDIF 2731 2732 ccc fin nrlmd le 10/04/2012 2599 2733 2600 2734 ! ---------------------------------------------------------------------- … … 2627 2761 c ============== 2628 2762 2629 ! Dans le cas o \`uon active les thermiques, on fait partir l'ajustement2763 ! Dans le cas où on active les thermiques, on fait partir l'ajustement 2630 2764 ! a partir du sommet des thermiques. 2631 2765 ! Dans le cas contraire, on demarre au niveau 1. … … 2814 2948 ! FH 22/09/2009 2815 2949 ! La ligne ci-dessous faisait osciller le modele et donnait une solution 2816 ! as ymptotique bidon et d\'ependant fortement du pas de temps.2950 ! assymptotique bidon et dépendant fortement du pas de temps. 2817 2951 ! ratqs(:,:)=sqrt(ratqs(:,:)**2+ratqss(:,:)**2) 2818 2952 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! … … 2842 2976 c Appeler le processus de condensation a grande echelle 2843 2977 c et le processus de precipitation 2978 c------------------------------------------------------------------------- 2979 IF (prt_level .GE.10) THEN 2980 print *,' ->fisrtilp ' 2981 ENDIF 2844 2982 c------------------------------------------------------------------------- 2845 2983 CALL fisrtilp(dtime,paprs,pplay, … … 2962 3100 cjq - introduce the aerosol direct and first indirect radiative forcings 2963 3101 cjq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) 2964 IF ( ok_ade.OR.ok_aie) THEN3102 IF (flag_aerosol .gt. 0) THEN 2965 3103 IF (.NOT. aerosol_couple) 2966 3104 & CALL readaerosol_optic( … … 3247 3385 cIM betaCRF 3248 3386 c 3249 cldtaurad = cldtau 3250 cldemirad = cldemi 3387 cldtaurad = cldtau 3388 cldtaupirad = cldtaupi 3389 cldemirad = cldemi 3251 3390 c 3252 3391 if(lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. … … 3265 3404 beta(i,k) = beta(i,k) * pctsrf(i,is_oce) 3266 3405 endif 3267 cldtaurad(i,k) = cldtau(i,k) * beta(i,k) 3268 cldemirad(i,k) = cldemi(i,k) * beta(i,k) 3406 cldtaurad(i,k) = cldtau(i,k) * beta(i,k) 3407 cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k) 3408 cldemirad(i,k) = cldemi(i,k) * beta(i,k) 3269 3409 ENDDO 3270 3410 ENDDO … … 3287 3427 beta(i,k) = beta(i,k) * pctsrf(i,is_oce) 3288 3428 endif 3289 cldtaurad(i,k) = cldtau(i,k) * beta(i,k) 3290 cldemirad(i,k) = cldemi(i,k) * beta(i,k) 3429 cldtaurad(i,k) = cldtau(i,k) * beta(i,k) 3430 cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k) 3431 cldemirad(i,k) = cldemi(i,k) * beta(i,k) 3291 3432 endif 3292 3433 c … … 3337 3478 s topsw_aero, topsw0_aero, 3338 3479 s solsw_aero, solsw0_aero, 3339 e cldtaupi ,3480 e cldtaupirad, 3340 3481 s topswai_aero, solswai_aero) 3341 3482 … … 3351 3492 RCFC12 = RCFC12_act 3352 3493 c 3494 IF (prt_level .GE.10) THEN 3495 print *,' ->radlwsw, number 1 ' 3496 ENDIF 3497 c 3353 3498 CALL radlwsw 3354 3499 e (dist, rmu0, fract, … … 3356 3501 e t_seri,q_seri,wo, 3357 3502 e cldfra, cldemirad, cldtaurad, 3358 e ok_ade, ok_aie, 3503 e ok_ade, ok_aie, flag_aerosol, 3359 3504 e tau_aero, piz_aero, cg_aero, 3360 e cldtaupi ,new_aod,3505 e cldtaupirad,new_aod, 3361 3506 e zqsat, flwc, fiwc, 3362 3507 s heat,heat0,cool,cool0,radsol,albpla, … … 3388 3533 RCFC12 = RCFC12_per 3389 3534 c 3535 IF (prt_level .GE.10) THEN 3536 print *,' ->radlwsw, number 2 ' 3537 ENDIF 3538 c 3390 3539 CALL radlwsw 3391 3540 e (dist, rmu0, fract, … … 3393 3542 e t_seri,q_seri,wo, 3394 3543 e cldfra, cldemi, cldtau, 3395 e ok_ade, ok_aie, 3544 e ok_ade, ok_aie, flag_aerosol, 3396 3545 e tau_aero, piz_aero, cg_aero, 3397 3546 e cldtaupi,new_aod, … … 3479 3628 c Appeler le programme de parametrisation de l'orographie 3480 3629 c a l'echelle sous-maille: 3630 c 3631 IF (prt_level .GE.10) THEN 3632 print *,' call orography ? ', ok_orodr 3633 ENDIF 3481 3634 c 3482 3635 IF (ok_orodr) THEN … … 3569 3722 3570 3723 IF (ok_hines) then 3724 3571 3725 CALL hines_gwd(klon,klev,dtime,paprs,pplay, 3572 3726 i rlat,t_seri,u_seri,v_seri, … … 3576 3730 c ajout des tendances 3577 3731 CALL add_phys_tend(d_u_hin,d_v_hin,d_t_hin,dq0,dql0,'hin') 3732 3578 3733 ENDIF 3579 3734 c 3735 3736 c 3737 cIM cf. FLott BEG 3580 3738 C STRESS NECESSAIRES: TOUTE LA PHYSIQUE 3581 3739 … … 3602 3760 cIM calcul composantes axiales du moment angulaire et couple des montagnes 3603 3761 c 3604 IF (is_sequential .and. ok_orodr) THEN 3605 3762 IF (is_sequential .and. ok_orodr) THEN 3606 3763 CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, 3607 3764 C ra,rg,romega, … … 3898 4055 c Convertir les incrementations en tendances 3899 4056 c 4057 IF (prt_level .GE.10) THEN 4058 print *,'Convertir les incrementations en tendances ' 4059 ENDIF 4060 c 3900 4061 if (mydebug) then 3901 4062 call writefield_phy('u_seri',u_seri,llm) … … 4016 4177 c============================================================= 4017 4178 4018 if (iflag_thermals> 1) then4179 if (iflag_thermals>=1) then 4019 4180 d_t_lscth=0. 4020 4181 d_t_lscst=0.
Note: See TracChangeset
for help on using the changeset viewer.
