Changeset 2159 for LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90
- Timestamp:
- Nov 27, 2014, 4:48:31 PM (10 years ago)
- File:
-
- 1 edited
-
LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90 (modified) (51 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/pbl_surface_mod.F90
r2126 r2159 174 174 rain_f, snow_f, solsw_m, sollw_m, & 175 175 t, q, u, v, & 176 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 177 !! t_x, q_x, t_w, q_w, & 178 wake_dlt, wake_dlq, & 179 wake_cstar, wake_s, & 180 !!! 176 181 pplay, paprs, pctsrf, & 177 182 ts, alb1, alb2,ustar, u10m, v10m,wstar, & … … 181 186 zxtsol, zxfluxlat, zt2m, qsat2m, & 182 187 d_t, d_q, d_u, d_v, d_t_diss, & 188 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 189 d_t_w, d_q_w, & 190 d_t_x, d_q_x, & 191 !! d_wake_dlt,d_wake_dlq, & 192 zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, & 193 !!! 194 !!! nrlmd le 13/06/2011 195 delta_tsurf,wake_dens,cdragh_x,cdragh_w, & 196 cdragm_x,cdragm_w,kh,kh_x,kh_w, & 197 !!! 183 198 zcoefh, zcoefm, slab_wfbils, & 184 199 qsol_d, zq2m, s_pblh, s_plcl, & 200 !!! 201 !!! jyg le 08/02/2012 202 s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, & 203 !!! 185 204 s_capCL, s_oliqCL, s_cteiCL, s_pblT, & 186 205 s_therm, s_trmb1, s_trmb2, s_trmb3, & … … 191 210 wfbils, wfbilo, flux_t, flux_u, flux_v,& 192 211 dflux_t, dflux_q, zxsnow, & 193 zxfluxt, zxfluxq, q2m, flux_q, tke ) 212 zxfluxt, zxfluxq, q2m, flux_q, tke, & 213 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 214 !! tke_x, tke_w & 215 wake_dltke & 216 !!! 217 ) 194 218 !**************************************************************************************** 195 219 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 … … 221 245 ! u--------input-R- vitesse u 222 246 ! v--------input-R- vitesse v 247 ! wake_dlt-input-R- temperatre difference between (w) and (x) (K) 248 ! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg) 249 !wake_cstar-input-R- wake gust front speed (m/s) 250 ! wake_s---input-R- wake fractionnal area 223 251 ! ts-------input-R- temperature du sol (en Kelvin) 224 252 ! paprs----input-R- pression a intercouche (Pa) … … 240 268 ! (orientation positive vers le bas) 241 269 ! tke---input/output-R- tke (kg/m**2/s) 270 ! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s) 242 271 ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s) 243 272 ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal … … 299 328 ! Martin 300 329 330 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 331 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: t_x ! Température hors poche froide 332 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: t_w ! Température dans la poches froide 333 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: q_x ! 334 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: q_w ! Pareil pour l'humidité 335 REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlt !temperature difference between (w) and (x) (K) 336 REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlq !humidity difference between (w) and (x) (K) 337 REAL, DIMENSION(klon), INTENT(IN) :: wake_s ! Fraction de poches froides 338 REAL, DIMENSION(klon), INTENT(IN) :: wake_cstar! Vitesse d'expansion des poches froides 339 REAL, DIMENSION(klon), INTENT(IN) :: wake_dens 340 !!! 341 301 342 ! Input/Output variables 302 343 !**************************************************************************************** 303 344 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K) 345 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: delta_tsurf !surface temperature difference between 346 !wake and off-wake regions 304 347 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: alb1 ! albedo in visible SW interval 305 348 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: alb2 ! albedo in near infra-red SW interval … … 309 352 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m 310 353 REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke 354 355 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 356 REAL, DIMENSION(klon, klev+1, nbsrf), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x 357 !!! 358 311 359 ! Output variables 312 360 !**************************************************************************************** … … 325 373 REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards 326 374 REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point 375 !!! jyg le ??? 376 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_w ! ! 377 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_w ! ! Tendances dans les poches 378 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_x ! ! 379 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_x ! ! Tendances hors des poches 380 !!! jyg 327 381 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point 328 382 REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point … … 340 394 ! coef for turbulent diffusion of U and V (?), mean for each grid point 341 395 396 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 397 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_x ! Flux sensible hors poche 398 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_w ! Flux sensible dans la poche 399 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_x! Flux latent hors poche 400 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_w! Flux latent dans la poche 401 !! REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_wake_dlt 402 !! REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_wake_dlq 403 342 404 ! Output only for diagnostics 405 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_x 406 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_w 407 REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_x 408 REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_w 409 REAL, DIMENSION(klon), INTENT(OUT) :: kh 410 REAL, DIMENSION(klon), INTENT(OUT) :: kh_x 411 REAL, DIMENSION(klon), INTENT(OUT) :: kh_w 412 !!! 343 413 REAL, DIMENSION(klon), INTENT(OUT) :: slab_wfbils! heat balance at surface only for slab at ocean points 344 414 REAL, DIMENSION(klon), INTENT(OUT) :: qsol_d ! water height in the soil (mm) 345 415 REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point 346 416 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL) 417 !!! jyg le 08/02/2012 418 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region 419 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region 420 !!! 347 421 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level 422 !!! jyg le 08/02/2012 423 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_x ! condensation level in the off-wake region 424 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_w ! condensation level in the wake region 425 !!! 348 426 REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL 349 427 REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL … … 409 487 ! Other local variables 410 488 !**************************************************************************************** 489 INTEGER :: iflag_split 411 490 INTEGER :: i, k, nsrf 412 491 INTEGER :: knon, j 413 492 INTEGER :: idayref 414 493 INTEGER , DIMENSION(klon) :: ni 494 REAL :: yt1_new 415 495 REAL :: zx_alf1, zx_alf2 !valeur ambiante par extrapola 416 496 REAL :: amn, amx … … 419 499 REAL, DIMENSION(klon) :: yts, yrugos, ypct, yz0_new 420 500 REAL, DIMENSION(klon) :: yalb, yalb1, yalb2 421 REAL, DIMENSION(klon) :: yu1, yv1 ,ytoto501 REAL, DIMENSION(klon) :: yu1, yv1 422 502 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol 423 503 REAL, DIMENSION(klon) :: yrain_f, ysnow_f … … 474 554 LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples 475 555 LOGICAL, PARAMETER :: check=.FALSE. 476 REAL, DIMENSION(klon) :: Kech_h ! Coefficient d'echange pour l'energie 556 557 !!! nrlmd le 02/05/2011 558 !!! jyg le 07/02/2012 559 REAL, DIMENSION(klon) :: ywake_s, ywake_cstar, ywake_dens 560 !!! 561 REAL, DIMENSION(klon,klev+1) :: ytke_x, ytke_w 562 REAL, DIMENSION(klon,klev+1) :: ywake_dltke 563 REAL, DIMENSION(klon,klev) :: yu_x, yv_x, yu_w, yv_w 564 REAL, DIMENSION(klon,klev) :: yt_x, yq_x, yt_w, yq_w 565 REAL, DIMENSION(klon,klev) :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w 566 REAL, DIMENSION(klon,klev) :: ycoefq_x, ycoefq_w 567 REAL, DIMENSION(klon) :: ycdragh_x, ycdragm_x, ycdragh_w, ycdragm_w 568 REAL, DIMENSION(klon) :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x 569 REAL, DIMENSION(klon) :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w 570 REAL, DIMENSION(klon) :: AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x 571 REAL, DIMENSION(klon) :: AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w 572 REAL, DIMENSION(klon) :: y_flux_t1_x, y_flux_q1_x, y_flux_t1_w, y_flux_q1_w 573 REAL, DIMENSION(klon) :: y_flux_u1_x, y_flux_v1_x, y_flux_u1_w, y_flux_v1_w 574 REAL, DIMENSION(klon,klev) :: y_flux_t_x, y_flux_q_x, y_flux_t_w, y_flux_q_w 575 REAL, DIMENSION(klon,klev) :: y_flux_u_x, y_flux_v_x, y_flux_u_w, y_flux_v_w 576 REAL, DIMENSION(klon) :: yfluxlat_x, yfluxlat_w 577 REAL, DIMENSION(klon,klev) :: y_d_t_x, y_d_q_x, y_d_t_w, y_d_q_w 578 REAL, DIMENSION(klon,klev) :: y_d_t_diss_x, y_d_t_diss_w 579 REAL, DIMENSION(klon,klev) :: d_t_diss_x, d_t_diss_w 580 REAL, DIMENSION(klon,klev) :: y_d_u_x, y_d_v_x, y_d_u_w, y_d_v_w 581 REAL, DIMENSION(klon, klev, nbsrf) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w 582 REAL, DIMENSION(klon, klev, nbsrf) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w 583 REAL, DIMENSION(klon, nbsrf) :: fluxlat_x, fluxlat_w 584 REAL, DIMENSION(klon, klev) :: zxfluxt_x, zxfluxq_x, zxfluxt_w, zxfluxq_w 585 REAL, DIMENSION(klon, klev) :: zxfluxu_x, zxfluxv_x, zxfluxu_w, zxfluxv_w 586 REAL :: zx_qs_surf, zcor_surf, zdelta_surf 587 REAL, DIMENSION(klon) :: ytsurf_th, yqsatsurf 588 REAL, DIMENSION(klon) :: ybeta 589 REAL, DIMENSION(klon, klev) :: d_u_x 590 REAL, DIMENSION(klon, klev) :: d_u_w 591 REAL, DIMENSION(klon, klev) :: d_v_x 592 REAL, DIMENSION(klon, klev) :: d_v_w 593 594 REAL, DIMENSION(klon,klev) :: CcoefH, CcoefQ, DcoefH, DcoefQ 595 REAL, DIMENSION(klon,klev) :: CcoefU, CcoefV, DcoefU, DcoefV 596 REAL, DIMENSION(klon,klev) :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x 597 REAL, DIMENSION(klon,klev) :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w 598 REAL, DIMENSION(klon,klev) :: CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x 599 REAL, DIMENSION(klon,klev) :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w 600 REAL, DIMENSION(klon,klev) :: Kcoef_hq, Kcoef_m, gama_h, gama_q 601 REAL, DIMENSION(klon,klev) :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x 602 REAL, DIMENSION(klon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w 603 REAL, DIMENSION(klon) :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w 604 !!! 605 !!!jyg le 08/02/2012 606 REAL, DIMENSION(klon, nbsrf) :: t2m_x 607 REAL, DIMENSION(klon, nbsrf) :: q2m_x 608 REAL, DIMENSION(klon) :: rh2m_x 609 REAL, DIMENSION(klon) :: qsat2m_x 610 REAL, DIMENSION(klon, nbsrf) :: u10m_x 611 REAL, DIMENSION(klon, nbsrf) :: v10m_x 612 REAL, DIMENSION(klon, nbsrf) :: ustar_x 613 REAL, DIMENSION(klon, nbsrf) :: wstar_x 614 ! 615 REAL, DIMENSION(klon, nbsrf) :: pblh_x 616 REAL, DIMENSION(klon, nbsrf) :: plcl_x 617 REAL, DIMENSION(klon, nbsrf) :: capCL_x 618 REAL, DIMENSION(klon, nbsrf) :: oliqCL_x 619 REAL, DIMENSION(klon, nbsrf) :: cteiCL_x 620 REAL, DIMENSION(klon, nbsrf) :: pblt_x 621 REAL, DIMENSION(klon, nbsrf) :: therm_x 622 REAL, DIMENSION(klon, nbsrf) :: trmb1_x 623 REAL, DIMENSION(klon, nbsrf) :: trmb2_x 624 REAL, DIMENSION(klon, nbsrf) :: trmb3_x 625 ! 626 REAL, DIMENSION(klon, nbsrf) :: t2m_w 627 REAL, DIMENSION(klon, nbsrf) :: q2m_w 628 REAL, DIMENSION(klon) :: rh2m_w 629 REAL, DIMENSION(klon) :: qsat2m_w 630 REAL, DIMENSION(klon, nbsrf) :: u10m_w 631 REAL, DIMENSION(klon, nbsrf) :: v10m_w 632 REAL, DIMENSION(klon, nbsrf) :: ustar_w 633 REAL, DIMENSION(klon, nbsrf) :: wstar_w 634 ! 635 REAL, DIMENSION(klon, nbsrf) :: pblh_w 636 REAL, DIMENSION(klon, nbsrf) :: plcl_w 637 REAL, DIMENSION(klon, nbsrf) :: capCL_w 638 REAL, DIMENSION(klon, nbsrf) :: oliqCL_w 639 REAL, DIMENSION(klon, nbsrf) :: cteiCL_w 640 REAL, DIMENSION(klon, nbsrf) :: pblt_w 641 REAL, DIMENSION(klon, nbsrf) :: therm_w 642 REAL, DIMENSION(klon, nbsrf) :: trmb1_w 643 REAL, DIMENSION(klon, nbsrf) :: trmb2_w 644 REAL, DIMENSION(klon, nbsrf) :: trmb3_w 645 ! 646 REAL, DIMENSION(klon) :: yt2m_x 647 REAL, DIMENSION(klon) :: yq2m_x 648 REAL, DIMENSION(klon) :: yt10m_x 649 REAL, DIMENSION(klon) :: yq10m_x 650 REAL, DIMENSION(klon) :: yu10m_x 651 REAL, DIMENSION(klon) :: yv10m_x 652 REAL, DIMENSION(klon) :: yustar_x 653 REAL, DIMENSION(klon) :: ywstar_x 654 ! 655 REAL, DIMENSION(klon) :: ypblh_x 656 REAL, DIMENSION(klon) :: ylcl_x 657 REAL, DIMENSION(klon) :: ycapCL_x 658 REAL, DIMENSION(klon) :: yoliqCL_x 659 REAL, DIMENSION(klon) :: ycteiCL_x 660 REAL, DIMENSION(klon) :: ypblt_x 661 REAL, DIMENSION(klon) :: ytherm_x 662 REAL, DIMENSION(klon) :: ytrmb1_x 663 REAL, DIMENSION(klon) :: ytrmb2_x 664 REAL, DIMENSION(klon) :: ytrmb3_x 665 ! 666 REAL, DIMENSION(klon) :: yt2m_w 667 REAL, DIMENSION(klon) :: yq2m_w 668 REAL, DIMENSION(klon) :: yt10m_w 669 REAL, DIMENSION(klon) :: yq10m_w 670 REAL, DIMENSION(klon) :: yu10m_w 671 REAL, DIMENSION(klon) :: yv10m_w 672 REAL, DIMENSION(klon) :: yustar_w 673 REAL, DIMENSION(klon) :: ywstar_w 674 ! 675 REAL, DIMENSION(klon) :: ypblh_w 676 REAL, DIMENSION(klon) :: ylcl_w 677 REAL, DIMENSION(klon) :: ycapCL_w 678 REAL, DIMENSION(klon) :: yoliqCL_w 679 REAL, DIMENSION(klon) :: ycteiCL_w 680 REAL, DIMENSION(klon) :: ypblt_w 681 REAL, DIMENSION(klon) :: ytherm_w 682 REAL, DIMENSION(klon) :: ytrmb1_w 683 REAL, DIMENSION(klon) :: ytrmb2_w 684 REAL, DIMENSION(klon) :: ytrmb3_w 685 ! 686 REAL, DIMENSION(klon) :: uzon_x, vmer_x 687 REAL, DIMENSION(klon) :: zgeo1_x, tair1_x, qair1_x, tairsol_x 688 ! 689 REAL, DIMENSION(klon) :: uzon_w, vmer_w 690 REAL, DIMENSION(klon) :: zgeo1_w, tair1_w, qair1_w, tairsol_w 691 692 !!! jyg le 25/03/2013 693 !! Variables intermediaires pour le raccord des deux colonnes à la surface 694 REAL :: dd_Ch 695 REAL :: dd_Cm 696 REAL :: dd_Kh 697 REAL :: dd_Km 698 REAL :: dd_u 699 REAL :: dd_v 700 REAL :: dd_t 701 REAL :: dd_q 702 REAL :: dd_AH 703 REAL :: dd_AQ 704 REAL :: dd_AU 705 REAL :: dd_AV 706 REAL :: dd_BH 707 REAL :: dd_BQ 708 REAL :: dd_BU 709 REAL :: dd_BV 710 711 REAL :: dd_KHp 712 REAL :: dd_KQp 713 REAL :: dd_KUp 714 REAL :: dd_KVp 715 716 !!! 717 !!! nrlmd le 13/06/2011 718 REAL, DIMENSION(klon) :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1 719 REAL, DIMENSION(klon) :: y_delta_tsurf,delta_coef,tau_eq 720 REAL, PARAMETER :: facteur=2./sqrt(3.14) 721 REAL, PARAMETER :: effusivity=2000. 722 REAL, DIMENSION(klon) :: ytsurf_th_x,ytsurf_th_w,yqsatsurf_x,yqsatsurf_w 723 REAL, DIMENSION(klon) :: ydtsurf_th 724 REAL :: zdelta_surf_x,zdelta_surf_w,zx_qs_surf_x,zx_qs_surf_w 725 REAL :: zcor_surf_x,zcor_surf_w 726 REAL :: mod_wind_x, mod_wind_w 727 REAL :: rho1 728 REAL, DIMENSION(klon) :: Kech_h ! Coefficient d'echange pour l'energie 729 REAL, DIMENSION(klon) :: Kech_h_x, Kech_h_w 730 REAL, DIMENSION(klon) :: Kech_m 731 REAL, DIMENSION(klon) :: Kech_m_x, Kech_m_w 732 REAL, DIMENSION(klon) :: yts_x,yts_w 733 REAL, DIMENSION(klon) :: Kech_Hp, Kech_H_xp, Kech_H_wp 734 REAL, DIMENSION(klon) :: Kech_Qp, Kech_Q_xp, Kech_Q_wp 735 REAL, DIMENSION(klon) :: Kech_Up, Kech_U_xp, Kech_U_wp 736 REAL, DIMENSION(klon) :: Kech_Vp, Kech_V_xp, Kech_V_wp 737 477 738 REAL :: vent 739 740 741 742 743 !!! 478 744 479 745 ! For debugging with IOIPSL … … 514 780 515 781 !**************************************************************************************** 516 517 782 ! End of declarations 518 783 !**************************************************************************************** 519 784 785 IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap 786 ! 787 iflag_split = mod(iflag_pbl_split,2) 520 788 521 789 !**************************************************************************************** … … 594 862 ypphi = 0.0 ; ycldt = 0.0 ; yrmu0 = 0.0 595 863 ! Martin 596 864 865 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 866 ytke_x=0. ; ytke_w=0. ; ywake_dltke=0. 867 y_d_t_x=0. ; y_d_t_w=0. ; y_d_q_x=0. ; y_d_q_w=0. 868 d_t_w=0. ; d_q_w=0. 869 d_t_x=0. ; d_q_x=0. 870 d_t_diss_x = 0. ; d_t_diss_w = 0. 871 !! d_wake_dlt=0. ; d_wake_dlq=0. 872 d_u_x=0. ; d_u_w=0. ; d_v_x=0. ; d_v_w=0. 873 flux_t_x=0. ; flux_t_w=0. ; flux_q_x=0. ; flux_q_w=0. 874 yfluxlat_x=0. ; yfluxlat_w=0. 875 ywake_s=0. ; ywake_cstar=0. ;ywake_dens=0. 876 !!! 877 !!! nrlmd le 13/06/2011 878 tau_eq=0. ; delta_coef=0. 879 y_delta_flux_t1=0. 880 ydtsurf_th=0. 881 yts_x=0. ; yts_w=0. 882 y_delta_tsurf=0. 883 cdragh_x=0. ; cdragh_w=0. ; cdragm_x=0. ;cdragm_w=0. 884 kh=0. ; kh_x=0. ; kh_w=0. 885 !!! 597 886 tke(:,:,is_ave)=0. 598 887 IF (iflag_pbl<20.or.iflag_pbl>=30) THEN … … 607 896 ytsoil = 999999. 608 897 898 !!! jyg le 23/02/2013 899 pblh(:,:) = 999999. ! pblh,plcl,cteiCL are meaningfull only over sub-surfaces 900 plcl(:,:) = 999999. ! actually present in the grid cell. 901 cteiCL(:,:) = 999999. 902 pblh_x(:,:) = 999999. 903 plcl_x(:,:) = 999999. 904 cteiCL_x(:,:) = 999999. 905 pblh_w(:,:) = 999999. 906 plcl_w(:,:) = 999999. 907 cteiCL_w(:,:) = 999999. 908 ! 909 t2m(:,:) = 999999. ! t2m and q2m are meaningfull only over sub-surfaces 910 q2m(:,:) = 999999. ! actually present in the grid cell. 911 !!! 609 912 rh2m(:) = 0. 610 913 qsat2m(:) = 0. 914 !!! 915 !!! jyg le 10/02/2012 916 rh2m_x(:) = 0. 917 qsat2m_x(:) = 0. 918 rh2m_w(:) = 0. 919 qsat2m_w(:) = 0. 920 !!! 611 921 !**************************************************************************************** 612 922 ! 3) - Calculate pressure thickness of each layer … … 699 1009 ! 4) Loop over different surfaces 700 1010 ! 701 ! Only points containing a fraction of the sub surface will be t hreated.1011 ! Only points containing a fraction of the sub surface will be treated. 702 1012 ! 703 1013 !**************************************************************************************** 704 1014 705 1015 loop_nbsrf: DO nsrf = 1, nbsrf 1016 IF (prt_level >=10) print *,' Loop nsrf ',nsrf 706 1017 707 1018 ! Search for index(ni) and size(knon) of domaine to treat … … 714 1025 ENDIF 715 1026 ENDDO 1027 1028 !!! jyg le 19/08/2012 1029 IF (knon <= 0) THEN 1030 IF (prt_level >= 10) print *,' no grid point for nsrf= ',nsrf 1031 cycle loop_nbsrf 1032 ENDIF 1033 !!! 716 1034 717 1035 ! write index, with IOIPSL … … 758 1076 yrmu0(j) = rmu0(i) 759 1077 ! Martin 1078 !!! nrlmd le 13/06/2011 1079 y_delta_tsurf(j)=delta_tsurf(i,nsrf) 1080 !!! 760 1081 END DO 761 1082 … … 766 1087 ypplay(j,k) = pplay(i,k) 767 1088 ydelp(j,k) = delp(i,k) 1089 ENDDO 1090 ENDDO 1091 !!! jyg le 07/02/2012 et le 10/04/2013 1092 DO k = 1, klev 1093 DO j = 1, knon 1094 i = ni(j) 768 1095 ytke(j,k) = tke(i,k,nsrf) 769 1096 yu(j,k) = u(i,k) … … 772 1099 yq(j,k) = q(i,k) 773 1100 ENDDO 774 ENDDO 775 1101 ENDDO 1102 ! 1103 IF (iflag_split .eq.1) THEN 1104 !!! nrlmd le 02/05/2011 1105 DO k = 1, klev 1106 DO j = 1, knon 1107 i = ni(j) 1108 yu_x(j,k) = u(i,k) 1109 yv_x(j,k) = v(i,k) 1110 yt_x(j,k) = t(i,k)-wake_s(i)*wake_dlt(i,k) 1111 yq_x(j,k) = q(i,k)-wake_s(i)*wake_dlq(i,k) 1112 yu_w(j,k) = u(i,k) 1113 yv_w(j,k) = v(i,k) 1114 yt_w(j,k) = t(i,k)+(1.-wake_s(i))*wake_dlt(i,k) 1115 yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k) 1116 !!! 1117 ENDDO 1118 ENDDO 1119 !!! nrlmd le 02/05/2011 1120 DO k = 1, klev+1 1121 DO j = 1, knon 1122 i = ni(j) 1123 ytke_x(j,k) = tke(i,k,nsrf)-wake_s(i)*wake_dltke(i,k,nsrf) 1124 ytke_w(j,k) = tke(i,k,nsrf)+(1.-wake_s(i))*wake_dltke(i,k,nsrf) 1125 ywake_dltke(j,k) = wake_dltke(i,k,nsrf) 1126 ytke(j,k) = tke(i,k,nsrf) 1127 ENDDO 1128 ENDDO 1129 !!! 1130 !!! jyg le 07/02/2012 1131 DO j = 1, knon 1132 i = ni(j) 1133 ywake_s(j)=wake_s(i) 1134 ywake_cstar(j)=wake_cstar(i) 1135 ywake_dens(j)=wake_dens(i) 1136 ENDDO 1137 !!! 1138 !!! nrlmd le 13/06/2011 1139 DO j=1,knon 1140 yts_x(j)=yts(j)-ywake_s(j)*y_delta_tsurf(j) 1141 yts_w(j)=yts(j)+(1.-ywake_s(j))*y_delta_tsurf(j) 1142 ENDDO 1143 !!! 1144 ENDIF ! (iflag_split .eq.1) 1145 !!! 776 1146 DO k = 1, nsoilmx 777 1147 DO j = 1, knon … … 794 1164 !**************************************************************************************** 795 1165 796 CALL clcdrag( knon, nsrf, ypaprs, ypplay, & 1166 !!! jyg le 07/02/2012 1167 IF (iflag_split .eq.0) THEN 1168 !!! 1169 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1170 CALL clcdrag( knon, nsrf, ypaprs, ypplay, & 797 1171 yu(:,1), yv(:,1), yt(:,1), yq(:,1), & 798 1172 yts, yqsurf, yrugos, & … … 810 1184 ENDDO 811 1185 ENDIF 812 813 814 !**************************************************************************************** 815 ! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefm et ycoefm. 816 ! 817 !**************************************************************************************** 818 819 CALL coef_diff_turb(dtime, nsrf, knon, ni, & 1186 IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh 1187 ELSE !(iflag_split .eq.0) 1188 CALL clcdrag( knon, nsrf, ypaprs, ypplay, & 1189 yu_x(:,1), yv_x(:,1), yt_x(:,1), yq_x(:,1), & 1190 yts_x, yqsurf, yrugos, & 1191 ycdragm_x, ycdragh_x ) 1192 ! --- special Dice. JYG+MPL 25112013 1193 IF (ok_prescr_ust) then 1194 DO i = 1, knon 1195 print *,'ycdragm_x avant=',ycdragm_x(i) 1196 vent= sqrt(yu_x(i,1)*yu_x(i,1)+yv_x(i,1)*yv_x(i,1)) 1197 ycdragm_x(i) = ust*ust/(1.+vent)/vent 1198 print *,'ycdragm_x ust yu yv apres=',ycdragm_x(i),ust,yu_x(i,1),yv_x(i,1) 1199 ENDDO 1200 ENDIF 1201 IF (prt_level >=10) print *,'clcdrag -> ycdragh_x ', ycdragh_x 1202 ! 1203 CALL clcdrag( knon, nsrf, ypaprs, ypplay, & 1204 yu_w(:,1), yv_w(:,1), yt_w(:,1), yq_w(:,1), & 1205 yts_w, yqsurf, yrugos, & 1206 ycdragm_w, ycdragh_w ) 1207 ! --- special Dice. JYG+MPL 25112013 1208 IF (ok_prescr_ust) then 1209 DO i = 1, knon 1210 print *,'ycdragm_w avant=',ycdragm_w(i) 1211 vent= sqrt(yu_w(i,1)*yu_w(i,1)+yv_w(i,1)*yv_w(i,1)) 1212 ycdragm_w(i) = ust*ust/(1.+vent)/vent 1213 print *,'ycdragm_w ust yu yv apres=',ycdragm_w(i),ust,yu_w(i,1),yv_w(i,1) 1214 ENDDO 1215 ENDIF 1216 IF (prt_level >=10) print *,'clcdrag -> ycdragh_w ', ycdragh_w 1217 !!! 1218 ENDIF ! (iflag_split .eq.0) 1219 !!! 1220 1221 1222 !**************************************************************************************** 1223 ! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefh et ycoefm. 1224 ! 1225 !**************************************************************************************** 1226 1227 !!! jyg le 07/02/2012 1228 IF (iflag_split .eq.0) THEN 1229 !!! 1230 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1231 IF (prt_level >=10) THEN 1232 print *,' args coef_diff_turb: yu ', yu 1233 print *,' args coef_diff_turb: yv ', yv 1234 print *,' args coef_diff_turb: yq ', yq 1235 print *,' args coef_diff_turb: yt ', yt 1236 print *,' args coef_diff_turb: yts ', yts 1237 print *,' args coef_diff_turb: yrugos ', yrugos 1238 print *,' args coef_diff_turb: yqsurf ', yqsurf 1239 print *,' args coef_diff_turb: ycdragm ', ycdragm 1240 print *,' args coef_diff_turb: ycdragh ', ycdragh 1241 print *,' args coef_diff_turb: ytke ', ytke 1242 ENDIF 1243 CALL coef_diff_turb(dtime, nsrf, knon, ni, & 820 1244 ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, & 821 1245 ycoefm, ycoefh, ytke) 822 823 1246 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN 824 1247 ! In this case, coef_diff_turb is called for the Cd only … … 831 1254 ENDDO 832 1255 ENDIF 1256 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh 1257 ! 1258 ELSE !(iflag_split .eq.0) 1259 IF (prt_level >=10) THEN 1260 print *,' args coef_diff_turb: yu_x ', yu_x 1261 print *,' args coef_diff_turb: yv_x ', yv_x 1262 print *,' args coef_diff_turb: yq_x ', yq_x 1263 print *,' args coef_diff_turb: yt_x ', yt_x 1264 print *,' args coef_diff_turb: yts_x ', yts_x 1265 print *,' args coef_diff_turb: yrugos ', yrugos 1266 print *,' args coef_diff_turb: yqsurf ', yqsurf 1267 print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x 1268 print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x 1269 print *,' args coef_diff_turb: ytke_x ', ytke_x 1270 ENDIF 1271 CALL coef_diff_turb(dtime, nsrf, knon, ni, & 1272 ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yrugos, yqsurf, ycdragm_x, & 1273 ycoefm_x, ycoefh_x, ytke_x) 1274 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN 1275 ! In this case, coef_diff_turb is called for the Cd only 1276 DO k = 2, klev 1277 DO j = 1, knon 1278 i = ni(j) 1279 ycoefh_x(j,k) = zcoefh(i,k,nsrf) 1280 ycoefm_x(j,k) = zcoefm(i,k,nsrf) 1281 ENDDO 1282 ENDDO 1283 ENDIF 1284 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x 1285 ! 1286 IF (prt_level >=10) THEN 1287 print *,' args coef_diff_turb: yu_w ', yu_w 1288 print *,' args coef_diff_turb: yv_w ', yv_w 1289 print *,' args coef_diff_turb: yq_w ', yq_w 1290 print *,' args coef_diff_turb: yt_w ', yt_w 1291 print *,' args coef_diff_turb: yts_w ', yts_w 1292 print *,' args coef_diff_turb: yrugos ', yrugos 1293 print *,' args coef_diff_turb: yqsurf ', yqsurf 1294 print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w 1295 print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w 1296 print *,' args coef_diff_turb: ytke_w ', ytke_w 1297 ENDIF 1298 CALL coef_diff_turb(dtime, nsrf, knon, ni, & 1299 ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yrugos, yqsurf, ycdragm_w, & 1300 ycoefm_w, ycoefh_w, ytke_w) 1301 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN 1302 ! In this case, coef_diff_turb is called for the Cd only 1303 DO k = 2, klev 1304 DO j = 1, knon 1305 i = ni(j) 1306 ycoefh_w(j,k) = zcoefh(i,k,nsrf) 1307 ycoefm_w(j,k) = zcoefm(i,k,nsrf) 1308 ENDDO 1309 ENDDO 1310 ENDIF 1311 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w 1312 ! 1313 !!!jyg le 10/04/2013 1314 !! En attendant de traiter le transport des traceurs dans les poches froides, formule 1315 !! arbitraire pour ycoefh et ycoefm 1316 DO k = 2,klev 1317 DO j = 1,knon 1318 ycoefh(j,k) = ycoefh_x(j,k) + ywake_s(j)*(ycoefh_w(j,k) - ycoefh_x(j,k)) 1319 ycoefm(j,k) = ycoefm_x(j,k) + ywake_s(j)*(ycoefm_w(j,k) - ycoefm_x(j,k)) 1320 ENDDO 1321 ENDDO 1322 !!! 1323 ENDIF ! (iflag_split .eq.0) 1324 !!! 833 1325 834 1326 !**************************************************************************************** … … 843 1335 844 1336 ! - Calculate the coefficients Ccoef_H, Ccoef_Q, Dcoef_H and Dcoef_Q 845 CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, & 1337 !!! jyg le 07/02/2012 1338 IF (iflag_split .eq.0) THEN 1339 !!! 1340 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1341 CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, & 846 1342 ydelp, yt, yq, dtime, & 1343 !!! jyg le 09/05/2011 1344 CcoefH, CcoefQ, DcoefH, DcoefQ, & 1345 Kcoef_hq, gama_q, gama_h, & 1346 !!! 847 1347 AcoefH, AcoefQ, BcoefH, BcoefQ) 1348 ELSE !(iflag_split .eq.0) 1349 CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, & 1350 ydelp, yt_x, yq_x, dtime, & 1351 !!! nrlmd le 02/05/2011 1352 CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, & 1353 Kcoef_hq_x, gama_q_x, gama_h_x, & 1354 !!! 1355 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x) 1356 ! 1357 CALL climb_hq_down(knon, ycoefh_w, ypaprs, ypplay, & 1358 ydelp, yt_w, yq_w, dtime, & 1359 !!! nrlmd le 02/05/2011 1360 CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, & 1361 Kcoef_hq_w, gama_q_w, gama_h_w, & 1362 !!! 1363 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w) 1364 !!! 1365 ENDIF ! (iflag_split .eq.0) 1366 !!! 848 1367 849 1368 ! - Calculate the coefficients Ccoef_U, Ccoef_V, Dcoef_U and Dcoef_V 850 CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, & 1369 !!! jyg le 07/02/2012 1370 IF (iflag_split .eq.0) THEN 1371 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1372 CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, & 1373 !!! jyg le 09/05/2011 1374 CcoefU, CcoefV, DcoefU, DcoefV, & 1375 Kcoef_m, alf_1, alf_2, & 1376 !!! 851 1377 AcoefU, AcoefV, BcoefU, BcoefV) 852 1378 ELSE ! (iflag_split .eq.0) 1379 CALL climb_wind_down(knon, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, & 1380 !!! nrlmd le 02/05/2011 1381 CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, & 1382 Kcoef_m_x, alf_1_x, alf_2_x, & 1383 !!! 1384 AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x) 1385 ! 1386 CALL climb_wind_down(knon, dtime, ycoefm_w, ypplay, ypaprs, yt_w, ydelp, yu_w, yv_w, & 1387 !!! nrlmd le 02/05/2011 1388 CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, & 1389 Kcoef_m_w, alf_1_w, alf_2_w, & 1390 !!! 1391 AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w) 1392 !!! 1393 ENDIF ! (iflag_split .eq.0) 1394 !!! 853 1395 854 1396 !**************************************************************************************** … … 870 1412 END IF 871 1413 1414 !!! nrlmd le 13/06/2011 1415 !----- On finit le calcul des coefficients d'échange:on multiplie le cdrag par le module du vent et la densité dans la première couche 1416 ! Kech_h_x(j) = ycdragh_x(j) * & 1417 ! (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * & 1418 ! ypplay(j,1)/(RD*yt_x(j,1)) 1419 ! Kech_h_w(j) = ycdragh_w(j) * & 1420 ! (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * & 1421 ! ypplay(j,1)/(RD*yt_w(j,1)) 1422 ! Kech_h(j) = (1.-ywake_s(j))*Kech_h_x(j)+ywake_s(j)*Kech_h_w(j) 1423 ! 1424 ! Kech_m_x(j) = ycdragm_x(j) * & 1425 ! (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * & 1426 ! ypplay(j,1)/(RD*yt_x(j,1)) 1427 ! Kech_m_w(j) = ycdragm_w(j) * & 1428 ! (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * & 1429 ! ypplay(j,1)/(RD*yt_w(j,1)) 1430 ! Kech_m(j) = (1.-ywake_s(j))*Kech_m_x(j)+ywake_s(j)*Kech_m_w(j) 1431 !!! 1432 1433 !!! nrlmd le 02/05/2011 -----------------------On raccorde les 2 colonnes dans la couche 1 1434 !---------------------------------------------------------------------------------------- 1435 !!! jyg le 07/02/2012 1436 IF (iflag_split .eq.1) THEN 1437 !!! 1438 !!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences 1439 1440 DO j=1,knon 1441 ! 1442 ! Calcul des coefficients d echange 1443 mod_wind_x = 1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2) 1444 mod_wind_w = 1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2) 1445 rho1 = ypplay(j,1)/(RD*yt(j,1)) 1446 Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1 1447 Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1 1448 Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1 1449 Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1 1450 ! 1451 dd_Kh = Kech_h_w(j) - Kech_h_x(j) 1452 dd_Km = Kech_m_w(j) - Kech_m_x(j) 1453 IF (prt_level >=10) THEN 1454 print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w 1455 print *,' rho1 ',rho1 1456 print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j) 1457 print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j) 1458 print *,' dd_Kh: ',dd_KH 1459 ENDIF 1460 ! 1461 Kech_h(j) = Kech_h_x(j) + ywake_s(j)*dd_Kh 1462 Kech_m(j) = Kech_m_x(j) + ywake_s(j)*dd_Km 1463 ! 1464 ! Calcul des coefficients d echange corriges des retroactions 1465 Kech_H_xp(j) = Kech_h_x(j)/(1.-BcoefH_x(j)*Kech_h_x(j)*dtime) 1466 Kech_H_wp(j) = Kech_h_w(j)/(1.-BcoefH_w(j)*Kech_h_w(j)*dtime) 1467 Kech_Q_xp(j) = Kech_h_x(j)/(1.-BcoefQ_x(j)*Kech_h_x(j)*dtime) 1468 Kech_Q_wp(j) = Kech_h_w(j)/(1.-BcoefQ_w(j)*Kech_h_w(j)*dtime) 1469 Kech_U_xp(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime) 1470 Kech_U_wp(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime) 1471 Kech_V_xp(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime) 1472 Kech_V_wp(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime) 1473 ! 1474 dd_KHp = Kech_H_wp(j) - Kech_H_xp(j) 1475 dd_KQp = Kech_Q_wp(j) - Kech_Q_xp(j) 1476 dd_KUp = Kech_U_wp(j) - Kech_U_xp(j) 1477 dd_KVp = Kech_V_wp(j) - Kech_V_xp(j) 1478 ! 1479 Kech_Hp(j) = Kech_H_xp(j) + ywake_s(j)*dd_KHp 1480 Kech_Qp(j) = Kech_Q_xp(j) + ywake_s(j)*dd_KQp 1481 Kech_Up(j) = Kech_U_xp(j) + ywake_s(j)*dd_KUp 1482 Kech_Vp(j) = Kech_V_xp(j) + ywake_s(j)*dd_KVp 1483 ! 1484 ! Calcul des differences w-x 1485 dd_CM = ycdragm_w(j) - ycdragm_x(j) 1486 dd_CH = ycdragh_w(j) - ycdragh_x(j) 1487 dd_u = yu_w(j,1) - yu_x(j,1) 1488 dd_v = yv_w(j,1) - yv_x(j,1) 1489 dd_t = yt_w(j,1) - yt_x(j,1) 1490 dd_q = yq_w(j,1) - yq_x(j,1) 1491 dd_AH = AcoefH_w(j) - AcoefH_x(j) 1492 dd_AQ = AcoefQ_w(j) - AcoefQ_x(j) 1493 dd_AU = AcoefU_w(j) - AcoefU_x(j) 1494 dd_AV = AcoefV_w(j) - AcoefV_x(j) 1495 dd_BH = BcoefH_w(j) - BcoefH_x(j) 1496 dd_BQ = BcoefQ_w(j) - BcoefQ_x(j) 1497 dd_BU = BcoefU_w(j) - BcoefU_x(j) 1498 dd_BV = BcoefV_w(j) - BcoefV_x(j) 1499 ! 1500 IF (prt_level >=10) THEN 1501 print *,'Variables pour la fusion : Kech_H_xp(j)' ,Kech_H_xp(j) 1502 print *,'Variables pour la fusion : Kech_H_wp(j)' ,Kech_H_wp(j) 1503 print *,'Variables pour la fusion : Kech_Hp(j)' ,Kech_Hp(j) 1504 print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j) 1505 ENDIF 1506 ! 1507 ! Calcul des coef A, B équivalents dans la couche 1 1508 ! 1509 AcoefH(j) = AcoefH_x(j) + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*dd_AH 1510 AcoefQ(j) = AcoefQ_x(j) + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*dd_AQ 1511 AcoefU(j) = AcoefU_x(j) + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*dd_AU 1512 AcoefV(j) = AcoefV_x(j) + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*dd_AV 1513 ! 1514 BcoefH(j) = BcoefH_x(j) + ywake_s(j)*BcoefH_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_H_wp(j)/Kech_Hp(j)) & 1515 + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BH 1516 1517 BcoefQ(j) = BcoefQ_x(j) + ywake_s(j)*BcoefQ_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_Q_wp(j)/Kech_Qp(j)) & 1518 + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BQ 1519 1520 BcoefU(j) = BcoefU_x(j) + ywake_s(j)*BcoefU_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_U_wp(j)/Kech_Up(j)) & 1521 + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*(Kech_m_w(j)/Kech_m(j))*dd_BU 1522 1523 BcoefV(j) = BcoefV_x(j) + ywake_s(j)*BcoefV_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_V_wp(j)/Kech_Vp(j)) & 1524 + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*(Kech_m_w(j)/Kech_m(j))*dd_BV 1525 1526 ! 1527 ! Calcul des cdrag équivalents dans la couche 1528 ! 1529 ycdragm(j) = ycdragm_x(j) + ywake_s(j)*dd_CM 1530 ycdragh(j) = ycdragh_x(j) + ywake_s(j)*dd_CH 1531 ! 1532 ! Calcul de T, q, u et v équivalents dans la couche 1 1533 yt(j,1) = yt_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_t 1534 yq(j,1) = yq_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_q 1535 yu(j,1) = yu_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_u 1536 yv(j,1) = yv_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_v 1537 1538 1539 ENDDO 1540 !!! 1541 ENDIF ! (iflag_split .eq.1) 1542 !!! 1543 872 1544 !**************************************************************************************** 873 1545 ! … … 893 1565 !**************************************************************************************** 894 1566 ! 895 ! 10) Switch seloncurrent surface1567 ! 10) Switch according to current surface 896 1568 ! It is necessary to start with the continental surfaces because the ocean 897 1569 ! needs their run-off. … … 992 1664 ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, & 993 1665 y_flux_u1, y_flux_v1) 1666 IF (prt_level >=10) THEN 1667 print *,'arg de surf_ocean: ycdragh ',ycdragh 1668 print *,'arg de surf_ocean: ycdragm ',ycdragm 1669 print *,'arg de surf_ocean: yt ', yt 1670 print *,'arg de surf_ocean: yq ', yq 1671 print *,'arg de surf_ocean: yts ', yts 1672 print *,'arg de surf_ocean: AcoefH ',AcoefH 1673 print *,'arg de surf_ocean: AcoefQ ',AcoefQ 1674 print *,'arg de surf_ocean: BcoefH ',BcoefH 1675 print *,'arg de surf_ocean: BcoefQ ',BcoefQ 1676 print *,'arg de surf_ocean: yevap ',yevap 1677 print *,'arg de surf_ocean: yfluxsens ',yfluxsens 1678 print *,'arg de surf_ocean: yfluxlat ',yfluxlat 1679 print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new 1680 ENDIF 994 1681 995 1682 CASE(is_sic) … … 1036 1723 ! 1037 1724 !**************************************************************************************** 1038 ! H and Q 1039 IF (ok_flux_surf) THEN 1040 PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT 1725 1726 !!! 1727 !!! jyg le 10/04/2013 1728 !!! 1729 IF (ok_flux_surf) THEN 1730 IF (prt_level >=10) THEN 1731 PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT 1732 ENDIF 1041 1733 y_flux_t1(:) = fsens 1042 1734 y_flux_q1(:) = flat/RLVTT 1043 1735 yfluxlat(:) = flat 1044 1045 Kech_h(:) = ycdragh(:) * (1.0+SQRT(yu(:,1)**2+yv(:,1)**2)) * & 1046 ypplay(:,1)/(RD*yt(:,1)) 1047 ytoto(:)=(1./RCPD)*(AcoefH(:)+BcoefH(:)*y_flux_t1(:)*dtime) 1048 ytsurf_new(:)=ytoto(:)-y_flux_t1(:)/(Kech_h(:)*RCPD) 1736 ! 1737 IF (iflag_split .eq.0) THEN 1738 Kech_h(:) = ycdragh(:) * (1.0+SQRT(yu(:,1)**2+yv(:,1)**2)) * & 1739 ypplay(:,1)/(RD*yt(:,1)) 1740 ENDIF ! (iflag_split .eq.0) 1741 1742 DO j = 1, knon 1743 yt1_new=(1./RCPD)*(AcoefH(j)+BcoefH(j)*yfluxsens(j)*dtime) 1744 ytsurf_new(j)=yt1_new-yfluxsens(j)/(Kech_h(j)*RCPD) 1745 ENDDO 1746 1049 1747 y_d_ts(:) = ytsurf_new(:) - yts(:) 1050 1748 1051 ELSE1749 ELSE ! (ok_flux_surf) 1052 1750 y_flux_t1(:) = yfluxsens(:) 1053 1751 y_flux_q1(:) = -yevap(:) 1752 ENDIF 1753 1754 IF (prt_level >=10) THEN 1755 DO j=1,knon 1756 print*,'y_flux_t1,yfluxlat,wakes' & 1757 & , y_flux_t1(j), yfluxlat(j), ywake_s(j) 1758 print*,'beta,ytsurf_new', ybeta(j), ytsurf_new(j) 1759 print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j) 1760 ENDDO 1054 1761 ENDIF 1055 1762 1056 CALL climb_hq_up(knon, dtime, yt, yq, & 1763 !!! jyg le 07/02/2012 puis le 10/04/2013 1764 IF (iflag_split .eq.1) THEN 1765 !!! 1766 DO j=1,knon 1767 y_delta_flux_t1(j) = ( Kech_H_wp(j)*Kech_H_xp(j)*(AcoefH_w(j)-AcoefH_x(j)) + & 1768 y_flux_t1(j)*(Kech_H_wp(j)-Kech_H_xp(j)) ) / Kech_Hp(j) 1769 y_delta_flux_q1(j) = ( Kech_Q_wp(j)*Kech_Q_xp(j)*(AcoefQ_w(j)-AcoefQ_x(j)) + & 1770 y_flux_q1(j)*(Kech_Q_wp(j)-Kech_Q_xp(j)) ) / Kech_Qp(j) 1771 y_delta_flux_u1(j) = ( Kech_U_wp(j)*Kech_U_xp(j)*(AcoefU_w(j)-AcoefU_x(j)) + & 1772 y_flux_u1(j)*(Kech_U_wp(j)-Kech_U_xp(j)) ) / Kech_Up(j) 1773 y_delta_flux_v1(j) = ( Kech_V_wp(j)*Kech_V_xp(j)*(AcoefV_w(j)-AcoefV_x(j)) + & 1774 y_flux_v1(j)*(Kech_V_wp(j)-Kech_V_xp(j)) ) / Kech_Vp(j) 1775 ! 1776 y_flux_t1_x(j)=y_flux_t1(j) - ywake_s(j)*y_delta_flux_t1(j) 1777 y_flux_t1_w(j)=y_flux_t1(j) + (1.-ywake_s(j))*y_delta_flux_t1(j) 1778 y_flux_q1_x(j)=y_flux_q1(j) - ywake_s(j)*y_delta_flux_q1(j) 1779 y_flux_q1_w(j)=y_flux_q1(j) + (1.-ywake_s(j))*y_delta_flux_q1(j) 1780 y_flux_u1_x(j)=y_flux_u1(j) - ywake_s(j)*y_delta_flux_u1(j) 1781 y_flux_u1_w(j)=y_flux_u1(j) + (1.-ywake_s(j))*y_delta_flux_u1(j) 1782 y_flux_v1_x(j)=y_flux_v1(j) - ywake_s(j)*y_delta_flux_v1(j) 1783 y_flux_v1_w(j)=y_flux_v1(j) + (1.-ywake_s(j))*y_delta_flux_v1(j) 1784 ! 1785 yfluxlat_x(j)=y_flux_q1_x(j)*RLVTT 1786 yfluxlat_w(j)=y_flux_q1_w(j)*RLVTT 1787 1788 ENDDO 1789 ! 1790 1791 !!jyg!! A reprendre apres reflexion =============================================== 1792 !!jyg!! 1793 !!jyg!! DO j=1,knon 1794 !!jyg!!!!! nrlmd le 13/06/2011 1795 !!jyg!! 1796 !!jyg!!!----Diffusion dans le sol dans le cas continental seulement 1797 !!jyg!! IF (nsrf.eq.is_ter) THEN 1798 !!jyg!!!----Calcul du coefficient delta_coeff 1799 !!jyg!! tau_eq(j)=(ywake_s(j)/2.)*(1./max(wake_cstar(j),0.01))*sqrt(0.4/(3.14*max(wake_dens(j),8e-12))) 1800 !!jyg!! 1801 !!jyg!!! delta_coef(j)=dtime/(effusivity*sqrt(tau_eq(j))) 1802 !!jyg!! delta_coef(j)=facteur*sqrt(tau_eq(j))/effusivity 1803 !!jyg!!! delta_coef(j)=0. 1804 !!jyg!! ELSE 1805 !!jyg!! delta_coef(j)=0. 1806 !!jyg!! ENDIF 1807 !!jyg!! 1808 !!jyg!!!----Calcul de delta_tsurf 1809 !!jyg!! y_delta_tsurf(j)=delta_coef(j)*y_delta_flux_t1(j) 1810 !!jyg!! 1811 !!jyg!!!----Si il n'y a pas des poches... 1812 !!jyg!! IF (wake_cstar(j).le.0.01) THEN 1813 !!jyg!! y_delta_tsurf(j)=0. 1814 !!jyg!! y_delta_flux_t1(j)=0. 1815 !!jyg!! ENDIF 1816 !!jyg!! 1817 !!jyg!!!-----Calcul de ybeta (evap_réelle/evap_potentielle) 1818 !!jyg!!!!!!! jyg le 23/02/2012 1819 !!jyg!!!!!!! 1820 !!jyg!!!! ybeta(j)=y_flux_q1(j) / & 1821 !!jyg!!!! & (Kech_h(j)*(yq(j,1)-yqsatsurf(j))) 1822 !!jyg!!!!!! ybeta(j)=-1.*yevap(j) / & 1823 !!jyg!!!!!! & (ywake_s(j)*Kech_h_w(j)*(yq_w(j,1)-yqsatsurf_w(j))+(1.-ywake_s(j))*Kech_h_x(j)*(yq_x(j,1)-yqsatsurf_x(j))) 1824 !!jyg!!!!!!! fin jyg 1825 !!jyg!!!!! 1826 !!jyg!! 1827 !!jyg!! ENDDO 1828 !!jyg!! 1829 !!jyg!!!!! fin nrlmd le 13/06/2011 1830 !!jyg!! 1831 IF (prt_level >=10) THEN 1832 DO j = 1, knon 1833 print*,'Chx,Chw,Ch', ycdragh_x(j), ycdragh_w(j), ycdragh(j) 1834 print*,'Khx,Khw,Kh', Kech_h_x(j), Kech_h_w(j), Kech_h(j) 1835 ! print*,'tsurf_x,tsurf_w,tsurf,t1', ytsurf_th_x(j), ytsurf_th_w(j), ytsurf_th(j), yt(j,1) 1836 print*,'tsurf_x,t1x,tsurf_w,t1w,tsurf,t1,t1_ancien', & 1837 & ytsurf_th_x(j), yt_x(j,1), ytsurf_th_w(j), yt_w(j,1), ytsurf_th(j), yt(j,1),t(j,1) 1838 print*,'qsatsurf,qsatsurf_x,qsatsurf_w', yqsatsurf(j), yqsatsurf_x(j), yqsatsurf_w(j) 1839 print*,'delta_coef,delta_flux,delta_tsurf,tau', delta_coef(j), y_delta_flux_t1(j), y_delta_tsurf(j), tau_eq(j) 1840 ENDDO 1841 1842 DO j=1,knon 1843 print*,'fluxT_x, fluxT_w, y_flux_t1, fluxQ_x, fluxQ_w, yfluxlat, wakes' & 1844 & , y_flux_t1_x(j), y_flux_t1_w(j), y_flux_t1(j), y_flux_q1_x(j)*RLVTT, y_flux_q1_w(j)*RLVTT, yfluxlat(j), ywake_s(j) 1845 print*,'beta,ytsurf_new,yqsatsurf', ybeta(j), ytsurf_new(j), yqsatsurf(j) 1846 print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j) 1847 ENDDO 1848 ENDIF 1849 1850 !!! jyg le 07/02/2012 1851 ENDIF ! (iflag_split .eq.1) 1852 !!! 1853 1854 !!! jyg le 07/02/2012 1855 IF (iflag_split .eq.0) THEN 1856 !!! 1857 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1858 CALL climb_hq_up(knon, dtime, yt, yq, & 1057 1859 y_flux_q1, y_flux_t1, ypaprs, ypplay, & 1860 !!! jyg le 07/02/2012 1861 AcoefH, AcoefQ, BcoefH, BcoefQ, & 1862 CcoefH, CcoefQ, DcoefH, DcoefQ, & 1863 Kcoef_hq, gama_q, gama_h, & 1864 !!! 1058 1865 y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:)) 1059 1060 1061 CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, & 1866 ELSE !(iflag_split .eq.0) 1867 CALL climb_hq_up(knon, dtime, yt_x, yq_x, & 1868 y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, & 1869 !!! nrlmd le 02/05/2011 1870 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x, & 1871 CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, & 1872 Kcoef_hq_x, gama_q_x, gama_h_x, & 1873 !!! 1874 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:)) 1875 ! 1876 CALL climb_hq_up(knon, dtime, yt_w, yq_w, & 1877 y_flux_q1_w, y_flux_t1_w, ypaprs, ypplay, & 1878 !!! nrlmd le 02/05/2011 1879 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w, & 1880 CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, & 1881 Kcoef_hq_w, gama_q_w, gama_h_w, & 1882 !!! 1883 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:)) 1884 !!! 1885 ENDIF ! (iflag_split .eq.0) 1886 !!! 1887 1888 !!! jyg le 07/02/2012 1889 IF (iflag_split .eq.0) THEN 1890 !!! 1891 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1892 CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, & 1893 !!! jyg le 07/02/2012 1894 AcoefU, AcoefV, BcoefU, BcoefV, & 1895 CcoefU, CcoefV, DcoefU, DcoefV, & 1896 Kcoef_m, & 1897 !!! 1062 1898 y_flux_u, y_flux_v, y_d_u, y_d_v) 1063 1064 1065 1899 y_d_t_diss(:,:)=0. 1066 1900 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN … … 1071 1905 ! print*,'yamada_c OK' 1072 1906 1073 DO j = 1, knon 1907 ELSE !(iflag_split .eq.0) 1908 CALL climb_wind_up(knon, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, & 1909 !!! nrlmd le 02/05/2011 1910 AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x, & 1911 CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, & 1912 Kcoef_m_x, & 1913 !!! 1914 y_flux_u_x, y_flux_v_x, y_d_u_x, y_d_v_x) 1915 ! 1916 y_d_t_diss_x(:,:)=0. 1917 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN 1918 CALL yamada_c(knon,dtime,ypaprs,ypplay & 1919 & ,yu_x,yv_x,yt_x,y_d_u_x,y_d_v_x,y_d_t_x,ycdragm_x,ytke_x,ycoefm_x,ycoefh_x & 1920 ,ycoefq_x,y_d_t_diss_x,yustar_x & 1921 & ,iflag_pbl,nsrf) 1922 ENDIF 1923 ! print*,'yamada_c OK' 1924 1925 CALL climb_wind_up(knon, dtime, yu_w, yv_w, y_flux_u1_w, y_flux_v1_w, & 1926 !!! nrlmd le 02/05/2011 1927 AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w, & 1928 CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, & 1929 Kcoef_m_w, & 1930 !!! 1931 y_flux_u_w, y_flux_v_w, y_d_u_w, y_d_v_w) 1932 !!! 1933 y_d_t_diss_w(:,:)=0. 1934 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN 1935 CALL yamada_c(knon,dtime,ypaprs,ypplay & 1936 & ,yu_w,yv_w,yt_w,y_d_u_w,y_d_v_w,y_d_t_w,ycdragm_w,ytke_w,ycoefm_w,ycoefh_w & 1937 ,ycoefq_w,y_d_t_diss_w,yustar_w & 1938 & ,iflag_pbl,nsrf) 1939 ENDIF 1940 ! print*,'yamada_c OK' 1941 ! 1942 IF (prt_level >=10) THEN 1943 print *, 'After climbing up, lfuxlat_x, fluxlat_w ', & 1944 yfluxlat_x, yfluxlat_w 1945 ENDIF 1946 ! 1947 ENDIF ! (iflag_split .eq.0) 1948 !!! 1949 1950 DO j = 1, knon 1074 1951 y_dflux_t(j) = y_dflux_t(j) * ypct(j) 1075 1952 y_dflux_q(j) = y_dflux_q(j) * ypct(j) 1076 ENDDO1953 ENDDO 1077 1954 1078 1955 !**************************************************************************************** … … 1084 1961 !**************************************************************************************** 1085 1962 1086 DO k = 1, klev 1087 DO j = 1, knon 1963 1964 !!! jyg le 07/02/2012 1965 IF (iflag_split .eq.0) THEN 1966 !!! 1967 DO k = 1, klev 1968 DO j = 1, knon 1088 1969 i = ni(j) 1089 1970 y_d_t_diss(j,k) = y_d_t_diss(j,k) * ypct(j) … … 1099 1980 1100 1981 1982 ENDDO 1983 ENDDO 1984 1985 1986 ELSE !(iflag_split .eq.0) 1987 1988 ! Tendances hors poches 1989 DO k = 1, klev 1990 DO j = 1, knon 1991 i = ni(j) 1992 y_d_t_diss_x(j,k) = y_d_t_diss_x(j,k) * ypct(j) 1993 y_d_t_x(j,k) = y_d_t_x(j,k) * ypct(j) 1994 y_d_q_x(j,k) = y_d_q_x(j,k) * ypct(j) 1995 y_d_u_x(j,k) = y_d_u_x(j,k) * ypct(j) 1996 y_d_v_x(j,k) = y_d_v_x(j,k) * ypct(j) 1997 1998 flux_t_x(i,k,nsrf) = y_flux_t_x(j,k) 1999 flux_q_x(i,k,nsrf) = y_flux_q_x(j,k) 2000 flux_u_x(i,k,nsrf) = y_flux_u_x(j,k) 2001 flux_v_x(i,k,nsrf) = y_flux_v_x(j,k) 1101 2002 ENDDO 1102 ENDDO 2003 ENDDO 2004 2005 ! Tendances dans les poches 2006 DO k = 1, klev 2007 DO j = 1, knon 2008 i = ni(j) 2009 y_d_t_diss_w(j,k) = y_d_t_diss_w(j,k) * ypct(j) 2010 y_d_t_w(j,k) = y_d_t_w(j,k) * ypct(j) 2011 y_d_q_w(j,k) = y_d_q_w(j,k) * ypct(j) 2012 y_d_u_w(j,k) = y_d_u_w(j,k) * ypct(j) 2013 y_d_v_w(j,k) = y_d_v_w(j,k) * ypct(j) 2014 2015 flux_t_w(i,k,nsrf) = y_flux_t_w(j,k) 2016 flux_q_w(i,k,nsrf) = y_flux_q_w(j,k) 2017 flux_u_w(i,k,nsrf) = y_flux_u_w(j,k) 2018 flux_v_w(i,k,nsrf) = y_flux_v_w(j,k) 2019 ENDDO 2020 ENDDO 2021 2022 ! Flux, tendances et Tke moyenne dans la maille 2023 DO k = 1, klev 2024 DO j = 1, knon 2025 i = ni(j) 2026 flux_t(i,k,nsrf) = flux_t_x(i,k,nsrf)+ywake_s(j)*(flux_t_w(i,k,nsrf)-flux_t_x(i,k,nsrf)) 2027 flux_q(i,k,nsrf) = flux_q_x(i,k,nsrf)+ywake_s(j)*(flux_q_w(i,k,nsrf)-flux_q_x(i,k,nsrf)) 2028 flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf)) 2029 flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf)) 2030 ENDDO 2031 ENDDO 2032 DO j=1,knon 2033 yfluxlat(j)=yfluxlat_x(j)+ywake_s(j)*(yfluxlat_w(j)-yfluxlat_x(j)) 2034 ENDDO 2035 IF (prt_level >=10) THEN 2036 print *,' nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) ', & 2037 nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) 2038 ENDIF 2039 2040 DO k = 1, klev 2041 DO j = 1, knon 2042 y_d_t_diss(j,k) = y_d_t_diss_x(j,k)+ywake_s(j)*(y_d_t_diss_w(j,k) -y_d_t_diss_x(j,k)) 2043 y_d_t(j,k) = y_d_t_x(j,k)+ywake_s(j)*(y_d_t_w(j,k) -y_d_t_x(j,k)) 2044 y_d_q(j,k) = y_d_q_x(j,k)+ywake_s(j)*(y_d_q_w(j,k) -y_d_q_x(j,k)) 2045 y_d_u(j,k) = y_d_u_x(j,k)+ywake_s(j)*(y_d_u_w(j,k) -y_d_u_x(j,k)) 2046 y_d_v(j,k) = y_d_v_x(j,k)+ywake_s(j)*(y_d_v_w(j,k) -y_d_v_x(j,k)) 2047 ENDDO 2048 ENDDO 2049 2050 ENDIF ! (iflag_split .eq.0) 2051 !!! 1103 2052 1104 2053 ! print*,'Dans pbl OK1' … … 1130 2079 ! print*,'Dans pbl OK2' 1131 2080 2081 !!! jyg le 07/02/2012 2082 IF (iflag_split .eq.1) THEN 2083 !!! 2084 !!! nrlmd le 02/05/2011 2085 fluxlat_x(:,nsrf) = 0. 2086 fluxlat_w(:,nsrf) = 0. 2087 DO j = 1, knon 2088 i = ni(j) 2089 fluxlat_x(i,nsrf) = yfluxlat_x(j) 2090 fluxlat_w(i,nsrf) = yfluxlat_w(j) 2091 !!! 2092 !!! nrlmd le 13/06/2011 2093 delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j) 2094 cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j) 2095 cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j) 2096 cdragm_x(i) = cdragm_x(i) + ycdragm_x(j)*ypct(j) 2097 cdragm_w(i) = cdragm_w(i) + ycdragm_w(j)*ypct(j) 2098 kh(i) = kh(i) + Kech_h(j)*ypct(j) 2099 kh_x(i) = kh_x(i) + Kech_h_x(j)*ypct(j) 2100 kh_w(i) = kh_w(i) + Kech_h_w(j)*ypct(j) 2101 !!! 2102 END DO 2103 !!! 2104 ENDIF ! (iflag_split .eq.1) 2105 !!! 2106 !!! nrlmd le 02/05/2011 2107 !!jyg le 20/02/2011 2108 !! tke_x(:,:,nsrf)=0. 2109 !! tke_w(:,:,nsrf)=0. 2110 !!jyg le 20/02/2011 2111 !! DO k = 1, klev+1 2112 !! DO j = 1, knon 2113 !! i = ni(j) 2114 !! wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k) 2115 !! tke(i,k,nsrf) = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf) 2116 !! ENDDO 2117 !! ENDDO 2118 !!jyg le 20/02/2011 2119 !! DO k = 1, klev+1 2120 !! DO j = 1, knon 2121 !! i = ni(j) 2122 !! tke(i,k,nsrf)=(1.-ywake_s(j))*tke_x(i,k,nsrf)+ywake_s(j)*tke_w(i,k,nsrf) 2123 !! ENDDO 2124 !! ENDDO 2125 !!! 2126 IF (iflag_split .eq.0) THEN 2127 DO k = 2, klev 2128 DO j = 1, knon 2129 i = ni(j) 2130 tke(i,k,nsrf) = ytke(j,k) 2131 tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j) 2132 END DO 2133 END DO 2134 2135 ELSE 2136 DO k = 2, klev 2137 DO j = 1, knon 2138 i = ni(j) 2139 wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k) 2140 tke(i,k,nsrf) = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf) 2141 tke(i,k,is_ave) = tke(i,k,is_ave) + tke(i,k,nsrf)*ypct(j) 2142 ENDDO 2143 ENDDO 2144 ENDIF ! (iflag_split .eq.0) 2145 !!! 1132 2146 DO k = 2, klev 1133 2147 DO j = 1, knon 1134 2148 i = ni(j) 1135 tke(i,k,nsrf) = ytke(j,k)1136 2149 zcoefh(i,k,nsrf) = ycoefh(j,k) 1137 2150 zcoefm(i,k,nsrf) = ycoefm(j,k) 1138 tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j)1139 2151 zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j) 1140 2152 zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j) … … 1159 2171 END DO 1160 2172 2173 !!! jyg le 07/02/2012 2174 IF (iflag_split .eq.1) THEN 2175 !!! 2176 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 2177 DO k = 1, klev 2178 DO j = 1, knon 2179 i = ni(j) 2180 d_t_diss_x(i,k) = d_t_diss_x(i,k) + y_d_t_diss_x(j,k) 2181 d_t_x(i,k) = d_t_x(i,k) + y_d_t_x(j,k) 2182 d_q_x(i,k) = d_q_x(i,k) + y_d_q_x(j,k) 2183 d_u_x(i,k) = d_u_x(i,k) + y_d_u_x(j,k) 2184 d_v_x(i,k) = d_v_x(i,k) + y_d_v_x(j,k) 2185 ! 2186 d_t_diss_w(i,k) = d_t_diss_w(i,k) + y_d_t_diss_w(j,k) 2187 d_t_w(i,k) = d_t_w(i,k) + y_d_t_w(j,k) 2188 d_q_w(i,k) = d_q_w(i,k) + y_d_q_w(j,k) 2189 d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k) 2190 d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k) 2191 ! 2192 !! d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k) 2193 !! d_wake_dlq(i,k) = d_wake_dlq(i,k) + y_d_q_w(i,k)-y_d_q_x(i,k) 2194 END DO 2195 END DO 2196 !!! 2197 ENDIF ! (iflag_split .eq.1) 2198 !!! 1161 2199 1162 2200 DO k = 1, klev … … 1173 2211 ! print*,'Dans pbl OK4' 1174 2212 1175 !**************************************************************************************** 1176 ! 14) Calculate the temperature et relative humidity at 2m and the wind at 10m 2213 IF (prt_level >=10) THEN 2214 print *, 'pbl_surface tendencies for w: d_t_w, d_t_x, d_t ', & 2215 d_t_w(:,1), d_t_x(:,1), d_t(:,1) 2216 ENDIF 2217 2218 !**************************************************************************************** 2219 ! 14) Calculate the temperature and relative humidity at 2m and the wind at 10m 1177 2220 ! Call HBTM 1178 2221 ! … … 1184 2227 u10m(:,nsrf) = 0. 1185 2228 v10m(:,nsrf) = 0. 2229 1186 2230 pblh(:,nsrf) = 0. ! Hauteur de couche limite 1187 2231 plcl(:,nsrf) = 0. ! Niveau de condensation de la CLA … … 1194 2238 trmb2(:,nsrf) = 0. ! inhibition 1195 2239 trmb3(:,nsrf) = 0. ! Point Omega 1196 2240 ! 2241 !!! jyg le 07/02/2012 2242 IF (iflag_split .eq.1) THEN 2243 t2m_x(:,nsrf) = 0. 2244 q2m_x(:,nsrf) = 0. 2245 ustar_x(:,nsrf) = 0. 2246 wstar_x(:,nsrf) = 0. 2247 u10m_x(:,nsrf) = 0. 2248 v10m_x(:,nsrf) = 0. 2249 2250 pblh_x(:,nsrf) = 0. ! Hauteur de couche limite 2251 plcl_x(:,nsrf) = 0. ! Niveau de condensation de la CLA 2252 capCL_x(:,nsrf) = 0. ! CAPE de couche limite 2253 oliqCL_x(:,nsrf) = 0. ! eau_liqu integree de couche limite 2254 cteiCL_x(:,nsrf) = 0. ! cloud top instab. crit. couche limite 2255 pblt_x(:,nsrf) = 0. ! T a la Hauteur de couche limite 2256 therm_x(:,nsrf) = 0. 2257 trmb1_x(:,nsrf) = 0. ! deep_cape 2258 trmb2_x(:,nsrf) = 0. ! inhibition 2259 trmb3_x(:,nsrf) = 0. ! Point Omega 2260 ! 2261 t2m_w(:,nsrf) = 0. 2262 q2m_w(:,nsrf) = 0. 2263 ustar_w(:,nsrf) = 0. 2264 wstar_w(:,nsrf) = 0. 2265 u10m_w(:,nsrf) = 0. 2266 v10m_w(:,nsrf) = 0. 2267 2268 pblh_w(:,nsrf) = 0. ! Hauteur de couche limite 2269 plcl_w(:,nsrf) = 0. ! Niveau de condensation de la CLA 2270 capCL_w(:,nsrf) = 0. ! CAPE de couche limite 2271 oliqCL_w(:,nsrf) = 0. ! eau_liqu integree de couche limite 2272 cteiCL_w(:,nsrf) = 0. ! cloud top instab. crit. couche limite 2273 pblt_w(:,nsrf) = 0. ! T a la Hauteur de couche limite 2274 therm_w(:,nsrf) = 0. 2275 trmb1_w(:,nsrf) = 0. ! deep_cape 2276 trmb2_w(:,nsrf) = 0. ! inhibition 2277 trmb3_w(:,nsrf) = 0. ! Point Omega 2278 !!! 2279 ENDIF ! (iflag_split .eq.1) 2280 !!! 2281 ! 1197 2282 #undef T2m 1198 2283 #define T2m … … 1203 2288 ! print*,'tair1,yt(:,1),y_d_t(:,1)' 1204 2289 ! print*, tair1,yt(:,1),y_d_t(:,1) 1205 DO j=1, knon 1206 i = ni(j) 2290 !!! jyg le 07/02/2012 2291 IF (iflag_split .eq.0) THEN 2292 DO j=1, knon 1207 2293 uzon(j) = yu(j,1) + y_d_u(j,1) 1208 2294 vmer(j) = yv(j,1) + y_d_v(j,1) … … 1212 2298 * (ypaprs(j,1)-ypplay(j,1)) 1213 2299 tairsol(j) = yts(j) + y_d_ts(j) 2300 qairsol(j) = yqsurf(j) 2301 END DO 2302 ELSE ! (iflag_split .eq.0) 2303 DO j=1, knon 2304 uzon_x(j) = yu_x(j,1) + y_d_u_x(j,1) 2305 vmer_x(j) = yv_x(j,1) + y_d_v_x(j,1) 2306 tair1_x(j) = yt_x(j,1) + y_d_t_x(j,1) + y_d_t_diss_x(j,1) 2307 qair1_x(j) = yq_x(j,1) + y_d_q_x(j,1) 2308 zgeo1_x(j) = RD * tair1_x(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) & 2309 * (ypaprs(j,1)-ypplay(j,1)) 2310 tairsol(j) = yts(j) + y_d_ts(j) 2311 tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j) 2312 qairsol(j) = yqsurf(j) 2313 END DO 2314 DO j=1, knon 2315 uzon_w(j) = yu_w(j,1) + y_d_u_w(j,1) 2316 vmer_w(j) = yv_w(j,1) + y_d_v_w(j,1) 2317 tair1_w(j) = yt_w(j,1) + y_d_t_w(j,1) + y_d_t_diss_w(j,1) 2318 qair1_w(j) = yq_w(j,1) + y_d_q_w(j,1) 2319 zgeo1_w(j) = RD * tair1_w(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) & 2320 * (ypaprs(j,1)-ypplay(j,1)) 2321 tairsol_w(j) = tairsol(j) + (1.- ywake_s(j))*y_delta_tsurf(j) 2322 qairsol(j) = yqsurf(j) 2323 END DO 2324 !!! 2325 ENDIF ! (iflag_split .eq.0) 2326 !!! 2327 DO j=1, knon 2328 i = ni(j) 1214 2329 rugo1(j) = yrugos(j) 1215 2330 IF(nsrf.EQ.is_oce) THEN … … 1218 2333 psfce(j)=ypaprs(j,1) 1219 2334 patm(j)=ypplay(j,1) 1220 qairsol(j) = yqsurf(j)1221 2335 END DO 1222 2336 … … 1226 2340 1227 2341 ! Calculate the temperature et relative humidity at 2m and the wind at 10m 1228 CALL stdlevvar(klon, knon, nsrf, zxli, & 2342 !!! jyg le 07/02/2012 2343 IF (iflag_split .eq.0) THEN 2344 CALL stdlevvar(klon, knon, nsrf, zxli, & 1229 2345 uzon, vmer, tair1, qair1, zgeo1, & 1230 2346 tairsol, qairsol, rugo1, psfce, patm, & 1231 2347 yt2m, yq2m, yt10m, yq10m, yu10m, yustar) 1232 ! print*,'Dans pbl OK42B' 1233 1234 DO j=1, knon 2348 ELSE !(iflag_split .eq.0) 2349 CALL stdlevvar(klon, knon, nsrf, zxli, & 2350 uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, & 2351 tairsol_x, qairsol, rugo1, psfce, patm, & 2352 yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x) 2353 CALL stdlevvar(klon, knon, nsrf, zxli, & 2354 uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, & 2355 tairsol_w, qairsol, rugo1, psfce, patm, & 2356 yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w) 2357 !!! 2358 ENDIF ! (iflag_split .eq.0) 2359 !!! 2360 !!! jyg le 07/02/2012 2361 IF (iflag_split .eq.0) THEN 2362 DO j=1, knon 1235 2363 i = ni(j) 1236 2364 t2m(i,nsrf)=yt2m(j) 1237 2365 q2m(i,nsrf)=yq2m(j) 1238 1239 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 2366 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 1240 2367 ustar(i,nsrf)=yustar(j) 1241 2368 u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2) 1242 2369 v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2) 1243 1244 END DO 2370 END DO 2371 ELSE !(iflag_split .eq.0) 2372 DO j=1, knon 2373 i = ni(j) 2374 t2m_x(i,nsrf)=yt2m_x(j) 2375 q2m_x(i,nsrf)=yq2m_x(j) 2376 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 2377 ustar_x(i,nsrf)=yustar_x(j) 2378 u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2) 2379 v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2) 2380 END DO 2381 DO j=1, knon 2382 i = ni(j) 2383 t2m_w(i,nsrf)=yt2m_w(j) 2384 q2m_w(i,nsrf)=yq2m_w(j) 2385 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 2386 ustar_w(i,nsrf)=yustar_w(j) 2387 u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2) 2388 v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2) 2389 ! 2390 ustar(i,nsrf) = ustar_x(i,nsrf) + wake_s(i)*(ustar_w(i,nsrf)-ustar_x(i,nsrf)) 2391 u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf)) 2392 v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf)) 2393 END DO 2394 !!! 2395 ENDIF ! (iflag_split .eq.0) 2396 !!! 1245 2397 1246 2398 ! print*,'Dans pbl OK43' … … 1248 2400 !IM Ajoute dependance type surface 1249 2401 IF (thermcep) THEN 2402 !!! jyg le 07/02/2012 2403 IF (iflag_split .eq.0) THEN 1250 2404 DO j = 1, knon 1251 2405 i=ni(j) … … 1259 2413 qsat2m(i) = qsat2m(i) + zx_qs1 * pctsrf(i,nsrf) 1260 2414 END DO 2415 ELSE ! (iflag_split .eq.0) 2416 DO j = 1, knon 2417 i=ni(j) 2418 zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_x(j) )) 2419 zx_qs1 = r2es * FOEEW(yt2m_x(j),zdelta1)/paprs(i,1) 2420 zx_qs1 = MIN(0.5,zx_qs1) 2421 zcor1 = 1./(1.-RETV*zx_qs1) 2422 zx_qs1 = zx_qs1*zcor1 2423 2424 rh2m_x(i) = rh2m_x(i) + yq2m_x(j)/zx_qs1 * pctsrf(i,nsrf) 2425 qsat2m_x(i) = qsat2m_x(i) + zx_qs1 * pctsrf(i,nsrf) 2426 END DO 2427 DO j = 1, knon 2428 i=ni(j) 2429 zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_w(j) )) 2430 zx_qs1 = r2es * FOEEW(yt2m_w(j),zdelta1)/paprs(i,1) 2431 zx_qs1 = MIN(0.5,zx_qs1) 2432 zcor1 = 1./(1.-RETV*zx_qs1) 2433 zx_qs1 = zx_qs1*zcor1 2434 2435 rh2m_w(i) = rh2m_w(i) + yq2m_w(j)/zx_qs1 * pctsrf(i,nsrf) 2436 qsat2m_w(i) = qsat2m_w(i) + zx_qs1 * pctsrf(i,nsrf) 2437 END DO 2438 !!! 2439 ENDIF ! (iflag_split .eq.0) 2440 !!! 1261 2441 END IF 2442 ! 2443 IF (prt_level >=10) THEN 2444 print *, 'T2m, q2m, RH2m ', & 2445 t2m, q2m, rh2m 2446 ENDIF 1262 2447 1263 2448 ! print*,'OK pbl 5' 1264 CALL hbtm(knon, ypaprs, ypplay, & 2449 ! 2450 !!! jyg le 07/02/2012 2451 IF (iflag_split .eq.0) THEN 2452 CALL hbtm(knon, ypaprs, ypplay, & 1265 2453 yt2m,yt10m,yq2m,yq10m,yustar,ywstar, & 1266 2454 y_flux_t,y_flux_q,yu,yv,yt,yq, & 1267 2455 ypblh,ycapCL,yoliqCL,ycteiCL,ypblT, & 1268 2456 ytherm,ytrmb1,ytrmb2,ytrmb3,ylcl) 2457 IF (prt_level >=10) THEN 2458 print *,' Arg. de HBTM: yt2m ',yt2m 2459 print *,' Arg. de HBTM: yt10m ',yt10m 2460 print *,' Arg. de HBTM: yq2m ',yq2m 2461 print *,' Arg. de HBTM: yq10m ',yq10m 2462 print *,' Arg. de HBTM: yustar ',yustar 2463 print *,' Arg. de HBTM: y_flux_t ',y_flux_t 2464 print *,' Arg. de HBTM: y_flux_q ',y_flux_q 2465 print *,' Arg. de HBTM: yu ',yu 2466 print *,' Arg. de HBTM: yv ',yv 2467 print *,' Arg. de HBTM: yt ',yt 2468 print *,' Arg. de HBTM: yq ',yq 2469 ENDIF 2470 ELSE ! (iflag_split .eq.0) 2471 CALL HBTM(knon, ypaprs, ypplay, & 2472 yt2m_x,yt10m_x,yq2m_x,yq10m_x,yustar_x,ywstar_x, & 2473 y_flux_t_x,y_flux_q_x,yu_x,yv_x,yt_x,yq_x, & 2474 ypblh_x,ycapCL_x,yoliqCL_x,ycteiCL_x,ypblT_x, & 2475 ytherm_x,ytrmb1_x,ytrmb2_x,ytrmb3_x,ylcl_x) 2476 IF (prt_level >=10) THEN 2477 print *,' Arg. de HBTM: yt2m_x ',yt2m_x 2478 print *,' Arg. de HBTM: yt10m_x ',yt10m_x 2479 print *,' Arg. de HBTM: yq2m_x ',yq2m_x 2480 print *,' Arg. de HBTM: yq10m_x ',yq10m_x 2481 print *,' Arg. de HBTM: yustar_x ',yustar_x 2482 print *,' Arg. de HBTM: y_flux_t_x ',y_flux_t_x 2483 print *,' Arg. de HBTM: y_flux_q_x ',y_flux_q_x 2484 print *,' Arg. de HBTM: yu_x ',yu_x 2485 print *,' Arg. de HBTM: yv_x ',yv_x 2486 print *,' Arg. de HBTM: yt_x ',yt_x 2487 print *,' Arg. de HBTM: yq_x ',yq_x 2488 ENDIF 2489 CALL HBTM(knon, ypaprs, ypplay, & 2490 yt2m_w,yt10m_w,yq2m_w,yq10m_w,yustar_w,ywstar_w, & 2491 y_flux_t_w,y_flux_q_w,yu_w,yv_w,yt_w,yq_w, & 2492 ypblh_w,ycapCL_w,yoliqCL_w,ycteiCL_w,ypblT_w, & 2493 ytherm_w,ytrmb1_w,ytrmb2_w,ytrmb3_w,ylcl_w) 2494 !!! 2495 ENDIF ! (iflag_split .eq.0) 2496 !!! 1269 2497 1270 DO j=1, knon 2498 !!! jyg le 07/02/2012 2499 IF (iflag_split .eq.0) THEN 2500 !!! 2501 DO j=1, knon 1271 2502 i = ni(j) 1272 2503 pblh(i,nsrf) = ypblh(j) … … 1281 2512 trmb2(i,nsrf) = ytrmb2(j) 1282 2513 trmb3(i,nsrf) = ytrmb3(j) 1283 END DO 1284 2514 END DO 2515 IF (prt_level >=10) THEN 2516 print *, 'After HBTM: pblh ', pblh 2517 print *, 'After HBTM: plcl ', plcl 2518 print *, 'After HBTM: cteiCL ', cteiCL 2519 ENDIF 2520 ELSE !(iflag_split .eq.0) 2521 DO j=1, knon 2522 i = ni(j) 2523 pblh_x(i,nsrf) = ypblh_x(j) 2524 wstar_x(i,nsrf) = ywstar_x(j) 2525 plcl_x(i,nsrf) = ylcl_x(j) 2526 capCL_x(i,nsrf) = ycapCL_x(j) 2527 oliqCL_x(i,nsrf) = yoliqCL_x(j) 2528 cteiCL_x(i,nsrf) = ycteiCL_x(j) 2529 pblT_x(i,nsrf) = ypblT_x(j) 2530 therm_x(i,nsrf) = ytherm_x(j) 2531 trmb1_x(i,nsrf) = ytrmb1_x(j) 2532 trmb2_x(i,nsrf) = ytrmb2_x(j) 2533 trmb3_x(i,nsrf) = ytrmb3_x(j) 2534 END DO 2535 IF (prt_level >=10) THEN 2536 print *, 'After HBTM: pblh_x ', pblh_x 2537 print *, 'After HBTM: plcl_x ', plcl_x 2538 print *, 'After HBTM: cteiCL_x ', cteiCL_x 2539 ENDIF 2540 DO j=1, knon 2541 i = ni(j) 2542 pblh_w(i,nsrf) = ypblh_w(j) 2543 wstar_w(i,nsrf) = ywstar_w(j) 2544 plcl_w(i,nsrf) = ylcl_w(j) 2545 capCL_w(i,nsrf) = ycapCL_w(j) 2546 oliqCL_w(i,nsrf) = yoliqCL_w(j) 2547 cteiCL_w(i,nsrf) = ycteiCL_w(j) 2548 pblT_w(i,nsrf) = ypblT_w(j) 2549 therm_w(i,nsrf) = ytherm_w(j) 2550 trmb1_w(i,nsrf) = ytrmb1_w(j) 2551 trmb2_w(i,nsrf) = ytrmb2_w(j) 2552 trmb3_w(i,nsrf) = ytrmb3_w(j) 2553 END DO 2554 IF (prt_level >=10) THEN 2555 print *, 'After HBTM: pblh_w ', pblh_w 2556 print *, 'After HBTM: plcl_w ', plcl_w 2557 print *, 'After HBTM: cteiCL_w ', cteiCL_w 2558 ENDIF 2559 !!! 2560 ENDIF ! (iflag_split .eq.0) 2561 !!! 2562 1285 2563 ! print*,'OK pbl 6' 1286 2564 #else … … 1297 2575 1298 2576 !**************************************************************************************** 1299 ! 16) Calculate the mean value over all sub-surfaces for som variables2577 ! 16) Calculate the mean value over all sub-surfaces for some variables 1300 2578 ! 1301 2579 !**************************************************************************************** … … 1304 2582 zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0 1305 2583 zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0 2584 zxfluxt_x(:,:) = 0.0 ; zxfluxq_x(:,:) = 0.0 2585 zxfluxu_x(:,:) = 0.0 ; zxfluxv_x(:,:) = 0.0 2586 zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0 2587 zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0 2588 2589 !!! jyg le 07/02/2012 2590 IF (iflag_split .eq.1) THEN 2591 !!! 2592 !!! nrlmd & jyg les 02/05/2011, 05/02/2012 2593 2594 DO nsrf = 1, nbsrf 2595 DO k = 1, klev 2596 DO i = 1, klon 2597 zxfluxt_x(i,k) = zxfluxt_x(i,k) + flux_t_x(i,k,nsrf) * pctsrf(i,nsrf) 2598 zxfluxq_x(i,k) = zxfluxq_x(i,k) + flux_q_x(i,k,nsrf) * pctsrf(i,nsrf) 2599 zxfluxu_x(i,k) = zxfluxu_x(i,k) + flux_u_x(i,k,nsrf) * pctsrf(i,nsrf) 2600 zxfluxv_x(i,k) = zxfluxv_x(i,k) + flux_v_x(i,k,nsrf) * pctsrf(i,nsrf) 2601 ! 2602 zxfluxt_w(i,k) = zxfluxt_w(i,k) + flux_t_w(i,k,nsrf) * pctsrf(i,nsrf) 2603 zxfluxq_w(i,k) = zxfluxq_w(i,k) + flux_q_w(i,k,nsrf) * pctsrf(i,nsrf) 2604 zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf) 2605 zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf) 2606 END DO 2607 END DO 2608 END DO 2609 2610 DO i = 1, klon 2611 zxsens_x(i) = - zxfluxt_x(i,1) 2612 zxsens_w(i) = - zxfluxt_w(i,1) 2613 END DO 2614 !!! 2615 ENDIF ! (iflag_split .eq.1) 2616 !!! 2617 1306 2618 DO nsrf = 1, nbsrf 1307 2619 DO k = 1, klev … … 1315 2627 END DO 1316 2628 1317 ! print*,'OK pbl 8'1318 2629 DO i = 1, klon 1319 2630 zxsens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol … … 1321 2632 fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i) 1322 2633 ENDDO 2634 !!! 1323 2635 1324 2636 ! … … 1329 2641 zustar(:)=0.0 ; zu10m(:) = 0.0 ; zv10m(:) = 0.0 1330 2642 s_pblh(:) = 0.0 ; s_plcl(:) = 0.0 2643 !!! jyg le 07/02/2012 2644 s_pblh_x(:) = 0.0 ; s_plcl_x(:) = 0.0 2645 s_pblh_w(:) = 0.0 ; s_plcl_w(:) = 0.0 2646 !!! 1331 2647 s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0 1332 2648 s_cteiCL(:) = 0.0; s_pblT(:) = 0.0 … … 1336 2652 1337 2653 ! print*,'OK pbl 9' 2654 2655 !!! nrlmd le 02/05/2011 2656 zxfluxlat_x(:) = 0.0 ; zxfluxlat_w(:) = 0.0 2657 !!! 1338 2658 1339 2659 DO nsrf = 1, nbsrf … … 1348 2668 zxtsol(i) = zxtsol(i) + ts(i,nsrf) * pctsrf(i,nsrf) 1349 2669 zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf) 2670 END DO 2671 END DO 1350 2672 2673 !!! jyg le 07/02/2012 2674 IF (iflag_split .eq.0) THEN 2675 DO nsrf = 1, nbsrf 2676 DO i = 1, klon 1351 2677 zt2m(i) = zt2m(i) + t2m(i,nsrf) * pctsrf(i,nsrf) 1352 2678 zq2m(i) = zq2m(i) + q2m(i,nsrf) * pctsrf(i,nsrf) … … 1366 2692 s_trmb2(i) = s_trmb2(i) + trmb2(i,nsrf) * pctsrf(i,nsrf) 1367 2693 s_trmb3(i) = s_trmb3(i) + trmb3(i,nsrf) * pctsrf(i,nsrf) 1368 END DO 1369 END DO 1370 ! print*,'OK pbl 10' 2694 END DO 2695 END DO 2696 ELSE !(iflag_split .eq.0) 2697 DO nsrf = 1, nbsrf 2698 DO i = 1, klon 2699 !!! nrlmd le 02/05/2011 2700 zxfluxlat_x(i) = zxfluxlat_x(i) + fluxlat_x(i,nsrf) * pctsrf(i,nsrf) 2701 zxfluxlat_w(i) = zxfluxlat_w(i) + fluxlat_w(i,nsrf) * pctsrf(i,nsrf) 2702 !!! 2703 !!! jyg le 08/02/2012 2704 !! Pour le moment, on sort les valeurs dans (x) et (w) de pblh et de plcl ; 2705 !! pour zt2m, on fait la moyenne surfacique sur les sous-surfaces ; 2706 !! pour qsat2m, on fait la moyenne surfacique sur (x) et (w) ; 2707 !! pour les autres variables, on sort les valeurs de la region (x). 2708 zt2m(i) = zt2m(i) + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf) 2709 zq2m(i) = zq2m(i) + q2m_x(i,nsrf) * pctsrf(i,nsrf) 2710 zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf) 2711 wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf) 2712 zu10m(i) = zu10m(i) + u10m_x(i,nsrf) * pctsrf(i,nsrf) 2713 zv10m(i) = zv10m(i) + v10m_x(i,nsrf) * pctsrf(i,nsrf) 2714 ! 2715 s_pblh(i) = s_pblh(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf) 2716 s_pblh_x(i) = s_pblh_x(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf) 2717 s_pblh_w(i) = s_pblh_w(i) + pblh_w(i,nsrf) * pctsrf(i,nsrf) 2718 ! 2719 s_plcl(i) = s_plcl(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf) 2720 s_plcl_x(i) = s_plcl_x(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf) 2721 s_plcl_w(i) = s_plcl_w(i) + plcl_w(i,nsrf) * pctsrf(i,nsrf) 2722 ! 2723 s_capCL(i) = s_capCL(i) + capCL_x(i,nsrf) * pctsrf(i,nsrf) 2724 s_oliqCL(i) = s_oliqCL(i) + oliqCL_x(i,nsrf)* pctsrf(i,nsrf) 2725 s_cteiCL(i) = s_cteiCL(i) + cteiCL_x(i,nsrf)* pctsrf(i,nsrf) 2726 s_pblT(i) = s_pblT(i) + pblT_x(i,nsrf) * pctsrf(i,nsrf) 2727 s_therm(i) = s_therm(i) + therm_x(i,nsrf) * pctsrf(i,nsrf) 2728 s_trmb1(i) = s_trmb1(i) + trmb1_x(i,nsrf) * pctsrf(i,nsrf) 2729 s_trmb2(i) = s_trmb2(i) + trmb2_x(i,nsrf) * pctsrf(i,nsrf) 2730 s_trmb3(i) = s_trmb3(i) + trmb3_x(i,nsrf) * pctsrf(i,nsrf) 2731 END DO 2732 END DO 2733 DO i = 1, klon 2734 qsat2m(i)= qsat2m_x(i)+ wake_s(i)*(qsat2m_x(i)-qsat2m_w(i)) 2735 END DO 2736 !!! 2737 ENDIF ! (iflag_split .eq.0) 2738 !!! 1371 2739 1372 2740 IF (check) THEN
Note: See TracChangeset
for help on using the changeset viewer.
