Changeset 5791 for LMDZ6/branches/contrails/libf/phylmd/pbl_surface_mod.F90
- Timestamp:
- Jul 28, 2025, 7:23:15 PM (6 days ago)
- Location:
- LMDZ6/branches/contrails
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/pbl_surface_mod.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/contrails
- Property svn:mergeinfo changed
/LMDZ6/trunk merged: 5654-5683,5685-5690,5692-5715,5718-5721,5726-5727,5729,5744-5761,5763-5778,5780,5785-5789
- Property svn:mergeinfo changed
-
LMDZ6/branches/contrails/libf/phylmd/pbl_surface_mod.F90
r5717 r5791 14 14 USE mod_grid_phy_lmdz, ONLY : klon_glo 15 15 USE ioipsl 16 USE surface_data, ONLY : type_ocean, ok_veget, landice_opt 16 USE surface_data, ONLY : type_ocean, ok_veget, landice_opt, iflag_leads 17 17 USE surf_land_mod, ONLY : surf_land 18 18 USE surf_landice_mod, ONLY : surf_landice … … 42 42 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: fder ! flux drift 43 43 !$OMP THREADPRIVATE(fder) 44 !GG 45 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: hice ! flux drift 46 !$OMP THREADPRIVATE(hice) 47 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: tice ! flux drift 48 !$OMP THREADPRIVATE(tice) 49 REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: bilg_cumul ! flux drift 50 !$OMP THREADPRIVATE(bilg_cumul) 51 !GG 44 52 REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE :: snow ! snow at surface 45 53 !$OMP THREADPRIVATE(snow) … … 68 76 !$OMP THREADPRIVATE(ok_bug_zg_wk_pbl) 69 77 78 79 !JYG< 80 REAL, SAVE, PROTECTED :: smallestreal 81 !$OMP THREADPRIVATE(smallestreal) 82 70 83 !FC 71 84 ! integer, save :: iflag_frein … … 76 89 !**************************************************************************************** 77 90 ! 78 SUBROUTINE pbl_surface_init(fder_rst, snow_rst, qsurf_rst, ftsoil_rst) 91 !GG 92 ! SUBROUTINE pbl_surface_init(fder_rst, snow_rst, qsurf_rst, ftsoil_rst) 93 SUBROUTINE pbl_surface_init(fder_rst, snow_rst, qsurf_rst, ftsoil_rst, hice_rst,tice_rst,bilg_cumul_rst) 94 !GG 79 95 80 96 ! This routine should be called after the restart file has been read. … … 91 107 !**************************************************************************************** 92 108 REAL, DIMENSION(klon), INTENT(IN) :: fder_rst 109 !GG 110 REAL, DIMENSION(klon), INTENT(IN) :: hice_rst 111 REAL, DIMENSION(klon), INTENT(IN) :: tice_rst 112 REAL, DIMENSION(klon), INTENT(IN) :: bilg_cumul_rst 113 !GG 93 114 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: snow_rst 94 115 REAL, DIMENSION(klon, nbsrf), INTENT(IN) :: qsurf_rst … … 100 121 CHARACTER(len=80) :: abort_message 101 122 CHARACTER(len = 20) :: modname = 'pbl_surface_init' 123 124 !**************************************************************************************** 125 ! Initialize some module variables 126 !**************************************************************************************** 127 smallestreal = tiny(smallestreal) 102 128 103 129 !**************************************************************************************** … … 105 131 ! 106 132 !**************************************************************************************** 133 107 134 ALLOCATE(fder(klon), stat=ierr) 108 135 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1) 109 136 137 !GG 138 ALLOCATE(hice(klon), stat=ierr) 139 IF (ierr /= 0) CALL abort_physic('pbl_surface_init hice', 'pb in allocation',1) 140 141 ALLOCATE(tice(klon), stat=ierr) 142 IF (ierr /= 0) CALL abort_physic('pbl_surface_init tice', 'pb in allocation',1) 143 144 ALLOCATE(bilg_cumul(klon), stat=ierr) 145 IF (ierr /= 0) CALL abort_physic('pbl_surface_init bilg', 'pb in allocation',1) 146 !GG 147 110 148 ALLOCATE(snow(klon,nbsrf), stat=ierr) 111 149 IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1) … … 124 162 125 163 fder(:) = fder_rst(:) 164 !GG 165 hice(:) = hice_rst(:) 166 tice(:) = tice_rst(:) 167 bilg_cumul(:) = bilg_cumul_rst(:) 168 !GG 126 169 snow(:,:) = snow_rst(:,:) 127 170 qsurf(:,:) = qsurf_rst(:,:) … … 261 304 debut, lafin, & 262 305 rlon, rlat, rugoro, rmu0, & 263 lwdown_m, cldt, & 306 !GG lwdown_m, cldt, & 307 lwdown_m, pphi, cldt, & 308 !GG 264 309 rain_f, snow_f, bs_f, solsw_m, solswfdiff_m, sollw_m, & 265 310 gustiness, & … … 312 357 !!! nrlmd+jyg le 02/05/2011 et le 20/02/2012 313 358 !! tke_x, tke_w & 314 wake_dltke, & 315 treedrg, & 359 wake_dltke, & 360 !GG treedrg & 361 treedrg,hice ,tice, bilg_cumul, & 362 fcds, fcdi, dh_basal_growth, dh_basal_melt, & 363 dh_top_melt, dh_snow2sic, & 364 dtice_melt, dtice_snow2sic , & 365 !GG 316 366 !FC 317 367 !AM heterogeneous continental sub-surfaces … … 369 419 ! cldt-----input-R- total cloud fraction 370 420 ! Martin 421 !GG 422 ! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol) 423 !GG 371 424 ! 372 425 ! d_t------output-R- le changement pour "t" … … 470 523 REAL, DIMENSION(klon), INTENT(IN) :: gustiness ! gustiness 471 524 525 !GG 526 REAL, DIMENSION(klon,klev), INTENT(IN) :: pphi ! geopotential (m2/s2) 527 !GG 472 528 REAL, DIMENSION(klon), INTENT(IN) :: cldt ! total cloud 473 529 … … 679 735 REAL, DIMENSION(klon), INTENT(OUT) :: runoff ! runoff on land ice 680 736 ! Martin 737 !GG 738 REAL, DIMENSION(klon), INTENT(INOUT) :: hice ! hice 739 REAL, DIMENSION(klon), INTENT(INOUT) :: tice ! tice 740 REAL, DIMENSION(klon), INTENT(INOUT) :: bilg_cumul ! flux cumulated 741 REAL, DIMENSION(klon), INTENT(INOUT) :: fcds 742 REAL, DIMENSION(klon), INTENT(INOUT) :: fcdi 743 REAL, DIMENSION(klon), INTENT(INOUT) :: dh_basal_growth 744 REAL, DIMENSION(klon), INTENT(INOUT) :: dh_basal_melt 745 REAL, DIMENSION(klon), INTENT(INOUT) :: dh_top_melt 746 REAL, DIMENSION(klon), INTENT(INOUT) :: dh_snow2sic 747 REAL, DIMENSION(klon), INTENT(INOUT) :: dtice_melt 748 REAL, DIMENSION(klon), INTENT(INOUT) :: dtice_snow2sic 749 !GG 681 750 682 751 ! Local variables with attribute SAVE … … 1075 1144 ! dt_ds, tkt, tks, taur, sss on ocean points 1076 1145 REAL :: missing_val 1146 1147 ! GG 1148 REAL, DIMENSION(klon,klev) :: ytheta 1149 REAL, DIMENSION(klon,klev) :: ypphii 1150 REAL, DIMENSION(klon,klev) :: ypphi 1151 REAL, DIMENSION(klon,klev) :: ydthetadz 1152 REAL, DIMENSION(klon) :: ydthetadz300 1153 REAL, DIMENSION(klon) :: Ampl 1154 ! GG 1155 1077 1156 ! AM ! 1078 1157 REAL, DIMENSION(klon) :: z0m_eff, z0h_eff, ratio_z0m_z0h_eff, albedo_eff … … 1398 1477 yfields_out(:,:) = 0. 1399 1478 ! << PC 1479 1480 !GG 1481 ypphi = 0.0 1482 !GG 1400 1483 1401 1484 … … 1796 1879 yq(j,k) = q(i,k) 1797 1880 yqbs(j,k)=qbs(i,k) 1881 !! GG 1882 ypphi(j,k) = pphi(i,k) 1883 !! 1884 1798 1885 #ifdef ISO 1799 1886 DO ixt=1,ntraciso … … 2491 2578 cdragm_tersrf, cdragh_tersrf, & 2492 2579 swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf & 2580 !GG 2581 ! yveget,ylai,yheight,hice,tice,bilg_cumul, & 2582 ! fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, & 2583 ! dtice_melt, dtice_snow2sic) 2584 !GG 2493 2585 #ifdef ISO 2494 2586 & ,yxtrain_f, yxtsnow_f,yxt1, & … … 2625 2717 2626 2718 CASE(is_oce) 2719 2720 !GG 2721 ! calculate length scale PBL 2722 2723 if (iflag_leads == 1) then 2724 ydthetadz = 999999. 2725 ypphii = 999999. 2726 ytheta = 999999. 2727 2728 DO k = 1, klev 2729 DO j = 1, knon 2730 ytheta(j,k) = yt(j,k)*(ypplay(j,k)/1.e5)**(RD/RCPD) 2731 ENDDO 2732 ENDDO 2733 2734 DO k = 2, klev 2735 DO j = 1, knon 2736 ydthetadz(j,k) = RG*( ytheta(j,k) - ytheta(j,k-1) ) / ( ypphi(j,k) - ypphi(j,k-1) ) 2737 ypphii(j,k) = (ypphi(j,k)+ypphi(j,k-1))/(RG*2.) 2738 ENDDO 2739 ENDDO 2740 2741 DO j = 1, knon 2742 ! print *, "ypphii(j,:)=", ypphii(j,:) 2743 ! print *, "ypplay(j,:)=", ypplay(j,:) 2744 ! print *, "ytheta(j,:)=", ytheta(j,:) 2745 ! print *, "minloc(abs(ypphii(j,:)-300))=", 2746 ! minloc(abs(ypphii(j,:)-300),1) 2747 k= minloc(abs(ypphii(j,:)-300),1) 2748 ydthetadz300(j)=ydthetadz(j,k) 2749 ENDDO 2750 end if 2751 !GG 2627 2752 CALL surf_ocean(rlon, rlat, ysolsw, ysollw, yalb_vis, & 2628 2753 ywindsp, rmu0, yfder, yts, & … … 2638 2763 y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), & 2639 2764 yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), & 2640 ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss & 2765 !GG ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss) 2766 ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss, & 2767 ydthetadz300,Ampl & 2768 !GG 2641 2769 #ifdef ISO 2642 2770 & ,yxtrain_f, yxtsnow_f,yxt1,Roce, & … … 2684 2812 !albedo SB <<< 2685 2813 ytsurf_new, y_dflux_t, y_dflux_q, & 2686 y_flux_u1, y_flux_v1 & 2814 !GG y_flux_u1, y_flux_v1) 2815 y_flux_u1, y_flux_v1, & 2816 hice,tice,bilg_cumul, & 2817 fcds, fcdi, dh_basal_growth, dh_basal_melt, dh_top_melt, dh_snow2sic, & 2818 dtice_melt, dtice_snow2sic & 2819 !GG 2687 2820 #ifdef ISO 2688 2821 & ,yxtrain_f, yxtsnow_f,yxt1,Roce, & … … 3729 3862 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 3730 3863 ustar(i,nsrf)=yustar(j) 3731 u10m(i,nsrf)=(yu10m(j) * uzon(j))/ SQRT(uzon(j)**2+vmer(j)**2)3732 v10m(i,nsrf)=(yu10m(j) * vmer(j))/ SQRT(uzon(j)**2+vmer(j)**2)3864 u10m(i,nsrf)=(yu10m(j) * uzon(j))/max(SQRT(uzon(j)**2+vmer(j)**2), smallestreal) 3865 v10m(i,nsrf)=(yu10m(j) * vmer(j))/max(SQRT(uzon(j)**2+vmer(j)**2), smallestreal) 3733 3866 ! 3734 3867 DO k = 1, 6 … … 3744 3877 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 3745 3878 ustar_x(i,nsrf)=yustar_x(j) 3746 u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/ SQRT(uzon_x(j)**2+vmer_x(j)**2)3747 v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/ SQRT(uzon_x(j)**2+vmer_x(j)**2)3879 u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/max(SQRT(uzon_x(j)**2+vmer_x(j)**2), smallestreal) 3880 v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/max(SQRT(uzon_x(j)**2+vmer_x(j)**2), smallestreal) 3748 3881 ! 3749 3882 DO k = 1, 6 … … 3758 3891 ! u10m, v10m : composantes du vent a 10m sans spirale de Ekman 3759 3892 ustar_w(i,nsrf)=yustar_w(j) 3760 u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/ SQRT(uzon_w(j)**2+vmer_w(j)**2)3761 v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/ SQRT(uzon_w(j)**2+vmer_w(j)**2)3893 u10m_w(i,nsrf)=(yu10m_w(j) * uzon_w(j))/max(SQRT(uzon_w(j)**2+vmer_w(j)**2), smallestreal) 3894 v10m_w(i,nsrf)=(yu10m_w(j) * vmer_w(j))/max(SQRT(uzon_w(j)**2+vmer_w(j)**2), smallestreal) 3762 3895 ! 3763 3896 ustar(i,nsrf) = ustar_x(i,nsrf) + wake_s(i)*(ustar_w(i,nsrf)-ustar_x(i,nsrf)) … … 4320 4453 ! DEALLOCATE(qsol, fder, snow, qsurf, evap, rugos, agesno, ftsoil) 4321 4454 IF (ALLOCATED(fder)) DEALLOCATE(fder) 4455 IF (ALLOCATED(hice)) DEALLOCATE(hice) 4456 IF (ALLOCATED(tice)) DEALLOCATE(tice) 4457 IF (ALLOCATED(bilg_cumul)) DEALLOCATE(bilg_cumul) 4322 4458 IF (ALLOCATED(snow)) DEALLOCATE(snow) 4323 4459 IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
Note: See TracChangeset
for help on using the changeset viewer.
