Changeset 2187 for LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90
- Timestamp:
- Jan 30, 2015, 2:57:13 PM (9 years ago)
- Location:
- LMDZ5/branches/testing
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/pbl_surface_mod.F90 (modified) (55 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/branches/testing
- Property svn:mergeinfo changed
/LMDZ5/trunk merged: 2159,2162,2166-2167,2169-2171,2177-2186
- Property svn:mergeinfo changed
-
LMDZ5/branches/testing/libf/phylmd/pbl_surface_mod.F90
r2160 r2187 12 12 USE dimphy 13 13 USE mod_phys_lmdz_para, ONLY : mpi_size 14 USE mod_grid_phy_lmdz, ONLY : klon_glo 14 15 USE ioipsl 15 16 USE surface_data, ONLY : type_ocean, ok_veget … … 174 175 rain_f, snow_f, solsw_m, sollw_m, & 175 176 t, q, u, v, & 177 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 178 !! t_x, q_x, t_w, q_w, & 179 wake_dlt, wake_dlq, & 180 wake_cstar, wake_s, & 181 !!! 176 182 pplay, paprs, pctsrf, & 177 183 ts, alb1, alb2,ustar, u10m, v10m,wstar, & … … 181 187 zxtsol, zxfluxlat, zt2m, qsat2m, & 182 188 d_t, d_q, d_u, d_v, d_t_diss, & 189 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 190 d_t_w, d_q_w, & 191 d_t_x, d_q_x, & 192 !! d_wake_dlt,d_wake_dlq, & 193 zxsens_x, zxfluxlat_x,zxsens_w,zxfluxlat_w, & 194 !!! 195 !!! nrlmd le 13/06/2011 196 delta_tsurf,wake_dens,cdragh_x,cdragh_w, & 197 cdragm_x,cdragm_w,kh,kh_x,kh_w, & 198 !!! 183 199 zcoefh, zcoefm, slab_wfbils, & 184 200 qsol_d, zq2m, s_pblh, s_plcl, & 201 !!! 202 !!! jyg le 08/02/2012 203 s_pblh_x, s_plcl_x, s_pblh_w, s_plcl_w, & 204 !!! 185 205 s_capCL, s_oliqCL, s_cteiCL, s_pblT, & 186 206 s_therm, s_trmb1, s_trmb2, s_trmb3, & … … 191 211 wfbils, wfbilo, flux_t, flux_u, flux_v,& 192 212 dflux_t, dflux_q, zxsnow, & 193 zxfluxt, zxfluxq, q2m, flux_q, tke ) 213 !jyg< 214 !! zxfluxt, zxfluxq, q2m, flux_q, tke, & 215 zxfluxt, zxfluxq, q2m, flux_q, tke_x, & 216 !>jyg 217 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 218 !! tke_x, tke_w & 219 wake_dltke & 220 !!! 221 ) 194 222 !**************************************************************************************** 195 223 ! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818 … … 221 249 ! u--------input-R- vitesse u 222 250 ! v--------input-R- vitesse v 251 ! wake_dlt-input-R- temperatre difference between (w) and (x) (K) 252 ! wake_dlq-input-R- humidity difference between (w) and (x) (kg/kg) 253 !wake_cstar-input-R- wake gust front speed (m/s) 254 ! wake_s---input-R- wake fractionnal area 223 255 ! ts-------input-R- temperature du sol (en Kelvin) 224 256 ! paprs----input-R- pression a intercouche (Pa) … … 239 271 ! flux_t---output-R- flux de chaleur sensible (CpT) J/m**2/s (W/m**2) 240 272 ! (orientation positive vers le bas) 241 ! tke---input/output-R- tke (kg/m**2/s) 273 ! tke_x---input/output-R- tke in the (x) region (kg/m**2/s) 274 ! wake_dltke-input/output-R- tke difference between (w) and (x) (kg/m**2/s) 242 275 ! flux_q---output-R- flux de vapeur d'eau (kg/m**2/s) 243 276 ! flux_u---output-R- tension du vent X: (kg m/s)/(m**2 s) ou Pascal … … 299 332 ! Martin 300 333 334 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 335 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: t_x ! Température hors poche froide 336 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: t_w ! Température dans la poches froide 337 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: q_x ! 338 !! REAL, DIMENSION(klon,klev), INTENT(IN) :: q_w ! Pareil pour l'humidité 339 REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlt !temperature difference between (w) and (x) (K) 340 REAL, DIMENSION(klon,klev), INTENT(IN) :: wake_dlq !humidity difference between (w) and (x) (K) 341 REAL, DIMENSION(klon), INTENT(IN) :: wake_s ! Fraction de poches froides 342 REAL, DIMENSION(klon), INTENT(IN) :: wake_cstar! Vitesse d'expansion des poches froides 343 REAL, DIMENSION(klon), INTENT(IN) :: wake_dens 344 !!! 345 301 346 ! Input/Output variables 302 347 !**************************************************************************************** 303 348 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ts ! temperature at surface (K) 349 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: delta_tsurf !surface temperature difference between 350 !wake and off-wake regions 304 351 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: alb1 ! albedo in visible SW interval 305 352 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: alb2 ! albedo in near infra-red SW interval 353 !jyg Pourquoi ustar et wstar sont-elles INOUT ? 306 354 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: ustar ! u* (m/s) 307 355 REAL, DIMENSION(klon, nbsrf+1), INTENT(INOUT) :: wstar ! w* (m/s) 308 356 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: u10m ! u speed at 10m 309 357 REAL, DIMENSION(klon, nbsrf), INTENT(INOUT) :: v10m ! v speed at 10m 310 REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke 358 !jyg< 359 !! REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke 360 REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: tke_x 361 !>jyg 362 363 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 364 REAL, DIMENSION(klon, klev+1, nbsrf+1), INTENT(INOUT) :: wake_dltke ! TKE_w - TKE_x 365 !!! 366 311 367 ! Output variables 312 368 !**************************************************************************************** … … 325 381 REAL, DIMENSION(klon), INTENT(OUT) :: zxevap ! water vapour flux at surface, positiv upwards 326 382 REAL, DIMENSION(klon), INTENT(OUT) :: zxtsol ! temperature at surface, mean for each grid point 383 !!! jyg le ??? 384 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_w ! ! 385 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_w ! ! Tendances dans les poches 386 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_x ! ! 387 REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_q_x ! ! Tendances hors des poches 388 !!! jyg 327 389 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat ! latent flux, mean for each grid point 328 390 REAL, DIMENSION(klon), INTENT(OUT) :: zt2m ! temperature at 2m, mean for each grid point … … 340 402 ! coef for turbulent diffusion of U and V (?), mean for each grid point 341 403 404 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 405 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_x ! Flux sensible hors poche 406 REAL, DIMENSION(klon), INTENT(OUT) :: zxsens_w ! Flux sensible dans la poche 407 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_x! Flux latent hors poche 408 REAL, DIMENSION(klon), INTENT(OUT) :: zxfluxlat_w! Flux latent dans la poche 409 !! REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_wake_dlt 410 !! REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_wake_dlq 411 342 412 ! Output only for diagnostics 413 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_x 414 REAL, DIMENSION(klon), INTENT(OUT) :: cdragh_w 415 REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_x 416 REAL, DIMENSION(klon), INTENT(OUT) :: cdragm_w 417 REAL, DIMENSION(klon), INTENT(OUT) :: kh 418 REAL, DIMENSION(klon), INTENT(OUT) :: kh_x 419 REAL, DIMENSION(klon), INTENT(OUT) :: kh_w 420 !!! 343 421 REAL, DIMENSION(klon), INTENT(OUT) :: slab_wfbils! heat balance at surface only for slab at ocean points 344 422 REAL, DIMENSION(klon), INTENT(OUT) :: qsol_d ! water height in the soil (mm) 345 423 REAL, DIMENSION(klon), INTENT(OUT) :: zq2m ! water vapour at 2m, mean for each grid point 346 424 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh ! height of the planetary boundary layer(HPBL) 425 !!! jyg le 08/02/2012 426 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_x ! height of the PBL in the off-wake region 427 REAL, DIMENSION(klon), INTENT(OUT) :: s_pblh_w ! height of the PBL in the wake region 428 !!! 347 429 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl ! condensation level 430 !!! jyg le 08/02/2012 431 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_x ! condensation level in the off-wake region 432 REAL, DIMENSION(klon), INTENT(OUT) :: s_plcl_w ! condensation level in the wake region 433 !!! 348 434 REAL, DIMENSION(klon), INTENT(OUT) :: s_capCL ! CAPE of PBL 349 435 REAL, DIMENSION(klon), INTENT(OUT) :: s_oliqCL ! liquid water intergral of PBL … … 409 495 ! Other local variables 410 496 !**************************************************************************************** 497 INTEGER :: iflag_split 411 498 INTEGER :: i, k, nsrf 412 499 INTEGER :: knon, j 413 500 INTEGER :: idayref 414 501 INTEGER , DIMENSION(klon) :: ni 502 REAL :: yt1_new 415 503 REAL :: zx_alf1, zx_alf2 !valeur ambiante par extrapola 416 504 REAL :: amn, amx … … 419 507 REAL, DIMENSION(klon) :: yts, yrugos, ypct, yz0_new 420 508 REAL, DIMENSION(klon) :: yalb, yalb1, yalb2 421 REAL, DIMENSION(klon) :: yu1, yv1 ,ytoto509 REAL, DIMENSION(klon) :: yu1, yv1 422 510 REAL, DIMENSION(klon) :: ysnow, yqsurf, yagesno, yqsol 423 511 REAL, DIMENSION(klon) :: yrain_f, ysnow_f … … 474 562 LOGICAL, PARAMETER :: zxli=.FALSE. ! utiliser un jeu de fonctions simples 475 563 LOGICAL, PARAMETER :: check=.FALSE. 476 REAL, DIMENSION(klon) :: Kech_h ! Coefficient d'echange pour l'energie 564 565 !!! nrlmd le 02/05/2011 566 !!! jyg le 07/02/2012 567 REAL, DIMENSION(klon) :: ywake_s, ywake_cstar, ywake_dens 568 !!! 569 REAL, DIMENSION(klon,klev+1) :: ytke_x, ytke_w 570 REAL, DIMENSION(klon,klev+1) :: ywake_dltke 571 REAL, DIMENSION(klon,klev) :: yu_x, yv_x, yu_w, yv_w 572 REAL, DIMENSION(klon,klev) :: yt_x, yq_x, yt_w, yq_w 573 REAL, DIMENSION(klon,klev) :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w 574 REAL, DIMENSION(klon,klev) :: ycoefq_x, ycoefq_w 575 REAL, DIMENSION(klon) :: ycdragh_x, ycdragm_x, ycdragh_w, ycdragm_w 576 REAL, DIMENSION(klon) :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x 577 REAL, DIMENSION(klon) :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w 578 REAL, DIMENSION(klon) :: AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x 579 REAL, DIMENSION(klon) :: AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w 580 REAL, DIMENSION(klon) :: y_flux_t1_x, y_flux_q1_x, y_flux_t1_w, y_flux_q1_w 581 REAL, DIMENSION(klon) :: y_flux_u1_x, y_flux_v1_x, y_flux_u1_w, y_flux_v1_w 582 REAL, DIMENSION(klon,klev) :: y_flux_t_x, y_flux_q_x, y_flux_t_w, y_flux_q_w 583 REAL, DIMENSION(klon,klev) :: y_flux_u_x, y_flux_v_x, y_flux_u_w, y_flux_v_w 584 REAL, DIMENSION(klon) :: yfluxlat_x, yfluxlat_w 585 REAL, DIMENSION(klon,klev) :: y_d_t_x, y_d_q_x, y_d_t_w, y_d_q_w 586 REAL, DIMENSION(klon,klev) :: y_d_t_diss_x, y_d_t_diss_w 587 REAL, DIMENSION(klon,klev) :: d_t_diss_x, d_t_diss_w 588 REAL, DIMENSION(klon,klev) :: y_d_u_x, y_d_v_x, y_d_u_w, y_d_v_w 589 REAL, DIMENSION(klon, klev, nbsrf) :: flux_t_x, flux_q_x, flux_t_w, flux_q_w 590 REAL, DIMENSION(klon, klev, nbsrf) :: flux_u_x, flux_v_x, flux_u_w, flux_v_w 591 REAL, DIMENSION(klon, nbsrf) :: fluxlat_x, fluxlat_w 592 REAL, DIMENSION(klon, klev) :: zxfluxt_x, zxfluxq_x, zxfluxt_w, zxfluxq_w 593 REAL, DIMENSION(klon, klev) :: zxfluxu_x, zxfluxv_x, zxfluxu_w, zxfluxv_w 594 REAL :: zx_qs_surf, zcor_surf, zdelta_surf 595 REAL, DIMENSION(klon) :: ytsurf_th, yqsatsurf 596 REAL, DIMENSION(klon) :: ybeta 597 REAL, DIMENSION(klon, klev) :: d_u_x 598 REAL, DIMENSION(klon, klev) :: d_u_w 599 REAL, DIMENSION(klon, klev) :: d_v_x 600 REAL, DIMENSION(klon, klev) :: d_v_w 601 602 REAL, DIMENSION(klon,klev) :: CcoefH, CcoefQ, DcoefH, DcoefQ 603 REAL, DIMENSION(klon,klev) :: CcoefU, CcoefV, DcoefU, DcoefV 604 REAL, DIMENSION(klon,klev) :: CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x 605 REAL, DIMENSION(klon,klev) :: CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w 606 REAL, DIMENSION(klon,klev) :: CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x 607 REAL, DIMENSION(klon,klev) :: CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w 608 REAL, DIMENSION(klon,klev) :: Kcoef_hq, Kcoef_m, gama_h, gama_q 609 REAL, DIMENSION(klon,klev) :: Kcoef_hq_x, Kcoef_m_x, gama_h_x, gama_q_x 610 REAL, DIMENSION(klon,klev) :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w 611 REAL, DIMENSION(klon) :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w 612 !!! 613 !!!jyg le 08/02/2012 614 REAL, DIMENSION(klon, nbsrf) :: windsp 615 ! 616 REAL, DIMENSION(klon, nbsrf) :: t2m_x 617 REAL, DIMENSION(klon, nbsrf) :: q2m_x 618 REAL, DIMENSION(klon) :: rh2m_x 619 REAL, DIMENSION(klon) :: qsat2m_x 620 REAL, DIMENSION(klon, nbsrf) :: u10m_x 621 REAL, DIMENSION(klon, nbsrf) :: v10m_x 622 REAL, DIMENSION(klon, nbsrf) :: ustar_x 623 REAL, DIMENSION(klon, nbsrf) :: wstar_x 624 ! 625 REAL, DIMENSION(klon, nbsrf) :: pblh_x 626 REAL, DIMENSION(klon, nbsrf) :: plcl_x 627 REAL, DIMENSION(klon, nbsrf) :: capCL_x 628 REAL, DIMENSION(klon, nbsrf) :: oliqCL_x 629 REAL, DIMENSION(klon, nbsrf) :: cteiCL_x 630 REAL, DIMENSION(klon, nbsrf) :: pblt_x 631 REAL, DIMENSION(klon, nbsrf) :: therm_x 632 REAL, DIMENSION(klon, nbsrf) :: trmb1_x 633 REAL, DIMENSION(klon, nbsrf) :: trmb2_x 634 REAL, DIMENSION(klon, nbsrf) :: trmb3_x 635 ! 636 REAL, DIMENSION(klon, nbsrf) :: t2m_w 637 REAL, DIMENSION(klon, nbsrf) :: q2m_w 638 REAL, DIMENSION(klon) :: rh2m_w 639 REAL, DIMENSION(klon) :: qsat2m_w 640 REAL, DIMENSION(klon, nbsrf) :: u10m_w 641 REAL, DIMENSION(klon, nbsrf) :: v10m_w 642 REAL, DIMENSION(klon, nbsrf) :: ustar_w 643 REAL, DIMENSION(klon, nbsrf) :: wstar_w 644 ! 645 REAL, DIMENSION(klon, nbsrf) :: pblh_w 646 REAL, DIMENSION(klon, nbsrf) :: plcl_w 647 REAL, DIMENSION(klon, nbsrf) :: capCL_w 648 REAL, DIMENSION(klon, nbsrf) :: oliqCL_w 649 REAL, DIMENSION(klon, nbsrf) :: cteiCL_w 650 REAL, DIMENSION(klon, nbsrf) :: pblt_w 651 REAL, DIMENSION(klon, nbsrf) :: therm_w 652 REAL, DIMENSION(klon, nbsrf) :: trmb1_w 653 REAL, DIMENSION(klon, nbsrf) :: trmb2_w 654 REAL, DIMENSION(klon, nbsrf) :: trmb3_w 655 ! 656 REAL, DIMENSION(klon) :: yt2m_x 657 REAL, DIMENSION(klon) :: yq2m_x 658 REAL, DIMENSION(klon) :: yt10m_x 659 REAL, DIMENSION(klon) :: yq10m_x 660 REAL, DIMENSION(klon) :: yu10m_x 661 REAL, DIMENSION(klon) :: yv10m_x 662 REAL, DIMENSION(klon) :: yustar_x 663 REAL, DIMENSION(klon) :: ywstar_x 664 ! 665 REAL, DIMENSION(klon) :: ypblh_x 666 REAL, DIMENSION(klon) :: ylcl_x 667 REAL, DIMENSION(klon) :: ycapCL_x 668 REAL, DIMENSION(klon) :: yoliqCL_x 669 REAL, DIMENSION(klon) :: ycteiCL_x 670 REAL, DIMENSION(klon) :: ypblt_x 671 REAL, DIMENSION(klon) :: ytherm_x 672 REAL, DIMENSION(klon) :: ytrmb1_x 673 REAL, DIMENSION(klon) :: ytrmb2_x 674 REAL, DIMENSION(klon) :: ytrmb3_x 675 ! 676 REAL, DIMENSION(klon) :: yt2m_w 677 REAL, DIMENSION(klon) :: yq2m_w 678 REAL, DIMENSION(klon) :: yt10m_w 679 REAL, DIMENSION(klon) :: yq10m_w 680 REAL, DIMENSION(klon) :: yu10m_w 681 REAL, DIMENSION(klon) :: yv10m_w 682 REAL, DIMENSION(klon) :: yustar_w 683 REAL, DIMENSION(klon) :: ywstar_w 684 ! 685 REAL, DIMENSION(klon) :: ypblh_w 686 REAL, DIMENSION(klon) :: ylcl_w 687 REAL, DIMENSION(klon) :: ycapCL_w 688 REAL, DIMENSION(klon) :: yoliqCL_w 689 REAL, DIMENSION(klon) :: ycteiCL_w 690 REAL, DIMENSION(klon) :: ypblt_w 691 REAL, DIMENSION(klon) :: ytherm_w 692 REAL, DIMENSION(klon) :: ytrmb1_w 693 REAL, DIMENSION(klon) :: ytrmb2_w 694 REAL, DIMENSION(klon) :: ytrmb3_w 695 ! 696 REAL, DIMENSION(klon) :: uzon_x, vmer_x 697 REAL, DIMENSION(klon) :: zgeo1_x, tair1_x, qair1_x, tairsol_x 698 ! 699 REAL, DIMENSION(klon) :: uzon_w, vmer_w 700 REAL, DIMENSION(klon) :: zgeo1_w, tair1_w, qair1_w, tairsol_w 701 702 !!! jyg le 25/03/2013 703 !! Variables intermediaires pour le raccord des deux colonnes à la surface 704 REAL :: dd_Ch 705 REAL :: dd_Cm 706 REAL :: dd_Kh 707 REAL :: dd_Km 708 REAL :: dd_u 709 REAL :: dd_v 710 REAL :: dd_t 711 REAL :: dd_q 712 REAL :: dd_AH 713 REAL :: dd_AQ 714 REAL :: dd_AU 715 REAL :: dd_AV 716 REAL :: dd_BH 717 REAL :: dd_BQ 718 REAL :: dd_BU 719 REAL :: dd_BV 720 721 REAL :: dd_KHp 722 REAL :: dd_KQp 723 REAL :: dd_KUp 724 REAL :: dd_KVp 725 726 !!! 727 !!! nrlmd le 13/06/2011 728 REAL, DIMENSION(klon) :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1 729 REAL, DIMENSION(klon) :: y_delta_tsurf,delta_coef,tau_eq 730 REAL, PARAMETER :: facteur=2./sqrt(3.14) 731 REAL, PARAMETER :: effusivity=2000. 732 REAL, DIMENSION(klon) :: ytsurf_th_x,ytsurf_th_w,yqsatsurf_x,yqsatsurf_w 733 REAL, DIMENSION(klon) :: ydtsurf_th 734 REAL :: zdelta_surf_x,zdelta_surf_w,zx_qs_surf_x,zx_qs_surf_w 735 REAL :: zcor_surf_x,zcor_surf_w 736 REAL :: mod_wind_x, mod_wind_w 737 REAL :: rho1 738 REAL, DIMENSION(klon) :: Kech_h ! Coefficient d'echange pour l'energie 739 REAL, DIMENSION(klon) :: Kech_h_x, Kech_h_w 740 REAL, DIMENSION(klon) :: Kech_m 741 REAL, DIMENSION(klon) :: Kech_m_x, Kech_m_w 742 REAL, DIMENSION(klon) :: yts_x,yts_w 743 REAL, DIMENSION(klon) :: Kech_Hp, Kech_H_xp, Kech_H_wp 744 REAL, DIMENSION(klon) :: Kech_Qp, Kech_Q_xp, Kech_Q_wp 745 REAL, DIMENSION(klon) :: Kech_Up, Kech_U_xp, Kech_U_wp 746 REAL, DIMENSION(klon) :: Kech_Vp, Kech_V_xp, Kech_V_wp 747 477 748 REAL :: vent 749 750 751 752 753 !!! 478 754 479 755 ! For debugging with IOIPSL … … 514 790 515 791 !**************************************************************************************** 516 517 792 ! End of declarations 518 793 !**************************************************************************************** 519 794 795 IF (prt_level >=10) print *,' -> pbl_surface, itap ',itap 796 ! 797 iflag_split = mod(iflag_pbl_split,2) 520 798 521 799 !**************************************************************************************** … … 529 807 530 808 ! Initialize ok_flux_surf (for 1D model) 531 if (klon >1) ok_flux_surf=.FALSE.809 if (klon_glo>1) ok_flux_surf=.FALSE. 532 810 533 811 ! Initilize debug IO … … 573 851 !**************************************************************************************** 574 852 ! 2) Initialization to zero 575 ! Done for all local variables that will be compressed later 576 ! and argument with INTENT(OUT) 577 !**************************************************************************************** 578 cdragh = 0.0 ; cdragm = 0.0 ; dflux_t = 0.0 ; dflux_q = 0.0 579 ypct = 0.0 ; yts = 0.0 ; ysnow = 0.0 580 zv1 = 0.0 ; yqsurf = 0.0 ; yalb1 = 0.0 ; yalb2 = 0.0 581 yrain_f = 0.0 ; ysnow_f = 0.0 ; yfder = 0.0 ; ysolsw = 0.0 582 ysollw = 0.0 ; yrugos = 0.0 ; yu1 = 0.0 583 yv1 = 0.0 ; ypaprs = 0.0 ; ypplay = 0.0 584 ydelp = 0.0 ; yu = 0.0 ; yv = 0.0 ; yt = 0.0 585 yq = 0.0 ; y_dflux_t = 0.0 ; y_dflux_q = 0.0 586 yrugoro = 0.0 ; ywindsp = 0.0 587 d_ts = 0.0 ; yfluxlat=0.0 ; flux_t = 0.0 ; flux_q = 0.0 588 flux_u = 0.0 ; flux_v = 0.0 ; d_t = 0.0 ; d_q = 0.0 589 d_t_diss= 0.0 ;d_u = 0.0 ; d_v = 0.0 ; yqsol = 0.0 590 ytherm = 0.0 ; ytke=0. 591 ! Martin 592 ysnowhgt = 0.0; yqsnow = 0.0 ; yrunoff = 0.0 ; ytoice =0.0 593 yalb3_new = 0.0 ; ysissnow = 0.0 ; ysollwd = 0.0 594 ypphi = 0.0 ; ycldt = 0.0 ; yrmu0 = 0.0 595 ! Martin 596 597 tke(:,:,is_ave)=0. 853 !**************************************************************************************** 854 ! 855 ! 2a) Initialization of all argument variables with INTENT(OUT) 856 !**************************************************************************************** 857 lwdown_m(:)=0. 858 cdragh(:)=0. ; cdragm(:)=0. 859 zu1(:)=0. ; zv1(:)=0. 860 alb1_m(:)=0. ; alb2_m(:)=0. ; alb3_lic(:)=0. 861 zxsens(:)=0. ; zxevap(:)=0. ; zxtsol(:)=0. 862 d_t_w(:,:)=0. ; d_q_w(:,:)=0. ; d_t_x(:,:)=0. ; d_q_x(:,:)=0. 863 zxfluxlat(:)=0. 864 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0. 865 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0. 866 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0. 867 zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0. 868 cdragh_x(:)=0. ; cdragh_w(:)=0. ; cdragm_x(:)=0. ; cdragm_w(:)=0. 869 kh(:)=0. ; kh_x(:)=0. ; kh_w(:)=0. 870 slab_wfbils(:)=0. 871 qsol_d(:)=0. 872 s_pblh(:)=0. ; s_pblh_x(:)=0. ; s_pblh_w(:)=0. 873 s_plcl(:)=0. ; s_plcl_x(:)=0. ; s_plcl_w(:)=0. 874 s_capCL(:)=0. ; s_oliqCL(:)=0. ; s_cteiCL(:)=0. ; s_pblT(:)=0. 875 s_therm(:)=0. 876 s_trmb1(:)=0. ; s_trmb2(:)=0. ; s_trmb3(:)=0. 877 zxrugs(:)=0. ; zustar(:)=0. 878 zu10m(:)=0. ; zv10m(:)=0. 879 fder_print(:)=0. 880 zxqsurf(:)=0. 881 zxfluxu(:,:)=0. ; zxfluxv(:,:)=0. 882 rugos_d(:,:)=0. ; agesno_d(:,:)=0. 883 solsw(:,:)=0. ; sollw(:,:)=0. 884 d_ts(:,:)=0. 885 evap_d(:,:)=0. 886 fluxlat(:,:)=0. 887 wfbils(:,:)=0. ; wfbilo(:,:)=0. 888 flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0. 889 dflux_t(:)=0. ; dflux_q(:)=0. 890 zxsnow(:)=0. 891 zxfluxt(:,:)=0. ; zxfluxq(:,:)=0. 892 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0. 893 runoff(:)=0. 598 894 IF (iflag_pbl<20.or.iflag_pbl>=30) THEN 599 895 zcoefh(:,:,:) = 0.0 … … 605 901 zcoefh(:,:,is_ave)=0. 606 902 ENDIF 903 !! 904 ! The components "is_ave" of tke_x and wake_deltke are "OUT" variables 905 !jyg< 906 !! tke(:,:,is_ave)=0. 907 tke_x(:,:,is_ave)=0. 908 wake_dltke(:,:,is_ave)=0. 909 !>jyg 910 !!! jyg le 23/02/2013 911 t2m(:,:) = 999999. ! t2m and q2m are meaningfull only over sub-surfaces 912 q2m(:,:) = 999999. ! actually present in the grid cell. 913 !!! 914 rh2m(:) = 0. ; qsat2m(:) = 0. 915 !!! 916 !!! jyg le 10/02/2012 917 rh2m_x(:) = 0. ; qsat2m_x(:) = 0. ; rh2m_w(:) = 0. ; qsat2m_w(:) = 0. 918 !!! 919 920 ! 2b) Initialization of all local variables that will be compressed later 921 !**************************************************************************************** 922 !! cdragh = 0.0 ; cdragm = 0.0 ; dflux_t = 0.0 ; dflux_q = 0.0 923 ypct = 0.0 ; yts = 0.0 ; ysnow = 0.0 924 !! zv1 = 0.0 ; yqsurf = 0.0 ; yalb1 = 0.0 ; yalb2 = 0.0 925 yqsurf = 0.0 ; yalb1 = 0.0 ; yalb2 = 0.0 926 yrain_f = 0.0 ; ysnow_f = 0.0 ; yfder = 0.0 ; ysolsw = 0.0 927 ysollw = 0.0 ; yrugos = 0.0 ; yu1 = 0.0 928 yv1 = 0.0 ; ypaprs = 0.0 ; ypplay = 0.0 929 ydelp = 0.0 ; yu = 0.0 ; yv = 0.0 ; yt = 0.0 930 yq = 0.0 ; y_dflux_t = 0.0 ; y_dflux_q = 0.0 931 yrugoro = 0.0 ; ywindsp = 0.0 932 !! d_ts = 0.0 ; yfluxlat=0.0 ; flux_t = 0.0 ; flux_q = 0.0 933 yfluxlat=0.0 934 !! flux_u = 0.0 ; flux_v = 0.0 ; d_t = 0.0 ; d_q = 0.0 935 !! d_t_diss= 0.0 ;d_u = 0.0 ; d_v = 0.0 936 yqsol = 0.0 937 ytherm = 0.0 ; ytke=0. 938 ! Martin 939 ysnowhgt = 0.0; yqsnow = 0.0 ; yrunoff = 0.0 ; ytoice =0.0 940 yalb3_new = 0.0 ; ysissnow = 0.0 ; ysollwd = 0.0 941 ypphi = 0.0 ; ycldt = 0.0 ; yrmu0 = 0.0 942 ! Martin 943 944 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 945 ytke_x=0. ; ytke_w=0. ; ywake_dltke=0. 946 y_d_t_x=0. ; y_d_t_w=0. ; y_d_q_x=0. ; y_d_q_w=0. 947 !! d_t_w=0. ; d_q_w=0. 948 !! d_t_x=0. ; d_q_x=0. 949 !! d_wake_dlt=0. ; d_wake_dlq=0. 950 yfluxlat_x=0. ; yfluxlat_w=0. 951 ywake_s=0. ; ywake_cstar=0. ;ywake_dens=0. 952 !!! 953 !!! nrlmd le 13/06/2011 954 tau_eq=0. ; delta_coef=0. 955 y_delta_flux_t1=0. 956 ydtsurf_th=0. 957 yts_x=0. ; yts_w=0. 958 y_delta_tsurf=0. 959 !!! 607 960 ytsoil = 999999. 608 961 609 rh2m(:) = 0. 610 qsat2m(:) = 0. 962 963 ! 2c) Initialization of all local variables computed within the subsurface loop and used later on 964 !**************************************************************************************** 965 d_t_diss_x(:,:) = 0. ; d_t_diss_w(:,:) = 0. 966 d_u_x(:,:)=0. ; d_u_w(:,:)=0. 967 d_v_x(:,:)=0. ; d_v_w(:,:)=0. 968 flux_t_x(:,:,:)=0. ; flux_t_w(:,:,:)=0. 969 flux_q_x(:,:,:)=0. ; flux_q_w(:,:,:)=0. 970 ! 971 !jyg< 972 flux_u_x(:,:,:)=0. ; flux_u_w(:,:,:)=0. 973 flux_v_x(:,:,:)=0. ; flux_v_w(:,:,:)=0. 974 fluxlat_x(:,:)=0. ; fluxlat_w(:,:)=0. 975 !>jyg 976 ! 977 !jyg< 978 ! pblh,plcl,capCL,cteiCL ... are meaningfull only over sub-surfaces 979 ! actually present in the grid cell ==> value set to 999999. 980 ! 981 !jyg< 982 ustar(:,:) = 999999. 983 wstar(:,:) = 999999. 984 windsp(:,:) = SQRT(u10m(:,:)**2 + v10m(:,:)**2 ) 985 u10m(:,:) = 999999. 986 v10m(:,:) = 999999. 987 !>jyg 988 ! 989 pblh(:,:) = 999999. ! Hauteur de couche limite 990 plcl(:,:) = 999999. ! Niveau de condensation de la CLA 991 capCL(:,:) = 999999. ! CAPE de couche limite 992 oliqCL(:,:) = 999999. ! eau_liqu integree de couche limite 993 cteiCL(:,:) = 999999. ! cloud top instab. crit. couche limite 994 pblt(:,:) = 999999. ! T a la Hauteur de couche limite 995 therm(:,:) = 999999. 996 trmb1(:,:) = 999999. ! deep_cape 997 trmb2(:,:) = 999999. ! inhibition 998 trmb3(:,:) = 999999. ! Point Omega 999 ! 1000 t2m_x(:,:) = 999999. 1001 q2m_x(:,:) = 999999. 1002 ustar_x(:,:) = 999999. 1003 wstar_x(:,:) = 999999. 1004 u10m_x(:,:) = 999999. 1005 v10m_x(:,:) = 999999. 1006 ! 1007 pblh_x(:,:) = 999999. ! Hauteur de couche limite 1008 plcl_x(:,:) = 999999. ! Niveau de condensation de la CLA 1009 capCL_x(:,:) = 999999. ! CAPE de couche limite 1010 oliqCL_x(:,:) = 999999. ! eau_liqu integree de couche limite 1011 cteiCL_x(:,:) = 999999. ! cloud top instab. crit. couche limite 1012 pblt_x(:,:) = 999999. ! T a la Hauteur de couche limite 1013 therm_x(:,:) = 999999. 1014 trmb1_x(:,:) = 999999. ! deep_cape 1015 trmb2_x(:,:) = 999999. ! inhibition 1016 trmb3_x(:,:) = 999999. ! Point Omega 1017 ! 1018 t2m_w(:,:) = 999999. 1019 q2m_w(:,:) = 999999. 1020 ustar_w(:,:) = 999999. 1021 wstar_w(:,:) = 999999. 1022 u10m_w(:,:) = 999999. 1023 v10m_w(:,:) = 999999. 1024 1025 pblh_w(:,:) = 999999. ! Hauteur de couche limite 1026 plcl_w(:,:) = 999999. ! Niveau de condensation de la CLA 1027 capCL_w(:,:) = 999999. ! CAPE de couche limite 1028 oliqCL_w(:,:) = 999999. ! eau_liqu integree de couche limite 1029 cteiCL_w(:,:) = 999999. ! cloud top instab. crit. couche limite 1030 pblt_w(:,:) = 999999. ! T a la Hauteur de couche limite 1031 therm_w(:,:) = 999999. 1032 trmb1_w(:,:) = 999999. ! deep_cape 1033 trmb2_w(:,:) = 999999. ! inhibition 1034 trmb3_w(:,:) = 999999. ! Point Omega 1035 !!! 1036 ! 1037 !!! 611 1038 !**************************************************************************************** 612 1039 ! 3) - Calculate pressure thickness of each layer … … 699 1126 ! 4) Loop over different surfaces 700 1127 ! 701 ! Only points containing a fraction of the sub surface will be t hreated.1128 ! Only points containing a fraction of the sub surface will be treated. 702 1129 ! 703 1130 !**************************************************************************************** 704 1131 705 1132 loop_nbsrf: DO nsrf = 1, nbsrf 1133 IF (prt_level >=10) print *,' Loop nsrf ',nsrf 706 1134 707 1135 ! Search for index(ni) and size(knon) of domaine to treat … … 714 1142 ENDIF 715 1143 ENDDO 1144 1145 !!! jyg le 19/08/2012 1146 ! IF (knon <= 0) THEN 1147 ! IF (prt_level >= 10) print *,' no grid point for nsrf= ',nsrf 1148 ! cycle loop_nbsrf 1149 ! ENDIF 1150 !!! 716 1151 717 1152 ! write index, with IOIPSL … … 752 1187 yv1(j) = v(i,1) 753 1188 ypaprs(j,klev+1) = paprs(i,klev+1) 754 ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 ) 1189 !jyg< 1190 !! ywindsp(j) = SQRT(u10m(i,nsrf)**2 + v10m(i,nsrf)**2 ) 1191 ywindsp(j) = windsp(i,nsrf) 1192 !>jyg 755 1193 ! Martin 756 1194 yzsig(j) = zsig(i) … … 758 1196 yrmu0(j) = rmu0(i) 759 1197 ! Martin 1198 !!! nrlmd le 13/06/2011 1199 y_delta_tsurf(j)=delta_tsurf(i,nsrf) 1200 !!! 760 1201 END DO 761 1202 … … 766 1207 ypplay(j,k) = pplay(i,k) 767 1208 ydelp(j,k) = delp(i,k) 768 ytke(j,k) = tke(i,k,nsrf) 1209 ENDDO 1210 ENDDO 1211 !!! jyg le 07/02/2012 et le 10/04/2013 1212 DO k = 1, klev 1213 DO j = 1, knon 1214 i = ni(j) 1215 !jyg< 1216 !! ytke(j,k) = tke(i,k,nsrf) 1217 ytke(j,k) = tke_x(i,k,nsrf) 1218 !>jyg 769 1219 yu(j,k) = u(i,k) 770 1220 yv(j,k) = v(i,k) … … 772 1222 yq(j,k) = q(i,k) 773 1223 ENDDO 774 ENDDO 775 1224 ENDDO 1225 ! 1226 IF (iflag_split .eq.1) THEN 1227 !!! nrlmd le 02/05/2011 1228 DO k = 1, klev 1229 DO j = 1, knon 1230 i = ni(j) 1231 yu_x(j,k) = u(i,k) 1232 yv_x(j,k) = v(i,k) 1233 yt_x(j,k) = t(i,k)-wake_s(i)*wake_dlt(i,k) 1234 yq_x(j,k) = q(i,k)-wake_s(i)*wake_dlq(i,k) 1235 yu_w(j,k) = u(i,k) 1236 yv_w(j,k) = v(i,k) 1237 yt_w(j,k) = t(i,k)+(1.-wake_s(i))*wake_dlt(i,k) 1238 yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k) 1239 !!! 1240 ENDDO 1241 ENDDO 1242 !!! nrlmd le 02/05/2011 1243 DO k = 1, klev+1 1244 DO j = 1, knon 1245 i = ni(j) 1246 !jyg< 1247 !! ytke_x(j,k) = tke(i,k,nsrf)-wake_s(i)*wake_dltke(i,k,nsrf) 1248 !! ytke_w(j,k) = tke(i,k,nsrf)+(1.-wake_s(i))*wake_dltke(i,k,nsrf) 1249 !! ywake_dltke(j,k) = wake_dltke(i,k,nsrf) 1250 !! ytke(j,k) = tke(i,k,nsrf) 1251 ! 1252 ytke_x(j,k) = tke_x(i,k,nsrf) 1253 ytke(j,k) = tke_x(i,k,nsrf)+wake_s(i)*wake_dltke(i,k,nsrf) 1254 ytke_w(j,k) = tke_x(i,k,nsrf)+wake_dltke(i,k,nsrf) 1255 ywake_dltke(j,k) = wake_dltke(i,k,nsrf) 1256 !>jyg 1257 ENDDO 1258 ENDDO 1259 !!! 1260 !!! jyg le 07/02/2012 1261 DO j = 1, knon 1262 i = ni(j) 1263 ywake_s(j)=wake_s(i) 1264 ywake_cstar(j)=wake_cstar(i) 1265 ywake_dens(j)=wake_dens(i) 1266 ENDDO 1267 !!! 1268 !!! nrlmd le 13/06/2011 1269 DO j=1,knon 1270 yts_x(j)=yts(j)-ywake_s(j)*y_delta_tsurf(j) 1271 yts_w(j)=yts(j)+(1.-ywake_s(j))*y_delta_tsurf(j) 1272 ENDDO 1273 !!! 1274 ENDIF ! (iflag_split .eq.1) 1275 !!! 776 1276 DO k = 1, nsoilmx 777 1277 DO j = 1, knon … … 794 1294 !**************************************************************************************** 795 1295 796 CALL clcdrag( knon, nsrf, ypaprs, ypplay, & 1296 !!! jyg le 07/02/2012 1297 IF (iflag_split .eq.0) THEN 1298 !!! 1299 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1300 CALL clcdrag( knon, nsrf, ypaprs, ypplay, & 797 1301 yu(:,1), yv(:,1), yt(:,1), yq(:,1), & 798 1302 yts, yqsurf, yrugos, & … … 810 1314 ENDDO 811 1315 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, & 1316 IF (prt_level >=10) print *,'clcdrag -> ycdragh ', ycdragh 1317 ELSE !(iflag_split .eq.0) 1318 CALL clcdrag( knon, nsrf, ypaprs, ypplay, & 1319 yu_x(:,1), yv_x(:,1), yt_x(:,1), yq_x(:,1), & 1320 yts_x, yqsurf, yrugos, & 1321 ycdragm_x, ycdragh_x ) 1322 ! --- special Dice. JYG+MPL 25112013 1323 IF (ok_prescr_ust) then 1324 DO i = 1, knon 1325 print *,'ycdragm_x avant=',ycdragm_x(i) 1326 vent= sqrt(yu_x(i,1)*yu_x(i,1)+yv_x(i,1)*yv_x(i,1)) 1327 ycdragm_x(i) = ust*ust/(1.+vent)/vent 1328 print *,'ycdragm_x ust yu yv apres=',ycdragm_x(i),ust,yu_x(i,1),yv_x(i,1) 1329 ENDDO 1330 ENDIF 1331 IF (prt_level >=10) print *,'clcdrag -> ycdragh_x ', ycdragh_x 1332 ! 1333 CALL clcdrag( knon, nsrf, ypaprs, ypplay, & 1334 yu_w(:,1), yv_w(:,1), yt_w(:,1), yq_w(:,1), & 1335 yts_w, yqsurf, yrugos, & 1336 ycdragm_w, ycdragh_w ) 1337 ! --- special Dice. JYG+MPL 25112013 1338 IF (ok_prescr_ust) then 1339 DO i = 1, knon 1340 print *,'ycdragm_w avant=',ycdragm_w(i) 1341 vent= sqrt(yu_w(i,1)*yu_w(i,1)+yv_w(i,1)*yv_w(i,1)) 1342 ycdragm_w(i) = ust*ust/(1.+vent)/vent 1343 print *,'ycdragm_w ust yu yv apres=',ycdragm_w(i),ust,yu_w(i,1),yv_w(i,1) 1344 ENDDO 1345 ENDIF 1346 IF (prt_level >=10) print *,'clcdrag -> ycdragh_w ', ycdragh_w 1347 !!! 1348 ENDIF ! (iflag_split .eq.0) 1349 !!! 1350 1351 1352 !**************************************************************************************** 1353 ! 6b) Calculate coefficients for turbulent diffusion in the atmosphere, ycoefh et ycoefm. 1354 ! 1355 !**************************************************************************************** 1356 1357 !!! jyg le 07/02/2012 1358 IF (iflag_split .eq.0) THEN 1359 !!! 1360 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1361 IF (prt_level >=10) THEN 1362 print *,' args coef_diff_turb: yu ', yu 1363 print *,' args coef_diff_turb: yv ', yv 1364 print *,' args coef_diff_turb: yq ', yq 1365 print *,' args coef_diff_turb: yt ', yt 1366 print *,' args coef_diff_turb: yts ', yts 1367 print *,' args coef_diff_turb: yrugos ', yrugos 1368 print *,' args coef_diff_turb: yqsurf ', yqsurf 1369 print *,' args coef_diff_turb: ycdragm ', ycdragm 1370 print *,' args coef_diff_turb: ycdragh ', ycdragh 1371 print *,' args coef_diff_turb: ytke ', ytke 1372 ENDIF 1373 CALL coef_diff_turb(dtime, nsrf, knon, ni, & 820 1374 ypaprs, ypplay, yu, yv, yq, yt, yts, yrugos, yqsurf, ycdragm, & 821 1375 ycoefm, ycoefh, ytke) 822 823 1376 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN 824 1377 ! In this case, coef_diff_turb is called for the Cd only … … 831 1384 ENDDO 832 1385 ENDIF 1386 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh ',ycoefh 1387 ! 1388 ELSE !(iflag_split .eq.0) 1389 IF (prt_level >=10) THEN 1390 print *,' args coef_diff_turb: yu_x ', yu_x 1391 print *,' args coef_diff_turb: yv_x ', yv_x 1392 print *,' args coef_diff_turb: yq_x ', yq_x 1393 print *,' args coef_diff_turb: yt_x ', yt_x 1394 print *,' args coef_diff_turb: yts_x ', yts_x 1395 print *,' args coef_diff_turb: yrugos ', yrugos 1396 print *,' args coef_diff_turb: yqsurf ', yqsurf 1397 print *,' args coef_diff_turb: ycdragm_x ', ycdragm_x 1398 print *,' args coef_diff_turb: ycdragh_x ', ycdragh_x 1399 print *,' args coef_diff_turb: ytke_x ', ytke_x 1400 ENDIF 1401 CALL coef_diff_turb(dtime, nsrf, knon, ni, & 1402 ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yrugos, yqsurf, ycdragm_x, & 1403 ycoefm_x, ycoefh_x, ytke_x) 1404 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN 1405 ! In this case, coef_diff_turb is called for the Cd only 1406 DO k = 2, klev 1407 DO j = 1, knon 1408 i = ni(j) 1409 ycoefh_x(j,k) = zcoefh(i,k,nsrf) 1410 ycoefm_x(j,k) = zcoefm(i,k,nsrf) 1411 ENDDO 1412 ENDDO 1413 ENDIF 1414 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_x ',ycoefh_x 1415 ! 1416 IF (prt_level >=10) THEN 1417 print *,' args coef_diff_turb: yu_w ', yu_w 1418 print *,' args coef_diff_turb: yv_w ', yv_w 1419 print *,' args coef_diff_turb: yq_w ', yq_w 1420 print *,' args coef_diff_turb: yt_w ', yt_w 1421 print *,' args coef_diff_turb: yts_w ', yts_w 1422 print *,' args coef_diff_turb: yrugos ', yrugos 1423 print *,' args coef_diff_turb: yqsurf ', yqsurf 1424 print *,' args coef_diff_turb: ycdragm_w ', ycdragm_w 1425 print *,' args coef_diff_turb: ycdragh_w ', ycdragh_w 1426 print *,' args coef_diff_turb: ytke_w ', ytke_w 1427 ENDIF 1428 CALL coef_diff_turb(dtime, nsrf, knon, ni, & 1429 ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yrugos, yqsurf, ycdragm_w, & 1430 ycoefm_w, ycoefh_w, ytke_w) 1431 IF (iflag_pbl>=20.AND.iflag_pbl<30) THEN 1432 ! In this case, coef_diff_turb is called for the Cd only 1433 DO k = 2, klev 1434 DO j = 1, knon 1435 i = ni(j) 1436 ycoefh_w(j,k) = zcoefh(i,k,nsrf) 1437 ycoefm_w(j,k) = zcoefm(i,k,nsrf) 1438 ENDDO 1439 ENDDO 1440 ENDIF 1441 IF (prt_level >=10) print *,'coef_diff_turb -> ycoefh_w ',ycoefh_w 1442 ! 1443 !!!jyg le 10/04/2013 1444 !! En attendant de traiter le transport des traceurs dans les poches froides, formule 1445 !! arbitraire pour ycoefh et ycoefm 1446 DO k = 2,klev 1447 DO j = 1,knon 1448 ycoefh(j,k) = ycoefh_x(j,k) + ywake_s(j)*(ycoefh_w(j,k) - ycoefh_x(j,k)) 1449 ycoefm(j,k) = ycoefm_x(j,k) + ywake_s(j)*(ycoefm_w(j,k) - ycoefm_x(j,k)) 1450 ENDDO 1451 ENDDO 1452 !!! 1453 ENDIF ! (iflag_split .eq.0) 1454 !!! 833 1455 834 1456 !**************************************************************************************** … … 843 1465 844 1466 ! - Calculate the coefficients Ccoef_H, Ccoef_Q, Dcoef_H and Dcoef_Q 845 CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, & 1467 !!! jyg le 07/02/2012 1468 IF (iflag_split .eq.0) THEN 1469 !!! 1470 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1471 CALL climb_hq_down(knon, ycoefh, ypaprs, ypplay, & 846 1472 ydelp, yt, yq, dtime, & 1473 !!! jyg le 09/05/2011 1474 CcoefH, CcoefQ, DcoefH, DcoefQ, & 1475 Kcoef_hq, gama_q, gama_h, & 1476 !!! 847 1477 AcoefH, AcoefQ, BcoefH, BcoefQ) 1478 ELSE !(iflag_split .eq.0) 1479 CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, & 1480 ydelp, yt_x, yq_x, dtime, & 1481 !!! nrlmd le 02/05/2011 1482 CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, & 1483 Kcoef_hq_x, gama_q_x, gama_h_x, & 1484 !!! 1485 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x) 1486 ! 1487 CALL climb_hq_down(knon, ycoefh_w, ypaprs, ypplay, & 1488 ydelp, yt_w, yq_w, dtime, & 1489 !!! nrlmd le 02/05/2011 1490 CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, & 1491 Kcoef_hq_w, gama_q_w, gama_h_w, & 1492 !!! 1493 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w) 1494 !!! 1495 ENDIF ! (iflag_split .eq.0) 1496 !!! 848 1497 849 1498 ! - 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, & 1499 !!! jyg le 07/02/2012 1500 IF (iflag_split .eq.0) THEN 1501 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1502 CALL climb_wind_down(knon, dtime, ycoefm, ypplay, ypaprs, yt, ydelp, yu, yv, & 1503 !!! jyg le 09/05/2011 1504 CcoefU, CcoefV, DcoefU, DcoefV, & 1505 Kcoef_m, alf_1, alf_2, & 1506 !!! 851 1507 AcoefU, AcoefV, BcoefU, BcoefV) 852 1508 ELSE ! (iflag_split .eq.0) 1509 CALL climb_wind_down(knon, dtime, ycoefm_x, ypplay, ypaprs, yt_x, ydelp, yu_x, yv_x, & 1510 !!! nrlmd le 02/05/2011 1511 CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, & 1512 Kcoef_m_x, alf_1_x, alf_2_x, & 1513 !!! 1514 AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x) 1515 ! 1516 CALL climb_wind_down(knon, dtime, ycoefm_w, ypplay, ypaprs, yt_w, ydelp, yu_w, yv_w, & 1517 !!! nrlmd le 02/05/2011 1518 CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, & 1519 Kcoef_m_w, alf_1_w, alf_2_w, & 1520 !!! 1521 AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w) 1522 !!! 1523 ENDIF ! (iflag_split .eq.0) 1524 !!! 853 1525 854 1526 !**************************************************************************************** … … 870 1542 END IF 871 1543 1544 !!! nrlmd le 13/06/2011 1545 !----- 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 1546 ! Kech_h_x(j) = ycdragh_x(j) * & 1547 ! (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * & 1548 ! ypplay(j,1)/(RD*yt_x(j,1)) 1549 ! Kech_h_w(j) = ycdragh_w(j) * & 1550 ! (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * & 1551 ! ypplay(j,1)/(RD*yt_w(j,1)) 1552 ! Kech_h(j) = (1.-ywake_s(j))*Kech_h_x(j)+ywake_s(j)*Kech_h_w(j) 1553 ! 1554 ! Kech_m_x(j) = ycdragm_x(j) * & 1555 ! (1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)) * & 1556 ! ypplay(j,1)/(RD*yt_x(j,1)) 1557 ! Kech_m_w(j) = ycdragm_w(j) * & 1558 ! (1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)) * & 1559 ! ypplay(j,1)/(RD*yt_w(j,1)) 1560 ! Kech_m(j) = (1.-ywake_s(j))*Kech_m_x(j)+ywake_s(j)*Kech_m_w(j) 1561 !!! 1562 1563 !!! nrlmd le 02/05/2011 -----------------------On raccorde les 2 colonnes dans la couche 1 1564 !---------------------------------------------------------------------------------------- 1565 !!! jyg le 07/02/2012 1566 IF (iflag_split .eq.1) THEN 1567 !!! 1568 !!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences 1569 1570 DO j=1,knon 1571 ! 1572 ! Calcul des coefficients d echange 1573 mod_wind_x = 1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2) 1574 mod_wind_w = 1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2) 1575 rho1 = ypplay(j,1)/(RD*yt(j,1)) 1576 Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1 1577 Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1 1578 Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1 1579 Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1 1580 ! 1581 dd_Kh = Kech_h_w(j) - Kech_h_x(j) 1582 dd_Km = Kech_m_w(j) - Kech_m_x(j) 1583 IF (prt_level >=10) THEN 1584 print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w 1585 print *,' rho1 ',rho1 1586 print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j) 1587 print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j) 1588 print *,' dd_Kh: ',dd_KH 1589 ENDIF 1590 ! 1591 Kech_h(j) = Kech_h_x(j) + ywake_s(j)*dd_Kh 1592 Kech_m(j) = Kech_m_x(j) + ywake_s(j)*dd_Km 1593 ! 1594 ! Calcul des coefficients d echange corriges des retroactions 1595 Kech_H_xp(j) = Kech_h_x(j)/(1.-BcoefH_x(j)*Kech_h_x(j)*dtime) 1596 Kech_H_wp(j) = Kech_h_w(j)/(1.-BcoefH_w(j)*Kech_h_w(j)*dtime) 1597 Kech_Q_xp(j) = Kech_h_x(j)/(1.-BcoefQ_x(j)*Kech_h_x(j)*dtime) 1598 Kech_Q_wp(j) = Kech_h_w(j)/(1.-BcoefQ_w(j)*Kech_h_w(j)*dtime) 1599 Kech_U_xp(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime) 1600 Kech_U_wp(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime) 1601 Kech_V_xp(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime) 1602 Kech_V_wp(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime) 1603 ! 1604 dd_KHp = Kech_H_wp(j) - Kech_H_xp(j) 1605 dd_KQp = Kech_Q_wp(j) - Kech_Q_xp(j) 1606 dd_KUp = Kech_U_wp(j) - Kech_U_xp(j) 1607 dd_KVp = Kech_V_wp(j) - Kech_V_xp(j) 1608 ! 1609 Kech_Hp(j) = Kech_H_xp(j) + ywake_s(j)*dd_KHp 1610 Kech_Qp(j) = Kech_Q_xp(j) + ywake_s(j)*dd_KQp 1611 Kech_Up(j) = Kech_U_xp(j) + ywake_s(j)*dd_KUp 1612 Kech_Vp(j) = Kech_V_xp(j) + ywake_s(j)*dd_KVp 1613 ! 1614 ! Calcul des differences w-x 1615 dd_CM = ycdragm_w(j) - ycdragm_x(j) 1616 dd_CH = ycdragh_w(j) - ycdragh_x(j) 1617 dd_u = yu_w(j,1) - yu_x(j,1) 1618 dd_v = yv_w(j,1) - yv_x(j,1) 1619 dd_t = yt_w(j,1) - yt_x(j,1) 1620 dd_q = yq_w(j,1) - yq_x(j,1) 1621 dd_AH = AcoefH_w(j) - AcoefH_x(j) 1622 dd_AQ = AcoefQ_w(j) - AcoefQ_x(j) 1623 dd_AU = AcoefU_w(j) - AcoefU_x(j) 1624 dd_AV = AcoefV_w(j) - AcoefV_x(j) 1625 dd_BH = BcoefH_w(j) - BcoefH_x(j) 1626 dd_BQ = BcoefQ_w(j) - BcoefQ_x(j) 1627 dd_BU = BcoefU_w(j) - BcoefU_x(j) 1628 dd_BV = BcoefV_w(j) - BcoefV_x(j) 1629 ! 1630 IF (prt_level >=10) THEN 1631 print *,'Variables pour la fusion : Kech_H_xp(j)' ,Kech_H_xp(j) 1632 print *,'Variables pour la fusion : Kech_H_wp(j)' ,Kech_H_wp(j) 1633 print *,'Variables pour la fusion : Kech_Hp(j)' ,Kech_Hp(j) 1634 print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j) 1635 ENDIF 1636 ! 1637 ! Calcul des coef A, B équivalents dans la couche 1 1638 ! 1639 AcoefH(j) = AcoefH_x(j) + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*dd_AH 1640 AcoefQ(j) = AcoefQ_x(j) + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*dd_AQ 1641 AcoefU(j) = AcoefU_x(j) + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*dd_AU 1642 AcoefV(j) = AcoefV_x(j) + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*dd_AV 1643 ! 1644 BcoefH(j) = BcoefH_x(j) + ywake_s(j)*BcoefH_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_H_wp(j)/Kech_Hp(j)) & 1645 + ywake_s(j)*(Kech_H_wp(j)/Kech_Hp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BH 1646 1647 BcoefQ(j) = BcoefQ_x(j) + ywake_s(j)*BcoefQ_x(j)*(dd_Kh/Kech_h(j))*(1.+Kech_Q_wp(j)/Kech_Qp(j)) & 1648 + ywake_s(j)*(Kech_Q_wp(j)/Kech_Qp(j))*(Kech_h_w(j)/Kech_h(j))*dd_BQ 1649 1650 BcoefU(j) = BcoefU_x(j) + ywake_s(j)*BcoefU_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_U_wp(j)/Kech_Up(j)) & 1651 + ywake_s(j)*(Kech_U_wp(j)/Kech_Up(j))*(Kech_m_w(j)/Kech_m(j))*dd_BU 1652 1653 BcoefV(j) = BcoefV_x(j) + ywake_s(j)*BcoefV_x(j)*(dd_Km/Kech_h(j))*(1.+Kech_V_wp(j)/Kech_Vp(j)) & 1654 + ywake_s(j)*(Kech_V_wp(j)/Kech_Vp(j))*(Kech_m_w(j)/Kech_m(j))*dd_BV 1655 1656 ! 1657 ! Calcul des cdrag équivalents dans la couche 1658 ! 1659 ycdragm(j) = ycdragm_x(j) + ywake_s(j)*dd_CM 1660 ycdragh(j) = ycdragh_x(j) + ywake_s(j)*dd_CH 1661 ! 1662 ! Calcul de T, q, u et v équivalents dans la couche 1 1663 yt(j,1) = yt_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_t 1664 yq(j,1) = yq_x(j,1) + ywake_s(j)*(Kech_h_w(j)/Kech_h(j))*dd_q 1665 yu(j,1) = yu_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_u 1666 yv(j,1) = yv_x(j,1) + ywake_s(j)*(Kech_m_w(j)/Kech_m(j))*dd_v 1667 1668 1669 ENDDO 1670 !!! 1671 ENDIF ! (iflag_split .eq.1) 1672 !!! 1673 872 1674 !**************************************************************************************** 873 1675 ! … … 893 1695 !**************************************************************************************** 894 1696 ! 895 ! 10) Switch seloncurrent surface1697 ! 10) Switch according to current surface 896 1698 ! It is necessary to start with the continental surfaces because the ocean 897 1699 ! needs their run-off. … … 968 1770 ! y_flux_u1, y_flux_v1) 969 1771 970 alb3_lic(:)=0. 1772 !jyg< 1773 !! alb3_lic(:)=0. 1774 !>jyg 971 1775 DO j = 1, knon 972 1776 i = ni(j) … … 992 1796 ytsurf_new, y_dflux_t, y_dflux_q, slab_wfbils, & 993 1797 y_flux_u1, y_flux_v1) 1798 IF (prt_level >=10) THEN 1799 print *,'arg de surf_ocean: ycdragh ',ycdragh 1800 print *,'arg de surf_ocean: ycdragm ',ycdragm 1801 print *,'arg de surf_ocean: yt ', yt 1802 print *,'arg de surf_ocean: yq ', yq 1803 print *,'arg de surf_ocean: yts ', yts 1804 print *,'arg de surf_ocean: AcoefH ',AcoefH 1805 print *,'arg de surf_ocean: AcoefQ ',AcoefQ 1806 print *,'arg de surf_ocean: BcoefH ',BcoefH 1807 print *,'arg de surf_ocean: BcoefQ ',BcoefQ 1808 print *,'arg de surf_ocean: yevap ',yevap 1809 print *,'arg de surf_ocean: yfluxsens ',yfluxsens 1810 print *,'arg de surf_ocean: yfluxlat ',yfluxlat 1811 print *,'arg de surf_ocean: ytsurf_new ',ytsurf_new 1812 ENDIF 994 1813 995 1814 CASE(is_sic) … … 1036 1855 ! 1037 1856 !**************************************************************************************** 1038 ! H and Q 1039 IF (ok_flux_surf) THEN 1040 PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT 1857 1858 !!! 1859 !!! jyg le 10/04/2013 1860 !!! 1861 IF (ok_flux_surf) THEN 1862 IF (prt_level >=10) THEN 1863 PRINT *,'pbl_surface: fsens flat RLVTT=',fsens,flat,RLVTT 1864 ENDIF 1041 1865 y_flux_t1(:) = fsens 1042 1866 y_flux_q1(:) = flat/RLVTT 1043 1867 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) 1868 ! 1869 IF (iflag_split .eq.0) THEN 1870 Kech_h(:) = ycdragh(:) * (1.0+SQRT(yu(:,1)**2+yv(:,1)**2)) * & 1871 ypplay(:,1)/(RD*yt(:,1)) 1872 ENDIF ! (iflag_split .eq.0) 1873 1874 DO j = 1, knon 1875 yt1_new=(1./RCPD)*(AcoefH(j)+BcoefH(j)*yfluxsens(j)*dtime) 1876 ytsurf_new(j)=yt1_new-yfluxsens(j)/(Kech_h(j)*RCPD) 1877 ENDDO 1878 1049 1879 y_d_ts(:) = ytsurf_new(:) - yts(:) 1050 1880 1051 ELSE1881 ELSE ! (ok_flux_surf) 1052 1882 y_flux_t1(:) = yfluxsens(:) 1053 1883 y_flux_q1(:) = -yevap(:) 1884 ENDIF 1885 1886 IF (prt_level >=10) THEN 1887 DO j=1,knon 1888 print*,'y_flux_t1,yfluxlat,wakes' & 1889 & , y_flux_t1(j), yfluxlat(j), ywake_s(j) 1890 print*,'beta,ytsurf_new', ybeta(j), ytsurf_new(j) 1891 print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j) 1892 ENDDO 1054 1893 ENDIF 1055 1894 1056 CALL climb_hq_up(knon, dtime, yt, yq, & 1895 !!! jyg le 07/02/2012 puis le 10/04/2013 1896 IF (iflag_split .eq.1) THEN 1897 !!! 1898 DO j=1,knon 1899 y_delta_flux_t1(j) = ( Kech_H_wp(j)*Kech_H_xp(j)*(AcoefH_w(j)-AcoefH_x(j)) + & 1900 y_flux_t1(j)*(Kech_H_wp(j)-Kech_H_xp(j)) ) / Kech_Hp(j) 1901 y_delta_flux_q1(j) = ( Kech_Q_wp(j)*Kech_Q_xp(j)*(AcoefQ_w(j)-AcoefQ_x(j)) + & 1902 y_flux_q1(j)*(Kech_Q_wp(j)-Kech_Q_xp(j)) ) / Kech_Qp(j) 1903 y_delta_flux_u1(j) = ( Kech_U_wp(j)*Kech_U_xp(j)*(AcoefU_w(j)-AcoefU_x(j)) + & 1904 y_flux_u1(j)*(Kech_U_wp(j)-Kech_U_xp(j)) ) / Kech_Up(j) 1905 y_delta_flux_v1(j) = ( Kech_V_wp(j)*Kech_V_xp(j)*(AcoefV_w(j)-AcoefV_x(j)) + & 1906 y_flux_v1(j)*(Kech_V_wp(j)-Kech_V_xp(j)) ) / Kech_Vp(j) 1907 ! 1908 y_flux_t1_x(j)=y_flux_t1(j) - ywake_s(j)*y_delta_flux_t1(j) 1909 y_flux_t1_w(j)=y_flux_t1(j) + (1.-ywake_s(j))*y_delta_flux_t1(j) 1910 y_flux_q1_x(j)=y_flux_q1(j) - ywake_s(j)*y_delta_flux_q1(j) 1911 y_flux_q1_w(j)=y_flux_q1(j) + (1.-ywake_s(j))*y_delta_flux_q1(j) 1912 y_flux_u1_x(j)=y_flux_u1(j) - ywake_s(j)*y_delta_flux_u1(j) 1913 y_flux_u1_w(j)=y_flux_u1(j) + (1.-ywake_s(j))*y_delta_flux_u1(j) 1914 y_flux_v1_x(j)=y_flux_v1(j) - ywake_s(j)*y_delta_flux_v1(j) 1915 y_flux_v1_w(j)=y_flux_v1(j) + (1.-ywake_s(j))*y_delta_flux_v1(j) 1916 ! 1917 yfluxlat_x(j)=y_flux_q1_x(j)*RLVTT 1918 yfluxlat_w(j)=y_flux_q1_w(j)*RLVTT 1919 1920 ENDDO 1921 ! 1922 1923 !!jyg!! A reprendre apres reflexion =============================================== 1924 !!jyg!! 1925 !!jyg!! DO j=1,knon 1926 !!jyg!!!!! nrlmd le 13/06/2011 1927 !!jyg!! 1928 !!jyg!!!----Diffusion dans le sol dans le cas continental seulement 1929 !!jyg!! IF (nsrf.eq.is_ter) THEN 1930 !!jyg!!!----Calcul du coefficient delta_coeff 1931 !!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))) 1932 !!jyg!! 1933 !!jyg!!! delta_coef(j)=dtime/(effusivity*sqrt(tau_eq(j))) 1934 !!jyg!! delta_coef(j)=facteur*sqrt(tau_eq(j))/effusivity 1935 !!jyg!!! delta_coef(j)=0. 1936 !!jyg!! ELSE 1937 !!jyg!! delta_coef(j)=0. 1938 !!jyg!! ENDIF 1939 !!jyg!! 1940 !!jyg!!!----Calcul de delta_tsurf 1941 !!jyg!! y_delta_tsurf(j)=delta_coef(j)*y_delta_flux_t1(j) 1942 !!jyg!! 1943 !!jyg!!!----Si il n'y a pas des poches... 1944 !!jyg!! IF (wake_cstar(j).le.0.01) THEN 1945 !!jyg!! y_delta_tsurf(j)=0. 1946 !!jyg!! y_delta_flux_t1(j)=0. 1947 !!jyg!! ENDIF 1948 !!jyg!! 1949 !!jyg!!!-----Calcul de ybeta (evap_réelle/evap_potentielle) 1950 !!jyg!!!!!!! jyg le 23/02/2012 1951 !!jyg!!!!!!! 1952 !!jyg!!!! ybeta(j)=y_flux_q1(j) / & 1953 !!jyg!!!! & (Kech_h(j)*(yq(j,1)-yqsatsurf(j))) 1954 !!jyg!!!!!! ybeta(j)=-1.*yevap(j) / & 1955 !!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))) 1956 !!jyg!!!!!!! fin jyg 1957 !!jyg!!!!! 1958 !!jyg!! 1959 !!jyg!! ENDDO 1960 !!jyg!! 1961 !!jyg!!!!! fin nrlmd le 13/06/2011 1962 !!jyg!! 1963 IF (prt_level >=10) THEN 1964 DO j = 1, knon 1965 print*,'Chx,Chw,Ch', ycdragh_x(j), ycdragh_w(j), ycdragh(j) 1966 print*,'Khx,Khw,Kh', Kech_h_x(j), Kech_h_w(j), Kech_h(j) 1967 ! print*,'tsurf_x,tsurf_w,tsurf,t1', ytsurf_th_x(j), ytsurf_th_w(j), ytsurf_th(j), yt(j,1) 1968 print*,'tsurf_x,t1x,tsurf_w,t1w,tsurf,t1,t1_ancien', & 1969 & 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) 1970 print*,'qsatsurf,qsatsurf_x,qsatsurf_w', yqsatsurf(j), yqsatsurf_x(j), yqsatsurf_w(j) 1971 print*,'delta_coef,delta_flux,delta_tsurf,tau', delta_coef(j), y_delta_flux_t1(j), y_delta_tsurf(j), tau_eq(j) 1972 ENDDO 1973 1974 DO j=1,knon 1975 print*,'fluxT_x, fluxT_w, y_flux_t1, fluxQ_x, fluxQ_w, yfluxlat, wakes' & 1976 & , 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) 1977 print*,'beta,ytsurf_new,yqsatsurf', ybeta(j), ytsurf_new(j), yqsatsurf(j) 1978 print*,'effusivity,facteur,cstar', effusivity, facteur,wake_cstar(j) 1979 ENDDO 1980 ENDIF 1981 1982 !!! jyg le 07/02/2012 1983 ENDIF ! (iflag_split .eq.1) 1984 !!! 1985 1986 !!! jyg le 07/02/2012 1987 IF (iflag_split .eq.0) THEN 1988 !!! 1989 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 1990 CALL climb_hq_up(knon, dtime, yt, yq, & 1057 1991 y_flux_q1, y_flux_t1, ypaprs, ypplay, & 1992 !!! jyg le 07/02/2012 1993 AcoefH, AcoefQ, BcoefH, BcoefQ, & 1994 CcoefH, CcoefQ, DcoefH, DcoefQ, & 1995 Kcoef_hq, gama_q, gama_h, & 1996 !!! 1058 1997 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, & 1998 ELSE !(iflag_split .eq.0) 1999 CALL climb_hq_up(knon, dtime, yt_x, yq_x, & 2000 y_flux_q1_x, y_flux_t1_x, ypaprs, ypplay, & 2001 !!! nrlmd le 02/05/2011 2002 AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x, & 2003 CcoefH_x, CcoefQ_x, DcoefH_x, DcoefQ_x, & 2004 Kcoef_hq_x, gama_q_x, gama_h_x, & 2005 !!! 2006 y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:)) 2007 ! 2008 CALL climb_hq_up(knon, dtime, yt_w, yq_w, & 2009 y_flux_q1_w, y_flux_t1_w, ypaprs, ypplay, & 2010 !!! nrlmd le 02/05/2011 2011 AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w, & 2012 CcoefH_w, CcoefQ_w, DcoefH_w, DcoefQ_w, & 2013 Kcoef_hq_w, gama_q_w, gama_h_w, & 2014 !!! 2015 y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:)) 2016 !!! 2017 ENDIF ! (iflag_split .eq.0) 2018 !!! 2019 2020 !!! jyg le 07/02/2012 2021 IF (iflag_split .eq.0) THEN 2022 !!! 2023 !!! nrlmd & jyg les 02/05/2011, 13/06/2011, 05/02/2012 2024 CALL climb_wind_up(knon, dtime, yu, yv, y_flux_u1, y_flux_v1, & 2025 !!! jyg le 07/02/2012 2026 AcoefU, AcoefV, BcoefU, BcoefV, & 2027 CcoefU, CcoefV, DcoefU, DcoefV, & 2028 Kcoef_m, & 2029 !!! 1062 2030 y_flux_u, y_flux_v, y_d_u, y_d_v) 1063 1064 1065 2031 y_d_t_diss(:,:)=0. 1066 2032 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN … … 1071 2037 ! print*,'yamada_c OK' 1072 2038 1073 DO j = 1, knon 2039 ELSE !(iflag_split .eq.0) 2040 CALL climb_wind_up(knon, dtime, yu_x, yv_x, y_flux_u1_x, y_flux_v1_x, & 2041 !!! nrlmd le 02/05/2011 2042 AcoefU_x, AcoefV_x, BcoefU_x, BcoefV_x, & 2043 CcoefU_x, CcoefV_x, DcoefU_x, DcoefV_x, & 2044 Kcoef_m_x, & 2045 !!! 2046 y_flux_u_x, y_flux_v_x, y_d_u_x, y_d_v_x) 2047 ! 2048 y_d_t_diss_x(:,:)=0. 2049 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN 2050 CALL yamada_c(knon,dtime,ypaprs,ypplay & 2051 & ,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 & 2052 ,ycoefq_x,y_d_t_diss_x,yustar_x & 2053 & ,iflag_pbl,nsrf) 2054 ENDIF 2055 ! print*,'yamada_c OK' 2056 2057 CALL climb_wind_up(knon, dtime, yu_w, yv_w, y_flux_u1_w, y_flux_v1_w, & 2058 !!! nrlmd le 02/05/2011 2059 AcoefU_w, AcoefV_w, BcoefU_w, BcoefV_w, & 2060 CcoefU_w, CcoefV_w, DcoefU_w, DcoefV_w, & 2061 Kcoef_m_w, & 2062 !!! 2063 y_flux_u_w, y_flux_v_w, y_d_u_w, y_d_v_w) 2064 !!! 2065 y_d_t_diss_w(:,:)=0. 2066 IF (iflag_pbl>=20 .and. iflag_pbl<30) THEN 2067 CALL yamada_c(knon,dtime,ypaprs,ypplay & 2068 & ,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 & 2069 ,ycoefq_w,y_d_t_diss_w,yustar_w & 2070 & ,iflag_pbl,nsrf) 2071 ENDIF 2072 ! print*,'yamada_c OK' 2073 ! 2074 IF (prt_level >=10) THEN 2075 print *, 'After climbing up, lfuxlat_x, fluxlat_w ', & 2076 yfluxlat_x, yfluxlat_w 2077 ENDIF 2078 ! 2079 ENDIF ! (iflag_split .eq.0) 2080 !!! 2081 2082 DO j = 1, knon 1074 2083 y_dflux_t(j) = y_dflux_t(j) * ypct(j) 1075 2084 y_dflux_q(j) = y_dflux_q(j) * ypct(j) 1076 ENDDO2085 ENDDO 1077 2086 1078 2087 !**************************************************************************************** … … 1084 2093 !**************************************************************************************** 1085 2094 1086 DO k = 1, klev 1087 DO j = 1, knon 2095 2096 !!! jyg le 07/02/2012 2097 IF (iflag_split .eq.0) THEN 2098 !!! 2099 DO k = 1, klev 2100 DO j = 1, knon 1088 2101 i = ni(j) 1089 2102 y_d_t_diss(j,k) = y_d_t_diss(j,k) * ypct(j) … … 1099 2112 1100 2113 2114 ENDDO 2115 ENDDO 2116 2117 2118 ELSE !(iflag_split .eq.0) 2119 2120 ! Tendances hors poches 2121 DO k = 1, klev 2122 DO j = 1, knon 2123 i = ni(j) 2124 y_d_t_diss_x(j,k) = y_d_t_diss_x(j,k) * ypct(j) 2125 y_d_t_x(j,k) = y_d_t_x(j,k) * ypct(j) 2126 y_d_q_x(j,k) = y_d_q_x(j,k) * ypct(j) 2127 y_d_u_x(j,k) = y_d_u_x(j,k) * ypct(j) 2128 y_d_v_x(j,k) = y_d_v_x(j,k) * ypct(j) 2129 2130 flux_t_x(i,k,nsrf) = y_flux_t_x(j,k) 2131 flux_q_x(i,k,nsrf) = y_flux_q_x(j,k) 2132 flux_u_x(i,k,nsrf) = y_flux_u_x(j,k) 2133 flux_v_x(i,k,nsrf) = y_flux_v_x(j,k) 1101 2134 ENDDO 1102 ENDDO 2135 ENDDO 2136 2137 ! Tendances dans les poches 2138 DO k = 1, klev 2139 DO j = 1, knon 2140 i = ni(j) 2141 y_d_t_diss_w(j,k) = y_d_t_diss_w(j,k) * ypct(j) 2142 y_d_t_w(j,k) = y_d_t_w(j,k) * ypct(j) 2143 y_d_q_w(j,k) = y_d_q_w(j,k) * ypct(j) 2144 y_d_u_w(j,k) = y_d_u_w(j,k) * ypct(j) 2145 y_d_v_w(j,k) = y_d_v_w(j,k) * ypct(j) 2146 2147 flux_t_w(i,k,nsrf) = y_flux_t_w(j,k) 2148 flux_q_w(i,k,nsrf) = y_flux_q_w(j,k) 2149 flux_u_w(i,k,nsrf) = y_flux_u_w(j,k) 2150 flux_v_w(i,k,nsrf) = y_flux_v_w(j,k) 2151 ENDDO 2152 ENDDO 2153 2154 ! Flux, tendances et Tke moyenne dans la maille 2155 DO k = 1, klev 2156 DO j = 1, knon 2157 i = ni(j) 2158 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)) 2159 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)) 2160 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)) 2161 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)) 2162 ENDDO 2163 ENDDO 2164 DO j=1,knon 2165 yfluxlat(j)=yfluxlat_x(j)+ywake_s(j)*(yfluxlat_w(j)-yfluxlat_x(j)) 2166 ENDDO 2167 IF (prt_level >=10) THEN 2168 print *,' nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) ', & 2169 nsrf, flux_t(:,1,nsrf), flux_t_x(:,1,nsrf), flux_t_w(:,1,nsrf) 2170 ENDIF 2171 2172 DO k = 1, klev 2173 DO j = 1, knon 2174 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)) 2175 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)) 2176 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)) 2177 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)) 2178 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)) 2179 ENDDO 2180 ENDDO 2181 2182 ENDIF ! (iflag_split .eq.0) 2183 !!! 1103 2184 1104 2185 ! print*,'Dans pbl OK1' 1105 2186 1106 evap(:,nsrf) = - flux_q(:,1,nsrf) 1107 1108 alb1(:, nsrf) = 0. 1109 alb2(:, nsrf) = 0. 1110 snow(:, nsrf) = 0. 1111 qsurf(:, nsrf) = 0. 1112 rugos(:, nsrf) = 0. 1113 fluxlat(:,nsrf) = 0. 2187 !jyg< 2188 !! evap(:,nsrf) = - flux_q(:,1,nsrf) 2189 !>jyg 1114 2190 DO j = 1, knon 1115 2191 i = ni(j) 2192 evap(i,nsrf) = - flux_q(i,1,nsrf) !jyg 1116 2193 d_ts(i,nsrf) = y_d_ts(j) 1117 2194 alb1(i,nsrf) = yalb1_new(j) … … 1130 2207 ! print*,'Dans pbl OK2' 1131 2208 2209 !!! jyg le 07/02/2012 2210 IF (iflag_split .eq.1) THEN 2211 !!! 2212 !!! nrlmd le 02/05/2011 2213 DO j = 1, knon 2214 i = ni(j) 2215 fluxlat_x(i,nsrf) = yfluxlat_x(j) 2216 fluxlat_w(i,nsrf) = yfluxlat_w(j) 2217 !!! 2218 !!! nrlmd le 13/06/2011 2219 delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j) 2220 cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j) 2221 cdragh_w(i) = cdragh_w(i) + ycdragh_w(j)*ypct(j) 2222 cdragm_x(i) = cdragm_x(i) + ycdragm_x(j)*ypct(j) 2223 cdragm_w(i) = cdragm_w(i) + ycdragm_w(j)*ypct(j) 2224 kh(i) = kh(i) + Kech_h(j)*ypct(j) 2225 kh_x(i) = kh_x(i) + Kech_h_x(j)*ypct(j) 2226 kh_w(i) = kh_w(i) + Kech_h_w(j)*ypct(j) 2227 !!! 2228 END DO 2229 !!! 2230 ENDIF ! (iflag_split .eq.1) 2231 !!! 2232 !!! nrlmd le 02/05/2011 2233 !!jyg le 20/02/2011 2234 !! tke_x(:,:,nsrf)=0. 2235 !! tke_w(:,:,nsrf)=0. 2236 !!jyg le 20/02/2011 2237 !! DO k = 1, klev+1 2238 !! DO j = 1, knon 2239 !! i = ni(j) 2240 !! wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k) 2241 !! tke(i,k,nsrf) = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf) 2242 !! ENDDO 2243 !! ENDDO 2244 !!jyg le 20/02/2011 2245 !! DO k = 1, klev+1 2246 !! DO j = 1, knon 2247 !! i = ni(j) 2248 !! tke(i,k,nsrf)=(1.-ywake_s(j))*tke_x(i,k,nsrf)+ywake_s(j)*tke_w(i,k,nsrf) 2249 !! ENDDO 2250 !! ENDDO 2251 !!! 2252 IF (iflag_split .eq.0) THEN 2253 DO k = 2, klev 2254 DO j = 1, knon 2255 i = ni(j) 2256 !jyg< 2257 !! tke(i,k,nsrf) = ytke(j,k) 2258 !! tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j) 2259 tke_x(i,k,nsrf) = ytke(j,k) 2260 tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + ytke(j,k)*ypct(j) 2261 !>jyg 2262 END DO 2263 END DO 2264 2265 ELSE 2266 DO k = 2, klev 2267 DO j = 1, knon 2268 i = ni(j) 2269 wake_dltke(i,k,nsrf) = ytke_w(j,k) - ytke_x(j,k) 2270 !jyg< 2271 !! tke(i,k,nsrf) = ytke_x(j,k) + ywake_s(j)*wake_dltke(i,k,nsrf) 2272 !! tke(i,k,is_ave) = tke(i,k,is_ave) + tke(i,k,nsrf)*ypct(j) 2273 tke_x(i,k,nsrf) = ytke_x(j,k) 2274 tke_x(i,k,is_ave) = tke_x(i,k,is_ave) + tke_x(i,k,nsrf)*ypct(j) 2275 wake_dltke(i,k,is_ave) = wake_dltke(i,k,is_ave) + wake_dltke(i,k,nsrf)*ypct(j) 2276 2277 !>jyg 2278 ENDDO 2279 ENDDO 2280 ENDIF ! (iflag_split .eq.0) 2281 !!! 1132 2282 DO k = 2, klev 1133 2283 DO j = 1, knon 1134 2284 i = ni(j) 1135 tke(i,k,nsrf) = ytke(j,k)1136 2285 zcoefh(i,k,nsrf) = ycoefh(j,k) 1137 2286 zcoefm(i,k,nsrf) = ycoefm(j,k) 1138 tke(i,k,is_ave) = tke(i,k,is_ave) + ytke(j,k)*ypct(j)1139 2287 zcoefh(i,k,is_ave) = zcoefh(i,k,is_ave) + ycoefh(j,k)*ypct(j) 1140 2288 zcoefm(i,k,is_ave) = zcoefm(i,k,is_ave) + ycoefm(j,k)*ypct(j) … … 1151 2299 END IF 1152 2300 1153 ftsoil(:,:,nsrf) = 0. 2301 !jyg< 2302 !! ftsoil(:,:,nsrf) = 0. 2303 !>jyg 1154 2304 DO k = 1, nsoilmx 1155 2305 DO j = 1, knon … … 1159 2309 END DO 1160 2310 2311 !!! jyg le 07/02/2012 2312 IF (iflag_split .eq.1) THEN 2313 !!! 2314 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 2315 DO k = 1, klev 2316 DO j = 1, knon 2317 i = ni(j) 2318 d_t_diss_x(i,k) = d_t_diss_x(i,k) + y_d_t_diss_x(j,k) 2319 d_t_x(i,k) = d_t_x(i,k) + y_d_t_x(j,k) 2320 d_q_x(i,k) = d_q_x(i,k) + y_d_q_x(j,k) 2321 d_u_x(i,k) = d_u_x(i,k) + y_d_u_x(j,k) 2322 d_v_x(i,k) = d_v_x(i,k) + y_d_v_x(j,k) 2323 ! 2324 d_t_diss_w(i,k) = d_t_diss_w(i,k) + y_d_t_diss_w(j,k) 2325 d_t_w(i,k) = d_t_w(i,k) + y_d_t_w(j,k) 2326 d_q_w(i,k) = d_q_w(i,k) + y_d_q_w(j,k) 2327 d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k) 2328 d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k) 2329 ! 2330 !! d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k) 2331 !! d_wake_dlq(i,k) = d_wake_dlq(i,k) + y_d_q_w(i,k)-y_d_q_x(i,k) 2332 END DO 2333 END DO 2334 !!! 2335 ENDIF ! (iflag_split .eq.1) 2336 !!! 1161 2337 1162 2338 DO k = 1, klev … … 1173 2349 ! print*,'Dans pbl OK4' 1174 2350 1175 !**************************************************************************************** 1176 ! 14) Calculate the temperature et relative humidity at 2m and the wind at 10m 2351 IF (prt_level >=10) THEN 2352 print *, 'pbl_surface tendencies for w: d_t_w, d_t_x, d_t ', & 2353 d_t_w(:,1), d_t_x(:,1), d_t(:,1) 2354 ENDIF 2355 2356 !**************************************************************************************** 2357 ! 14) Calculate the temperature and relative humidity at 2m and the wind at 10m 1177 2358 ! Call HBTM 1178 2359 ! 1179 2360 !**************************************************************************************** 1180 t2m(:,nsrf) = 0. 1181 q2m(:,nsrf) = 0. 1182 ustar(:,nsrf) = 0. 1183 wstar(:,nsrf) = 0. 1184 u10m(:,nsrf) = 0. 1185 v10m(:,nsrf) = 0. 1186 pblh(:,nsrf) = 0. ! Hauteur de couche limite 1187 plcl(:,nsrf) = 0. ! Niveau de condensation de la CLA 1188 capCL(:,nsrf) = 0. ! CAPE de couche limite 1189 oliqCL(:,nsrf) = 0. ! eau_liqu integree de couche limite 1190 cteiCL(:,nsrf) = 0. ! cloud top instab. crit. couche limite 1191 pblt(:,nsrf) = 0. ! T a la Hauteur de couche limite 1192 therm(:,nsrf) = 0. 1193 trmb1(:,nsrf) = 0. ! deep_cape 1194 trmb2(:,nsrf) = 0. ! inhibition 1195 trmb3(:,nsrf) = 0. ! Point Omega 1196 2361 !!! 2362 ! 1197 2363 #undef T2m 1198 2364 #define T2m … … 1203 2369 ! print*,'tair1,yt(:,1),y_d_t(:,1)' 1204 2370 ! print*, tair1,yt(:,1),y_d_t(:,1) 1205 DO j=1, knon 1206 i = ni(j) 2371 !!! jyg le 07/02/2012 2372 IF (iflag_split .eq.0) THEN 2373 DO j=1, knon 1207 2374 uzon(j) = yu(j,1) + y_d_u(j,1) 1208 2375 vmer(j) = yv(j,1) + y_d_v(j,1) … … 1212 2379 * (ypaprs(j,1)-ypplay(j,1)) 1213 2380 tairsol(j) = yts(j) + y_d_ts(j) 2381 qairsol(j) = yqsurf(j) 2382 END DO 2383 ELSE ! (iflag_split .eq.0) 2384 DO j=1, knon 2385 uzon_x(j) = yu_x(j,1) + y_d_u_x(j,1) 2386 vmer_x(j) = yv_x(j,1) + y_d_v_x(j,1) 2387 tair1_x(j) = yt_x(j,1) + y_d_t_x(j,1) + y_d_t_diss_x(j,1) 2388 qair1_x(j) = yq_x(j,1) + y_d_q_x(j,1) 2389 zgeo1_x(j) = RD * tair1_x(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) & 2390 * (ypaprs(j,1)-ypplay(j,1)) 2391 tairsol(j) = yts(j) + y_d_ts(j) 2392 tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j) 2393 qairsol(j) = yqsurf(j) 2394 END DO 2395 DO j=1, knon 2396 uzon_w(j) = yu_w(j,1) + y_d_u_w(j,1) 2397 vmer_w(j) = yv_w(j,1) + y_d_v_w(j,1) 2398 tair1_w(j) = yt_w(j,1) + y_d_t_w(j,1) + y_d_t_diss_w(j,1) 2399 qair1_w(j) = yq_w(j,1) + y_d_q_w(j,1) 2400 zgeo1_w(j) = RD * tair1_w(j) / (0.5*(ypaprs(j,1)+ypplay(j,1))) & 2401 * (ypaprs(j,1)-ypplay(j,1)) 2402 tairsol_w(j) = tairsol(j) + (1.- ywake_s(j))*y_delta_tsurf(j) 2403 qairsol(j) = yqsurf(j) 2404 END DO 2405 !!! 2406 ENDIF ! (iflag_split .eq.0) 2407 !!! 2408 DO j=1, knon 2409 i = ni(j) 1214 2410 rugo1(j) = yrugos(j) 1215 2411 IF(nsrf.EQ.is_oce) THEN … … 1218 2414 psfce(j)=ypaprs(j,1) 1219 2415 patm(j)=ypplay(j,1) 1220 qairsol(j) = yqsurf(j)1221 2416 END DO 1222 2417 … … 1226 2421 1227 2422 ! Calculate the temperature et relative humidity at 2m and the wind at 10m 1228 CALL stdlevvar(klon, knon, nsrf, zxli, & 2423 !!! jyg le 07/02/2012 2424 IF (iflag_split .eq.0) THEN 2425 CALL stdlevvar(klon, knon, nsrf, zxli, & 1229 2426 uzon, vmer, tair1, qair1, zgeo1, & 1230 2427 tairsol, qairsol, rugo1, psfce, patm, & 1231 2428 yt2m, yq2m, yt10m, yq10m, yu10m, yustar) 1232 ! print*,'Dans pbl OK42B' 1233 1234 DO j=1, knon 2429 ELSE !(iflag_split .eq.0) 2430 CALL stdlevvar(klon, knon, nsrf, zxli, & 2431 uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, & 2432 tairsol_x, qairsol, rugo1, psfce, patm, & 2433 yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x) 2434 CALL stdlevvar(klon, knon, nsrf, zxli, & 2435 uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, & 2436 tairsol_w, qairsol, rugo1, psfce, patm, & 2437 yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w) 2438 !!! 2439 ENDIF ! (iflag_split .eq.0) 2440 !!! 2441 !!! jyg le 07/02/2012 2442 IF (iflag_split .eq.0) THEN 2443 DO j=1, knon 1235 2444 i = ni(j) 1236 2445 t2m(i,nsrf)=yt2m(j) 1237 2446 q2m(i,nsrf)=yq2m(j) 1238 1239 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 2447 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 1240 2448 ustar(i,nsrf)=yustar(j) 1241 2449 u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2) 1242 2450 v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2) 1243 1244 END DO 2451 END DO 2452 ELSE !(iflag_split .eq.0) 2453 DO j=1, knon 2454 i = ni(j) 2455 t2m_x(i,nsrf)=yt2m_x(j) 2456 q2m_x(i,nsrf)=yq2m_x(j) 2457 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 2458 ustar_x(i,nsrf)=yustar_x(j) 2459 u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2) 2460 v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2) 2461 END DO 2462 DO j=1, knon 2463 i = ni(j) 2464 t2m_w(i,nsrf)=yt2m_w(j) 2465 q2m_w(i,nsrf)=yq2m_w(j) 2466 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 2467 ustar_w(i,nsrf)=yustar_w(j) 2468 u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2) 2469 v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/SQRT(uzon_w(j)**2+vmer_w(j)**2) 2470 ! 2471 ustar(i,nsrf) = ustar_x(i,nsrf) + wake_s(i)*(ustar_w(i,nsrf)-ustar_x(i,nsrf)) 2472 u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf)) 2473 v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf)) 2474 END DO 2475 !!! 2476 ENDIF ! (iflag_split .eq.0) 2477 !!! 1245 2478 1246 2479 ! print*,'Dans pbl OK43' … … 1248 2481 !IM Ajoute dependance type surface 1249 2482 IF (thermcep) THEN 2483 !!! jyg le 07/02/2012 2484 IF (iflag_split .eq.0) THEN 1250 2485 DO j = 1, knon 1251 2486 i=ni(j) … … 1259 2494 qsat2m(i) = qsat2m(i) + zx_qs1 * pctsrf(i,nsrf) 1260 2495 END DO 2496 ELSE ! (iflag_split .eq.0) 2497 DO j = 1, knon 2498 i=ni(j) 2499 zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_x(j) )) 2500 zx_qs1 = r2es * FOEEW(yt2m_x(j),zdelta1)/paprs(i,1) 2501 zx_qs1 = MIN(0.5,zx_qs1) 2502 zcor1 = 1./(1.-RETV*zx_qs1) 2503 zx_qs1 = zx_qs1*zcor1 2504 2505 rh2m_x(i) = rh2m_x(i) + yq2m_x(j)/zx_qs1 * pctsrf(i,nsrf) 2506 qsat2m_x(i) = qsat2m_x(i) + zx_qs1 * pctsrf(i,nsrf) 2507 END DO 2508 DO j = 1, knon 2509 i=ni(j) 2510 zdelta1 = MAX(0.,SIGN(1., rtt-yt2m_w(j) )) 2511 zx_qs1 = r2es * FOEEW(yt2m_w(j),zdelta1)/paprs(i,1) 2512 zx_qs1 = MIN(0.5,zx_qs1) 2513 zcor1 = 1./(1.-RETV*zx_qs1) 2514 zx_qs1 = zx_qs1*zcor1 2515 2516 rh2m_w(i) = rh2m_w(i) + yq2m_w(j)/zx_qs1 * pctsrf(i,nsrf) 2517 qsat2m_w(i) = qsat2m_w(i) + zx_qs1 * pctsrf(i,nsrf) 2518 END DO 2519 !!! 2520 ENDIF ! (iflag_split .eq.0) 2521 !!! 1261 2522 END IF 2523 ! 2524 IF (prt_level >=10) THEN 2525 print *, 'T2m, q2m, RH2m ', & 2526 t2m, q2m, rh2m 2527 ENDIF 1262 2528 1263 2529 ! print*,'OK pbl 5' 1264 CALL hbtm(knon, ypaprs, ypplay, & 2530 ! 2531 !!! jyg le 07/02/2012 2532 IF (iflag_split .eq.0) THEN 2533 CALL hbtm(knon, ypaprs, ypplay, & 1265 2534 yt2m,yt10m,yq2m,yq10m,yustar,ywstar, & 1266 2535 y_flux_t,y_flux_q,yu,yv,yt,yq, & 1267 2536 ypblh,ycapCL,yoliqCL,ycteiCL,ypblT, & 1268 2537 ytherm,ytrmb1,ytrmb2,ytrmb3,ylcl) 2538 IF (prt_level >=10) THEN 2539 print *,' Arg. de HBTM: yt2m ',yt2m 2540 print *,' Arg. de HBTM: yt10m ',yt10m 2541 print *,' Arg. de HBTM: yq2m ',yq2m 2542 print *,' Arg. de HBTM: yq10m ',yq10m 2543 print *,' Arg. de HBTM: yustar ',yustar 2544 print *,' Arg. de HBTM: y_flux_t ',y_flux_t 2545 print *,' Arg. de HBTM: y_flux_q ',y_flux_q 2546 print *,' Arg. de HBTM: yu ',yu 2547 print *,' Arg. de HBTM: yv ',yv 2548 print *,' Arg. de HBTM: yt ',yt 2549 print *,' Arg. de HBTM: yq ',yq 2550 ENDIF 2551 ELSE ! (iflag_split .eq.0) 2552 CALL HBTM(knon, ypaprs, ypplay, & 2553 yt2m_x,yt10m_x,yq2m_x,yq10m_x,yustar_x,ywstar_x, & 2554 y_flux_t_x,y_flux_q_x,yu_x,yv_x,yt_x,yq_x, & 2555 ypblh_x,ycapCL_x,yoliqCL_x,ycteiCL_x,ypblT_x, & 2556 ytherm_x,ytrmb1_x,ytrmb2_x,ytrmb3_x,ylcl_x) 2557 IF (prt_level >=10) THEN 2558 print *,' Arg. de HBTM: yt2m_x ',yt2m_x 2559 print *,' Arg. de HBTM: yt10m_x ',yt10m_x 2560 print *,' Arg. de HBTM: yq2m_x ',yq2m_x 2561 print *,' Arg. de HBTM: yq10m_x ',yq10m_x 2562 print *,' Arg. de HBTM: yustar_x ',yustar_x 2563 print *,' Arg. de HBTM: y_flux_t_x ',y_flux_t_x 2564 print *,' Arg. de HBTM: y_flux_q_x ',y_flux_q_x 2565 print *,' Arg. de HBTM: yu_x ',yu_x 2566 print *,' Arg. de HBTM: yv_x ',yv_x 2567 print *,' Arg. de HBTM: yt_x ',yt_x 2568 print *,' Arg. de HBTM: yq_x ',yq_x 2569 ENDIF 2570 CALL HBTM(knon, ypaprs, ypplay, & 2571 yt2m_w,yt10m_w,yq2m_w,yq10m_w,yustar_w,ywstar_w, & 2572 y_flux_t_w,y_flux_q_w,yu_w,yv_w,yt_w,yq_w, & 2573 ypblh_w,ycapCL_w,yoliqCL_w,ycteiCL_w,ypblT_w, & 2574 ytherm_w,ytrmb1_w,ytrmb2_w,ytrmb3_w,ylcl_w) 2575 !!! 2576 ENDIF ! (iflag_split .eq.0) 2577 !!! 1269 2578 1270 DO j=1, knon 2579 !!! jyg le 07/02/2012 2580 IF (iflag_split .eq.0) THEN 2581 !!! 2582 DO j=1, knon 1271 2583 i = ni(j) 1272 2584 pblh(i,nsrf) = ypblh(j) … … 1281 2593 trmb2(i,nsrf) = ytrmb2(j) 1282 2594 trmb3(i,nsrf) = ytrmb3(j) 1283 END DO 1284 2595 END DO 2596 IF (prt_level >=10) THEN 2597 print *, 'After HBTM: pblh ', pblh 2598 print *, 'After HBTM: plcl ', plcl 2599 print *, 'After HBTM: cteiCL ', cteiCL 2600 ENDIF 2601 ELSE !(iflag_split .eq.0) 2602 DO j=1, knon 2603 i = ni(j) 2604 pblh_x(i,nsrf) = ypblh_x(j) 2605 wstar_x(i,nsrf) = ywstar_x(j) 2606 plcl_x(i,nsrf) = ylcl_x(j) 2607 capCL_x(i,nsrf) = ycapCL_x(j) 2608 oliqCL_x(i,nsrf) = yoliqCL_x(j) 2609 cteiCL_x(i,nsrf) = ycteiCL_x(j) 2610 pblT_x(i,nsrf) = ypblT_x(j) 2611 therm_x(i,nsrf) = ytherm_x(j) 2612 trmb1_x(i,nsrf) = ytrmb1_x(j) 2613 trmb2_x(i,nsrf) = ytrmb2_x(j) 2614 trmb3_x(i,nsrf) = ytrmb3_x(j) 2615 END DO 2616 IF (prt_level >=10) THEN 2617 print *, 'After HBTM: pblh_x ', pblh_x 2618 print *, 'After HBTM: plcl_x ', plcl_x 2619 print *, 'After HBTM: cteiCL_x ', cteiCL_x 2620 ENDIF 2621 DO j=1, knon 2622 i = ni(j) 2623 pblh_w(i,nsrf) = ypblh_w(j) 2624 wstar_w(i,nsrf) = ywstar_w(j) 2625 plcl_w(i,nsrf) = ylcl_w(j) 2626 capCL_w(i,nsrf) = ycapCL_w(j) 2627 oliqCL_w(i,nsrf) = yoliqCL_w(j) 2628 cteiCL_w(i,nsrf) = ycteiCL_w(j) 2629 pblT_w(i,nsrf) = ypblT_w(j) 2630 therm_w(i,nsrf) = ytherm_w(j) 2631 trmb1_w(i,nsrf) = ytrmb1_w(j) 2632 trmb2_w(i,nsrf) = ytrmb2_w(j) 2633 trmb3_w(i,nsrf) = ytrmb3_w(j) 2634 END DO 2635 IF (prt_level >=10) THEN 2636 print *, 'After HBTM: pblh_w ', pblh_w 2637 print *, 'After HBTM: plcl_w ', plcl_w 2638 print *, 'After HBTM: cteiCL_w ', cteiCL_w 2639 ENDIF 2640 !!! 2641 ENDIF ! (iflag_split .eq.0) 2642 !!! 2643 1285 2644 ! print*,'OK pbl 6' 1286 2645 #else … … 1297 2656 1298 2657 !**************************************************************************************** 1299 ! 16) Calculate the mean value over all sub-surfaces for som variables2658 ! 16) Calculate the mean value over all sub-surfaces for some variables 1300 2659 ! 1301 2660 !**************************************************************************************** … … 1304 2663 zxfluxt(:,:) = 0.0 ; zxfluxq(:,:) = 0.0 1305 2664 zxfluxu(:,:) = 0.0 ; zxfluxv(:,:) = 0.0 2665 zxfluxt_x(:,:) = 0.0 ; zxfluxq_x(:,:) = 0.0 2666 zxfluxu_x(:,:) = 0.0 ; zxfluxv_x(:,:) = 0.0 2667 zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0 2668 zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0 2669 2670 !!! jyg le 07/02/2012 2671 IF (iflag_split .eq.1) THEN 2672 !!! 2673 !!! nrlmd & jyg les 02/05/2011, 05/02/2012 2674 2675 DO nsrf = 1, nbsrf 2676 DO k = 1, klev 2677 DO i = 1, klon 2678 zxfluxt_x(i,k) = zxfluxt_x(i,k) + flux_t_x(i,k,nsrf) * pctsrf(i,nsrf) 2679 zxfluxq_x(i,k) = zxfluxq_x(i,k) + flux_q_x(i,k,nsrf) * pctsrf(i,nsrf) 2680 zxfluxu_x(i,k) = zxfluxu_x(i,k) + flux_u_x(i,k,nsrf) * pctsrf(i,nsrf) 2681 zxfluxv_x(i,k) = zxfluxv_x(i,k) + flux_v_x(i,k,nsrf) * pctsrf(i,nsrf) 2682 ! 2683 zxfluxt_w(i,k) = zxfluxt_w(i,k) + flux_t_w(i,k,nsrf) * pctsrf(i,nsrf) 2684 zxfluxq_w(i,k) = zxfluxq_w(i,k) + flux_q_w(i,k,nsrf) * pctsrf(i,nsrf) 2685 zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf) 2686 zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf) 2687 END DO 2688 END DO 2689 END DO 2690 2691 DO i = 1, klon 2692 zxsens_x(i) = - zxfluxt_x(i,1) 2693 zxsens_w(i) = - zxfluxt_w(i,1) 2694 END DO 2695 !!! 2696 ENDIF ! (iflag_split .eq.1) 2697 !!! 2698 1306 2699 DO nsrf = 1, nbsrf 1307 2700 DO k = 1, klev … … 1315 2708 END DO 1316 2709 1317 ! print*,'OK pbl 8'1318 2710 DO i = 1, klon 1319 2711 zxsens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol … … 1321 2713 fder_print(i) = fder(i) + dflux_t(i) + dflux_q(i) 1322 2714 ENDDO 2715 !!! 1323 2716 1324 2717 ! … … 1329 2722 zustar(:)=0.0 ; zu10m(:) = 0.0 ; zv10m(:) = 0.0 1330 2723 s_pblh(:) = 0.0 ; s_plcl(:) = 0.0 2724 !!! jyg le 07/02/2012 2725 s_pblh_x(:) = 0.0 ; s_plcl_x(:) = 0.0 2726 s_pblh_w(:) = 0.0 ; s_plcl_w(:) = 0.0 2727 !!! 1331 2728 s_capCL(:) = 0.0 ; s_oliqCL(:) = 0.0 1332 2729 s_cteiCL(:) = 0.0; s_pblT(:) = 0.0 … … 1336 2733 1337 2734 ! print*,'OK pbl 9' 2735 2736 !!! nrlmd le 02/05/2011 2737 zxfluxlat_x(:) = 0.0 ; zxfluxlat_w(:) = 0.0 2738 !!! 1338 2739 1339 2740 DO nsrf = 1, nbsrf … … 1348 2749 zxtsol(i) = zxtsol(i) + ts(i,nsrf) * pctsrf(i,nsrf) 1349 2750 zxfluxlat(i) = zxfluxlat(i) + fluxlat(i,nsrf) * pctsrf(i,nsrf) 2751 END DO 2752 END DO 1350 2753 2754 !!! jyg le 07/02/2012 2755 IF (iflag_split .eq.0) THEN 2756 DO nsrf = 1, nbsrf 2757 DO i = 1, klon 1351 2758 zt2m(i) = zt2m(i) + t2m(i,nsrf) * pctsrf(i,nsrf) 1352 2759 zq2m(i) = zq2m(i) + q2m(i,nsrf) * pctsrf(i,nsrf) … … 1366 2773 s_trmb2(i) = s_trmb2(i) + trmb2(i,nsrf) * pctsrf(i,nsrf) 1367 2774 s_trmb3(i) = s_trmb3(i) + trmb3(i,nsrf) * pctsrf(i,nsrf) 1368 END DO 1369 END DO 1370 ! print*,'OK pbl 10' 2775 END DO 2776 END DO 2777 ELSE !(iflag_split .eq.0) 2778 DO nsrf = 1, nbsrf 2779 DO i = 1, klon 2780 !!! nrlmd le 02/05/2011 2781 zxfluxlat_x(i) = zxfluxlat_x(i) + fluxlat_x(i,nsrf) * pctsrf(i,nsrf) 2782 zxfluxlat_w(i) = zxfluxlat_w(i) + fluxlat_w(i,nsrf) * pctsrf(i,nsrf) 2783 !!! 2784 !!! jyg le 08/02/2012 2785 !! Pour le moment, on sort les valeurs dans (x) et (w) de pblh et de plcl ; 2786 !! pour zt2m, on fait la moyenne surfacique sur les sous-surfaces ; 2787 !! pour qsat2m, on fait la moyenne surfacique sur (x) et (w) ; 2788 !! pour les autres variables, on sort les valeurs de la region (x). 2789 zt2m(i) = zt2m(i) + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf) 2790 zq2m(i) = zq2m(i) + q2m_x(i,nsrf) * pctsrf(i,nsrf) 2791 zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf) 2792 wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf) 2793 zu10m(i) = zu10m(i) + u10m_x(i,nsrf) * pctsrf(i,nsrf) 2794 zv10m(i) = zv10m(i) + v10m_x(i,nsrf) * pctsrf(i,nsrf) 2795 ! 2796 s_pblh(i) = s_pblh(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf) 2797 s_pblh_x(i) = s_pblh_x(i) + pblh_x(i,nsrf) * pctsrf(i,nsrf) 2798 s_pblh_w(i) = s_pblh_w(i) + pblh_w(i,nsrf) * pctsrf(i,nsrf) 2799 ! 2800 s_plcl(i) = s_plcl(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf) 2801 s_plcl_x(i) = s_plcl_x(i) + plcl_x(i,nsrf) * pctsrf(i,nsrf) 2802 s_plcl_w(i) = s_plcl_w(i) + plcl_w(i,nsrf) * pctsrf(i,nsrf) 2803 ! 2804 s_capCL(i) = s_capCL(i) + capCL_x(i,nsrf) * pctsrf(i,nsrf) 2805 s_oliqCL(i) = s_oliqCL(i) + oliqCL_x(i,nsrf)* pctsrf(i,nsrf) 2806 s_cteiCL(i) = s_cteiCL(i) + cteiCL_x(i,nsrf)* pctsrf(i,nsrf) 2807 s_pblT(i) = s_pblT(i) + pblT_x(i,nsrf) * pctsrf(i,nsrf) 2808 s_therm(i) = s_therm(i) + therm_x(i,nsrf) * pctsrf(i,nsrf) 2809 s_trmb1(i) = s_trmb1(i) + trmb1_x(i,nsrf) * pctsrf(i,nsrf) 2810 s_trmb2(i) = s_trmb2(i) + trmb2_x(i,nsrf) * pctsrf(i,nsrf) 2811 s_trmb3(i) = s_trmb3(i) + trmb3_x(i,nsrf) * pctsrf(i,nsrf) 2812 END DO 2813 END DO 2814 DO i = 1, klon 2815 qsat2m(i)= qsat2m_x(i)+ wake_s(i)*(qsat2m_x(i)-qsat2m_w(i)) 2816 END DO 2817 !!! 2818 ENDIF ! (iflag_split .eq.0) 2819 !!! 1371 2820 1372 2821 IF (check) THEN … … 1508 2957 REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: alb1, alb2 1509 2958 REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: ustar,u10m, v10m 1510 REAL, DIMENSION(klon,klev+1,nbsrf ), INTENT(INOUT) :: tke2959 REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke 1511 2960 1512 2961 ! Local variables … … 1597 3046 1598 3047 END MODULE pbl_surface_mod 3048
Note: See TracChangeset
for help on using the changeset viewer.
