From cbbc106fdba491398b9ccfab7d658744a9f4dda1 Mon Sep 17 00:00:00 2001 From: "Yihua.Wu" Date: Mon, 8 Aug 2022 14:07:41 +0000 Subject: [PATCH 01/46] Updated Flake physics and modified related files --- physics/GFS_phys_time_vary.fv3.F90 | 21 +- physics/GFS_phys_time_vary.fv3.meta | 30 ++ physics/GFS_radiation_surface.F90 | 3 +- physics/GFS_radiation_surface.meta | 2 +- physics/GFS_surface_composites_inter.F90 | 9 +- physics/GFS_surface_composites_inter.meta | 11 +- physics/GFS_surface_composites_post.F90 | 14 +- physics/GFS_surface_composites_pre.F90 | 23 +- physics/GFS_surface_composites_pre.meta | 4 +- physics/flake.F90 | 83 ++++-- physics/flake_driver.F90 | 316 ++++++++++++++-------- physics/flake_driver.meta | 282 +++++++++++++++++-- physics/lsm_ruc.F90 | 5 +- physics/lsm_ruc.meta | 2 +- physics/radiation_surface.f | 4 +- physics/sfc_diff.f | 9 +- physics/sfc_diff.meta | 9 +- physics/sfc_nst.f | 12 +- physics/sfc_nst.meta | 4 +- physics/sfc_nst_post.f | 5 +- physics/sfc_nst_post.meta | 2 +- physics/sfc_ocean.F | 5 +- physics/sfc_ocean.meta | 2 +- physics/sfc_sice.f | 5 +- physics/sfc_sice.meta | 2 +- 25 files changed, 656 insertions(+), 208 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 3c5a5af9b..25e5218d5 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -82,7 +82,7 @@ subroutine GFS_phys_time_vary_init ( zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & - errmsg, errflg) + lkm, use_flake, lakefrac, lakedepth, errmsg, errflg) implicit none @@ -93,6 +93,10 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(in) :: fhour real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) + integer, intent(in) :: lkm + integer, intent(inout) :: use_flake(:) + real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) + integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) real(kind_phys), intent(inout) :: ddy_o3(:), ddy_h(:) real(kind_phys), intent(in) :: ozpl(:,:,:), h2opl(:,:,:) @@ -672,6 +676,21 @@ subroutine GFS_phys_time_vary_init ( endif noahmp_init endif lsm_init +!Flake + do i = 1, im + if (lakefrac(i) > 0.0 .and. lakedepth(i) > 1.0 ) then + if (lkm == 1 ) then + use_flake(i) = 1 + elseif (lkm == 2 ) then + use_flake(i) = 2 + else + use_flake(i) = 0 + endif + else + use_flake(i) = 0 + endif + enddo + is_initialized = .true. contains diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index f37235975..c8f178bf3 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -895,6 +895,36 @@ dimensions = () type = integer intent = in +[lkm] + standard_name = control_for_lake_surface_scheme + long_name = flag for lake surface model + units = flag + dimensions = () + type = integer + intent = in +[use_flake] + standard_name = flag_for_using_flake + long_name = flag indicating lake points using flake model + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in +[lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 index 73de41282..07c87414e 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/GFS_radiation_surface.F90 @@ -67,7 +67,8 @@ subroutine GFS_radiation_surface_run ( & logical, intent(in) :: frac_grid, lslwr, lsswr, use_cice_alb, cplice integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice - logical, dimension(:), intent(in) :: use_flake + + integer, dimension(:), intent(in) :: use_flake real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, slmsk, & sfc_alb_pert, lndp_prt_list, & diff --git a/physics/GFS_radiation_surface.meta b/physics/GFS_radiation_surface.meta index 3fd851a40..e9de370e8 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/GFS_radiation_surface.meta @@ -291,7 +291,7 @@ long_name = flag indicating lake points using flake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer intent = inout [alvsf] standard_name = vis_albedo_strong_cosz diff --git a/physics/GFS_surface_composites_inter.F90 b/physics/GFS_surface_composites_inter.F90 index 0e288691c..715b85518 100644 --- a/physics/GFS_surface_composites_inter.F90 +++ b/physics/GFS_surface_composites_inter.F90 @@ -18,17 +18,19 @@ module GFS_surface_composites_inter !! subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis_lnd, semis_ice, & adjsfcdlw, gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat,& - adjsfcusw, adjsfcdsw, adjsfcnsw, errmsg, errflg) + adjsfcusw, adjsfcdsw, adjsfcnsw, use_flake, errmsg, errflg) implicit none ! Interface variables integer, intent(in ) :: im - logical, dimension(:), intent(in ) :: dry, icy, wet + logical, dimension(:), intent(in ) :: dry, icy + logical, dimension(:), intent(inout) :: wet real(kind=kind_phys), dimension(:), intent(in ) :: semis_wat, semis_lnd, semis_ice, & adjsfcdlw, adjsfcdsw, adjsfcnsw real(kind=kind_phys), dimension(:), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat real(kind=kind_phys), dimension(:), intent(out) :: adjsfcusw + integer, dimension(:), intent(in) :: use_flake ! CCPP error handling character(len=*), intent(out) :: errmsg @@ -60,6 +62,7 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis ! --- ... define the downward lw flux absorbed by ground do i=1,im + if(use_flake(i)>0.0) wet(i)=.true. if (dry(i)) gabsbdlw_lnd(i) = semis_lnd(i) * adjsfcdlw(i) if (icy(i)) gabsbdlw_ice(i) = semis_ice(i) * adjsfcdlw(i) if (wet(i)) gabsbdlw_wat(i) = semis_wat(i) * adjsfcdlw(i) @@ -68,4 +71,4 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis end subroutine GFS_surface_composites_inter_run -end module GFS_surface_composites_inter \ No newline at end of file +end module GFS_surface_composites_inter diff --git a/physics/GFS_surface_composites_inter.meta b/physics/GFS_surface_composites_inter.meta index 00227a09b..2ed966d01 100644 --- a/physics/GFS_surface_composites_inter.meta +++ b/physics/GFS_surface_composites_inter.meta @@ -35,7 +35,7 @@ units = flag dimensions = (horizontal_loop_extent) type = logical - intent = in + intent = inout [semis_wat] standard_name = surface_longwave_emissivity_over_water long_name = surface lw emissivity in fraction over water @@ -116,6 +116,13 @@ type = real kind = kind_phys intent = in +[use_flake] + standard_name = flag_for_using_flake + long_name = flag indicating lake points using flake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -130,4 +137,4 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out diff --git a/physics/GFS_surface_composites_post.F90 b/physics/GFS_surface_composites_post.F90 index f39ccb77e..62c014417 100644 --- a/physics/GFS_surface_composites_post.F90 +++ b/physics/GFS_surface_composites_post.F90 @@ -40,7 +40,8 @@ subroutine GFS_surface_composites_post_run ( integer, intent(in) :: im, kice, km logical, intent(in) :: cplflx, frac_grid, cplwav2atm logical, intent(in) :: lheatstrg - logical, dimension(:), intent(in) :: flag_cice, dry, wet, icy + logical, dimension(:), intent(in) :: flag_cice, dry, icy + logical, dimension(:), intent(inout) :: wet integer, dimension(:), intent(in) :: islmsk real(kind=kind_phys), dimension(:), intent(in) :: wind, t1, q1, prsl1, landfrac, lakefrac, oceanfrac, & cd_wat, cd_lnd, cd_ice, cdq_wat, cdq_lnd, cdq_ice, rb_wat, rb_lnd, rb_ice, stress_wat, & @@ -87,6 +88,11 @@ subroutine GFS_surface_composites_post_run ( errflg = 0 ! --- generate ocean/land/ice composites + do i=1, im + if(lakefrac(i)>0.0) then + wet(i) = .true. + endif + enddo if (frac_grid) then @@ -263,7 +269,8 @@ subroutine GFS_surface_composites_post_run ( else do i=1,im - if (islmsk(i) == 1) then +! if (islmsk(i) == 1) then + if (dry(i)) then !-- land zorl(i) = zorll(i) cd(i) = cd_lnd(i) @@ -289,7 +296,8 @@ subroutine GFS_surface_composites_post_run ( qss(i) = qss_lnd(i) hice(i) = zero cice(i) = zero - elseif (islmsk(i) == 0) then +! elseif (islmsk(i) == 0) then + elseif (wet(i)) then !-- water zorl(i) = zorlo(i) cd(i) = cd_wat(i) diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/GFS_surface_composites_pre.F90 index 734f1965b..04ce7e314 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/GFS_surface_composites_pre.F90 @@ -38,7 +38,8 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, integer, intent(in ) :: im, lkm, kdt, lsm, lsm_ruc logical, intent(in ) :: cplflx, cplice, cplwav2atm, frac_grid logical, dimension(:), intent(inout) :: flag_cice - logical, dimension(:), intent(inout) :: dry, icy, lake, use_flake, wet + logical, dimension(:), intent(inout) :: dry, icy, lake, wet + integer, dimension(:), intent(inout) :: use_flake real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice real(kind=kind_phys), dimension(:), intent( out) :: frland @@ -71,6 +72,12 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, errmsg = '' errflg = 0 + do i=1,im + if(use_flake(i) > 0.0) then + wet(i) = .true. + endif + enddo + if (frac_grid) then ! cice is ice fraction wrt water area do i=1,im frland(i) = landfrac(i) @@ -239,20 +246,6 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, if (nint(slmsk(i)) /= 1) slmsk(i) = islmsk(i) enddo -! to prepare to separate lake from ocean under water category - do i = 1, im - if ((wet(i) .or. icy(i)) .and. lakefrac(i) > zero) then - lake(i) = .true. - if (lkm == 1 .and. lakefrac(i) >= 0.15 .and. lakedepth(i) > one) then - use_flake(i) = .true. - else - use_flake(i) = .false. - endif - else - lake(i) = .false. - use_flake(i) = .false. - endif - enddo ! if (frac_grid) then do i=1,im diff --git a/physics/GFS_surface_composites_pre.meta b/physics/GFS_surface_composites_pre.meta index e87af3e28..1aef9a76b 100644 --- a/physics/GFS_surface_composites_pre.meta +++ b/physics/GFS_surface_composites_pre.meta @@ -136,7 +136,7 @@ long_name = flag indicating lake points using flake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer intent = inout [wet] standard_name = flag_nonzero_wet_surface_fraction @@ -484,4 +484,4 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out diff --git a/physics/flake.F90 b/physics/flake.F90 index 2c2e7218c..74394847b 100644 --- a/physics/flake.F90 +++ b/physics/flake.F90 @@ -101,7 +101,8 @@ MODULE flake_albedo_ref albedo_water_ref = 0.07 , & ! Water albedo_whiteice_ref = 0.60 , & ! White ice albedo_blueice_ref = 0.10 , & ! Blue ice - albedo_drysnow_ref = 0.60 , & ! Dry snow +! albedo_drysnow_ref = 0.60 , & ! Dry snow + albedo_drysnow_ref = 0.90 , & ! Dry snow albedo_meltingsnow_ref = 0.10 ! Melting snow ! Empirical parameters. @@ -1544,7 +1545,11 @@ SUBROUTINE flake_main ( depthw, depthbs, T_bs, par_Coriolis, & flk_str_1 = flk_str_1 - CTT/CT*( (Q_bot_flk+I_bot_flk-I_HH_flk)/tpl_rho_w_r/tpl_c_w - & depth_bs * ( 1.0 - CT ) * (T_bot_n_flk-T_bot_p_flk)/del_time ) flk_str_2 = CTT * (T_bot_p_flk-T_bot_2_in) - d_h_D_dt = flk_str_1/flk_str_2 + if(abs(flk_str_2)<0.01) then + d_h_D_dt = 0.0 + else + d_h_D_dt = flk_str_1/flk_str_2 + endif ! compute d_T_H_dt flk_str_1 = (Q_bot_flk+I_bot_flk-I_HH_flk)/tpl_rho_w_r/tpl_c_w @@ -1869,7 +1874,8 @@ MODULE SfcFlx ! similarity relations and in the expressions for the roughness lengths. REAL (KIND = kind_phys), PARAMETER :: & c_Karman = 0.40 , & ! The von Karman constant - Pr_neutral = 1.0 , & ! Turbulent Prandtl number at neutral static stability +! Pr_neutral = 1.0 , & ! Turbulent Prandtl number at neutral static stability + Pr_neutral = 0.9 , & ! Turbulent Prandtl number at neutral static stability Sc_neutral = 1.0 , & ! Turbulent Schmidt number at neutral static stability c_MO_u_stab = 5.0 , & ! Constant of the MO theory (wind, stable stratification) c_MO_t_stab = 5.0 , & ! Constant of the MO theory (temperature, stable stratification) @@ -2480,18 +2486,37 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & ELSE ! Convection psi_u = (1.0-c_MO_t_conv*R_z*ZoL)**c_MO_t_exp psi_t = (1.0-c_MO_t_conv*R_z*ZoL*MIN(z0t_sf/height_tq, 1.0))**c_MO_t_exp - psi_t = 2.0*LOG((1.0+psi_t)/(1.0+psi_u)) +! psi_t = 2.0*LOG((1.0+psi_t)/(1.0+psi_u)) + psi_t = abs(2.0*LOG((1.0+psi_t)/(1.0+psi_u))) psi_u = (1.0-c_MO_q_conv*R_z*ZoL)**c_MO_q_exp psi_q = (1.0-c_MO_q_conv*R_z*ZoL*MIN(z0q_sf/height_tq, 1.0))**c_MO_q_exp - psi_q = 2.0*LOG((1.0+psi_q)/(1.0+psi_u)) +! psi_q = 2.0*LOG((1.0+psi_q)/(1.0+psi_u)) + psi_q = abs(2.0*LOG((1.0+psi_q)/(1.0+psi_u))) +! write(0,*) 'psi_q= ',psi_q !_dbg ! print*(*,*) 'CONV: psi_t = ', psi_t, ' psi_q = ', psi_q !_dbg END IF Q_sen_tur = -(T_a-T_s)*u_star_st*c_Karman/Pr_neutral & / MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) +if(MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) .lt. 10E-6) then + write(0,*)'inside flake' + write(0,*) Q_sen_tur, T_a, T_s, u_star_st, c_Karman, Pr_neutral + write(0,*) c_small_sf,height_tq,z0t_sf,psi_t + write(0,*) 'nominator= ', (T_a-T_s)*u_star_st*c_Karman/Pr_neutral + write(0,*) 'denominator= ',MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) +endif Q_lat_tur = -(q_a-q_s)*u_star_st*c_Karman/Sc_neutral & / MAX(c_small_sf, LOG(height_tq/z0q_sf)+psi_q) +if(Q_lat_tur .gt. 6.0E-4) then + Q_lat_tur = -(q_a-q_s)*u_star_st*c_Karman/3.0 & + / MAX(c_small_sf, LOG(height_tq/z0q_sf)+psi_q) + write(0,*) 'Q_lat_tur= ',Q_lat_tur + write(0,135) q_a,q_s,u_star_st,c_Karman + write(0,136) MAX(c_small_sf,LOG(height_tq/z0q_sf)+psi_q),c_small_sf, LOG(height_tq/z0q_sf),psi_q +endif +135 format(1x,4(f16.4)) +136 format(1x,4(f16.4)) END IF Turb_Fluxes @@ -2536,13 +2561,19 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & Q_momentum = Q_momentum*rho_a !Q_sensible = Q_sensible*rho_a*tpsf_c_a_p +!write(0,*) 'Q_sensible= ',Q_sensible Q_watvap = Q_latent*rho_a -Q_latent = tpsf_L_evap +!Q_latent = tpsf_L_evap IF(h_ice.GE.h_Ice_min_flk) Q_latent = Q_latent + tpl_L_f ! Add latent heat of fusion over ice -Q_latent = Q_watvap*Q_latent - +!Q_latent = Q_watvap*Q_latent +Q_latent = Q_watvap*tpsf_L_evap +if(Q_latent .gt. 2000.00) then + write(0,145) 'final Q_watvap= ',Q_watvap, 'tpsf_L_evap= ',tpsf_L_evap, 'Q_latent= ', Q_latent +endif +!Q_latent = Q_watvap*Q_latent +145 format(A17,E12.5,1x,A13,1x,f10.2,1x,A10,1x,E12.4) ! Set "*_sf" variables to make fluxes accessible to driving routines that use "SfcFlx" u_star_a_sf = u_star_st Q_mom_a_sf = Q_momentum @@ -2551,7 +2582,7 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & Q_watvap_a_sf = Q_watvap !write(85,127) Q_sensible, Q_watvap, Q_latent - 127 format(1x, 3(f16.9,1x)) + 127 format(1x, 3(f16.5,1x)) !------------------------------------------------------------------------------ ! End calculations @@ -2945,7 +2976,7 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he T_snow_out, T_ice_out, T_mnw_out, T_wML_out, T_bot_out, & T_B1_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & - H_B1_out, T_sfc_n, hflx_out, evap_out, & + H_B1_out, T_sfc_n, hflx_out, evap_out, gflx_out, lflx_out, & T_bot_2_in, T_bot_2_out,ustar, q_sfc, chh, cmm ) @@ -2987,11 +3018,11 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he USE flake_derivedtypes ! Definitions of several derived TYPEs -USE flake_parameters , ONLY : & - tpl_T_f , & ! Fresh water freezing point [K] - tpl_rho_w_r , & ! Maximum density of fresh water [kg m^{-3}] - h_Snow_min_flk , & ! Minimum snow thickness [m] - h_Ice_min_flk ! Minimum ice thickness [m] +!USE flake_parameters , ONLY : & +! tpl_T_f , & ! Fresh water freezing point [K] +! tpl_rho_w_r , & ! Maximum density of fresh water [kg m^{-3}] +! h_Snow_min_flk , & ! Minimum snow thickness [m] +! h_Ice_min_flk ! Minimum ice thickness [m] USE flake_paramoptic_ref ! Reference values of the optical characteristics ! of the lake water, lake ice and snow @@ -3117,6 +3148,8 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he T_sfc_n , & ! Updated surface temperature [K] hflx_out , & ! sensibl heat flux evap_out , & ! Latent heat flux + gflx_out , & ! flux from to water + lflx_out , & ! latent heat flux T_bot_2_out , & ! Bottom temperature ustar , & q_sfc , & @@ -3130,16 +3163,21 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he Q_sensible , & ! Sensible heat flux [W m^{-2}] Q_latent , & ! Latent heat flux [W m^{-2}] Q_watvap , & ! Flux of water vapour [kg m^{-2} s^{-1}] + Q_w_flux , & ! flux from ice to water rho_a ! ADDED by Shaobo Zhang LOGICAL lflk_botsed_use !REAL (KIND = kind_phys) :: T_bot_2_in, T_bot_2_out - +REAL (KIND = kind_phys), parameter :: tpl_rho_w_r = 1.0E+03 +REAL (KIND = kind_phys), parameter :: tpl_T_f = 273.15 +REAL (KIND = kind_phys), parameter :: h_Snow_min_flk = 1.0E-5 +REAL (KIND = kind_phys), parameter :: h_Ice_min_flk = 1.0E-9 !============================================================================== ! Start calculations !------------------------------------------------------------------------------ - lflk_botsed_use = .TRUE. +! lflk_botsed_use = .TRUE. + lflk_botsed_use = .FALSE. !------------------------------------------------------------------------------ ! Set albedos of the lake water, lake ice and snow !------------------------------------------------------------------------------ @@ -3153,9 +3191,10 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he ! Snow is not considered !albedo_snow = albedo_ice albedo_ice = albedo_whiteice_ref -albedo_snow = albedo_ice +!albedo_snow = albedo_ice +albedo_snow = albedo_drysnow_ref opticpar_water%extincoef_optic(1) = water_extinc -!print*,'albedo= ',albedo_water,albedo_ice,albedo_snow +!write(0,*)'albedo= ',albedo_water,albedo_ice,albedo_snow !------------------------------------------------------------------------------ ! Set optical characteristics of the lake water, lake ice and snow @@ -3218,7 +3257,8 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he CALL SfcFlx_momsenlat ( height_u_in, height_tq_in, fetch, & U_a_in, T_a_in, q_a_in, T_sfc_p, P_a_in, h_ice_p_flk, & Q_momentum, Q_sensible, Q_latent, Q_watvap, q_sfc, rho_a ) - +!write(0,*)'tpl_rho_w_r= ', tpl_rho_w_r +!write(0,*) 'Q_momentum= ',Q_momentum u_star_w_flk = SQRT(-Q_momentum/tpl_rho_w_r) ustar = u_star_w_flk @@ -3268,6 +3308,9 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he H_B1_out = H_B1_n_flk hflx_out = Q_sensible evap_out = Q_watvap +!evap_out = Q_latent +gflx_out = Q_w_flk +lflx_out = Q_latent chh = ch * U_a_in * rho_a cmm = cm * U_a_in diff --git a/physics/flake_driver.F90 b/physics/flake_driver.F90 index 94fe8286b..a78c6acf6 100644 --- a/physics/flake_driver.F90 +++ b/physics/flake_driver.F90 @@ -49,13 +49,17 @@ end subroutine flake_driver_finalize !! SUBROUTINE flake_driver_run ( & ! ---- Inputs - im, ps, t1, q1, wind, & - dlwflx, dswsfc, weasd, lakedepth, & - use_flake, xlat, delt, zlvl, elev, & - wet, flag_iter, yearlen, julian, imon, & + im, ps, t1, q1, wind, min_lakeice, & + dlwflx, dswsfc, lakedepth, lakefrac, & + use_flake, snow, xlat, delt, zlvl, elev, & + wet, yearlen, julian, imon, & + flag_iter, first_time_step, flag_restart, & + weasd, & ! ---- in/outs - snwdph, hice, tsurf, fice, T_sfc, hflx, evap, & - ustar, qsfc, ch, cm, chh, cmm, & + snwdph, hice, tsurf, t_sfc, fice, hflx, evap, & + lflx, gflx, ustar, qsfc, ch, cm, chh, cmm, & + h_ML, t_wML, t_mnw, H_B, T_B, t_bot1, & + t_bot2, c_t, T_snow, T_ice, tsurf_ice, & errmsg, errflg ) !============================================================================== @@ -84,37 +88,41 @@ SUBROUTINE flake_driver_run ( & real (kind=kind_phys), dimension(:), intent(in) :: ps, wind, & & t1, q1, dlwflx, dswsfc, zlvl, elev - real (kind=kind_phys), intent(in) :: delt + real (kind=kind_phys), intent(in) :: delt, min_lakeice real (kind=kind_phys), dimension(:), intent(in) :: & - & xlat, weasd, lakedepth + & xlat, lakedepth, lakefrac, snow - real (kind=kind_phys),dimension(:),intent(inout) :: & - & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, & - & ch, cm, chh, cmm + real (kind=kind_phys), dimension(:), intent(in) :: weasd + + real (kind=kind_phys),dimension(:),intent(inout) :: & + & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, & + & ch, cm, chh, cmm, h_ML, t_wML, t_mnw, H_B, T_B, & + & t_bot1, t_bot2, c_t, T_snow, T_ice, tsurf_ice, lflx, gflx real (kind=kind_phys), intent(in) :: julian - logical, dimension(:), intent(in) :: flag_iter, wet, use_flake + logical, dimension(:), intent(in) :: flag_iter, wet + integer, dimension(:), intent(in) :: use_flake + logical, intent(in) :: flag_restart, first_time_step character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- locals - - real (kind=kind_phys) , parameter :: lake_pct_min = 0.1 + real (kind=kind_phys), parameter :: lake_pct_min = 0.1 real (kind=kind_phys), dimension(im) :: & - T_snow , & ! Temperature at the air-snow interface [K] - T_ice , & ! Temperature at the snow-ice or air-ice interface [K] - T_mnw , & ! Mean temperature of the water column [K] - T_wML , & ! Mixed-layer temperature [K] - T_bot , & ! Temperature at the water-bottom sediment interface [K] - T_B1 , & ! Temperature at the upper layer of the sediments [K] - C_T , & ! Shape factor (thermocline) +! T_snow , & ! Temperature at the air-snow interface [K] +! T_ice , & ! Temperature at the snow-ice or air-ice interface [K] +! T_mnw , & ! Mean temperature of the water column [K] +! T_wML , & ! Mixed-layer temperature [K] +! T_bot , & ! Temperature at the water-bottom sediment interface [K] +! T_B , & ! Temperature at the upper layer of the sediments [K] +! C_T , & ! Shape factor (thermocline) fetch , & ! Typical wind fetch [m] - h_ML , & ! Thickness of the mixed-layer [m] - H_B1 , & ! Thickness of the upper layer of bottom sediments [m] +! h_ML , & ! Thickness of the mixed-layer [m] +! H_B1 , & ! Thickness of the upper layer of bottom sediments [m] w_albedo , & ! w_extinc @@ -147,7 +155,7 @@ SUBROUTINE flake_driver_run ( & T_mnw_in , & ! Mean temperature of the water column [K] T_wML_in , & ! Mixed-layer temperature [K] T_bot_in , & ! Temperature at the water-bottom sediment interface [K] - T_B1_in , & ! Temperature at the bottom of the upper layer of the sediments [K] + T_B_in , & ! Temperature at the bottom of the upper layer of the sediments [K] C_T_in , & ! Shape factor (thermocline) h_snow_in , & ! Snow thickness [m] h_ice_in , & ! Ice thickness [m] @@ -165,7 +173,7 @@ SUBROUTINE flake_driver_run ( & T_mnw_out , & ! Mean temperature of the water column [K] T_wML_out , & ! Mixed-layer temperature [K] T_bot_out , & ! Temperature at the water-bottom sediment interface [K] - T_B1_out , & ! Temperature at the bottom of the upper layer of the sediments [K] + T_B_out , & ! Temperature at the bottom of the upper layer of the sediments [K] C_T_out , & ! Shape factor (thermocline) h_snow_out , & ! Snow thickness [m] h_ice_out , & ! Ice thickness [m] @@ -182,17 +190,19 @@ SUBROUTINE flake_driver_run ( & Q_momentum , & ! Momentum flux [N m^{-2}] Q_SHT_flx , & ! Sensible heat flux [W m^{-2}] Q_LHT_flx , & ! Latent heat flux [W m^{-2}] - Q_watvap ! Flux of water vapour [kg m^{-2} s^{-1}] + Q_watvap , & ! Flux of water vapour [kg m^{-2} s^{-1}] + Q_gflx , & ! Flux from ice to water [W m^{-2}] + Q_lflx ! latent fluxes [W m^{-2}] REAL (KIND = kind_phys) :: & - lake_depth_max, T_bot_2_in, T_bot_2_out, dxlat,tb,tr,tt,temp,temp2 + lake_depth_max, T_bot_2_in, T_bot_2_out, dlat,tb,tr,tt,temp,temp2 real (kind=kind_phys), parameter :: pi=4.0_kind_phys*atan(1.0_kind_phys) real (kind=kind_phys), parameter :: degrad=180.0_kind_phys/pi real (kind=kind_phys), parameter :: Kbar = 3.5_kind_phys, DelK = 3.0_kind_phys, & KbaroDelK = Kbar / DelK - REAL (KIND = kind_phys) :: x, y !temperarory variables used for Tbot and Tsfc + REAL (KIND = kind_phys) :: x, y, w !temperarory variables used for Tbot and Tsfc !initilizations INTEGER :: i,ipr,iter @@ -205,15 +215,17 @@ SUBROUTINE flake_driver_run ( & ! Start calculations !------------------------------------------------------------------------------ ! FLake_write need to assign original value to make the model somooth + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! --- ... set flag for lake points do_flake = .false. do i = 1, im - flag(i) = wet(i) .and. flag_iter(i) .and. use_flake(i) - do_flake = flag(i) .or. do_flake + flag(i) = flag_iter(i) .and. use_flake(i) .gt. 0 + do_flake = flag(i) .or. do_flake enddo - if (.not. do_flake) return lake_depth_max = 60.0 @@ -230,61 +242,61 @@ SUBROUTINE flake_driver_run ( & temp2 = sin((pi+pi)*(julian-151)/244) do i = 1, im - if (flag(i)) then - T_ice(i) = 273.15 - T_snow(i) = 273.15 - fetch(i) = 2.0E+03 - C_T(i) = 0.50 - - dxlat = degrad*abs(xlat(i)) - tt = 29.275+(0.0813-0.0052*dxlat)*dxlat-0.0038*elev(i)+273.15 - tb = 29.075-(0.7566-0.0051*dxlat)*dxlat-0.0038*elev(i)+273.15 -! if (fice(i).le.0.0) then -! h_ice(i) = 0.0 -! h_snow(i)= 0.0 -! endif - if (snwdph(i) > 0.0 .or. hice(i) > 0.0) then - if (tsurf(i) < T_ice(i)) then - T_sfc(i) = T_ice(i) - else - T_sfc(i) = tsurf(i) - endif - else -! if (tsurf(i) < tt) then -! T_sfc(i) = tt -! else -! T_sfc(i) = tsurf(i) -! endif - T_sfc(i) = 0.1*tt + 0.9* tsurf(i) - endif -! + if (flag(i) .and. lakedepth(i) >1.0) then + if(.not.flag_restart .and. first_time_step) then + T_ice(i) = 273.15 + T_snow(i) = 273.15 + C_T(i) = 0.50 + dlat = abs(xlat(i)) + if(dlat .lt. 1.40) then + tt = (((21.181*dlat-51.376)*dlat+20.808)*dlat-3.8408)*dlat+29.554 + tt = tt -0.0038*elev(i)+273.15 + tb = (((-29.794*dlat+96.91)*dlat-86.129)*dlat-7.1921)*dlat+28.176 + tb = tb -0.0038*elev(i)+273.15 + w = (((2.5467*dlat-7.4683)*dlat+5.2465)*dlat+0.4360)*dlat+0.0643 + else + tt = 4.0+273.15-0.0038*elev(i) + tb = 0.05+273.15-0.0038*elev(i) + w = 0.207312 + endif + if(tsurf(i) > 400.00) then + write(0,*) tsurf(i) + write(0,*) 'Surface temperature initial is bad' + tsurf(i) = tt + write(0,*) tsurf(i) + endif + T_sfc(i) = 0.05*tt + 0.95* tsurf(i) + ! Add empirical climatology of lake Tsfc and Tbot to the current Tsfc and Tbot ! to make sure Tsfc and Tbot are warmer than Tair in Winter or colder than Tair ! in Summer - if (xlat(i) >= 0.0) then - T_sfc(i) = T_sfc(i) + 0.3*y - tb = tb + 0.05*y - else - T_sfc(i) = T_sfc(i) - 0.3*y - tb = tb - 0.05*y - endif - T_bot(i) = tb - T_B1(i) = tb - -! if (lakedepth(i) < 10.0) then -! T_bot(i) = T_sfc(i) -! T_B1(i) = T_bot(i) -! endif - - T_mnw(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*T_bot(i) - T_wML(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*T_bot(i) - h_ML(i) = C_T(i)* min ( lakedepth(i), lake_depth_max ) - H_B1(i) = min ( lakedepth(i),4.0) - hflx(i) = 0.0 - evap(i) = 0.0 + if (xlat(i) >= 0.0) then + T_sfc(i) = T_sfc(i) + 0.05*y*w + tb = tb + 0.005*y*w + else + T_sfc(i) = T_sfc(i) - 0.5*y*w + tb = tb - 0.005*y*w + endif + + t_bot1(i) = tb + t_bot2(i) = tb + T_B(i) = tb + + T_mnw(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*t_bot1(i) + T_wML(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*t_bot1(i) + h_ML(i) = C_T(i)* min ( lakedepth(i), lake_depth_max ) + H_B(i) = min ( lakedepth(i),4.0) + hflx(i) = 0.0 + lflx(i) = 0.0 + evap(i) = 0.0 + chh = ch(i) * wind(i) * 1.225 !(kg/m3) + cmm = cm(i) * wind(i) + endif !end of .not.flag_restart + fetch(i) = 2.0E+03 ! compute albedo as a function of julian day and latitude +! write(0,*) ' xlat= ',xlat(i), temp w_albedo(I) = 0.06/cos((xlat(i)-temp)/1.2) ! w_albedo(I) = 0.06 ! compute water extinction coefficient as a function of julian day @@ -295,24 +307,26 @@ SUBROUTINE flake_driver_run ( & endif ! w_extinc(i) = 3.0 -! write(65,1002) julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) -! print 1002 julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) -! print*,'inside flake driver' -! print*, julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) +! write(0,1002) julian,xlat(i),w_albedo(I),w_extinc(i),elev(i),tsurf(i),T_sfc(i),t_bot1(i) +! write(0,1003) use_flake(i),i,lakefrac(i),lakedepth(i), snwdph(i), hice(i), fice(i) +! write(0,1004) ps(i), wind(i), t1(i), q1(i), dlwflx(i), dswsfc(i), zlvl(i) endif !flag enddo - 1001 format ( 'At icount=', i5, ' x = ', f5.2,5x, 'y = ', & - 1p, e12.3) -! 1002 format ( ' julian= ',F6.2,1x,5(F8.4,1x),3(f11.4,1x)) - 1002 format (I4,1x,3(f8.4,1x),6(f11.4,1x)) - - + 1002 format ( 'julian=',F6.2,1x,F8.3,1x,2(E7.2,1x),E7.2,1x,3(E7.2,1x)) + 1003 format ( 'use_flake=',I2,1x,I3,1x,F6.4,1x,F9.4,1x,2(F8.4,1x),F7.4) + 1004 format ( 'pressure',F12.2,1x,F6.2,1x,F7.2,1x,F7.4,1x,2(F8.2,1x),F8.4) ! ! call lake interface do i=1,im - if (flag(i)) then - dMsnowdt_in = weasd(i)/delt + if (flag(i) .and. lakedepth(i) > 1.0) then +! write(0,*) 'flag(i)= ', i, flag(i) +! if(weasd(i) < 0.0 .or. hice(i) < 0.0) weasd(i) =0.0 + if(snwdph(i) < 0.0) snwdph(i) =0.0 +! dMsnowdt_in = 10.0*0.001*weasd(i)/delt +! dMsnowdt_in = snow(i)/delt + dMsnowdt_in = snow(i)*0.001 + if(dMsnowdt_in < 0.0) dMsnowdt_in=0.0 I_atm_in = dswsfc(i) Q_atm_lw_in = dlwflx(i) height_u_in = zlvl(i) @@ -329,27 +343,36 @@ SUBROUTINE flake_driver_run ( & depth_w = min ( lakedepth(i), lake_depth_max ) depth_bs_in = max ( 4.0, min ( depth_w * 0.2, 10.0 ) ) fetch_in = fetch(i) - T_bs_in = T_bot(i) + T_bs_in = T_bot1(i) par_Coriolis = 2 * 7.2921 / 100000. * sin ( xlat(i) ) del_time = delt - do iter=1,10 !interation loop +! if(lakedepth(i).lt.10) then +! T_sfc(i) = t1(i) +! T_bs_in = T_sfc(i) +! T_B(i) = T_bs_in +! endif + + do iter=1,5 !interation loop T_snow_in = T_snow(i) T_ice_in = T_ice(i) T_mnw_in = T_mnw(i) T_wML_in = T_wML(i) - T_bot_in = T_bot(i) - T_B1_in = T_B1(i) + T_bot_in = t_bot1(i) + T_B_in = T_B(i) C_T_in = C_T(i) h_snow_in = snwdph(i) h_ice_in = hice(i) h_ML_in = h_ML(i) - H_B1_in = H_B1(i) + H_B1_in = H_B(i) T_sfc_in = T_sfc(i) + tsurf_ice(i)= T_ice(i) - T_bot_2_in = T_bot(i) + T_bot_2_in = t_bot2(i) Q_SHT_flx = hflx(i) Q_watvap = evap(i) + Q_gflx = 0.0 + Q_lflx = 0.0 !------------------------------------------------------------------------------ ! Set the rate of snow accumulation @@ -359,13 +382,13 @@ SUBROUTINE flake_driver_run ( & height_tq_in, U_a_in, T_a_in, q_a_in, P_a_in, & depth_w, fetch_in, depth_bs_in, T_bs_in, par_Coriolis, del_time, & - T_snow_in, T_ice_in, T_mnw_in, T_wML_in, T_bot_in, T_B1_in, & + T_snow_in, T_ice_in, T_mnw_in, T_wML_in, T_bot_in, T_B_in, & C_T_in, h_snow_in, h_ice_in, h_ML_in, H_B1_in, T_sfc_in, & ch_in, cm_in, albedo_water, water_extinc, & ! T_snow_out, T_ice_out, T_mnw_out, T_wML_out, T_bot_out, & - T_B1_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & - H_B1_out, T_sfc_out, Q_SHT_flx, Q_watvap, & + T_B_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & + H_B1_out, T_sfc_out, Q_SHT_flx, Q_watvap, Q_gflx, Q_lflx, & ! T_bot_2_in, T_bot_2_out,u_star, q_sfc,chh_out,cmm_out ) @@ -378,11 +401,13 @@ SUBROUTINE flake_driver_run ( & T_wML(i) = T_wML_out T_sfc(i) = T_sfc_out Tsurf(i) = T_sfc_out - T_bot(i) = T_bot_out - T_B1(i) = T_B1_out + tsurf_ice(i) = T_ice(i) + t_bot1(i) = T_bot_out + t_bot2(i) = T_bot_2_out + T_B(i) = T_B_out C_T(i) = C_T_out h_ML(i) = h_ML_out - H_B1(i) = H_B1_out + H_B(i) = H_B1_out ustar(i) = u_star qsfc(i) = q_sfc chh(i) = chh_out @@ -391,26 +416,91 @@ SUBROUTINE flake_driver_run ( & hice(i) = h_ice_out evap(i) = Q_watvap hflx(i) = Q_SHT_flx - - if (hice(i) > 0.0 .or. snwdph(i) > 0.0) then - fice(i) = 1.0 - else - fice(i) = 0.0 - endif + gflx(i) = Q_gflx + lflx(i) = Q_lflx +! if(lflx(i) > 2500.00 .or. Tsurf(i) > 350.00) then +! write(0,125) i,lflx(i), Tsurf(i),ps(i), wind(i), & +! & t1(i), q1(i), dlwflx(i), dswsfc(i),hflx(i) +! endif +! fice(i) = fice(i)+0.01*(h_ice_out-h_ice_in) +! if(fice(i) .lt. min_lakeice ) then +! fice(i) = 0.0 +! elseif(fice(i) .gt. 1.0) then +! fice(i) = 1.0 +! endif enddo !iter loop +! endif !endif use_flake endif !endif of flag enddo -!125 format(1x,i2,1x,i2,1x,i2,1x,6(1x,f14.8)) +125 format(1x,i3,1x,9(1x,f10.3)) !126 format(1x,i2,1x,i2,1x,6(1x,f14.8)) !127 format(1x,i2,2(1x,f16.9)) !------------------------------------------------------------------------------ ! End calculations !============================================================================== -END SUBROUTINE flake_driver_run + END SUBROUTINE flake_driver_run + +end module flake_driver + +module flake_driver_post + use machine, only: kind_phys + implicit none + private + public flake_driver_post_init, flake_driver_post_finalize, flake_driver_post_run + +contains + subroutine flake_driver_post_init() + end subroutine flake_driver_post_init + + subroutine flake_driver_post_finalize() + end subroutine flake_driver_post_finalize + +!> \section arg_table_flake_driver_post Argument Table +!! \htmlinclude flake_driver_post.html +!! +subroutine flake_driver_post_run (im, use_flake, h_ML, T_wML, Tsurf, & + lakedepth, xz, zm, tref, tsfco, & + errmsg, errflg) + +!use machine , only : kind_phys +!============================================================================== + + implicit none + integer, intent(in) :: im +! integer, dimension(im), intent(in) :: islmsk + + real (kind=kind_phys), dimension(:), intent(in) :: & + & lakedepth, tsurf, h_ML, t_wML + + real (kind=kind_phys),dimension(:),intent(inout) :: & + & xz, zm, tref, tsfco + + integer, dimension(:), intent(in) :: use_flake + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: i + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do I=1, im + if(use_flake(i).eq.2) then + write(0,*)'flake-post-use-flake= ',use_flake(i) + xz(i) = lakedepth(i) + zm(i) = h_ML(i) + tref(i) = tsurf(i) + tsfco(i) = t_wML(i) + endif + enddo + + +end subroutine flake_driver_post_run !--------------------------------- - end module flake_driver +end module flake_driver_post diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index 7ed80d866..67822df05 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -86,9 +86,17 @@ type = real kind = kind_phys intent = in +[min_lakeice] + standard_name = min_lake_ice_area_fraction + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in [dlwflx] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_water - long_name = total sky surface downward longwave flux absorbed by the ground over water + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time units = W m-2 dimensions = (horizontal_loop_extent) type = real @@ -102,14 +110,6 @@ type = real kind = kind_phys intent = in -[weasd] - standard_name = water_equivalent_accumulated_snow_depth_over_ice - long_name = water equiv of acc snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [lakedepth] standard_name = lake_depth long_name = lake depth @@ -118,12 +118,28 @@ type = real kind = kind_phys intent = in +[lakefrac] + standard_name = lake_area_fraction + long_name = fraction of horizontal grid area occupied by lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [use_flake] standard_name = flag_for_using_flake long_name = flag indicating lake points using flake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer + intent = in +[snow] + standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep + long_name = snow fall at this time step + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys intent = in [xlat] standard_name = latitude @@ -164,13 +180,6 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[flag_iter] - standard_name = flag_for_iteration - long_name = flag for iteration - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = in [yearlen] standard_name = number_of_days_in_current_year long_name = number of days in a year @@ -193,6 +202,35 @@ dimensions = () type = integer intent = in +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[first_time_step] + standard_name = flag_for_first_timestep + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical + intent = in +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [snwdph] standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice @@ -210,8 +248,8 @@ kind = kind_phys intent = inout [tsurf] - standard_name = surface_skin_temperature_after_iteration_over_water - long_name = surface skin temperature after iteration over water + standard_name = surface_skin_temperature_over_water + long_name = surface skin temperature over water units = K dimensions = (horizontal_loop_extent) type = real @@ -226,8 +264,8 @@ kind = kind_phys intent = inout [t_sfc] - standard_name = surface_skin_temperature_over_water - long_name = surface skin temperature over water + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water units = K dimensions = (horizontal_loop_extent) type = real @@ -249,6 +287,22 @@ type = real kind = kind_phys intent = inout +[lflx] + standard_name = surface_upward_potential_latent_heat_flux_over_water + long_name = surface upward potential latent heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[gflx] + standard_name = upward_heat_flux_in_soil_over_water + long_name = soil heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [ustar] standard_name = surface_friction_velocity_over_water long_name = surface friction velocity over water @@ -297,6 +351,190 @@ type = real kind = kind_phys intent = inout +[h_ML] + standard_name = mixed_layer_depth_of_lakes + long_name = depth of lake mixing layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_wML] + standard_name = lake_mixed_layer_temperature + long_name = temperature of lake mixing layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_mnw] + standard_name = mean_temperature_of_the_water_column + long_name = thee mean temperature of the water column + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[H_B] + standard_name = the_thermally_active_layer_depth_of_the_bottom_sediment + long_name = the depth of the thermally active layer of the bottom sediment + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[T_B] + standard_name = temperature_at_the_bottom_of_the_sediment_upper_layer + long_name = the temperature at the bottom of the sediment upper layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_bot1] + standard_name = lake_bottom_temperature + long_name = the temperature at the water-bottom sediment interface + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_bot2] + standard_name = temperature_for_bottom_layer_of_water + long_name = the temperature at the lake bottom layer water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[c_t] + standard_name = shape_factor_of_water_temperature_vertical_profile + long_name = the shape factor of water temperature vertical profile + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[T_snow] + standard_name = temperature_of_snow_on_lake + long_name = the temperature of snow on a lake + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[T_ice] + standard_name = surface_skin_temperature_over_ice + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-table-properties] + name = flake_driver_post + type = scheme + dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = flake_driver_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[h_ML] + standard_name = mixed_layer_depth_of_lakes + long_name = depth of lake mixing layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[t_wML] + standard_name = lake_mixed_layer_temperature + long_name = temperature of lake mixing layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[xz] + standard_name = diurnal_thermocline_layer_thickness + long_name = diurnal thermocline layer thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[zm] + standard_name = ocean_mixed_layer_thickness + long_name = mixed layer thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[tref] + standard_name = reference_sea_surface_temperature + long_name = reference/foundation temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[tfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/lsm_ruc.F90 b/physics/lsm_ruc.F90 index 3ca78ad04..cd65dd8f8 100644 --- a/physics/lsm_ruc.F90 +++ b/physics/lsm_ruc.F90 @@ -393,7 +393,8 @@ subroutine lsm_ruc_run & ! inputs con_hvap, con_fvirt logical, dimension(:), intent(in) :: flag_iter, flag_guess - logical, dimension(:), intent(in) :: land, icy, use_lake + logical, dimension(:), intent(in) :: land, icy + integer, dimension(:), intent(in) :: use_lake logical, dimension(:), intent(in) :: flag_cice logical, intent(in) :: frac_grid logical, intent(in) :: do_mynnsfclay @@ -565,7 +566,7 @@ subroutine lsm_ruc_run & ! inputs endif ! - Set flag for ice points for uncoupled model (islmsk(i) == 4 when coupled to CICE) ! - Exclude ice on the lakes if the lake model is turned on. - flag_ice_uncoupled(i) = (flag_ice(i) .and. .not. use_lake(i)) + flag_ice_uncoupled(i) = (flag_ice(i) .and. use_lake(i)<1) !> - Set flag for land and ice points. !- 10may19 - ice points are turned off. flag(i) = land(i) .or. flag_ice_uncoupled(i) diff --git a/physics/lsm_ruc.meta b/physics/lsm_ruc.meta index 587fda681..9e56e2941 100644 --- a/physics/lsm_ruc.meta +++ b/physics/lsm_ruc.meta @@ -784,7 +784,7 @@ long_name = flag indicating lake points using flake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer intent = in [rainnc] standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 64afd0a35..ffda6fd89 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -794,7 +794,7 @@ subroutine setemis & integer, intent(in) :: IMAX integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in) :: frac_grid, cplice - logical, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_flake real (kind=kind_phys), dimension(:), intent(in) :: lakefrac real (kind=kind_phys), dimension(:), intent(in) :: & @@ -959,7 +959,7 @@ subroutine setemis & sfcemis_ice = semis_ice(i) ! output from CICE endif elseif (lsm == lsm_ruc) then - if (use_flake(i)) then + if (use_flake(i)>0) then if (sncovr_ice(i) > f_zero) then sfcemis_ice = emsref(7) * (f_one-sncovr_ice(i)) & & + emsref(8) * sncovr_ice(i) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 59c6d2d60..7a7a4496c 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -84,7 +84,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & fm10_wat, fm10_lnd, fm10_ice, & !intent(inout) & fh2_wat, fh2_lnd, fh2_ice, & !intent(inout) & ztmax_wat, ztmax_lnd, ztmax_ice, & !intent(inout) - & zvfun, & !intent(out) + & zvfun, use_flake, & !intent(out) & errmsg, errflg) !intent(out) ! implicit none @@ -94,9 +94,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean integer, dimension(:), intent(in) :: vegtype + integer, dimension(:), intent(in) :: use_flake logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) - logical, dimension(:), intent(in) :: flag_iter, wet, dry, icy + logical, dimension(:), intent(in) :: flag_iter, dry, icy + logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation @@ -171,6 +173,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm ! + do i=1,im + if(use_flake(i) > 0) wet(i) = .true. + enddo ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index a2e1fe9f7..33149eb16 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -223,7 +223,7 @@ units = flag dimensions = (horizontal_loop_extent) type = logical - intent = in + intent = inout [dry] standard_name = flag_nonzero_land_surface_fraction long_name = flag indicating presence of some land surface area fraction @@ -565,6 +565,13 @@ type = real kind = kind_phys intent = inout +[use_flake] + standard_name = flag_for_using_flake + long_name = flag indicating lake points using flake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index 22961458d..e8e3627c5 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -193,8 +193,8 @@ subroutine sfc_nst_run & ! For sea spray effect logical, intent(in) :: lseaspray ! - logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet, & - & use_flake + logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet + integer, dimension(:), intent(in) :: use_flake ! &, icy logical, intent(in) :: lprnt logical, intent(in) :: thsfc_loc @@ -276,7 +276,7 @@ subroutine sfc_nst_run & do_nst = .false. do i = 1, im ! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) - flag(i) = wet(i) .and. flag_iter(i) .and. .not. use_flake(i) + flag(i) = wet(i) .and. flag_iter(i) .and. use_flake(i)/=1 do_nst = do_nst .or. flag(i) enddo if (.not. do_nst) return @@ -285,7 +285,7 @@ subroutine sfc_nst_run & ! do i=1, im ! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then - if(wet(i) .and. flag_guess(i) .and. .not. use_flake(i)) then + if(wet(i) .and. flag_guess(i) .and. use_flake(i)/=1) then xt_old(i) = xt(i) xs_old(i) = xs(i) xu_old(i) = xu(i) @@ -604,7 +604,7 @@ subroutine sfc_nst_run & ! restore nst-related prognostic fields for guess run do i=1, im ! if (wet(i) .and. .not.icy(i)) then - if (wet(i) .and. .not. use_flake(i)) then + if (wet(i) .and. use_flake(i)/=1) then if (flag_guess(i)) then ! when it is guess of xt(i) = xt_old(i) xs(i) = xs_old(i) @@ -692,4 +692,4 @@ subroutine sfc_nst_run & return end subroutine sfc_nst_run !> @} - end module sfc_nst \ No newline at end of file + end module sfc_nst diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index fa15749b6..3f281231c 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -241,7 +241,7 @@ long_name = flag indicating lake points using flake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer intent = in [xlon] standard_name = longitude @@ -616,4 +616,4 @@ units = 1 dimensions = () type = integer - intent = out \ No newline at end of file + intent = out diff --git a/physics/sfc_nst_post.f b/physics/sfc_nst_post.f index 80f96d3f8..b316dccd0 100644 --- a/physics/sfc_nst_post.f +++ b/physics/sfc_nst_post.f @@ -30,7 +30,8 @@ subroutine sfc_nst_post_run & ! --- inputs: integer, intent(in) :: im, kdt, nthreads - logical, dimension(:), intent(in) :: wet, icy, use_flake + logical, dimension(:), intent(in) :: wet, icy + integer, dimension(:), intent(in) :: use_flake real (kind=kind_phys), intent(in) :: rlapse, tgice real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 @@ -75,7 +76,7 @@ subroutine sfc_nst_post_run & do i = 1, im ! if (wet(i) .and. .not.icy(i)) then ! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then - if (wet(i) .and. .not. use_flake(i)) then + if (wet(i) .and. use_flake(i) /=1) then tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) ! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & ! (oro(i)-oro_uf(i))*rlapse diff --git a/physics/sfc_nst_post.meta b/physics/sfc_nst_post.meta index aefa53bb0..45257fe41 100644 --- a/physics/sfc_nst_post.meta +++ b/physics/sfc_nst_post.meta @@ -50,7 +50,7 @@ long_name = flag indicating lake points using flake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer intent = in [icy] standard_name = flag_nonzero_sea_ice_surface_fraction diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 2b9449eab..574388317 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -117,7 +117,8 @@ subroutine sfc_ocean_run & ! For sea spray effect logical, intent(in) :: lseaspray ! - logical, dimension(:), intent(in) :: flag_iter, wet, use_flake + logical, dimension(:), intent(in) :: flag_iter, wet + integer, dimension(:), intent(in) :: use_flake ! logical, intent(in) :: use_med_flux @@ -166,7 +167,7 @@ subroutine sfc_ocean_run & ! ! --- ... flag for open water do i = 1, im - flag(i) = (wet(i) .and. flag_iter(i) .and. .not. use_flake(i)) + flag(i) = (wet(i) .and. flag_iter(i) .and. use_flake(i) /=1) ! --- ... initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! rho is density, qss is sat. hum. at surface diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index fcf4daa07..f30be6ea8 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -177,7 +177,7 @@ long_name = flag indicating lake points using flake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer intent = in [wind] standard_name = wind_speed_at_lowest_model_layer diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index b88178702..195ebec80 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -167,7 +167,8 @@ subroutine sfc_sice_run & integer, dimension(:), intent(in) :: islmsk real (kind=kind_phys), intent(in) :: delt - logical, dimension(im), intent(in) :: flag_iter, use_flake + logical, dimension(im), intent(in) :: flag_iter + integer, dimension(im), intent(in) :: use_flake ! --- input/outputs: real (kind=kind_phys), dimension(:), intent(inout) :: hice, & @@ -215,7 +216,7 @@ subroutine sfc_sice_run & do_sice = .false. do i = 1, im flag(i) = islmsk(i) == 2 .and. flag_iter(i) & - & .and. .not. use_flake(i) + & .and. use_flake(i) /=1 do_sice = do_sice .or. flag(i) ! if (flag_iter(i) .and. islmsk(i) < 2) then ! hice(i) = zero diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index 718109879..489c3758b 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -241,7 +241,7 @@ long_name = flag indicating lake points using flake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer intent = in [lprnt] standard_name = flag_print From 23290c37b305181bbd801b29b33bafd1a6f75e01 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 11 Aug 2022 20:27:23 +0000 Subject: [PATCH 02/46] add clm lake --- physics/GFS_phys_time_vary.fv3.F90 | 43 +- physics/GFS_phys_time_vary.fv3.meta | 47 +- physics/GFS_radiation_surface.F90 | 6 +- physics/GFS_radiation_surface.meta | 6 +- physics/GFS_surface_composites_inter.F90 | 6 +- physics/GFS_surface_composites_inter.meta | 6 +- physics/GFS_surface_composites_pre.F90 | 6 +- physics/GFS_surface_composites_pre.meta | 10 +- physics/clm_lake.f90 | 5441 +++++++++++++++++++++ physics/clm_lake.meta | 680 +++ physics/flake_driver.F90 | 22 +- physics/flake_driver.meta | 6 +- physics/radiation_surface.f | 8 +- physics/scm_sfc_flux_spec.F90 | 10 +- physics/scm_sfc_flux_spec.meta | 12 +- physics/sfc_diff.f | 7 +- physics/sfc_diff.meta | 6 +- physics/sfc_nst.f | 14 +- physics/sfc_nst.meta | 6 +- physics/sfc_nst_post.f | 8 +- physics/sfc_nst_post.meta | 6 +- physics/sfc_ocean.F | 8 +- physics/sfc_ocean.meta | 6 +- physics/sfc_sice.f | 8 +- physics/sfc_sice.meta | 6 +- 25 files changed, 6275 insertions(+), 109 deletions(-) create mode 100644 physics/clm_lake.f90 create mode 100644 physics/clm_lake.meta diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 25e5218d5..db293503e 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -82,19 +82,20 @@ subroutine GFS_phys_time_vary_init ( zwtxy, xlaixy, xsaixy, lfmassxy, stmassxy, rtmassxy, woodxy, stblcpxy, fastcpxy, & smcwtdxy, deeprechxy, rechxy, snowxy, snicexy, snliqxy, tsnoxy , smoiseq, zsnsoxy, & slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, lsm_cold_start, nthrds, & - lkm, use_flake, lakefrac, lakedepth, errmsg, errflg) + lkm, use_lake_model, lakefrac, lakedepth, iopt_lake, iopt_lake_clm, iopt_lake_flake, & + lakefrac_threshold, lakedepth_threshold, errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny, levs logical, intent(in) :: h2o_phys, iaerclm, lsm_cold_start - integer, intent(in) :: idate(:) - real(kind_phys), intent(in) :: fhour + integer, intent(in) :: idate(:), iopt_lake, iopt_lake_clm, iopt_lake_flake + real(kind_phys), intent(in) :: fhour, lakefrac_threshold, lakedepth_threshold real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) integer, intent(in) :: lkm - integer, intent(inout) :: use_flake(:) + integer, intent(inout) :: use_lake_model(:) real(kind=kind_phys), intent(in ) :: lakefrac(:), lakedepth(:) integer, intent(inout) :: jindx1_o3(:), jindx2_o3(:), jindx1_h(:), jindx2_h(:) @@ -676,20 +677,26 @@ subroutine GFS_phys_time_vary_init ( endif noahmp_init endif lsm_init -!Flake - do i = 1, im - if (lakefrac(i) > 0.0 .and. lakedepth(i) > 1.0 ) then - if (lkm == 1 ) then - use_flake(i) = 1 - elseif (lkm == 2 ) then - use_flake(i) = 2 - else - use_flake(i) = 0 - endif - else - use_flake(i) = 0 - endif - enddo +!Lake model + if((lkm==1 .or. lkm==2) .and. (iopt_lake==iopt_lake_flake .or. iopt_lake==iopt_lake_clm)) then + ! A lake model is enabled. + do i = 1, im + !if (lakefrac(i) > 0.0 .and. lakedepth(i) > 1.0 ) then + + ! The lake data must say there's a lake here (lakefrac) with a depth (lakedepth) + if (lakefrac(i) > lakefrac_threshold .and. lakedepth(i) > lakedepth_threshold ) then + ! This is a lake point. Inform the other schemes to use a lake model, and possibly nsst (lkm) + use_lake_model(i) = lkm + cycle + else + ! Not a valid lake point. + use_lake_model(i) = 0 + endif + enddo + else + ! Lake model is disabled or settings are invalid. + use_lake_model = 0 + endif is_initialized = .true. diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index c8f178bf3..107eb8f56 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -896,15 +896,15 @@ type = integer intent = in [lkm] - standard_name = control_for_lake_surface_scheme - long_name = flag for lake surface model + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst units = flag dimensions = () type = integer intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_dimension) type = integer @@ -925,6 +925,43 @@ type = real kind = kind_phys intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_flake] + standard_name = flake_model_control_selection_value + long_name = value that indicates flake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[lakefrac_threshold] + standard_name = lakefrac_threshold_for_enabling_lake_model + long_name = fraction of horizontal grid area occupied by lake must be greater than this value to enable a lake model + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[lakedepth_threshold] + standard_name = lake_depth_threshold_for_enabling_lake_model + long_name = lake depth must be greater than this value to enable a lake model + units = m + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 index 07c87414e..e8bcca69f 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/GFS_radiation_surface.F90 @@ -50,7 +50,7 @@ subroutine GFS_radiation_surface_run ( & xlat, xlon, slmsk, lndp_type, n_var_lndp, sfc_alb_pert, & lndp_var_list, lndp_prt_list, landfrac, snodl, snodi, sncovr, & sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, & - cplice, min_seaice, min_lakeice, lakefrac, use_flake, & + cplice, min_seaice, min_lakeice, lakefrac, use_lake_model, & alvsf, alnsf, alvwf, alnwf, facsf, facwf, & semis_lnd, semis_ice, semis_wat, snoalb, use_cice_alb, & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & @@ -68,7 +68,7 @@ subroutine GFS_radiation_surface_run ( & integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, slmsk, & sfc_alb_pert, lndp_prt_list, & @@ -153,7 +153,7 @@ subroutine GFS_radiation_surface_run ( & !> - Call module_radiation_surface::setemis(),to set up surface !! emissivity for LW radiation. call setemis (lsm, lsm_noahmp, lsm_ruc, frac_grid, cplice, & - use_flake, lakefrac, xlon, xlat, slmsk, & + use_lake_model, lakefrac, xlon, xlat, slmsk, & ! frac_grid, min_seaice, xlon, xlat, slmsk, & snodl, snodi, sncovr, sncovr_ice, zorl, tsfg, & tsfa, hprime, semis_lnd, semis_ice, semis_wat,& diff --git a/physics/GFS_radiation_surface.meta b/physics/GFS_radiation_surface.meta index e9de370e8..fb19e985e 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/GFS_radiation_surface.meta @@ -286,9 +286,9 @@ type = real kind = kind_phys intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer diff --git a/physics/GFS_surface_composites_inter.F90 b/physics/GFS_surface_composites_inter.F90 index 715b85518..a4004bb82 100644 --- a/physics/GFS_surface_composites_inter.F90 +++ b/physics/GFS_surface_composites_inter.F90 @@ -18,7 +18,7 @@ module GFS_surface_composites_inter !! subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis_lnd, semis_ice, & adjsfcdlw, gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat,& - adjsfcusw, adjsfcdsw, adjsfcnsw, use_flake, errmsg, errflg) + adjsfcusw, adjsfcdsw, adjsfcnsw, use_lake_model, errmsg, errflg) implicit none @@ -30,7 +30,7 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis adjsfcdlw, adjsfcdsw, adjsfcnsw real(kind=kind_phys), dimension(:), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_wat real(kind=kind_phys), dimension(:), intent(out) :: adjsfcusw - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model ! CCPP error handling character(len=*), intent(out) :: errmsg @@ -62,7 +62,7 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis ! --- ... define the downward lw flux absorbed by ground do i=1,im - if(use_flake(i)>0.0) wet(i)=.true. + if(use_lake_model(i)>0.0) wet(i)=.true. if (dry(i)) gabsbdlw_lnd(i) = semis_lnd(i) * adjsfcdlw(i) if (icy(i)) gabsbdlw_ice(i) = semis_ice(i) * adjsfcdlw(i) if (wet(i)) gabsbdlw_wat(i) = semis_wat(i) * adjsfcdlw(i) diff --git a/physics/GFS_surface_composites_inter.meta b/physics/GFS_surface_composites_inter.meta index 2ed966d01..36af0ef5a 100644 --- a/physics/GFS_surface_composites_inter.meta +++ b/physics/GFS_surface_composites_inter.meta @@ -116,9 +116,9 @@ type = real kind = kind_phys intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/GFS_surface_composites_pre.F90 index 04ce7e314..862ba2b6c 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/GFS_surface_composites_pre.F90 @@ -24,7 +24,7 @@ module GFS_surface_composites_pre subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, & flag_cice, cplflx, cplice, cplwav2atm, lsm, lsm_ruc, & landfrac, lakefrac, lakedepth, oceanfrac, frland, & - dry, icy, lake, use_flake, wet, hice, cice, zorlo, zorll, zorli, & + dry, icy, lake, use_lake_model, wet, hice, cice, zorlo, zorll, zorli, & snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & weasd, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & @@ -39,7 +39,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, logical, intent(in ) :: cplflx, cplice, cplwav2atm, frac_grid logical, dimension(:), intent(inout) :: flag_cice logical, dimension(:), intent(inout) :: dry, icy, lake, wet - integer, dimension(:), intent(inout) :: use_flake + integer, dimension(:), intent(inout) :: use_lake_model real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice real(kind=kind_phys), dimension(:), intent( out) :: frland @@ -73,7 +73,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, errflg = 0 do i=1,im - if(use_flake(i) > 0.0) then + if(use_lake_model(i) > 0.0) then wet(i) = .true. endif enddo diff --git a/physics/GFS_surface_composites_pre.meta b/physics/GFS_surface_composites_pre.meta index 1aef9a76b..6a56b35b8 100644 --- a/physics/GFS_surface_composites_pre.meta +++ b/physics/GFS_surface_composites_pre.meta @@ -15,8 +15,8 @@ type = integer intent = in [lkm] - standard_name = control_for_lake_surface_scheme - long_name = flag for lake surface model + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst units = flag dimensions = () type = integer @@ -131,9 +131,9 @@ dimensions = (horizontal_loop_extent) type = logical intent = inout -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 new file mode 100644 index 000000000..384faf419 --- /dev/null +++ b/physics/clm_lake.f90 @@ -0,0 +1,5441 @@ +!> \file clm_lake.F90 +!! Contains code related to the CLM lake model +!! +!! This lake scheme was taken from module_sf_lake in WRF 4.3.1, and +!! modified for CCPP by Sam Trahan in June 2022. +!! +!! The original documentation said: +!! +!! The lake scheme was retrieved from the Community Land Model version 4.5 +!! (Oleson et al. 2013) with some modifications by Gu et al. (2013). It is a +!! one-dimensional mass and energy balance scheme with 20-25 model layers, +!! including up to 5 snow layers on the lake ice, 10 water layers, and 10 soil +!! layers on the lake bottom. The lake scheme is used with actual lake points and +!! lake depth derived from the WPS, and it also can be used with user defined +!! lake points and lake depth in WRF (lake_min_elev and lakedepth_default). +!! The lake scheme is independent of a land surface scheme and therefore +!! can be used with any land surface scheme embedded in WRF. The lake scheme +!! developments and evaluations were included in Subin et al. (2012) and Gu et al. (2013) +!! +!! Subin et al. 2012: Improved lake model for climate simulations, J. Adv. Model. +!! +!! Earth Syst., 4, M02001. DOI:10.1029/2011MS000072; +!! +!! Gu et al. 2013: Calibration and validation of lake surface temperature simulations +!! +!! with the coupled WRF-Lake model. Climatic Change, 1-13, 10.1007/s10584-013-0978-y. + +MODULE clm_lake + + use machine, only: kind_phys + + implicit none + + logical, parameter :: LAKEDEBUG = .true. ! Enable lots of checks and debug prints + + real(kind_phys), parameter :: zero_h2o = 1e-12 + + ! FIXME: REMOVE OR DOCUMENT PERGRO + logical, parameter :: PERGRO = .false. + + ! FIXME: REMOVE OR DOCUMENT ETALAKE + logical, parameter :: USE_ETALAKE = .false. + real, parameter :: ETALAKE = 1.1925*50**(-0.424) ! Set this to your desired value if USE_ETALAKE=.true. + + real(kind_phys), parameter :: snow_bd = 250._kind_phys !constant snow bulk density (only used in special case here) [kg/m^3] + + integer, parameter :: nlevsoil = 10 ! number of soil layers + integer, parameter :: nlevlake = 10 ! number of lake layers + integer, parameter :: nlevsnow = 5 ! maximum number of snow layers + + integer,parameter :: lbp = 1 ! pft-index bounds + integer,parameter :: ubp = 1 + integer,parameter :: lbc = 1 ! column-index bounds + integer,parameter :: ubc = 1 + integer,parameter :: num_shlakec = 1 ! number of columns in lake filter + integer,parameter :: filter_shlakec(1) = 1 ! lake filter (columns) + integer,parameter :: num_shlakep = 1 ! number of pfts in lake filter + integer,parameter :: filter_shlakep(1) = 1 ! lake filter (pfts) + integer,parameter :: pcolumn(1) = 1 + integer,parameter :: pgridcell(1) = 1 + integer,parameter :: cgridcell(1) = 1 ! gridcell index of column + integer,parameter :: clandunit(1) = 1 ! landunit index of column + + integer,parameter :: begg = 1 + integer,parameter :: endg = 1 + integer,parameter :: begl = 1 + integer,parameter :: endl = 1 + integer,parameter :: begc = 1 + integer,parameter :: endc = 1 + integer,parameter :: begp = 1 + integer,parameter :: endp = 1 + + integer,parameter :: column =1 + logical,parameter :: lakpoi(1) = .true. + + + + + !Initialize physical constants: + ! FIXME: GET THESE FROM THE MODEL + real(kind_phys), parameter :: vkc = 0.4_kind_phys !von Karman constant [-] + real(kind_phys), parameter :: pi = 3.141592653589793_kind_phys ! pi + real(kind_phys), parameter :: grav = 9.80616_kind_phys !gravity constant [m/s2] + real(kind_phys), parameter :: sb = 5.67e-8_kind_phys !stefan-boltzmann constant [W/m2/K4] + real(kind_phys), parameter :: tfrz = 273.16_kind_phys !freezing temperature [K] + real(kind_phys), parameter :: denh2o = 1.000e3_kind_phys !density of liquid water [kg/m3] + real(kind_phys), parameter :: denice = 0.917e3_kind_phys !density of ice [kg/m3] + real(kind_phys), parameter :: cpice = 2.11727e3_kind_phys !Specific heat of ice [J/kg-K] + real(kind_phys), parameter :: cpliq = 4.188e3_kind_phys !Specific heat of water [J/kg-K] + real(kind_phys), parameter :: hfus = 3.337e5_kind_phys !Latent heat of fusion for ice [J/kg] + real(kind_phys), parameter :: hvap = 2.501e6_kind_phys !Latent heat of evap for water [J/kg] + real(kind_phys), parameter :: hsub = 2.501e6_kind_phys+3.337e5_kind_phys !Latent heat of sublimation [J/kg] + real(kind_phys), parameter :: rair = 287.0423_kind_phys !gas constant for dry air [J/kg/K] + real(kind_phys), parameter :: cpair = 1.00464e3_kind_phys !specific heat of dry air [J/kg/K] + real(kind_phys), parameter :: tcrit = 2.5 !critical temperature to determine rain or snow + real(kind_phys), parameter :: tkwat = 0.6 !thermal conductivity of water [W/m/k] + real(kind_phys), parameter :: tkice = 2.290 !thermal conductivity of ice [W/m/k] + real(kind_phys), parameter :: tkairc = 0.023 !thermal conductivity of air [W/m/k] + real(kind_phys), parameter :: bdsno = 250. !bulk density snow (kg/m**3) + + real(kind_phys), public, parameter :: spval = 1.e36 !special value for missing data (ocean) + + real(kind_phys), parameter :: depth_c = 50. ! below the level t_lake3d will be 277.0 !mchen + + + ! These are tunable constants + real(kind_phys), parameter :: wimp = 0.05 !Water impermeable if porosity less than wimp + real(kind_phys), parameter :: ssi = 0.033 !Irreducible water saturation of snow + real(kind_phys), parameter :: cnfac = 0.5 !Crank Nicholson factor between 0 and 1 + + + ! Initialize water type constants + integer,parameter :: istsoil = 1 !soil "water" type + integer, private :: i ! loop index + real(kind_phys) :: dtime ! land model time step (sec) + + real(kind_phys) :: zlak(1:nlevlake) !lake z (layers) + real(kind_phys) :: dzlak(1:nlevlake) !lake dz (thickness) + real(kind_phys) :: zsoi(1:nlevsoil) !soil z (layers) + real(kind_phys) :: dzsoi(1:nlevsoil) !soil dz (thickness) + real(kind_phys) :: zisoi(0:nlevsoil) !soil zi (interfaces) + + + real(kind_phys) :: sand(19) ! percent sand + real(kind_phys) :: clay(19) ! percent clay + + data(sand(i), i=1,19)/92.,80.,66.,20.,5.,43.,60.,& + 10.,32.,51., 6.,22.,39.7,0.,100.,54.,17.,100.,92./ + + data(clay(i), i=1,19)/ 3., 5.,10.,15.,5.,18.,27.,& + 33.,33.,41.,47.,58.,14.7,0., 0., 8.5,54., 0., 3./ + + + ! real(kind_phys) :: dtime ! land model time step (sec) + real(kind_phys) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_phys) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_phys) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_phys) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + CONTAINS + + !> \section arg_table_clm_lake_run Argument Table + !! \htmlinclude clm_lake_run.html + !! + SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& + gt0 ,prsi ,con_rd,con_g ,qvcurr ,& !i + gu0 ,gv0 ,dlwsfci ,emiss ,& + rain ,dtp ,dswsfci ,albedo ,& + xlat_d ,z_lake3d ,dz_lake3d ,lakedepth2d ,& + watsat3d ,csol3d ,tkmg3d ,tkdry3d ,& + tksatu3d ,phii ,& + xice, xice_threshold ,im,km ,& + h2osno2d ,snowdp2d ,snl2d ,z3d ,& !h + dz3d ,zi3d ,h2osoi_vol3d ,h2osoi_liq3d ,& + h2osoi_ice3d ,t_grnd2d ,t_soisno3d ,t_lake3d ,& + savedtke12d ,lake_icefrac3d ,use_lake_model ,& + iopt_lake ,iopt_lake_clm ,& + con_cp ,& + hflx ,evap ,grdflx ,tsfc ,& !o + lake_t2m ,lake_q2m ,clm_lake_initialized ,& + isltyp ,snow ,use_lakedepth ,& + restart ,lakedepth_default ,& + sand3d ,clay3d ,& +! Flake output variables + weasd ,snwdph ,hice ,tsurf ,& + t_sfc ,lflx ,ustar ,qsfc ,& + ch ,cm ,chh ,cmm ,& + T_snow ,T_ice ,tsurf_ice ,wind ,& +! + xlon_d ,kdt ,tg3 ,& + me ,master ,errmsg ,errflg ) + + !============================================================================== + ! This subroutine was first edited by Hongping Gu and Jiming Jin for coupling + ! 07/20/2010 + ! Long after, in June 2022, Sam Trahan updated it for CCPP + !============================================================================== + + IMPLICIT NONE + + !in: + + INTEGER, INTENT(IN) :: iopt_lake, iopt_lake_clm, kdt + INTEGER, INTENT(OUT) :: errflg + CHARACTER(*), INTENT(OUT) :: errmsg + INTEGER , INTENT (IN) :: im,km,me,master + LOGICAL, INTENT(IN) :: restart,use_lakedepth,first_time_step + INTEGER, INTENT(INOUT) :: clm_lake_initialized(:) + REAL(KIND_PHYS), INTENT(IN) :: xice_threshold, con_rd,con_g,con_cp,lakedepth_default + REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: XICE + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN):: tg3 + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: SNOW, ZLVL + + INTEGER, DIMENSION(:), INTENT(IN) :: use_lake_model + real(kind_phys), dimension(:), intent(in) :: rho0 ! air density at surface + + REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT) :: & + weasd ,snwdph ,hice ,tsurf ,& + t_sfc ,lflx ,ustar ,qsfc ,& + chh ,cmm ,T_snow ,T_ice ,& + tsurf_ice ,wind + LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter + REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: gt0 + REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: prsi + REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: phii + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: qvcurr + REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: gu0 + REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: gv0 + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: xlat_d, xlon_d + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: ch + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: cm + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: dlwsfci + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: dswsfci + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: emiss + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: rain + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: albedo + INTEGER, DIMENSION( : ), INTENT(IN) :: ISLTYP + REAL(KIND_PHYS), INTENT(IN) :: dtp + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: z_lake3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: dz_lake3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: watsat3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: csol3d, sand3d, clay3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkmg3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkdry3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tksatu3d + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: lakedepth2d + + !feedback to atmosphere: + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: hflx + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: evap + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: GRDFLX + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN ) :: tsfc + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: lake_t2m + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: lake_q2m + + !in&out: + + real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d + real(kind_phys), dimension(: ) ,intent(inout) :: snowdp2d, & + h2osno2d, & + snl2d, & + t_grnd2d + + real(kind_phys), dimension( :,: ) ,INTENT(inout) :: t_lake3d, & + lake_icefrac3d + real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout) :: t_soisno3d, & + h2osoi_ice3d, & + h2osoi_liq3d, & + h2osoi_vol3d, & + z3d, & + dz3d + real(kind_phys), dimension( :,-nlevsnow+0: ) ,INTENT(inout) :: zi3d + + + !local variable: + + REAL(kind_phys) :: SFCTMP,PBOT,PSFC,Q2K,LWDN,PRCP,SOLDN,SOLNET + INTEGER :: C,i,j,k + + + !tempory varibles in: + real(kind_phys) :: forc_t(1) ! atmospheric temperature (Kelvin) + real(kind_phys) :: forc_pbot(1) ! atm bottom level pressure (Pa) + real(kind_phys) :: forc_psrf(1) ! atmospheric surface pressure (Pa) + real(kind_phys) :: forc_hgt(1) ! atmospheric reference height (m) + real(kind_phys) :: forc_hgt_q(1) ! observational height of humidity [m] + real(kind_phys) :: forc_hgt_t(1) ! observational height of temperature [m] + real(kind_phys) :: forc_hgt_u(1) ! observational height of wind [m] + real(kind_phys) :: forc_q(1) ! atmospheric specific humidity (kg/kg) + real(kind_phys) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) + real(kind_phys) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) + real(kind_phys) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) + real(kind_phys) :: prec(1) ! snow or rain rate [mm/s] + real(kind_phys) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) + real(kind_phys) :: lat(1) ! latitude (radians) + real(kind_phys) :: z_lake(1,nlevlake) ! layer depth for lake (m) + real(kind_phys) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + + real(kind_phys) :: lakedepth(1) ! column lake depth (m) + logical :: do_capsnow(1) ! true => do snow capping + + !in&out + real(kind_phys) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] + real(kind_phys) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_phys) :: h2osno(1) ! snow water (mm H2O) + real(kind_phys) :: snowdp(1) ! snow height (m) + real(kind_phys) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) + real(kind_phys) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) + real(kind_phys) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) + real(kind_phys) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + integer :: snl(1) ! number of snow layers + real(kind_phys) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_phys) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + real(kind_phys) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) + real(kind_phys) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) + real(kind_phys) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + + + !out: + real(kind_phys) :: eflx_gnet(1) !net heat flux into ground (W/m**2) + real(kind_phys) :: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(kind_phys) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] + real(kind_phys) :: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] + real(kind_phys) :: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) + real(kind_phys) :: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) + real(kind_phys) :: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) + real(kind_phys) :: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) + real(kind_phys) :: ram1(1) ! aerodynamical resistance (s/m) + ! for calculation of decay of eddy diffusivity with depth + ! Change the type variable to pass back to WRF. + real(kind_phys) :: z0mg(1) ! roughness length over ground, momentum (m( + real(kind_phys) :: qfx ! mass flux, old WRF qfx(:) variable, (kg/(sm^2)) + + real(kind_phys) :: ustar_out(1) ! friction velocity (temporary) [m/s] + + real(kind_phys) :: discard1, discard2, discard3 ! for unused temporary data + + integer :: lake_points + character*255 :: message + logical, parameter :: feedback_to_atmosphere = .true. ! FIXME: REMOVE + logical :: was_unhappy,is_unhappy + + integer, parameter :: HAVE_NOT_READ_UNHAPPY_POINTS_YET = -1 + integer, parameter :: FAILED_TO_READ_UNHAPPY_POINTS = -2 + + integer, save :: unhappy_count = HAVE_NOT_READ_UNHAPPY_POINTS_YET + real(kind_phys), allocatable, save :: unhappy_lat(:),unhappy_lon(:) + character(*), parameter :: unhappy_txt = "unhappy.txt" + + errmsg = ' ' + errflg = 0 + + if(LAKEDEBUG) then + if(unhappy_count==HAVE_NOT_READ_UNHAPPY_POINTS_YET) then + !$OMP CRITICAL + if(unhappy_count==HAVE_NOT_READ_UNHAPPY_POINTS_YET) then + call read_unhappy_points + if(unhappy_count>0) then +1308 format("Read ",I0,' points from unhappy point list file "',A,'"!') + print 1308,unhappy_count,unhappy_txt +8031 format('Read unhappy xlat_d=',F20.12,' xlon_d=',F20.12) + do i=1,unhappy_count + print 8031,unhappy_lat(i),unhappy_lon(i) + enddo + endif + endif + !$OMP END CRITICAL + endif + if(unhappy_count==FAILED_TO_READ_UNHAPPY_POINTS) then + write(message,'(A)') "ERROR: Could not read unhappy points" + errmsg=message + errflg=1 + return + endif + endif + + ! Still have some points to initialize + call lakeini( ISLTYP, gt0, SNOW, & !i + restart, lakedepth_default, & + lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o + snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & + z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & + h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & + zi3d, watsat3d, csol3d, tkmg3d, & + xice, xice_threshold, tsfc, & + use_lake_model, use_lakedepth, con_g, con_rd, & + tkdry3d, tksatu3d, im, prsi, & + clm_lake_initialized, & + sand3d, clay3d, tg3, & + km, me, master, errmsg, errflg) + if(errflg/=0) then + return + endif + if(any(clay3d>0 .and. clay3d<1)) then + write(message,*) 'Invalid clay3d. Abort.' + errmsg=trim(message) + errflg=1 + return + endif + if(any(dz_lake3d>0 .and. dz_lake3d<.1)) then + write(message,*) 'Invalid dz_lake3d. Abort.' + errmsg=trim(message) + errflg=1 + return + endif + + lake_points=0 + + dtime = dtp + + lake_top_loop: DO I = 1,im + + if_lake_is_here: if (flag_iter(i) .and. use_lake_model(i)/=0) THEN + + SFCTMP = gt0(i,1) + PBOT = prsi(i,2) + PSFC = prsi(i,1) + Q2K = qvcurr(i) + LWDN = DLWSFCI(I)*EMISS(I) + PRCP = RAIN(i)*1000.0_kind_phys/dtp ! use physics timestep since PRCP comes from non-surface schemes + SOLDN = DSWSFCI(I) ! SOLDN is total incoming solar + SOLNET = SOLDN*(1.-ALBEDO(I)) ! use mid-day albedo to determine net downward solar + ! (no solar zenith angle correction) + + lake_points = lake_points+1 + + do c = 1,column + + forc_t(c) = SFCTMP ! [K] + forc_pbot(c) = PBOT ! [Pa] + forc_psrf(c) = PSFC ! [Pa] + forc_hgt(c) = zlvl(i) ! [m] + forc_hgt_q(c) = zlvl(i) ! [m] + forc_hgt_t(c) = zlvl(i) ! [m] + forc_hgt_u(c) = zlvl(i) ! [m] + forc_q(c) = Q2K ! [kg/kg] + forc_u(c) = gu0(I,1) ! [m/s] + forc_v(c) = gv0(I,1) ! [m/s] + forc_lwrad(c) = LWDN ! [W/m/m] + prec(c) = PRCP ! [mm/s] + sabg(c) = SOLNET + lat(c) = XLAT_D(I)*pi/180 ! [radian] + do_capsnow(c) = .false. + + lakedepth(c) = lakedepth2d(i) + savedtke1(c) = savedtke12d(i) + snowdp(c) = snowdp2d(i) + h2osno(c) = h2osno2d(i) + snl(c) = snl2d(i) + t_grnd(c) = t_grnd2d(i) + do k = 1,nlevlake + t_lake(c,k) = t_lake3d(i,k) + lake_icefrac(c,k) = lake_icefrac3d(i,k) + z_lake(c,k) = z_lake3d(i,k) + dz_lake(c,k) = dz_lake3d(i,k) + enddo + do k = -nlevsnow+1,nlevsoil + t_soisno(c,k) = t_soisno3d(i,k) + h2osoi_ice(c,k) = h2osoi_ice3d(i,k) + h2osoi_liq(c,k) = h2osoi_liq3d(i,k) + h2osoi_vol(c,k) = h2osoi_vol3d(i,k) + z(c,k) = z3d(i,k) + dz(c,k) = dz3d(i,k) + enddo + do k = -nlevsnow+0,nlevsoil + zi(c,k) = zi3d(i,k) + enddo + do k = 1,nlevsoil + watsat(c,k) = watsat3d(i,k) + csol(c,k) = csol3d(i,k) + tkmg(c,k) = tkmg3d(i,k) + tkdry(c,k) = tkdry3d(i,k) + tksatu(c,k) = tksatu3d(i,k) + enddo + + enddo + if(LAKEDEBUG.and.kdt<3) then + was_unhappy = point_is_unhappy(xlat_d(i),xlon_d(i)) + if(was_unhappy) then + print *,'Unhappy point before LakeMain t_lake = ',t_lake(1,:) + print *,'Unhappy point before LakeMain t_soilsno = ',t_soisno(1,:) + endif + endif + is_unhappy=.false. + CALL LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I + forc_hgt_t,forc_hgt_u,forc_q, forc_u, & + forc_v,forc_lwrad,prec, sabg,lat, & + z_lake,dz_lake,lakedepth,do_capsnow, & + h2osno,snowdp,snl,z,dz,zi, & !H + h2osoi_vol,h2osoi_liq,h2osoi_ice, & + t_grnd,t_soisno,t_lake, & + savedtke1,lake_icefrac, & + eflx_lwrad_net,eflx_gnet, & !O + eflx_sh_tot,eflx_lh_tot, & + t_ref2m,q_ref2m, & + taux,tauy,ram1,z0mg,ustar_out,errmsg,errflg, & + xlat_d(i),xlon_d(i),is_unhappy) + if(LAKEDEBUG) then + if((was_unhappy .or. is_unhappy) .and. kdt<3) then + print *,'Unhappy point after LakeMain t_lake = ',t_lake(1,:) + print *,'Unhappy point after LakeMain t_soilsno = ',t_soisno(1,:) + endif + if(is_unhappy .and. kdt<3) then +3081 format('UNHAPPY AT: lat=',F20.12,' lon=',F20.12) + print 3081,xlat_d(i),xlon_d(i) + endif + if(errflg/=0) then + errflg=0 ! Bad. Remove this + ! return ! should do this instead + endif + endif + ! Renew Lake State Variables:(14) + do c = 1,column + + savedtke12d(i) = savedtke1(c) + snowdp2d(i) = snowdp(c) + h2osno2d(i) = h2osno(c) + snl2d(i) = snl(c) + t_grnd2d(i) = t_grnd(c) + do k = 1,nlevlake + t_lake3d(i,k) = t_lake(c,k) + lake_icefrac3d(i,k) = lake_icefrac(c,k) + enddo + do k = -nlevsnow+1,nlevsoil + z3d(i,k) = z(c,k) + dz3d(i,k) = dz(c,k) + t_soisno3d(i,k) = t_soisno(c,k) + h2osoi_liq3d(i,k) = h2osoi_liq(c,k) + h2osoi_ice3d(i,k) = h2osoi_ice(c,k) + h2osoi_vol3d(i,k) = h2osoi_vol(c,k) + enddo + do k = -nlevsnow+0,nlevsoil + zi3d(i,k) = zi(c,k) + enddo + + + enddo + + if(feedback_to_atmosphere) then + c = 1 + + ! No equivalent in CCPP: + ! LH(I) = eflx_lh_tot(c)/rho1(i) ![kg*m/(kg*s)] + + + if( t_grnd(c) >= tfrz ) then + qfx = eflx_lh_tot(c)/hvap + else + qfx = eflx_lh_tot(c)/hsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) + endif + evap(i) = qfx/rho0(i) ! kinematic_surface_upward_latent_heat_flux_over_water + HFLX(i)=eflx_sh_tot(c)/(rho0(i)*con_cp) ! kinematic_surface_upward_sensible_heat_flux_over_water + GRDFLX(I) = eflx_gnet(c) ![W/m/m] upward_heat_flux_in_soil_over_water + lflx(i) = eflx_lh_tot(c) ![W/m/m] surface_upward_potential_latent_heat_flux_over_water + tsurf(I) = t_grnd(c) ![K] surface skin temperature after iteration over water + t_sfc(I) = t_grnd(c) ![K] surface skin temperature over water + lake_t2m(I) = t_ref2m(c) + !TH2(I) = T2(I)*(1.E5/PSFC)**RCP ! potential temperature (CCPP doesn't want this) + lake_q2m(I) = q_ref2m(c) ! [frac] specific humidity + albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + ( (1.0-lake_icefrac3d(i,1)) * 0.08) + xice(i) = lake_icefrac3d(i,1) + + if(xice(i)>0) then + weasd(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice + snwdph(i) = h2osno(c)/snow_bd*1000 ! surface_snow_thickness_water_equivalent_over_ice + T_ice(i) = t_grnd(c) ! surface_skin_temperature_over_ice + tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice + + ! Assume that, if a layer has ice, the entire layer thickness is ice. + hice(I) = 0 + do k=1,nlevlake + if(lake_icefrac3d(i,k)>0) then + hice(i) = hice(i) + dz_lake3d(i,k) + endif + end do + else + weasd(i) = 0 + snwdph(i) = 0 + T_ice(i) = tsurf(i) + tsurf_ice(i) = T_ice(i) + hice(i) = 0 + endif + + if(snl2d(i)>0) then + T_snow(i) = t_grnd(c) ! temperature_of_snow_on_lake + endif + + ustar = ustar_out(1) ! surface_friction_velocity_over_water + + ! Calculate qsfc from t_grnd: (surface_specific_humidity_over_water) + call QSat(t_grnd(c),psfc,discard1,discard2,qsfc(i),discard3) + + ! From flake driver: + chh(i)=ch(i)*wind(i)*1.225 ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water + cmm(i)=cm(i)*wind(i) ! surface_drag_wind_speed_for_momentum_in_air_over_water + + endif + + endif if_lake_is_here + ENDDO lake_top_loop + + if(LAKEDEBUG .and. lake_points>0) then +3082 format('lake points processed in timestep ',I0,' by rank ',I0,' = ',I0) + print 3082,kdt,me,lake_points + endif + + CONTAINS + + logical function point_is_unhappy(xlat_d,xlon_d) + implicit none + integer :: j + real, intent(in) :: xlat_d,xlon_d + + do j=1,unhappy_count + if(abs(xlat_d-unhappy_lat(j))<.015 .and. abs(xlon_d-unhappy_lon(j))<.015) then + point_is_unhappy=.true. +1444 format('Now processing unhappy point ',I0,' location xlat_d=',F20.12,' xlon_d=',F20.12,' close to xlat_d=',F20.12,' xlon_d=',F20.12) + print 1444,j,xlat_d,xlon_d,unhappy_lat(j),unhappy_lon(j) + return + endif + enddo + + ! No points matched + point_is_unhappy=.false. + end function point_is_unhappy + + subroutine read_unhappy_points + use ISO_FORTRAN_ENV, only: iostat_end, iostat_eor + implicit none + integer :: i,unhappy_iostat,unhappy_unit,expect_count,actual_count + + ! Number of points actually read in is 0 since we haven't read yet. + actual_count=0 + + ! Open the unhappy points file + open(file=unhappy_txt,form='formatted',newunit=unhappy_unit,action='read',iostat=unhappy_iostat,status='old') + if(unhappy_iostat/=0) then + write(message,'(A,A,A)') 'Could not open "',unhappy_txt,'"!!' + goto 1001 ! Error handler without closing file + endif + + ! Determine how many points to read in. + expect_count=-1 + read(unit=unhappy_unit,fmt='(I12)',iostat=unhappy_iostat) expect_count + if(unhappy_iostat/=0 .or. expect_count<0) then + write(message,'(A,A,A)') 'Could not read unhappy point count from "',unhappy_txt,'"!!' + goto 1000 ! Error handler that also closes the file + endif + + ! Allocate enough data for the number of points we expect to read in + allocate(unhappy_lat(expect_count)) + allocate(unhappy_lon(expect_count)) + + unhappy_lat = -999 + unhappy_lon = -999 + + ! Read data, and determine the number of points actually in the file + do i=1,expect_count + read(unit=unhappy_unit,fmt='(F20.14,F20.14)',iostat=unhappy_iostat) & + unhappy_lat(actual_count+1),unhappy_lon(actual_count+1) + if(unhappy_iostat==iostat_end) then + exit + else if(unhappy_iostat==iostat_eor) then + continue ! Probably a blank line + else if(unhappy_iostat/=0) then + write(message,'(A,A,A)') 'Error reading from "',unhappy_txt,'"!!' + goto 1000 ! Error handler that also closes the file + else + actual_count=actual_count+1 + endif + enddo + + ! Indicate successful read by setting the unhappy_count to the number of points actually read in. + unhappy_count=actual_count + close(unhappy_iostat) + + return ! Success! + +1000 continue ! Error handler, after file is opened + close(unhappy_iostat) + +1001 continue ! Error handler, whether file was opened or not + write(0,'(A)') message + errmsg=message + errflg=1 + if(allocated(unhappy_lat)) deallocate(unhappy_lat) + if(allocated(unhappy_lon)) deallocate(unhappy_lon) + unhappy_count=FAILED_TO_READ_UNHAPPY_POINTS + + end subroutine read_unhappy_points + + END SUBROUTINE clm_lake_run + + + SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I + forc_hgt_t,forc_hgt_u,forc_q, forc_u, & + forc_v,forc_lwrad,prec, sabg,lat, & + z_lake,dz_lake,lakedepth,do_capsnow, & + h2osno,snowdp,snl,z,dz,zi, & !H + h2osoi_vol,h2osoi_liq,h2osoi_ice, & + t_grnd,t_soisno,t_lake, & + savedtke1,lake_icefrac, & + eflx_lwrad_net,eflx_gnet, & !O + eflx_sh_tot,eflx_lh_tot, & + t_ref2m,q_ref2m, & + taux,tauy,ram1,z0mg,ustar_out,errmsg,errflg, xlat_d,xlon_d,unhappy) + implicit none + !in: + + logical :: unhappy + integer, intent(inout) :: errflg + character(*), intent(inout) :: errmsg + real(kind_phys),intent(in) :: xlat_d, xlon_d ! grid location for debugging + real(kind_phys),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) + real(kind_phys),intent(in) :: forc_pbot(1) ! atm bottom level pressure (Pa) + real(kind_phys),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) + real(kind_phys),intent(in) :: forc_hgt(1) ! atmospheric reference height (m) + real(kind_phys),intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] + real(kind_phys),intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] + real(kind_phys),intent(in) :: forc_hgt_u(1) ! observational height of wind [m] + real(kind_phys),intent(in) :: forc_q(1) ! atmospheric specific humidity (kg/kg) + real(kind_phys),intent(in) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) + real(kind_phys),intent(in) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) + ! real(kind_phys),intent(in) :: forc_rho(1) ! density (kg/m**3) + real(kind_phys),intent(in) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) + real(kind_phys),intent(in) :: prec(1) ! snow or rain rate [mm/s] + real(kind_phys),intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) + real(kind_phys),intent(in) :: lat(1) ! latitude (radians) + real(kind_phys),intent(in) :: z_lake(1,nlevlake) ! layer depth for lake (m) + real(kind_phys),intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + real(kind_phys),intent(out) :: ustar_out(1) ! friction velocity [m/s] + real(kind_phys), intent(in) :: lakedepth(1) ! column lake depth (m) + !!!!!!!!!!!!!!!!tep(in),hydro(in) + ! real(kind_phys), intent(in) :: watsat(1,1:nlevsoil) ! volumetric soil water at saturation (porosity) + !!!!!!!!!!!!!!!!hydro + logical , intent(in) :: do_capsnow(1) ! true => do snow capping + + + + !in&out + real(kind_phys),intent(inout) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] + real(kind_phys),intent(inout) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_phys),intent(inout) :: h2osno(1) ! snow water (mm H2O) + real(kind_phys),intent(inout) :: snowdp(1) ! snow height (m) + real(kind_phys),intent(inout) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) + real(kind_phys),intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) + real(kind_phys),intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) + real(kind_phys),intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + integer ,intent(inout) :: snl(1) ! number of snow layers + real(kind_phys),intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_phys),intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + real(kind_phys),intent(inout) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) + real(kind_phys),intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) + real(kind_phys),intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + + + !out: + real(kind_phys),intent(out) :: eflx_gnet(1) !net heat flux into ground (W/m**2) + real(kind_phys),intent(out) :: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(kind_phys),intent(out) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] + real(kind_phys),intent(out) :: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] + real(kind_phys),intent(out) :: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) + real(kind_phys),intent(out) :: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) + real(kind_phys),intent(out) :: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) + real(kind_phys),intent(out) :: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) + real(kind_phys),intent(out) :: ram1(1) ! aerodynamical resistance (s/m) + ! for calculation of decay of eddy diffusivity with depth + ! Change the type variable to pass back to WRF. + real(kind_phys),intent(out) :: z0mg(1) ! roughness length over ground, momentum (m( + + + !local output + + real(kind_phys) :: begwb(1) ! water mass begining of the time step + real(kind_phys) :: t_veg(1) ! vegetation temperature (Kelvin) + real(kind_phys) :: eflx_soil_grnd(1) ! soil heat flux (W/m**2) [+ = into soil] + real(kind_phys) :: eflx_lh_grnd(1) ! ground evaporation heat flux (W/m**2) [+ to atm] + real(kind_phys) :: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(kind_phys) :: eflx_lwrad_out(1) ! emitted infrared (longwave) radiation (W/m**2) + real(kind_phys) :: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + real(kind_phys) :: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) + real(kind_phys) :: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] + real(kind_phys) :: forc_snow(1) ! snow rate [mm/s] + real(kind_phys) :: forc_rain(1) ! rain rate [mm/s] + real(kind_phys) :: ws(1) ! surface friction velocity (m/s) + real(kind_phys) :: ks(1) ! coefficient passed to ShalLakeTemperature + real(kind_phys) :: qflx_snomelt(1) !snow melt (mm H2O /s) tem(out),snowwater(in) + integer :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 (new) + real(kind_phys) :: endwb(1) ! water mass end of the time step + real(kind_phys) :: snowage(1) ! non dimensional snow age [-] + real(kind_phys) :: snowice(1) ! average snow ice lens + real(kind_phys) :: snowliq(1) ! average snow liquid water + real(kind_phys) :: t_snow(1) ! vertically averaged snow temperature + real(kind_phys) :: qflx_drain(1) ! sub-surface runoff (mm H2O /s) + real(kind_phys) :: qflx_surf(1) ! surface runoff (mm H2O /s) + real(kind_phys) :: qflx_infl(1) ! infiltration (mm H2O /s) + real(kind_phys) :: qflx_qrgwl(1) ! qflx_surf at glaciers, wetlands, lakes + real(kind_phys) :: qcharge(1) ! aquifer recharge rate (mm/s) + real(kind_phys) :: qflx_snowcap(1) ! excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_phys) :: qflx_snowcap_col(1) ! excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_phys) :: qflx_snow_grnd_pft(1) ! snow on ground after interception (mm H2O/s) [+] + real(kind_phys) :: qflx_snow_grnd_col(1) ! snow on ground after interception (mm H2O/s) [+] + real(kind_phys) :: qflx_rain_grnd(1) ! rain on ground after interception (mm H2O/s) [+] + real(kind_phys) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water + real(kind_phys) :: qflx_evap_tot_col(1) !pft quantity averaged to the column (assuming one pft) + real(kind_phys) :: soilalpha(1) !factor that reduces ground saturated specific humidity (-) + real(kind_phys) :: zwt(1) !water table depth + real(kind_phys) :: fcov(1) !fractional area with water table at surface + real(kind_phys) :: rootr_column(1,1:nlevsoil) !effective fraction of roots in each soil layer + real(kind_phys) :: qflx_evap_grnd(1) ! ground surface evaporation rate (mm H2O/s) [+] + real(kind_phys) :: qflx_sub_snow(1) ! sublimation rate from snow pack (mm H2O /s) [+] + real(kind_phys) :: qflx_dew_snow(1) ! surface dew added to snow pack (mm H2O /s) [+] + real(kind_phys) :: qflx_dew_grnd(1) ! ground surface dew formation (mm H2O /s) [+] + real(kind_phys) :: qflx_rain_grnd_col(1) !rain on ground after interception (mm H2O/s) [+] + begwb = 0 + + ! lat = lat*pi/180 ! [radian] + + if (prec(1)> 0.) then + if ( forc_t(1) > (tfrz + tcrit)) then + forc_rain(1) = prec(1) + forc_snow(1) = 0. + ! flfall(1) = 1. + else + forc_rain(1) = 0. + forc_snow(1) = prec(1) + + ! if ( forc_t(1) <= tfrz) then + ! flfall(1) = 0. + ! else if ( forc_t(1) <= tfrz+2.) then + ! flfall(1) = -54.632 + 0.2 * forc_t(1) + ! else + ! flfall(1) = 0.4 + endif + else + forc_rain(1) = 0. + forc_snow(1) = 0. + ! flfall(1) = 1. + endif + + CALL ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !i + forc_hgt_t,forc_hgt_u,forc_q, & + forc_u,forc_v,forc_lwrad,forc_snow, & + forc_rain,t_grnd,h2osno,snowdp,sabg,lat, & + dz,dz_lake,t_soisno,t_lake,snl,h2osoi_liq, & + h2osoi_ice,savedtke1, & + qflx_prec_grnd,qflx_evap_soi,qflx_evap_tot, & !o + eflx_sh_grnd,eflx_lwrad_out,eflx_lwrad_net, & + eflx_soil_grnd,eflx_sh_tot,eflx_lh_tot, & + eflx_lh_grnd,t_veg,t_ref2m,q_ref2m,taux,tauy, & + ram1,ws,ks,eflx_gnet,z0mg,ustar_out,errmsg,errflg,xlat_d,xlon_d,unhappy) + if(errflg/=0) then + !return ! State is invalid now, so pass error to caller. + endif + + CALL ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & !i + z_lake,ws,ks,snl,eflx_gnet,lakedepth, & + lake_icefrac,snowdp, & !i&o + eflx_sh_grnd,eflx_sh_tot,eflx_soil_grnd, & !o + t_lake,t_soisno,h2osoi_liq, & + h2osoi_ice,savedtke1, & + frac_iceold,qflx_snomelt,imelt,errmsg,errflg) + if(errflg/=0) then + !return ! State is invalid now, so pass error to caller. + endif + + CALL ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & !i + begwb,qflx_evap_tot,forc_t,do_capsnow, & + t_grnd,qflx_evap_soi, & + qflx_snomelt,imelt,frac_iceold, & !i add by guhp + z,dz,zi,snl,h2osno,snowdp,lake_icefrac,t_lake, & !i&o + endwb,snowage,snowice,snowliq,t_snow, & !o + t_soisno,h2osoi_ice,h2osoi_liq,h2osoi_vol, & + qflx_drain,qflx_surf,qflx_infl,qflx_qrgwl, & + qcharge,qflx_prec_grnd,qflx_snowcap, & + qflx_snowcap_col,qflx_snow_grnd_pft, & + qflx_snow_grnd_col,qflx_rain_grnd, & + qflx_evap_tot_col,soilalpha,zwt,fcov, & + rootr_column,qflx_evap_grnd,qflx_sub_snow, & + qflx_dew_snow,qflx_dew_grnd,qflx_rain_grnd_col, & + errmsg,errflg) + if(errflg/=0) then + !return ! State is invalid now, so pass error to caller. + endif + + !================================================================================== + ! !DESCRIPTION: + ! Calculation of Shallow Lake Hydrology. Full hydrology of snow layers is + ! done. However, there is no infiltration, and the water budget is balanced with + + END SUBROUTINE LakeMain + + +SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !i + forc_hgt_t,forc_hgt_u,forc_q, & + forc_u,forc_v,forc_lwrad,forc_snow, & + forc_rain,t_grnd,h2osno,snowdp,sabg,lat, & + dz,dz_lake,t_soisno,t_lake,snl,h2osoi_liq, & + h2osoi_ice,savedtke1, & + qflx_prec_grnd,qflx_evap_soi,qflx_evap_tot, & !o + eflx_sh_grnd,eflx_lwrad_out,eflx_lwrad_net, & + eflx_soil_grnd,eflx_sh_tot,eflx_lh_tot, & + eflx_lh_grnd,t_veg,t_ref2m,q_ref2m,taux,tauy, & + ram1,ws,ks,eflx_gnet,z0mg,ustar_out,errmsg,errflg,xlat_d,xlon_d,unhappy) + !============================================================================== + ! DESCRIPTION: + ! Calculates lake temperatures and surface fluxes for shallow lakes. + ! + ! Shallow lakes have variable depth, possible snow layers above, freezing & thawing of lake water, + ! and soil layers with active temperature and gas diffusion below. + ! + ! WARNING: This subroutine assumes lake columns have one and only one pft. + ! + ! REVISION HISTORY: + ! Created by Zack Subin, 2009 + ! Reedited by Hongping Gu, 2010 + ! Updated for CCPP by Sam Trahan, 2022 + !============================================================================== + + ! implicit none + + implicit none + + !in: + + integer, intent(inout) :: errflg + logical :: unhappy + character(len=*), intent(inout) :: errmsg + real(kind_phys),intent(in) :: xlat_d,xlon_d + real(kind_phys),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) + real(kind_phys),intent(in) :: forc_pbot(1) ! atmospheric pressure (Pa) + real(kind_phys),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) + real(kind_phys),intent(in) :: forc_hgt(1) ! atmospheric reference height (m) + real(kind_phys),intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] + real(kind_phys),intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] + real(kind_phys),intent(in) :: forc_hgt_u(1) ! observational height of wind [m] + real(kind_phys),intent(in) :: forc_q(1) ! atmospheric specific humidity (kg/kg) + real(kind_phys),intent(in) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) + real(kind_phys),intent(in) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) + real(kind_phys),intent(in) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) + ! real(kind_phys),intent(in) :: forc_rho(1) ! density (kg/m**3) + real(kind_phys),intent(in) :: forc_snow(1) ! snow rate [mm/s] + real(kind_phys),intent(in) :: forc_rain(1) ! rain rate [mm/s] + real(kind_phys),intent(in) :: h2osno(1) ! snow water (mm H2O) + real(kind_phys),intent(in) :: snowdp(1) ! snow height (m) + real(kind_phys),intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) + real(kind_phys),intent(in) :: lat(1) ! latitude (radians) + real(kind_phys),intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) + real(kind_phys),intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + real(kind_phys),intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) + real(kind_phys),intent(in) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + integer ,intent(in) :: snl(1) ! number of snow layers + real(kind_phys),intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_phys),intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + real(kind_phys),intent(in) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) + + !inout: + real(kind_phys),intent(inout) :: t_grnd(1) ! ground temperature (Kelvin) + !out: + real(kind_phys),intent(out):: ustar_out(1) ! friction velocity [m/s] + real(kind_phys),intent(out):: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] + real(kind_phys),intent(out):: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) + real(kind_phys),intent(out):: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + real(kind_phys),intent(out):: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(kind_phys),intent(out):: eflx_lwrad_out(1) ! emitted infrared (longwave) radiation (W/m**2) + real(kind_phys),intent(out):: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(kind_phys),intent(out):: eflx_soil_grnd(1) ! soil heat flux (W/m**2) [+ = into soil] + real(kind_phys),intent(out):: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] + real(kind_phys),intent(out):: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] + real(kind_phys),intent(out):: eflx_lh_grnd(1) ! ground evaporation heat flux (W/m**2) [+ to atm] + real(kind_phys),intent(out):: t_veg(1) ! vegetation temperature (Kelvin) + real(kind_phys),intent(out):: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) + real(kind_phys),intent(out):: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) + real(kind_phys),intent(out):: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) + real(kind_phys),intent(out):: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) + real(kind_phys),intent(out):: ram1(1) ! aerodynamical resistance (s/m) + real(kind_phys),intent(out):: ws(1) ! surface friction velocity (m/s) + real(kind_phys),intent(out):: ks(1) ! coefficient passed to ShalLakeTemperature + ! for calculation of decay of eddy diffusivity with depth + real(kind_phys),intent(out):: eflx_gnet(1) !net heat flux into ground (W/m**2) + ! Change the type variable to pass back to WRF. + real(kind_phys),intent(out):: z0mg(1) ! roughness length over ground, momentum (m( + + + + !OTHER LOCAL VARIABLES: + + integer , parameter :: islak = 2 ! index of lake, 1 = deep lake, 2 = shallow lake + integer , parameter :: niters = 3 ! maximum number of iterations for surface temperature + real(kind_phys), parameter :: beta1 = 1._kind_phys ! coefficient of convective velocity (in computing W_*) [-] + real(kind_phys), parameter :: emg = 0.97_kind_phys ! ground emissivity (0.97 for snow) + real(kind_phys), parameter :: zii = 1000._kind_phys! convective boundary height [m] + real(kind_phys), parameter :: tdmax = 277._kind_phys ! temperature of maximum water density + real(kind_phys) :: forc_th(1) ! atmospheric potential temperature (Kelvin) + real(kind_phys) :: forc_vp(1) !atmospheric vapor pressure (Pa) + real(kind_phys) :: forc_rho(1) ! density (kg/m**3) + integer :: i,fc,fp,g,c,p ! do loop or array index + integer :: fncopy ! number of values in pft filter copy + integer :: fnold ! previous number of pft filter values + integer :: fpcopy(num_shlakep) ! pft filter copy for iteration loop + integer :: iter ! iteration index + integer :: nmozsgn(lbp:ubp) ! number of times moz changes sign + integer :: jtop(lbc:ubc) ! top level for each column (no longer all 1) + ! real(kind_phys) :: dtime ! land model time step (sec) + real(kind_phys) :: ax ! used in iteration loop for calculating t_grnd (numerator of NR solution) + real(kind_phys) :: bx ! used in iteration loop for calculating t_grnd (denomin. of NR solution) + real(kind_phys) :: degdT ! d(eg)/dT + real(kind_phys) :: dqh(lbp:ubp) ! diff of humidity between ref. height and surface + real(kind_phys) :: dth(lbp:ubp) ! diff of virtual temp. between ref. height and surface + real(kind_phys) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(kind_phys) :: dzsur(lbc:ubc) ! 1/2 the top layer thickness (m) + real(kind_phys) :: eg ! water vapor pressure at temperature T [pa] + real(kind_phys) :: htvp(lbc:ubc) ! latent heat of vapor of water (or sublimation) [j/kg] + real(kind_phys) :: obu(lbp:ubp) ! monin-obukhov length (m) + real(kind_phys) :: obuold(lbp:ubp) ! monin-obukhov length of previous iteration + real(kind_phys) :: qsatg(lbc:ubc) ! saturated humidity [kg/kg] + real(kind_phys) :: qsatgdT(lbc:ubc) ! d(qsatg)/dT + real(kind_phys) :: qstar ! moisture scaling parameter + real(kind_phys) :: ram(lbp:ubp) ! aerodynamical resistance [s/m] + real(kind_phys) :: rah(lbp:ubp) ! thermal resistance [s/m] + real(kind_phys) :: raw(lbp:ubp) ! moisture resistance [s/m] + real(kind_phys) :: stftg3(lbp:ubp) ! derivative of fluxes w.r.t ground temperature + real(kind_phys) :: temp1(lbp:ubp) ! relation for potential temperature profile + real(kind_phys) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m + real(kind_phys) :: temp2(lbp:ubp) ! relation for specific humidity profile + real(kind_phys) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m + real(kind_phys) :: tgbef(lbc:ubc) ! initial ground temperature + real(kind_phys) :: thm(lbc:ubc) ! intermediate variable (forc_t+0.0098*forc_hgt_t) + real(kind_phys) :: thv(lbc:ubc) ! virtual potential temperature (kelvin) + real(kind_phys) :: thvstar ! virtual potential temperature scaling parameter + real(kind_phys) :: tksur ! thermal conductivity of snow/soil (w/m/kelvin) + real(kind_phys) :: tsur ! top layer temperature + real(kind_phys) :: tstar ! temperature scaling parameter + real(kind_phys) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] + real(kind_phys) :: ur(lbp:ubp) ! wind speed at reference height [m/s] + real(kind_phys) :: ustar(lbp:ubp) ! friction velocity [m/s] + real(kind_phys) :: wc ! convective velocity [m/s] + real(kind_phys) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(kind_phys) :: zldis(lbp:ubp) ! reference height "minus" zero displacement height [m] + real(kind_phys) :: displa(lbp:ubp) ! displacement (always zero) [m] + ! real(kind_phys) :: z0mg(lbp:ubp) ! roughness length over ground, momentum [m] + real(kind_phys) :: z0hg(lbp:ubp) ! roughness length over ground, sensible heat [m] + real(kind_phys) :: z0qg(lbp:ubp) ! roughness length over ground, latent heat [m] + real(kind_phys) :: beta(2) ! fraction solar rad absorbed at surface: depends on lake type + real(kind_phys) :: u2m ! 2 m wind speed (m/s) + real(kind_phys) :: u10(1) ! 10-m wind (m/s) (for dust model) + real(kind_phys) :: fv(1) ! friction velocity (m/s) (for dust model) + + real(kind_phys) :: fm(lbp:ubp) ! needed for BGC only to diagnose 10m wind speed + real(kind_phys) :: bw ! partial density of water (ice + liquid) + real(kind_phys) :: t_grnd_temp ! Used in surface flux correction over frozen ground + real(kind_phys) :: betaprime(lbc:ubc) ! Effective beta: 1 for snow layers, beta(islak) otherwise + character*256 :: message + ! This assumes all radiation is absorbed in the top snow layer and will need + ! to be changed for CLM 4. + ! + ! Constants for lake temperature model + ! + data beta/0.4_kind_phys, 0.4_kind_phys/ ! (deep lake, shallow lake) + ! This is the energy absorbed at the lake surface if no snow. + ! data za /0.6_kind_phys, 0.5_kind_phys/ + ! data eta /0.1_kind_phys, 0.5_kind_phys/ + !----------------------------------------------------------------------- + + unhappy=.false. + + ! dtime = get_step_size() + + ! Begin calculations + + !dir$ concurrent + !cdir nodep + forc_th(1) = forc_t(1) * (forc_psrf(1)/ forc_pbot(1))**(rair/cpair) + forc_vp(1) = forc_q(1) * forc_pbot(1)/ (0.622 + 0.378 * forc_q(1)) + forc_rho(1) = (forc_pbot(1) - 0.378 * forc_vp(1)) / (rair * forc_t(1)) + + do fc = 1, num_shlakec + c = filter_shlakec(fc) + g = cgridcell(c) + + ! Surface temperature and fluxes + + ! Find top layer + if (snl(c) > 0 .or. snl(c) < -5) then + errmsg='snl is not defined in ShalLakeFluxesMod; snl: out of range value' + errflg=1 + unhappy=.true. + return ! Cannot continue + end if + ! if (snl(c) /= 0) then + ! write(6,*)'snl is not equal to zero in ShalLakeFluxesMod' + ! call endrun() + ! end if + jtop(c) = snl(c) + 1 + + + if (snl(c) < 0) then + betaprime(c) = 1._kind_phys !Assume all solar rad. absorbed at the surface of the top snow layer. + dzsur(c) = dz(c,jtop(c))/2._kind_phys + else + betaprime(c) = beta(islak) + dzsur(c) = dz_lake(c,1)/2._kind_phys + end if + ! Originally this was 1*dz, but shouldn't it be 1/2? + + ! Saturated vapor pressure, specific humidity and their derivatives + ! at lake surface + + call QSat(t_grnd(c), forc_pbot(g), eg, degdT, qsatg(c), qsatgdT(c)) + + ! Potential, virtual potential temperature, and wind speed at the + ! reference height + + thm(c) = forc_t(g) + 0.0098_kind_phys*forc_hgt_t(g) ! intermediate variable + thv(c) = forc_th(g)*(1._kind_phys+0.61_kind_phys*forc_q(g)) ! virtual potential T + end do + + !dir$ concurrent + !cdir nodep + do fp = 1, num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + g = pgridcell(p) + + nmozsgn(p) = 0 + obuold(p) = 0._kind_phys + displa(p) = 0._kind_phys + + ! Roughness lengths + + + ! changed by Hongping Gu + ! if (t_grnd(c) >= tfrz) then ! for unfrozen lake + ! z0mg(p) = 0.01_kind_phys + ! else ! for frozen lake + ! ! Is this okay even if it is snow covered? What is the roughness over + ! non-veg. snow? + ! z0mg(p) = 0.04_kind_phys + ! end if + + if (t_grnd(c) >= tfrz) then ! for unfrozen lake + z0mg(p) = 0.001_kind_phys !original 0.01 + else if(snl(c) == 0 ) then ! for frozen lake + ! Is this okay even if it is snow covered? What is the roughness over + ! non-veg. snow? + z0mg(p) = 0.005_kind_phys !original 0.04, now for frozen lake without snow + else ! for frozen lake with snow + z0mg(p) = 0.0024_kind_phys + end if + + + + + z0hg(p) = z0mg(p) + z0qg(p) = z0mg(p) + + ! Latent heat + + if(PERGRO) then + htvp(c) = hvap + else + if (t_grnd(c) > tfrz) then + htvp(c) = hvap + else + htvp(c) = hsub + end if + endif + + ! Zack Subin, 3/26/09: Shouldn't this be the ground temperature rather than the air temperature above? + ! I'll change it for now. + + ! Initialize stability variables + + ur(p) = max(1.0_kind_phys,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + dth(p) = thm(c)-t_grnd(c) + dqh(p) = forc_q(g)-qsatg(c) + dthv = dth(p)*(1._kind_phys+0.61_kind_phys*forc_q(g))+0.61_kind_phys*forc_th(g)*dqh(p) + zldis(p) = forc_hgt_u(g) - 0._kind_phys + + ! Initialize Monin-Obukhov length and wind speed + + call MoninObukIni(ur(p), thv(c), dthv, zldis(p), z0mg(p), um(p), obu(p)) + + end do + + iter = 1 + fncopy = num_shlakep + fpcopy(1:num_shlakep) = filter_shlakep(1:num_shlakep) + + ! Begin stability iteration + + ITERATION : do while (iter <= niters .and. fncopy > 0) + + ! Determine friction velocity, and potential temperature and humidity + ! profiles of the surface boundary layer + + call FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i + forc_hgt_t,forc_hgt_q, & !i + lbp, ubp, fncopy, fpcopy, & !i + displa, z0mg, z0hg, z0qg, & !i + obu, iter, ur, um, & !i + ustar,temp1, temp2, temp12m, temp22m, & !o + u10,fv, & !o + fm) !i&o + + !dir$ concurrent + !cdir nodep + do fp = 1, fncopy + p = fpcopy(fp) + c = pcolumn(p) + g = pgridcell(p) + + tgbef(c) = t_grnd(c) + if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then + tksur = savedtke1(c) + ! Set this to the eddy conductivity from the last + ! timestep, as the molecular conductivity will be orders of magnitude too small. + ! Will have to deal with first timestep. + tsur = t_lake(c,1) + else if (snl(c) == 0) then !frozen but no snow layers + tksur = tkice + tsur = t_lake(c,1) + else + !Need to calculate thermal conductivity of the top snow layer + bw = (h2osoi_ice(c,jtop(c))+h2osoi_liq(c,jtop(c)))/dz(c,jtop(c)) + tksur = tkairc + (7.75e-5_kind_phys *bw + 1.105e-6_kind_phys*bw*bw)*(tkice-tkairc) + tsur = t_soisno(c,jtop(c)) + end if + + ! Determine aerodynamic resistances + + ram(p) = 1._kind_phys/(ustar(p)*ustar(p)/um(p)) + rah(p) = 1._kind_phys/(temp1(p)*ustar(p)) + raw(p) = 1._kind_phys/(temp2(p)*ustar(p)) + ram1(p) = ram(p) !pass value to global variable + + ! Get derivative of fluxes with respect to ground temperature + + stftg3(p) = emg*sb*tgbef(c)*tgbef(c)*tgbef(c) + + ! Changed surface temperature from t_lake(c,1) to tsur. + ! Also adjusted so that if there are snow layers present, all radiation is absorbed in the top layer. + ax = betaprime(c)*sabg(p) + emg*forc_lwrad(g) + 3._kind_phys*stftg3(p)*tgbef(c) & + + forc_rho(g)*cpair/rah(p)*thm(c) & + - htvp(c)*forc_rho(g)/raw(p)*(qsatg(c)-qsatgdT(c)*tgbef(c) - forc_q(g)) & + + tksur*tsur/dzsur(c) + !Changed sabg(p) and to betaprime(c)*sabg(p). + bx = 4._kind_phys*stftg3(p) + forc_rho(g)*cpair/rah(p) & + + htvp(c)*forc_rho(g)/raw(p)*qsatgdT(c) + tksur/dzsur(c) + + t_grnd(c) = ax/bx + + ! Update htvp + if(.not.PERGRO) then + if (t_grnd(c) > tfrz) then + htvp(c) = hvap + else + htvp(c) = hsub + end if + endif + + ! Surface fluxes of momentum, sensible and latent heat + ! using ground temperatures from previous time step + + eflx_sh_grnd(p) = forc_rho(g)*cpair*(t_grnd(c)-thm(c))/rah(p) + qflx_evap_soi(p) = forc_rho(g)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-tgbef(c))-forc_q(g))/raw(p) + + ! Re-calculate saturated vapor pressure, specific humidity and their + ! derivatives at lake surface + + call QSat(t_grnd(c), forc_pbot(g), eg, degdT, qsatg(c), qsatgdT(c)) + + dth(p)=thm(c)-t_grnd(c) + dqh(p)=forc_q(g)-qsatg(c) + + tstar = temp1(p)*dth(p) + qstar = temp2(p)*dqh(p) + + thvstar=tstar*(1._kind_phys+0.61_kind_phys*forc_q(g)) + 0.61_kind_phys*forc_th(g)*qstar + zeta=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c)) + + if (zeta >= 0._kind_phys) then !stable + zeta = min(2._kind_phys,max(zeta,0.01_kind_phys)) + um(p) = max(ur(p),0.1_kind_phys) + else !unstable + zeta = max(-100._kind_phys,min(zeta,-0.01_kind_phys)) + wc = beta1*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_kind_phys + um(p) = sqrt(ur(p)*ur(p)+wc*wc) + end if + obu(p) = zldis(p)/zeta + + if (obuold(p)*obu(p) < 0._kind_phys) nmozsgn(p) = nmozsgn(p)+1 + + obuold(p) = obu(p) + + end do ! end of filtered pft loop + + iter = iter + 1 + if (iter <= niters ) then + ! Rebuild copy of pft filter for next pass through the ITERATION loop + + fnold = fncopy + fncopy = 0 + do fp = 1, fnold + p = fpcopy(fp) + if (nmozsgn(p) < 3) then + fncopy = fncopy + 1 + fpcopy(fncopy) = p + end if + end do ! end of filtered pft loop + end if + + end do ITERATION ! end of stability iteration + + !dir$ concurrent + !cdir nodep + do fp = 1, num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + g = pgridcell(p) + + ! If there is snow on the ground and t_grnd > tfrz: reset t_grnd = tfrz. + ! Re-evaluate ground fluxes. + ! h2osno > 0.5 prevents spurious fluxes. + ! note that qsatg and qsatgdT should be f(tgbef) (PET: not sure what this + ! comment means) + ! Zack Subin, 3/27/09: Since they are now a function of whatever t_grnd was before cooling + ! to freezing temperature, then this value should be used in the derivative correction term. + ! Should this happen if the lake temperature is below freezing, too? I'll assume that for now. + ! Also, allow convection if ground temp is colder than lake but warmer than 4C, or warmer than + ! lake which is warmer than freezing but less than 4C. + if ( (h2osno(c) > 0.5_kind_phys .or. t_lake(c,1) <= tfrz) .and. t_grnd(c) > tfrz) then + t_grnd_temp = t_grnd(c) + t_grnd(c) = tfrz + eflx_sh_grnd(p) = forc_rho(g)*cpair*(t_grnd(c)-thm(c))/rah(p) + qflx_evap_soi(p) = forc_rho(g)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-t_grnd_temp) - forc_q(g))/raw(p) + else if ( (t_lake(c,1) > t_grnd(c) .and. t_grnd(c) > tdmax) .or. & + (t_lake(c,1) < t_grnd(c) .and. t_lake(c,1) > tfrz .and. t_grnd(c) < tdmax) ) then + ! Convective mixing will occur at surface + t_grnd_temp = t_grnd(c) + t_grnd(c) = t_lake(c,1) + eflx_sh_grnd(p) = forc_rho(g)*cpair*(t_grnd(c)-thm(c))/rah(p) + qflx_evap_soi(p) = forc_rho(g)*(qsatg(c)+qsatgdT(c)*(t_grnd(c)-t_grnd_temp) - forc_q(g))/raw(p) + end if + + ! Update htvp + if(.not.PERGRO) then + if (t_grnd(c) > tfrz) then + htvp(c) = hvap + else + htvp(c) = hsub + end if + endif + + ! Net longwave from ground to atmosphere + + ! eflx_lwrad_out(p) = (1._kind_phys-emg)*forc_lwrad(g) + stftg3(p)*(-3._kind_phys*tgbef(c)+4._kind_phys*t_grnd(c)) + ! What is tgbef doing in this equation? Can't it be exact now? --Zack Subin, 4/14/09 + eflx_lwrad_out(p) = (1._kind_phys-emg)*forc_lwrad(g) + emg*sb*t_grnd(c)**4 + + ! Ground heat flux + + eflx_soil_grnd(p) = sabg(p) + forc_lwrad(g) - eflx_lwrad_out(p) - & + eflx_sh_grnd(p) - htvp(c)*qflx_evap_soi(p) + !Why is this sabg(p) and not beta*sabg(p)?? + !I've kept this as the incorrect sabg so that the energy balance check will be correct. + !This is the effective energy flux into the ground including the lake solar absorption + !below the surface. The variable eflx_gnet will be used to pass the actual heat flux + !from the ground interface into the lake. + + taux(p) = -forc_rho(g)*forc_u(g)/ram(p) + tauy(p) = -forc_rho(g)*forc_v(g)/ram(p) + + eflx_sh_tot(p) = eflx_sh_grnd(p) + qflx_evap_tot(p) = qflx_evap_soi(p) + eflx_lh_tot(p) = htvp(c)*qflx_evap_soi(p) + eflx_lh_grnd(p) = htvp(c)*qflx_evap_soi(p) + if(LAKEDEBUG) then +1604 format('CLM_Lake ShalLakeFluxes: c=',I0,' sensible heat = ',F12.4,' latent heat =',F12.4, & + ' ground temp = ', F12.4, ' h2osno = ', F12.4, ' at xlat_d=',F10.3,' xlon_d=',F10.3) + print 1604, c, eflx_sh_tot(p), eflx_lh_tot(p), t_grnd(c), h2osno(c),xlat_d,xlon_d + if (abs(eflx_sh_tot(p)) > 1500 .or. abs(eflx_lh_tot(p)) > 1500) then +3018 format('CLM_Lake ShalLakeFluxes: WARNING: SH=',F12.4,' LH=',F12.4,' at xlat_d=',F10.3,' xlon_d=',F10.3) + print 3018,eflx_sh_tot(p), eflx_lh_tot(p),xlat_d,xlon_d + unhappy = .true. + end if + if (abs(eflx_sh_tot(p)) > 10000 .or. abs(eflx_lh_tot(p)) > 10000 & + .or. abs(t_grnd(c)-288)>200 ) then +840 format('CLM_Lake ShalLakeFluxes: t_grnd is out of range: eflx_sh_tot(p)=',G20.12,' eflx_lh_tot(p)=',G20.12,' t_grnd(c)=',G20.12,' at p=',I0,' c=',I0,' xlat_d=',F10.3,' xlon_d=',F10.3) + write(message,840) eflx_sh_tot(p),eflx_lh_tot(p),t_grnd(c),p,c,xlat_d,xlon_d + errmsg=message + errflg=1 + unhappy = .true. + endif + endif + ! 2 m height air temperature + t_ref2m(p) = thm(c) + temp1(p)*dth(p)*(1._kind_phys/temp12m(p) - 1._kind_phys/temp1(p)) + + ! 2 m height specific humidity + q_ref2m(p) = forc_q(g) + temp2(p)*dqh(p)*(1._kind_phys/temp22m(p) - 1._kind_phys/temp2(p)) + + ! Energy residual used for melting snow + ! Effectively moved to ShalLakeTemp + + ! Prepare for lake layer temperature calculations below + ! fin(c) = betaprime * sabg(p) + forc_lwrad(g) - (eflx_lwrad_out(p) + & + ! eflx_sh_tot(p) + eflx_lh_tot(p)) + ! NOW this is just the net ground heat flux calculated below. + + eflx_gnet(p) = betaprime(c) * sabg(p) + forc_lwrad(g) - (eflx_lwrad_out(p) + & + eflx_sh_tot(p) + eflx_lh_tot(p)) + ! This is the actual heat flux from the ground interface into the lake, not including + ! the light that penetrates the surface. + + ! u2m = max(1.0_kind_phys,ustar(p)/vkc*log(2._kind_phys/z0mg(p))) + ! u2 often goes below 1 m/s; it seems like the only reason for this minimum is to + ! keep it from being zero in the ks equation below; 0.1 m/s is a better limit for + ! stable conditions --ZS + u2m = max(0.1_kind_phys,ustar(p)/vkc*log(2._kind_phys/z0mg(p))) + + ws(c) = 1.2e-03_kind_phys * u2m + ks(c) = 6.6_kind_phys*sqrt(abs(sin(lat(g))))*(u2m**(-1.84_kind_phys)) + + end do + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! End of surface flux relevant code in original BiogeophysicsLakeMod until history loop. + + ! The following are needed for global average on history tape. + + !dir$ concurrent + !cdir nodep + do fp = 1, num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + g = pgridcell(p) + ! t_veg(p) = forc_t(g) + !This is an odd choice, since elsewhere t_veg = t_grnd for bare ground. + !Zack Subin, 4/09 + t_veg(p) = t_grnd(c) + eflx_lwrad_net(p) = eflx_lwrad_out(p) - forc_lwrad(g) + qflx_prec_grnd(p) = forc_rain(g) + forc_snow(g) + end do + + ustar_out(1) = ustar(1) + + +END SUBROUTINE ShalLakeFluxes + +SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & !i + z_lake,ws,ks,snl,eflx_gnet,lakedepth, & + lake_icefrac,snowdp, & !i&o + eflx_sh_grnd,eflx_sh_tot,eflx_soil_grnd, & !o + t_lake,t_soisno,h2osoi_liq, & + h2osoi_ice,savedtke1, & + frac_iceold,qflx_snomelt,imelt,errmsg,errflg) + !======================================================================================================= + ! !DESCRIPTION: + ! Calculates temperatures in the 20-25 layer column of (possible) snow, + ! lake water, and soil beneath lake. + ! Snow and soil temperatures are determined as in SoilTemperature, except + ! for appropriate boundary conditions at the top of the snow (the flux is fixed + ! to be the ground heat flux calculated in ShalLakeFluxes), the bottom of the snow + ! (adjacent to top lake layer), and the top of the soil (adjacent to the bottom + ! lake layer). Also, the soil is assumed to be always fully saturated (ShalLakeHydrology + ! will have to insure this). The whole column is solved simultaneously as one tridiagonal matrix. + ! Lake temperatures are determined from the Hostetler model as before, except now: + ! i) Lake water layers can freeze by any fraction and release latent heat; thermal + ! and mechanical properties are adjusted for ice fraction. + ! ii) Convective mixing (though not eddy diffusion) still occurs for frozen lakes. + ! iii) No sunlight is absorbed in the lake if there are snow layers. + ! iv) Light is allowed to reach the top soil layer (where it is assumed to be completely absorbed). + ! v) Lakes have variable depth, set ultimately in surface data set but now in initShalLakeMod. + ! + ! Eddy + molecular diffusion: + ! d ts d d ts 1 ds + ! ---- = -- [(km + ke) ----] + -- -- + ! dt dz dz cw dz + ! + ! where: ts = temperature (kelvin) + ! t = time (s) + ! z = depth (m) + ! km = molecular diffusion coefficient (m**2/s) + ! ke = eddy diffusion coefficient (m**2/s) + ! cw = heat capacity (j/m**3/kelvin) + ! s = heat source term (w/m**2) + ! + ! Shallow lakes are allowed to have variable depth, set in _____. + ! + ! For shallow lakes: ke > 0 if unfrozen, + ! and convective mixing occurs WHETHER OR NOT frozen. (See e.g. Martynov...) + ! + ! Use the Crank-Nicholson method to set up tridiagonal system of equations to + ! solve for ts at time n+1, where the temperature equation for layer i is + ! r_i = a_i [ts_i-1] n+1 + b_i [ts_i] n+1 + c_i [ts_i+1] n+1 + ! + ! The solution conserves energy as: + ! + ! [For lake layers] + ! cw*([ts( 1)] n+1 - [ts( 1)] n)*dz( 1)/dt + ... + + ! cw*([ts(nlevlake)] n+1 - [ts(nlevlake)] n)*dz(nlevlake)/dt = fin + ! But now there is phase change, so cv is not constant and there is + ! latent heat. + ! + ! where: + ! [ts] n = old temperature (kelvin) + ! [ts] n+1 = new temperature (kelvin) + ! fin = heat flux into lake (w/m**2) + ! = betaprime*sabg + forc_lwrad - eflx_lwrad_out - eflx_sh_tot - eflx_lh_tot + ! (This is now the same as the ground heat flux.) + ! + phi(1) + ... + phi(nlevlake) + phi(top soil level) + ! betaprime = beta(islak) for no snow layers, and 1 for snow layers. + ! This assumes all radiation is absorbed in the top snow layer and will need + ! to be changed for CLM 4. + ! + ! WARNING: This subroutine assumes lake columns have one and only one pft. + ! + ! Outline: + ! 1!) Initialization + ! 2!) Lake density + ! 3!) Diffusivity + ! 4!) Heat source term from solar radiation penetrating lake + ! 5!) Set thermal props and find initial energy content + ! 6!) Set up vectors for tridiagonal matrix solution + ! 7!) Solve tridiagonal and back-substitute + ! 8!) (Optional) Do first energy check using temperature change at constant heat capacity. + ! 9!) Phase change + ! 9.5!) (Optional) Do second energy check using temperature change and latent heat, considering changed heat capacity. + ! Also do soil water balance check. + !10!) Convective mixing + !11!) Do final energy check to detect small numerical errors (especially from convection) + ! and dump small imbalance into sensible heat, or pass large errors to BalanceCheckMod for abort. + ! + ! REVISION HISTORY: + ! Created by Zack Subin, 2009. + ! Reedited by Hongping Gu, 2010. + ! Updated for CCPP by Sam Trahan, 2022. + !========================================================================================================= + + + implicit none + + !in: + integer, intent(inout) :: errflg + character(*), intent(inout) :: errmsg + real(kind_phys), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_phys), intent(inout) :: h2osno(1) ! snow water (mm H2O) + real(kind_phys), intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) + real(kind_phys), intent(in) :: dz(1,-nlevsnow + 1:nlevsoil) ! layer thickness for snow & soil (m) + real(kind_phys), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + real(kind_phys), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) + real(kind_phys), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) + ! the other z and dz variables + real(kind_phys), intent(in) :: z_lake(1,nlevlake) ! layer depth for lake (m) + real(kind_phys), intent(in) :: ws(1) ! surface friction velocity (m/s) + real(kind_phys), intent(in) :: ks(1) ! coefficient passed to ShalLakeTemperature + ! for calculation of decay of eddy diffusivity with depth + integer , intent(in) :: snl(1) ! negative of number of snow layers + real(kind_phys), intent(inout) :: eflx_gnet(1) ! net heat flux into ground (W/m**2) at the surface interface + real(kind_phys), intent(in) :: lakedepth(1) ! column lake depth (m) + + ! real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys), intent(inout) :: snowdp(1) !snow height (m) + !out: + + real(kind_phys), intent(out) :: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(kind_phys), intent(out) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] + real(kind_phys), intent(out) :: eflx_soil_grnd(1) ! heat flux into snow / lake (W/m**2) [+ = into soil] + ! Here this includes the whole lake radiation absorbed. + !real(kind_phys), intent(out) :: qmelt(1) ! snow melt [mm/s] [temporary] + + real(kind_phys), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + real(kind_phys), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) + real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) [for snow & soil layers] + real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) [for snow & soil layers] + real(kind_phys), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_phys), intent(out) :: savedtke1(1) ! top level thermal conductivity (W/mK) + real(kind_phys), intent(out) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water + real(kind_phys), intent(out) :: qflx_snomelt(1) !snow melt (mm H2O /s) + integer, intent(out) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 (new) + + + ! OTHER LOCAL VARIABLES: + + integer , parameter :: islak = 2 ! index of lake, 1 = deep lake, 2 = shallow lake + real(kind_phys), parameter :: p0 = 1._kind_phys ! neutral value of turbulent prandtl number + integer :: i,j,fc,fp,g,c,p ! do loop or array index + ! real(kind_phys) :: dtime ! land model time step (sec) + real(kind_phys) :: beta(2) ! fraction solar rad absorbed at surface: depends on lake type + real(kind_phys) :: za(2) ! base of surface absorption layer (m): depends on lake type + real(kind_phys) :: eta(2) ! light extinction coefficient (/m): depends on lake type + real(kind_phys) :: cwat ! specific heat capacity of water (j/m**3/kelvin) + real(kind_phys) :: cice_eff ! effective heat capacity of ice (using density of + ! water because layer depth is not adjusted when freezing + real(kind_phys) :: cfus ! effective heat of fusion per unit volume + ! using water density as above + real(kind_phys) :: km ! molecular diffusion coefficient (m**2/s) + real(kind_phys) :: tkice_eff ! effective conductivity since layer depth is constant + real(kind_phys) :: a(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "a" vector for tridiagonal matrix + real(kind_phys) :: b(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "b" vector for tridiagonal matrix + real(kind_phys) :: c1(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "c" vector for tridiagonal matrix + real(kind_phys) :: r(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "r" vector for tridiagonal solution + real(kind_phys) :: rhow(lbc:ubc,nlevlake) ! density of water (kg/m**3) + real(kind_phys) :: phi(lbc:ubc,nlevlake) ! solar radiation absorbed by layer (w/m**2) + real(kind_phys) :: kme(lbc:ubc,nlevlake) ! molecular + eddy diffusion coefficient (m**2/s) + real(kind_phys) :: rsfin ! relative flux of solar radiation into layer + real(kind_phys) :: rsfout ! relative flux of solar radiation out of layer + real(kind_phys) :: phi_soil(lbc:ubc) ! solar radiation into top soil layer (W/m**2) + real(kind_phys) :: ri ! richardson number + real(kind_phys) :: fin(lbc:ubc) ! net heat flux into lake at ground interface (w/m**2) + real(kind_phys) :: ocvts(lbc:ubc) ! (cwat*(t_lake[n ])*dz + real(kind_phys) :: ncvts(lbc:ubc) ! (cwat*(t_lake[n+1])*dz + real(kind_phys) :: ke ! eddy diffusion coefficient (m**2/s) + real(kind_phys) :: zin ! depth at top of layer (m) + real(kind_phys) :: zout ! depth at bottom of layer (m) + real(kind_phys) :: drhodz ! d [rhow] /dz (kg/m**4) + real(kind_phys) :: n2 ! brunt-vaisala frequency (/s**2) + real(kind_phys) :: num ! used in calculating ri + real(kind_phys) :: den ! used in calculating ri + real(kind_phys) :: tav_froz(lbc:ubc) ! used in aver temp for convectively mixed layers (C) + real(kind_phys) :: tav_unfr(lbc:ubc) ! " + real(kind_phys) :: nav(lbc:ubc) ! used in aver temp for convectively mixed layers + real(kind_phys) :: phidum ! temporary value of phi + real(kind_phys) :: iceav(lbc:ubc) ! used in calc aver ice for convectively mixed layers + real(kind_phys) :: qav(lbc:ubc) ! used in calc aver heat content for conv. mixed layers + integer :: jtop(lbc:ubc) ! top level for each column (no longer all 1) + real(kind_phys) :: cv (lbc:ubc,-nlevsnow+1:nlevsoil) !heat capacity of soil/snow [J/(m2 K)] + real(kind_phys) :: tk (lbc:ubc,-nlevsnow+1:nlevsoil) !thermal conductivity of soil/snow [W/(m K)] + !(at interface below, except for j=0) + real(kind_phys) :: cv_lake (lbc:ubc,1:nlevlake) !heat capacity [J/(m2 K)] + real(kind_phys) :: tk_lake (lbc:ubc,1:nlevlake) !thermal conductivity at layer node [W/(m K)] + real(kind_phys) :: cvx (lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !heat capacity for whole column [J/(m2 K)] + real(kind_phys) :: tkix(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !thermal conductivity at layer interfaces + !for whole column [W/(m K)] + real(kind_phys) :: tx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! temperature of whole column [K] + real(kind_phys) :: tktopsoillay(lbc:ubc) ! thermal conductivity [W/(m K)] + real(kind_phys) :: fnx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !heat diffusion through the layer interface below [W/m2] + real(kind_phys) :: phix(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !solar source term for whole column [W/m**2] + real(kind_phys) :: zx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !interface depth (+ below surface) for whole column [m] + real(kind_phys) :: dzm !used in computing tridiagonal matrix [m] + real(kind_phys) :: dzp !used in computing tridiagonal matrix [m] + integer :: jprime ! j - nlevlake + real(kind_phys) :: factx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !coefficient used in computing tridiagonal matrix + real(kind_phys) :: t_lake_bef(lbc:ubc,1:nlevlake) !beginning lake temp for energy conservation check [K] + real(kind_phys) :: t_soisno_bef(lbc:ubc,-nlevsnow+1:nlevsoil) !beginning soil temp for E cons. check [K] + real(kind_phys) :: lhabs(lbc:ubc) ! total per-column latent heat abs. from phase change (J/m^2) + real(kind_phys) :: esum1(lbc:ubc) ! temp for checking energy (J/m^2) + real(kind_phys) :: esum2(lbc:ubc) ! "" + real(kind_phys) :: zsum(lbc:ubc) ! temp for putting ice at the top during convection (m) + real(kind_phys) :: wsum(lbc:ubc) ! temp for checking water (kg/m^2) + real(kind_phys) :: wsum_end(lbc:ubc) ! temp for checking water (kg/m^2) + real(kind_phys) :: errsoi(1) ! soil/lake energy conservation error (W/m**2) + real(kind_phys) :: eflx_snomelt(1) !snow melt heat flux (W/m**2) + CHARACTER*256 :: message + ! + ! Constants for lake temperature model + ! + data beta/0.4_kind_phys, 0.4_kind_phys/ ! (deep lake, shallow lake) + data za /0.6_kind_phys, 0.6_kind_phys/ + ! For now, keep beta and za for shallow lake the same as deep lake, until better data is found. + ! It looks like eta is key and that larger values give better results for shallow lakes. Use + ! empirical expression from Hakanson (below). This is still a very unconstrained parameter + ! that deserves more attention. + ! Some radiation will be allowed to reach the soil. + !----------------------------------------------------------------------- + + + ! 1!) Initialization + ! Determine step size + + ! dtime = get_step_size() + + ! Initialize constants + cwat = cpliq*denh2o ! water heat capacity per unit volume + cice_eff = cpice*denh2o !use water density because layer depth is not adjusted + !for freezing + cfus = hfus*denh2o ! latent heat per unit volume + tkice_eff = tkice * denice/denh2o !effective conductivity since layer depth is constant + km = tkwat/cwat ! a constant (molecular diffusivity) + + ! Begin calculations + + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + ! Initialize Ebal quantities computed below + + ocvts(c) = 0._kind_phys + ncvts(c) = 0._kind_phys + esum1(c) = 0._kind_phys + esum2(c) = 0._kind_phys + + end do + + ! Initialize set of previous time-step variables as in DriverInit, + ! which is currently not called over lakes. This has to be done + ! here because phase change will occur in this routine. + ! Ice fraction of snow at previous time step + + do j = -nlevsnow+1,0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + if (j >= snl(c) + 1) then + frac_iceold(c,j) = h2osoi_ice(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j)) + end if + end do + end do + + ! Sum soil water. + do j = 1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + if (j == 1) wsum(c) = 0._kind_phys + wsum(c) = wsum(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + end do + end do + + !dir$ concurrent + !cdir nodep + do fp = 1, num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + + + ! Prepare for lake layer temperature calculations below + + ! fin(c) = betaprime * sabg(p) + forc_lwrad(g) - (eflx_lwrad_out(p) + & + ! eflx_sh_tot(p) + eflx_lh_tot(p)) + ! fin(c) now passed from ShalLakeFluxes as eflx_gnet + fin(c) = eflx_gnet(p) + + end do + + ! 2!) Lake density + + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + rhow(c,j) = (1._kind_phys - lake_icefrac(c,j)) * & + 1000._kind_phys*( 1.0_kind_phys - 1.9549e-05_kind_phys*(abs(t_lake(c,j)-277._kind_phys))**1.68_kind_phys ) & + + lake_icefrac(c,j)*denice + ! Allow for ice fraction; assume constant ice density. + ! Is this the right weighted average? + ! Using this average will make sure that surface ice is treated properly during + ! convective mixing. + end do + end do + + ! 3!) Diffusivity and implied thermal "conductivity" = diffusivity * cwat + do j = 1, nlevlake-1 + !dir$ prefervector + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + drhodz = (rhow(c,j+1)-rhow(c,j)) / (z_lake(c,j+1)-z_lake(c,j)) + n2 = grav / rhow(c,j) * drhodz + ! Fixed sign error here: our z goes up going down into the lake, so no negative + ! sign is needed to make this positive unlike in Hostetler. --ZS + num = 40._kind_phys * n2 * (vkc*z_lake(c,j))**2 + den = max( (ws(c)**2) * exp(-2._kind_phys*ks(c)*z_lake(c,j)), 1.e-10_kind_phys ) + ri = ( -1._kind_phys + sqrt( max(1._kind_phys+num/den, 0._kind_phys) ) ) / 20._kind_phys + if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then + ! ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + + if( t_lake(c,1) > 277.15_kind_phys ) then + if (lakedepth(c) > 15.0 ) then + ke = 1.e+2_kind_phys*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + else + ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + endif + else + if (lakedepth(c) > 15.0 ) then + if (lakedepth(c) > 150.0 ) then + ke = 1.e+5_kind_phys*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + else + ke =1.e+4_kind_phys*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + end if + else + ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + endif + end if + + kme(c,j) = km + ke + tk_lake(c,j) = kme(c,j)*cwat + ! If there is some ice in this layer (this should rarely happen because the surface + ! is unfrozen and it will be unstable), still use the cwat to get out the tk b/c the eddy + ! diffusivity equation assumes water. + else + kme(c,j) = km + tk_lake(c,j) = tkwat*tkice_eff / ( (1._kind_phys-lake_icefrac(c,j))*tkice_eff & + + tkwat*lake_icefrac(c,j) ) + ! Assume the resistances add as for the calculation of conductivities at layer interfaces. + end if + end do + end do + + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + j = nlevlake + kme(c,nlevlake) = kme(c,nlevlake-1) + + if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then + tk_lake(c,j) = tk_lake(c,j-1) + else + tk_lake(c,j) = tkwat*tkice_eff / ( (1._kind_phys-lake_icefrac(c,j))*tkice_eff & + + tkwat*lake_icefrac(c,j) ) + end if + + ! Use in surface flux calculation for next timestep. + savedtke1(c) = kme(c,1)*cwat ! Will only be used if unfrozen + ! set number of column levels for use by Tridiagonal below + jtop(c) = snl(c) + 1 + end do + + ! 4!) Heat source term: unfrozen lakes only + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fp = 1, num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + + ! Set eta(:), the extinction coefficient, according to L Hakanson, Aquatic Sciences, 1995 + ! (regression of Secchi Depth with lake depth for small glacial basin lakes), and the + ! Poole & Atkins expression for extinction coeffient of 1.7 / Secchi Depth (m). + if(.not.USE_ETALAKE) then + eta(:) = 1.1925_kind_phys*lakedepth(c)**(-0.424) + else + eta(:) = ETALAKE + endif + + zin = z_lake(c,j) - 0.5_kind_phys*dz_lake(c,j) + zout = z_lake(c,j) + 0.5_kind_phys*dz_lake(c,j) + rsfin = exp( -eta(islak)*max( zin-za(islak),0._kind_phys ) ) + rsfout = exp( -eta(islak)*max( zout-za(islak),0._kind_phys ) ) + + ! Let rsfout for bottom layer go into soil. + ! This looks like it should be robust even for pathological cases, + ! like lakes thinner than za. + if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then + phidum = (rsfin-rsfout) * sabg(p) * (1._kind_phys-beta(islak)) + if (j == nlevlake) then + phi_soil(c) = rsfout * sabg(p) * (1._kind_phys-beta(islak)) + end if + else if (j == 1 .and. snl(c) == 0) then !if frozen but no snow layers + phidum = sabg(p) * (1._kind_phys-beta(islak)) + else !radiation absorbed at surface + phidum = 0._kind_phys + if (j == nlevlake) phi_soil(c) = 0._kind_phys + end if + phi(c,j) = phidum + + end do + end do + + ! 5!) Set thermal properties and check initial energy content. + + ! For lake + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._kind_phys-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) + end do + end do + + ! For snow / soil + call SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & + tk, cv, tktopsoillay,errmsg,errflg) + if(errflg/=0) then + ! State is no longer valid, so return error to caller + ! FIXME: PUT THIS BACK return + endif + + ! Sum cv*t_lake for energy check + ! Include latent heat term, and correction for changing heat capacity with phase change. + + ! This will need to be over all soil / lake / snow layers. Lake is below. + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + ! ocvts(c) = ocvts(c) + cv_lake(c,j)*t_lake(c,j) & + ocvts(c) = ocvts(c) + cv_lake(c,j)*(t_lake(c,j)-tfrz) & + + cfus*dz_lake(c,j)*(1._kind_phys-lake_icefrac(c,j)) !& + ! + (cwat-cice_eff)*lake_icefrac(c)*tfrz*dz_lake(c,j) !enthalpy reconciliation term + t_lake_bef(c,j) = t_lake(c,j) + end do + end do + + ! Now do for soil / snow layers + do j = -nlevsnow + 1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + if (j >= jtop(c)) then + ! ocvts(c) = ocvts(c) + cv(c,j)*t_soisno(c,j) & + ocvts(c) = ocvts(c) + cv(c,j)*(t_soisno(c,j)-tfrz) & + + hfus*h2osoi_liq(c,j) !& + ! + (cpliq-cpice)*h2osoi_ice(c,j)*tfrz !enthalpy reconciliation term + if (j == 1 .and. h2osno(c) > 0._kind_phys .and. j == jtop(c)) then + ocvts(c) = ocvts(c) - h2osno(c)*hfus + end if + t_soisno_bef(c,j) = t_soisno(c,j) + if(abs(t_soisno(c,j)-288) > 150) then +48 format('WARNING: At c=',I0,' level=',I0,' extreme t_soisno = ',F15.10) + WRITE(message,48) c,j,t_soisno(c,j) + errmsg=trim(message) + errflg=1 + endif + end if + end do + end do + + !!!!!!!!!!!!!!!!!!! + ! 6!) Set up vector r and vectors a, b, c1 that define tridiagonal matrix + + ! Heat capacity and resistance of snow without snow layers (<1cm) is ignored during diffusion, + ! but its capacity to absorb latent heat may be used during phase change. + + ! Set up interface depths, zx, heat capacities, cvx, solar source terms, phix, and temperatures, tx. + do j = -nlevsnow+1, nlevlake+nlevsoil + !dir$ prefervector + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + + jprime = j - nlevlake + + if (j >= jtop(c)) then + if (j < 1) then !snow layer + zx(c,j) = z(c,j) + cvx(c,j) = cv(c,j) + phix(c,j) = 0._kind_phys + tx(c,j) = t_soisno(c,j) + else if (j <= nlevlake) then !lake layer + zx(c,j) = z_lake(c,j) + cvx(c,j) = cv_lake(c,j) + phix(c,j) = phi(c,j) + tx(c,j) = t_lake(c,j) + else !soil layer + zx(c,j) = zx(c,nlevlake) + dz_lake(c,nlevlake)/2._kind_phys + z(c,jprime) + cvx(c,j) = cv(c,jprime) + if (j == nlevlake + 1) then !top soil layer + phix(c,j) = phi_soil(c) + else !middle or bottom soil layer + phix(c,j) = 0._kind_phys + end if + tx(c,j) = t_soisno(c,jprime) + end if + end if + + end do + end do + + ! Determine interface thermal conductivities, tkix + + do j = -nlevsnow+1, nlevlake+nlevsoil + !dir$ prefervector + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + + jprime = j - nlevlake + + if (j >= jtop(c)) then + if (j < 0) then !non-bottom snow layer + tkix(c,j) = tk(c,j) + else if (j == 0) then !bottom snow layer + dzp = zx(c,j+1) - zx(c,j) + tkix(c,j) = tk_lake(c,1)*tk(c,j)*dzp / & + (tk(c,j)*z_lake(c,1) + tk_lake(c,1)*(-z(c,j)) ) + ! tk(c,0) is the conductivity at the middle of that layer, as defined in SoilThermProp_Lake + else if (j < nlevlake) then !non-bottom lake layer + tkix(c,j) = ( tk_lake(c,j)*tk_lake(c,j+1) * (dz_lake(c,j+1)+dz_lake(c,j)) ) & + / ( tk_lake(c,j)*dz_lake(c,j+1) + tk_lake(c,j+1)*dz_lake(c,j) ) + else if (j == nlevlake) then !bottom lake layer + dzp = zx(c,j+1) - zx(c,j) + tkix(c,j) = (tktopsoillay(c)*tk_lake(c,j)*dzp / & + (tktopsoillay(c)*dz_lake(c,j)/2._kind_phys + tk_lake(c,j)*z(c,1) ) ) + ! tktopsoillay is the conductivity at the middle of that layer, as defined in SoilThermProp_Lake + else !soil layer + tkix(c,j) = tk(c,jprime) + end if + end if + + end do + end do + + + ! Determine heat diffusion through the layer interface and factor used in computing + ! tridiagonal matrix and set up vector r and vectors a, b, c1 that define tridiagonal + ! matrix and solve system + + do j = -nlevsnow+1, nlevlake+nlevsoil + !dir$ prefervector + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + if (j >= jtop(c)) then + if (j < nlevlake+nlevsoil) then !top or interior layer + factx(c,j) = dtime/cvx(c,j) + fnx(c,j) = tkix(c,j)*(tx(c,j+1)-tx(c,j))/(zx(c,j+1)-zx(c,j)) + else !bottom soil layer + factx(c,j) = dtime/cvx(c,j) + fnx(c,j) = 0._kind_phys !not used + end if + end if + enddo + end do + + do j = -nlevsnow+1,nlevlake+nlevsoil + !dir$ prefervector + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + if (j >= jtop(c)) then + if (j == jtop(c)) then !top layer + dzp = zx(c,j+1)-zx(c,j) + a(c,j) = 0._kind_phys + b(c,j) = 1+(1._kind_phys-cnfac)*factx(c,j)*tkix(c,j)/dzp + c1(c,j) = -(1._kind_phys-cnfac)*factx(c,j)*tkix(c,j)/dzp + r(c,j) = tx(c,j) + factx(c,j)*( fin(c) + phix(c,j) + cnfac*fnx(c,j) ) + else if (j < nlevlake+nlevsoil) then !middle layer + dzm = (zx(c,j)-zx(c,j-1)) + dzp = (zx(c,j+1)-zx(c,j)) + a(c,j) = - (1._kind_phys-cnfac)*factx(c,j)* tkix(c,j-1)/dzm + b(c,j) = 1._kind_phys+ (1._kind_phys-cnfac)*factx(c,j)*(tkix(c,j)/dzp + tkix(c,j-1)/dzm) + c1(c,j) = - (1._kind_phys-cnfac)*factx(c,j)* tkix(c,j)/dzp + r(c,j) = tx(c,j) + cnfac*factx(c,j)*( fnx(c,j) - fnx(c,j-1) ) + factx(c,j)*phix(c,j) + else !bottom soil layer + dzm = (zx(c,j)-zx(c,j-1)) + a(c,j) = - (1._kind_phys-cnfac)*factx(c,j)*tkix(c,j-1)/dzm + b(c,j) = 1._kind_phys+ (1._kind_phys-cnfac)*factx(c,j)*tkix(c,j-1)/dzm + c1(c,j) = 0._kind_phys + r(c,j) = tx(c,j) - cnfac*factx(c,j)*fnx(c,j-1) + end if + end if + enddo + end do + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + ! 7!) Solve for tdsolution + + call Tridiagonal(lbc, ubc, -nlevsnow + 1, nlevlake + nlevsoil, jtop, num_shlakec, filter_shlakec, & + a, b, c1, r, tx) + + ! Set t_soisno and t_lake + do j = -nlevsnow+1, nlevlake + nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + jprime = j - nlevlake + + ! Don't do anything with invalid snow layers. + if (j >= jtop(c)) then + if (j < 1) then !snow layer + t_soisno(c,j) = tx(c,j) + else if (j <= nlevlake) then !lake layer + t_lake(c,j) = tx(c,j) + else !soil layer + t_soisno(c,jprime) = tx(c,j) + end if + end if + end do + end do + + !!!!!!!!!!!!!!!!!!!!!!! + + ! 8!) Sum energy content and total energy into lake for energy check. Any errors will be from the + ! Tridiagonal solution. + + if_debug_energy: if (LAKEDEBUG) then + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + esum1(c) = esum1(c) + (t_lake(c,j)-t_lake_bef(c,j))*cv_lake(c,j) + esum2(c) = esum2(c) + (t_lake(c,j)-tfrz)*cv_lake(c,j) + end do + end do + + do j = -nlevsnow+1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + if (j >= jtop(c)) then + esum1(c) = esum1(c) + (t_soisno(c,j)-t_soisno_bef(c,j))*cv(c,j) + esum2(c) = esum2(c) + (t_soisno(c,j)-tfrz)*cv(c,j) + end if + end do + end do + + !dir$ concurrent + !cdir nodep + do fp = 1, num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + ! Again assuming only one pft per column + ! esum1(c) = esum1(c) + lhabs(c) + errsoi(c) = esum1(c)/dtime - eflx_soil_grnd(p) + ! eflx_soil_grnd includes all the solar radiation absorbed in the lake, + ! unlike eflx_gnet + if(abs(errsoi(c)) > .001_kind_phys) then ! 1.e-5_kind_phys) then + WRITE( message,* )'Primary soil energy conservation error in shlake & + column during Tridiagonal Solution,', 'error (W/m^2):', c, errsoi(c) + errmsg=trim(message) + errflg=1 + end if + end do + ! This has to be done before convective mixing because the heat capacities for each layer + ! will get scrambled. + + end if if_debug_energy + + !!!!!!!!!!!!!!!!!!!!!!! + + ! 9!) Phase change + call PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i + t_soisno,h2osoi_liq,h2osoi_ice, & !i&o + lake_icefrac,t_lake, snowdp, & !i&o + qflx_snomelt,eflx_snomelt,imelt, & !o + cv, cv_lake, & !i&o + lhabs) !o + + !!!!!!!!!!!!!!!!!!!!!!! + + ! 9.5!) Second energy check and water check. Now check energy balance before and after phase + ! change, considering the possibility of changed heat capacity during phase change, by + ! using initial heat capacity in the first step, final heat capacity in the second step, + ! and differences from tfrz only to avoid enthalpy correction for (cpliq-cpice)*melt*tfrz. + ! Also check soil water sum. + + if_debug_balance: if (LAKEDEBUG) then + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + esum2(c) = esum2(c) - (t_lake(c,j)-tfrz)*cv_lake(c,j) + end do + end do + + do j = -nlevsnow+1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + if (j >= jtop(c)) then + esum2(c) = esum2(c) - (t_soisno(c,j)-tfrz)*cv(c,j) + end if + end do + end do + + !dir$ concurrent + !cdir nodep + do fp = 1, num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + ! Again assuming only one pft per column + esum2(c) = esum2(c) - lhabs(c) + errsoi(c) = esum2(c)/dtime + if(abs(errsoi(c)) > 1.e-5_kind_phys) then + write(message,*)'Primary soil energy conservation error in shlake column during Phase Change, error (W/m^2):', & + c, errsoi(c) + errmsg=trim(message) + errflg=1 + end if + end do + + ! Check soil water + ! Sum soil water. + do j = 1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + if (j == 1) wsum_end(c) = 0._kind_phys + wsum_end(c) = wsum_end(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + if (j == nlevsoil) then + if (abs(wsum(c)-wsum_end(c))>1.e-7_kind_phys) then + write(message,*)'Soil water balance error during phase change in ShalLakeTemperature.', & + 'column, error (kg/m^2):', c, wsum_end(c)-wsum(c) + errmsg=trim(message) + errflg=1 + end if + end if + end do + end do + + endif if_debug_balance + + !!!!!!!!!!!!!!!!!!!!!!!!!! + ! 10!) Convective mixing: make sure fracice*dz is conserved, heat content c*dz*T is conserved, and + ! all ice ends up at the top. Done over all lakes even if frozen. + ! Either an unstable density profile or ice in a layer below an incompletely frozen layer will trigger. + + !Recalculate density + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + rhow(c,j) = (1._kind_phys - lake_icefrac(c,j)) * & + 1000._kind_phys*( 1.0_kind_phys - 1.9549e-05_kind_phys*(abs(t_lake(c,j)-277._kind_phys))**1.68_kind_phys ) & + + lake_icefrac(c,j)*denice + end do + end do + + do j = 1, nlevlake-1 + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + qav(c) = 0._kind_phys + nav(c) = 0._kind_phys + iceav(c) = 0._kind_phys + end do + + do i = 1, j+1 + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + if (rhow(c,j) > rhow(c,j+1) .or. & + (lake_icefrac(c,j) < 1._kind_phys .and. lake_icefrac(c,j+1) > 0._kind_phys) ) then + if(LAKEDEBUG) then + if (i==1) then + print *, 'Convective Mixing in column ', c, '.' + endif + endif + qav(c) = qav(c) + dz_lake(c,i)*(t_lake(c,i)-tfrz) * & + ((1._kind_phys - lake_icefrac(c,i))*cwat + lake_icefrac(c,i)*cice_eff) + ! tav(c) = tav(c) + t_lake(c,i)*dz_lake(c,i) + iceav(c) = iceav(c) + lake_icefrac(c,i)*dz_lake(c,i) + nav(c) = nav(c) + dz_lake(c,i) + end if + end do + end do + + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + if (rhow(c,j) > rhow(c,j+1) .or. & + (lake_icefrac(c,j) < 1._kind_phys .and. lake_icefrac(c,j+1) > 0._kind_phys) ) then + qav(c) = qav(c)/nav(c) + iceav(c) = iceav(c)/nav(c) + !If the average temperature is above freezing, put the extra energy into the water. + !If it is below freezing, take it away from the ice. + if (qav(c) > 0._kind_phys) then + tav_froz(c) = 0._kind_phys !Celsius + tav_unfr(c) = qav(c) / ((1._kind_phys - iceav(c))*cwat) + else if (qav(c) < 0._kind_phys) then + tav_froz(c) = qav(c) / (iceav(c)*cice_eff) + tav_unfr(c) = 0._kind_phys !Celsius + else + tav_froz(c) = 0._kind_phys + tav_unfr(c) = 0._kind_phys + end if + end if + end do + + do i = 1, j+1 + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + if (nav(c) > 0._kind_phys) then + ! if(0==1) then + + !Put all the ice at the top.! + !If the average temperature is above freezing, put the extra energy into the water. + !If it is below freezing, take it away from the ice. + !For the layer with both ice & water, be careful to use the average temperature + !that preserves the correct total heat content given what the heat capacity of that + !layer will actually be. + if (i == 1) zsum(c) = 0._kind_phys + if ((zsum(c)+dz_lake(c,i))/nav(c) <= iceav(c)) then + lake_icefrac(c,i) = 1._kind_phys + t_lake(c,i) = tav_froz(c) + tfrz + else if (zsum(c)/nav(c) < iceav(c)) then + lake_icefrac(c,i) = (iceav(c)*nav(c) - zsum(c)) / dz_lake(c,i) + ! Find average value that preserves correct heat content. + t_lake(c,i) = ( lake_icefrac(c,i)*tav_froz(c)*cice_eff & + + (1._kind_phys - lake_icefrac(c,i))*tav_unfr(c)*cwat ) & + / ( lake_icefrac(c,i)*cice_eff + (1-lake_icefrac(c,i))*cwat ) + tfrz + else + lake_icefrac(c,i) = 0._kind_phys + t_lake(c,i) = tav_unfr(c) + tfrz + end if + zsum(c) = zsum(c) + dz_lake(c,i) + + rhow(c,i) = (1._kind_phys - lake_icefrac(c,i)) * & + 1000._kind_phys*( 1.0_kind_phys - 1.9549e-05_kind_phys*(abs(t_lake(c,i)-277._kind_phys))**1.68_kind_phys ) & + + lake_icefrac(c,i)*denice + end if + end do + end do + end do + + !!!!!!!!!!!!!!!!!!!!!!! + ! 11!) Re-evaluate thermal properties and sum energy content. + ! For lake + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._kind_phys-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) + if (LAKEDEBUG) then + print *,'Lake Ice Fraction, c, level:', c, j, lake_icefrac(c,j) + endif + end do + end do + ! For snow / soil + ! call SoilThermProp_Lake(lbc, ubc, num_shlakec, filter_shlakec, tk, cv, tktopsoillay) + call SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & + tk, cv, tktopsoillay,errmsg,errflg) + + + ! Do as above to sum energy content + do j = 1, nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + ! ncvts(c) = ncvts(c) + cv_lake(c,j)*t_lake(c,j) & + ncvts(c) = ncvts(c) + cv_lake(c,j)*(t_lake(c,j)-tfrz) & + + cfus*dz_lake(c,j)*(1._kind_phys-lake_icefrac(c,j)) !& + ! + (cwat-cice_eff)*lake_icefrac(c)*tfrz*dz_lake(c,j) !enthalpy reconciliation term + fin(c) = fin(c) + phi(c,j) + end do + end do + + do j = -nlevsnow + 1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + if (j >= jtop(c)) then + ! ncvts(c) = ncvts(c) + cv(c,j)*t_soisno(c,j) & + ncvts(c) = ncvts(c) + cv(c,j)*(t_soisno(c,j)-tfrz) & + + hfus*h2osoi_liq(c,j) !& + ! + (cpliq-cpice)*h2osoi_ice(c,j)*tfrz !enthalpy reconciliation term + if (j == 1 .and. h2osno(c) > 0._kind_phys .and. j == jtop(c)) then + ncvts(c) = ncvts(c) - h2osno(c)*hfus + end if + end if + if (j == 1) fin(c) = fin(c) + phi_soil(c) + end do + end do + + + ! Check energy conservation. + + do fp = 1, num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + errsoi(c) = (ncvts(c)-ocvts(c)) / dtime - fin(c) + if( (LAKEDEBUG .and. abs(errsoi(c)) < 1._kind_phys) & + .or. (.not.LAKEDEBUG .and. abs(errsoi(c)) < 10._kind_phys)) then + eflx_sh_tot(p) = eflx_sh_tot(p) - errsoi(c) + eflx_sh_grnd(p) = eflx_sh_grnd(p) - errsoi(c) + eflx_soil_grnd(p) = eflx_soil_grnd(p) + errsoi(c) + eflx_gnet(p) = eflx_gnet(p) + errsoi(c) + ! if (abs(errsoi(c)) > 1.e-3_kind_phys) then + if (abs(errsoi(c)) > 1.e-1_kind_phys) then + print *,'errsoi incorporated into sensible heat in ShalLakeTemperature: c, (W/m^2):', c, errsoi(c) + end if + errsoi(c) = 0._kind_phys + else if(LAKEDEBUG) then + print *,'Soil Energy Balance Error at column, ', c, 'G, fintotal, column E tendency = ', & + eflx_gnet(p), fin(c), (ncvts(c)-ocvts(c)) / dtime + end if + end do + ! This loop assumes only one point per column. + + end subroutine ShalLakeTemperature + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !----------------------------------------------------------------------- + !BOP + ! + ! ROUTINE: SoilThermProp_Lake + ! + ! !INTERFACE: + subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & + tk, cv, tktopsoillay,errmsg,errflg) + + ! + ! !DESCRIPTION: + ! Calculation of thermal conductivities and heat capacities of + ! snow/soil layers + ! (1) The volumetric heat capacity is calculated as a linear combination + ! in terms of the volumetric fraction of the constituent phases. + ! + ! (2) The thermal conductivity of soil is computed from the algorithm of + ! Johansen (as reported by Farouki 1981), and of snow is from the + ! formulation used in SNTHERM (Jordan 1991). + ! The thermal conductivities at the interfaces between two neighboring + ! layers (j, j+1) are derived from an assumption that the flux across + ! the interface is equal to that from the node j to the interface and the + ! flux from the interface to the node j+1. + ! + ! For lakes, the proper soil layers (not snow) should always be saturated. + ! + ! !USES: + + implicit none + !in + + integer, intent(inout) :: errflg + character(*), intent(inout) :: errmsg + integer , intent(in) :: snl(1) ! number of snow layers + ! real(kind_phys), intent(in) :: h2osno(1) ! snow water (mm H2O) + ! real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + ! real(kind_phys), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + ! real(kind_phys), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + ! real(kind_phys), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + ! real(kind_phys), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + real(kind_phys), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness (m) + real(kind_phys), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) + real(kind_phys), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) + real(kind_phys), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil temperature (Kelvin) + real(kind_phys), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_phys), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + + !out + real(kind_phys), intent(out) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) ! heat capacity [J/(m2 K)] + real(kind_phys), intent(out) :: tk(lbc:ubc,-nlevsnow+1:nlevsoil) ! thermal conductivity [W/(m K)] + real(kind_phys), intent(out) :: tktopsoillay(lbc:ubc) ! thermal conductivity [W/(m K)] + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! !CALLED FROM: + ! subroutine ShalLakeTemperature in this module. + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! 2/13/02, Peter Thornton: migrated to new data structures + ! 7/01/03, Mariana Vertenstein: migrated to vector code + ! 4/09, Zack Subin, adjustment for ShalLake code. + ! June 2022, Sam Trahan updated for CCPP + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! !LOCAL VARIABLES: + ! + ! local pointers to original implicit in scalars + ! + ! integer , pointer :: clandunit(:) ! column's landunit + ! integer , pointer :: ityplun(:) ! landunit type + ! + !EOP + + + ! OTHER LOCAL VARIABLES: + + integer :: l,c,j ! indices + integer :: fc ! lake filtered column indices + real(kind_phys) :: bw ! partial density of water (ice + liquid) + real(kind_phys) :: dksat ! thermal conductivity for saturated soil (j/(k s m)) + real(kind_phys) :: dke ! kersten number + real(kind_phys) :: fl ! fraction of liquid or unfrozen water to total water + real(kind_phys) :: satw ! relative total water content of soil. + real(kind_phys) :: thk(lbc:ubc,-nlevsnow+1:nlevsoil) ! thermal conductivity of layer + character*256 :: message + + real(kind_phys) :: denom + + ! Thermal conductivity of soil from Farouki (1981) + + do j = -nlevsnow+1,nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + ! Only examine levels from 1->nlevsoil + if (j >= 1) then + ! l = clandunit(c) + ! if (ityplun(l) /= istwet .AND. ityplun(l) /= istice) then + ! This could be altered later for allowing this to be over glaciers. + + ! Soil should be saturated. + if (LAKEDEBUG) then + satw = (h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice)/(dz(c,j)*watsat(c,j)) + ! satw = min(1._kind_phys, satw) + if (satw < 0.999_kind_phys) then + write(message,*)'WARNING: soil layer unsaturated in SoilThermProp_Lake, satw, j = ', satw, j + errmsg=trim(message) + errflg=1 + end if + ! Could use denice because if it starts out frozen, the volume of water will go below sat., + ! since we're not yet doing excess ice. + ! But take care of this in HydrologyLake. + endif + satw = 1._kind_phys + denom = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) + if(denom>zero_h2o) then + fl = h2osoi_liq(c,j)/denom + else + write(message,'(A,I0)') 'WARNING: zero h2osoi_ice+h2osoi_liq at j = ', j + errmsg=trim(message) + errflg=1 + fl = 0 + endif + if (t_soisno(c,j) >= tfrz) then ! Unfrozen soil + dke = max(0._kind_phys, log10(satw) + 1.0_kind_phys) + dksat = tksatu(c,j) + else ! Frozen soil + dke = satw + dksat = tkmg(c,j)*0.249_kind_phys**(fl*watsat(c,j))*2.29_kind_phys**watsat(c,j) + endif + thk(c,j) = dke*dksat + (1._kind_phys-dke)*tkdry(c,j) + ! else + ! thk(c,j) = tkwat + ! if (t_soisno(c,j) < tfrz) thk(c,j) = tkice + ! endif + endif + + ! Thermal conductivity of snow, which from Jordan (1991) pp. 18 + ! Only examine levels from snl(c)+1 -> 0 where snl(c) < 1 + if (snl(c)+1 < 1 .AND. (j >= snl(c)+1) .AND. (j <= 0)) then + bw = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/dz(c,j) + thk(c,j) = tkairc + (7.75e-5_kind_phys *bw + 1.105e-6_kind_phys*bw*bw)*(tkice-tkairc) + end if + + end do + end do + + ! Thermal conductivity at the layer interface + + ! Have to correct for the fact that bottom snow layer and top soil layer border lake. + ! For the first case, the snow layer conductivity for the middle of the layer will be returned. + ! Because the interfaces are below the soil layers, the conductivity for the top soil layer + ! will have to be returned separately. + do j = -nlevsnow+1,nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + if (j >= snl(c)+1 .AND. j <= nlevsoil-1 .AND. j /= 0) then + tk(c,j) = thk(c,j)*thk(c,j+1)*(z(c,j+1)-z(c,j)) & + /(thk(c,j)*(z(c,j+1)-zi(c,j))+thk(c,j+1)*(zi(c,j)-z(c,j))) + else if (j == 0) then + tk(c,j) = thk(c,j) + else if (j == nlevsoil) then + tk(c,j) = 0._kind_phys + end if + ! For top soil layer. + if (j == 1) tktopsoillay(c) = thk(c,j) + end do + end do + + ! Soil heat capacity, from de Vires (1963) + + do j = 1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + ! l = clandunit(c) + ! if (ityplun(l) /= istwet .AND. ityplun(l) /= istice) then + cv(c,j) = csol(c,j)*(1-watsat(c,j))*dz(c,j) + & + (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + ! else + ! cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) + ! endif + ! if (j == 1) then + ! if (snl(c)+1 == 1 .AND. h2osno(c) > 0._kind_phys) then + ! cv(c,j) = cv(c,j) + cpice*h2osno(c) + ! end if + ! end if + ! Won't worry about heat capacity for thin snow on lake with no snow layers. + enddo + end do + + ! Snow heat capacity + + do j = -nlevsnow+1,0 + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + if (snl(c)+1 < 1 .and. j >= snl(c)+1) then + cv(c,j) = cpliq*h2osoi_liq(c,j) + cpice*h2osoi_ice(c,j) + end if + end do + end do + + end subroutine SoilThermProp_Lake + + + !----------------------------------------------------------------------- + !BOP + ! + ! ROUTINE: PhaseChange_Lake + ! + ! !INTERFACE: + subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i + t_soisno,h2osoi_liq,h2osoi_ice, & !i&o + lake_icefrac,t_lake, snowdp, & !i&o + qflx_snomelt,eflx_snomelt,imelt, & !o + cv, cv_lake, & !i&o + lhabs) !o + !============================================================================================= + ! !DESCRIPTION: + ! Calculation of the phase change within snow, soil, & lake layers: + ! (1) Check the conditions for which the phase change may take place, + ! i.e., the layer temperature is great than the freezing point + ! and the ice mass is not equal to zero (i.e. melting), + ! or the layer temperature is less than the freezing point + ! and the liquid water mass is greater than the allowable supercooled + ! (i.e. freezing). + ! (2) Assess the amount of phase change from the energy excess (or deficit) + ! after setting the layer temperature to freezing point, depending on + ! how much water or ice is available. + ! (3) Re-adjust the ice and liquid mass, and the layer temperature: either to + ! the freezing point if enough water or ice is available to fully compensate, + ! or to a remaining temperature. + ! The specific heats are assumed constant. Potential cycling errors resulting from + ! this assumption will be trapped at the end of ShalLakeTemperature. + ! !CALLED FROM: + ! subroutine ShalLakeTemperature in this module + ! + ! !REVISION HISTORY: + ! 04/2009 Zack Subin: Initial code + ! June 2022 Sam Trahan: Modified for CCPP + !============================================================================================== + ! !USES: + ! + ! !ARGUMENTS: + implicit none + !in: + + integer , intent(in) :: snl(1) !number of snow layers + real(kind_phys), intent(inout) :: h2osno(1) !snow water (mm H2O) + real(kind_phys), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !layer thickness (m) + real(kind_phys), intent(in) :: dz_lake(1,nlevlake) !lake layer thickness (m) + ! Needed in case snow height is less than critical value. + + !inout: + + real(kind_phys), intent(inout) :: snowdp(1) !snow height (m) + real(kind_phys), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) + real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_phys), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_phys), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + !out: + + real(kind_phys), intent(out) :: qflx_snomelt(1) !snow melt (mm H2O /s) + real(kind_phys), intent(out) :: eflx_snomelt(1) !snow melt heat flux (W/m**2) + integer, intent(out) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 (new) + !What's the sign of this? Is it just output? + real(kind_phys), intent(inout) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) ! heat capacity [J/(m2 K)] + real(kind_phys), intent(inout) :: cv_lake (lbc:ubc,1:nlevlake) ! heat capacity [J/(m2 K)] + real(kind_phys), intent(out):: lhabs(lbc:ubc) ! total per-column latent heat abs. (J/m^2) + + + ! OTHER LOCAL VARIABLES: + + integer :: j,c,g !do loop index + integer :: fc !lake filtered column indices + ! real(kind_phys) :: dtime !land model time step (sec) + real(kind_phys) :: heatavail !available energy for melting or freezing (J/m^2) + real(kind_phys) :: heatrem !energy residual or loss after melting or freezing + real(kind_phys) :: melt !actual melting (+) or freezing (-) [kg/m2] + real(kind_phys), parameter :: smallnumber = 1.e-7_kind_phys !to prevent tiny residuals from rounding error + logical :: dophasechangeflag + !----------------------------------------------------------------------- + + ! dtime = get_step_size() + + ! Initialization + + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + + qflx_snomelt(c) = 0._kind_phys + eflx_snomelt(c) = 0._kind_phys + lhabs(c) = 0._kind_phys + end do + + do j = -nlevsnow+1,0 + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + + if (j >= snl(c) + 1) imelt(c,j) = 0 + end do + end do + + ! Check for case of snow without snow layers and top lake layer temp above freezing. + + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + + if (snl(c) == 0 .and. h2osno(c) > 0._kind_phys .and. t_lake(c,1) > tfrz) then + heatavail = (t_lake(c,1) - tfrz) * cv_lake(c,1) + melt = min(h2osno(c), heatavail/hfus) + heatrem = max(heatavail - melt*hfus, 0._kind_phys) + !catch small negative value to keep t at tfrz + t_lake(c,1) = tfrz + heatrem/(cv_lake(c,1)) + snowdp(c) = snowdp(c)*(1._kind_phys - melt/h2osno(c)) + h2osno(c) = h2osno(c) - melt + lhabs(c) = lhabs(c) + melt*hfus + qflx_snomelt(c) = qflx_snomelt(c) + melt + ! Prevent tiny residuals + if (h2osno(c) < smallnumber) h2osno(c) = 0._kind_phys + if (snowdp(c) < smallnumber) snowdp(c) = 0._kind_phys + end if + end do + + ! Lake phase change + + do j = 1,nlevlake + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + + dophasechangeflag = .false. + if (t_lake(c,j) > tfrz .and. lake_icefrac(c,j) > 0._kind_phys) then ! melting + dophasechangeflag = .true. + heatavail = (t_lake(c,j) - tfrz) * cv_lake(c,j) + melt = min(lake_icefrac(c,j)*denh2o*dz_lake(c,j), heatavail/hfus) + !denh2o is used because layer thickness is not adjusted for freezing + heatrem = max(heatavail - melt*hfus, 0._kind_phys) + !catch small negative value to keep t at tfrz + else if (t_lake(c,j) < tfrz .and. lake_icefrac(c,j) < 1._kind_phys) then !freezing + dophasechangeflag = .true. + heatavail = (t_lake(c,j) - tfrz) * cv_lake(c,j) + melt = max(-(1._kind_phys-lake_icefrac(c,j))*denh2o*dz_lake(c,j), heatavail/hfus) + !denh2o is used because layer thickness is not adjusted for freezing + heatrem = min(heatavail - melt*hfus, 0._kind_phys) + !catch small positive value to keep t at tfrz + end if + ! Update temperature and ice fraction. + if (dophasechangeflag) then + lake_icefrac(c,j) = lake_icefrac(c,j) - melt/(denh2o*dz_lake(c,j)) + lhabs(c) = lhabs(c) + melt*hfus + ! Update heat capacity + cv_lake(c,j) = cv_lake(c,j) + melt*(cpliq-cpice) + t_lake(c,j) = tfrz + heatrem/cv_lake(c,j) + ! Prevent tiny residuals + if (lake_icefrac(c,j) > 1._kind_phys - smallnumber) lake_icefrac(c,j) = 1._kind_phys + if (lake_icefrac(c,j) < smallnumber) lake_icefrac(c,j) = 0._kind_phys + end if + end do + end do + + ! Snow & soil phase change + + do j = -nlevsnow+1,nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + dophasechangeflag = .false. + + if (j >= snl(c) + 1) then + + if (t_soisno(c,j) > tfrz .and. h2osoi_ice(c,j) > 0._kind_phys) then ! melting + dophasechangeflag = .true. + heatavail = (t_soisno(c,j) - tfrz) * cv(c,j) + melt = min(h2osoi_ice(c,j), heatavail/hfus) + heatrem = max(heatavail - melt*hfus, 0._kind_phys) + !catch small negative value to keep t at tfrz + if (j <= 0) then !snow + imelt(c,j) = 1 + qflx_snomelt(c) = qflx_snomelt(c) + melt + end if + else if (t_soisno(c,j) < tfrz .and. h2osoi_liq(c,j) > 0._kind_phys) then !freezing + dophasechangeflag = .true. + heatavail = (t_soisno(c,j) - tfrz) * cv(c,j) + melt = max(-h2osoi_liq(c,j), heatavail/hfus) + heatrem = min(heatavail - melt*hfus, 0._kind_phys) + !catch small positive value to keep t at tfrz + if (j <= 0) then !snow + imelt(c,j) = 2 + qflx_snomelt(c) = qflx_snomelt(c) + melt + ! Does this works for both signs of melt in SnowHydrology? I think + ! qflx_snomelt(c) is just output. + end if + end if + + ! Update temperature and soil components. + if (dophasechangeflag) then + h2osoi_ice(c,j) = h2osoi_ice(c,j) - melt + h2osoi_liq(c,j) = h2osoi_liq(c,j) + melt + lhabs(c) = lhabs(c) + melt*hfus + ! Update heat capacity + cv(c,j) = cv(c,j) + melt*(cpliq-cpice) + t_soisno(c,j) = tfrz + heatrem/cv(c,j) + ! Prevent tiny residuals + if (h2osoi_ice(c,j) < smallnumber) h2osoi_ice(c,j) = 0._kind_phys + if (h2osoi_liq(c,j) < smallnumber) h2osoi_liq(c,j) = 0._kind_phys + end if + + end if + end do + end do + + ! Update eflx_snomelt(c) + !dir$ concurrent + !cdir nodep + do fc = 1,num_shlakec + c = filter_shlakec(fc) + eflx_snomelt(c) = qflx_snomelt(c)*hfus + end do + !!! + + end subroutine PhaseChange_Lake + + + subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & !i + begwb,qflx_evap_tot,forc_t,do_capsnow, & + t_grnd,qflx_evap_soi, & + qflx_snomelt,imelt,frac_iceold, & !i add by guhp + z,dz,zi,snl,h2osno,snowdp,lake_icefrac,t_lake, & !i&o + endwb,snowage,snowice,snowliq,t_snow, & !o + t_soisno,h2osoi_ice,h2osoi_liq,h2osoi_vol, & + qflx_drain,qflx_surf,qflx_infl,qflx_qrgwl, & + qcharge,qflx_prec_grnd,qflx_snowcap, & + qflx_snowcap_col,qflx_snow_grnd_pft, & + qflx_snow_grnd_col,qflx_rain_grnd, & + qflx_evap_tot_col,soilalpha,zwt,fcov, & + rootr_column,qflx_evap_grnd,qflx_sub_snow, & + qflx_dew_snow,qflx_dew_grnd,qflx_rain_grnd_col, & + errmsg,errflg) + + !================================================================================== + ! !DESCRIPTION: + ! Calculation of Shallow Lake Hydrology. Full hydrology of snow layers is + ! done. However, there is no infiltration, and the water budget is balanced with + ! qflx_qrgwl. Lake water mass is kept constant. The soil is simply maintained at + ! volumetric saturation if ice melting frees up pore space. Likewise, if the water + ! portion alone at some point exceeds pore capacity, it is reduced. This is consistent + ! with the possibility of initializing the soil layer with excess ice. The only + ! real error with that is that the thermal conductivity will ignore the excess ice + ! (and accompanying thickness change). + ! + ! If snow layers are present over an unfrozen lake, and the top layer of the lake + ! is capable of absorbing the latent heat without going below freezing, + ! the snow-water is runoff and the latent heat is subtracted from the lake. + ! + ! WARNING: This subroutine assumes lake columns have one and only one pft. + ! + ! Sequence is: + ! ShalLakeHydrology: + ! Do needed tasks from Hydrology1, Biogeophysics2, & top of Hydrology2. + ! -> SnowWater: change of snow mass and snow water onto soil + ! -> SnowCompaction: compaction of snow layers + ! -> CombineSnowLayers: combine snow layers that are thinner than minimum + ! -> DivideSnowLayers: subdivide snow layers that are thicker than maximum + ! Add water to soil if melting has left it with open pore space. + ! Cleanup and do water balance. + ! If snow layers are found above a lake with unfrozen top layer, whose top + ! layer has enough heat to melt all the snow ice without freezing, do so + ! and eliminate the snow layers. + ! + ! !REVISION HISTORY: + ! Created by Zack Subin, 2009 + ! + !============================================================================================ + + ! USES: + ! + implicit none + + ! in: + + integer, intent(inout) :: errflg + character(*), intent(inout) :: errmsg + + ! integer , intent(in) :: clandunit(1) ! column's landunit + ! integer , intent(in) :: ityplun(1) ! landunit type + ! real(kind_phys), intent(in) :: watsat(1,1:nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + real(kind_phys), intent(in) :: forc_rain(1) ! rain rate [mm/s] + real(kind_phys), intent(in) :: forc_snow(1) ! snow rate [mm/s] + real(kind_phys), intent(in) :: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + real(kind_phys), intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) + + !real(kind_phys), intent(in),optional :: flfall(1) ! fraction of liquid water within falling precipitation (unused) + + logical , intent(in) :: do_capsnow(1) ! true => do snow capping + real(kind_phys), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_phys), intent(in) :: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) + real(kind_phys), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) + integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 + + !inout: + + real(kind_phys), intent(inout) :: begwb(1) ! water mass begining of the time step + + ! inout: + + + real(kind_phys), intent(inout) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) + real(kind_phys), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness depth (m) + real(kind_phys), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) ! interface depth (m) + integer , intent(inout) :: snl(1) ! number of snow layers + real(kind_phys), intent(inout) :: h2osno(1) ! snow water (mm H2O) + real(kind_phys), intent(inout) :: snowdp(1) ! snow height (m) + real(kind_phys), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_phys), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + + real(kind_phys), intent(inout) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water + ! out: + + + real(kind_phys), intent(out) :: endwb(1) ! water mass end of the time step + real(kind_phys), intent(out) :: snowage(1) ! non dimensional snow age [-] + real(kind_phys), intent(out) :: snowice(1) ! average snow ice lens + real(kind_phys), intent(out) :: snowliq(1) ! average snow liquid water + real(kind_phys), intent(out) :: t_snow(1) ! vertically averaged snow temperature + real(kind_phys), intent(out) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! snow temperature (Kelvin) + real(kind_phys), intent(out) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + real(kind_phys), intent(out) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_phys), intent(out) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] + real(kind_phys), intent(out) :: qflx_drain(1) ! sub-surface runoff (mm H2O /s) + real(kind_phys), intent(out) :: qflx_surf(1) ! surface runoff (mm H2O /s) + real(kind_phys), intent(out) :: qflx_infl(1) ! infiltration (mm H2O /s) + real(kind_phys), intent(out) :: qflx_qrgwl(1) ! qflx_surf at glaciers, wetlands, lakes + real(kind_phys), intent(out) :: qcharge(1) ! aquifer recharge rate (mm/s) + real(kind_phys), intent(out) :: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] + real(kind_phys), intent(out) :: qflx_snowcap(1) ! excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_phys), intent(out) :: qflx_snowcap_col(1) ! excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_phys), intent(out) :: qflx_snow_grnd_pft(1) ! snow on ground after interception (mm H2O/s) [+] + real(kind_phys), intent(out) :: qflx_snow_grnd_col(1) ! snow on ground after interception (mm H2O/s) [+] + real(kind_phys), intent(out) :: qflx_rain_grnd(1) ! rain on ground after interception (mm H2O/s) [+] + real(kind_phys), intent(out) :: qflx_evap_tot_col(1) !pft quantity averaged to the column (assuming one pft) + real(kind_phys) ,intent(out) :: soilalpha(1) !factor that reduces ground saturated specific humidity (-) + real(kind_phys), intent(out) :: zwt(1) !water table depth + real(kind_phys), intent(out) :: fcov(1) !fractional area with water table at surface + real(kind_phys), intent(out) :: rootr_column(1,1:nlevsoil) !effective fraction of roots in each soil layer + real(kind_phys), intent(out) :: qflx_evap_grnd(1) ! ground surface evaporation rate (mm H2O/s) [+] + real(kind_phys), intent(out) :: qflx_sub_snow(1) ! sublimation rate from snow pack (mm H2O /s) [+] + real(kind_phys), intent(out) :: qflx_dew_snow(1) ! surface dew added to snow pack (mm H2O /s) [+] + real(kind_phys), intent(out) :: qflx_dew_grnd(1) ! ground surface dew formation (mm H2O /s) [+] + real(kind_phys), intent(out) :: qflx_rain_grnd_col(1) !rain on ground after interception (mm H2O/s) [+] + + ! Block of biogeochem currently not used. + real(kind_phys), pointer :: sucsat(:,:) ! minimum soil suction (mm) + real(kind_phys), pointer :: bsw(:,:) ! Clapp and Hornberger "b" + real(kind_phys), pointer :: bsw2(:,:) ! Clapp and Hornberger "b" for CN code + real(kind_phys), pointer :: psisat(:,:) ! soil water potential at saturation for CN code (MPa) + real(kind_phys), pointer :: vwcsat(:,:) ! volumetric water content at saturation for CN code (m3/m3) + real(kind_phys), pointer :: wf(:) ! soil water as frac. of whc for top 0.5 m + real(kind_phys), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) + + ! OTHER LOCAL VARIABLES: + + integer :: p,fp,g,l,c,j,fc,jtop ! indices + integer :: num_shlakesnowc ! number of column snow points + integer :: filter_shlakesnowc(ubc-lbc+1) ! column filter for snow points + integer :: num_shlakenosnowc ! number of column non-snow points + integer :: filter_shlakenosnowc(ubc-lbc+1) ! column filter for non-snow points + ! real(kind_phys) :: dtime ! land model time step (sec) + integer :: newnode ! flag when new snow node is set, (1=yes, 0=no) + real(kind_phys) :: dz_snowf ! layer thickness rate change due to precipitation [mm/s] + real(kind_phys) :: bifall ! bulk density of newly fallen dry snow [kg/m3] + real(kind_phys) :: fracsnow(lbp:ubp) ! frac of precipitation that is snow + real(kind_phys) :: fracrain(lbp:ubp) ! frac of precipitation that is rain + real(kind_phys) :: qflx_prec_grnd_snow(lbp:ubp) ! snow precipitation incident on ground [mm/s] + real(kind_phys) :: qflx_prec_grnd_rain(lbp:ubp) ! rain precipitation incident on ground [mm/s] + real(kind_phys) :: qflx_evap_soi_lim ! temporary evap_soi limited by top snow layer content [mm/s] + real(kind_phys) :: h2osno_temp ! temporary h2osno [kg/m^2] + real(kind_phys) :: sumsnowice(lbc:ubc) ! sum of snow ice if snow layers found above unfrozen lake [kg/m&2] + logical :: unfrozen(lbc:ubc) ! true if top lake layer is unfrozen with snow layers above + real(kind_phys) :: heatrem ! used in case above [J/m^2] + real(kind_phys) :: heatsum(lbc:ubc) ! used in case above [J/m^2] + real(kind_phys) :: qflx_top_soil(1) !net water input into soil from top (mm/s) + character*256 :: message + + real(kind_phys),allocatable :: snow_water(:) ! temporary sum of snow water for Bal Check [kg/m^2] + !----------------------------------------------------------------------- + + ! Determine step size + + ! dtime = get_step_size() + + ! Add soil water to water balance. + do j = 1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + begwb(c) = begwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + end do + end do + + !!!!!!!!!!!!!!!!!!!!!!!!!!! + + ! Do precipitation onto ground, etc., from Hydrology1. + + !dir$ concurrent + !cdir nodep + do fp = 1, num_shlakep + p = filter_shlakep(fp) + g = pgridcell(p) + ! l = plandunit(p) + c = pcolumn(p) + + ! Precipitation onto ground (kg/(m2 s)) + ! ! PET, 1/18/2005: Added new terms for mass balance correction + ! ! due to dynamic pft weight shifting (column-level h2ocan_loss) + ! ! Because the fractionation between rain and snow is indeterminate if + ! ! rain + snow = 0, I am adding this very small flux only to the rain + ! ! components. + ! Not relevant unless PFTs are added to lake later. + ! if (frac_veg_nosno(p) == 0) then + qflx_prec_grnd_snow(p) = forc_snow(g) + qflx_prec_grnd_rain(p) = forc_rain(g) !+ h2ocan_loss(c) + ! else + ! qflx_prec_grnd_snow(p) = qflx_through_snow(p) + (qflx_candrip(p) * fracsnow(p)) + ! qflx_prec_grnd_rain(p) = qflx_through_rain(p) + (qflx_candrip(p) * fracrain(p)) + h2ocan_loss(c) + ! end if + qflx_prec_grnd(p) = qflx_prec_grnd_snow(p) + qflx_prec_grnd_rain(p) + + if (do_capsnow(c)) then + qflx_snowcap(p) = qflx_prec_grnd_snow(p) + qflx_prec_grnd_rain(p) + qflx_snow_grnd_pft(p) = 0._kind_phys + qflx_rain_grnd(p) = 0._kind_phys + else + qflx_snowcap(p) = 0._kind_phys + qflx_snow_grnd_pft(p) = qflx_prec_grnd_snow(p) ! ice onto ground (mm/s) + qflx_rain_grnd(p) = qflx_prec_grnd_rain(p) ! liquid water onto ground (mm/s) + end if + ! Assuming one PFT; needed for below + qflx_snow_grnd_col(c) = qflx_snow_grnd_pft(p) + qflx_rain_grnd_col(c) = qflx_rain_grnd(p) + + end do ! (end pft loop) + + ! Determine snow height and snow water + + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + ! l = clandunit(c) + g = cgridcell(c) + + ! Use Alta relationship, Anderson(1976); LaChapelle(1961), + ! U.S.Department of Agriculture Forest Service, Project F, + ! Progress Rep. 1, Alta Avalanche Study Center:Snow Layer Densification. + + if (do_capsnow(c)) then + dz_snowf = 0._kind_phys + else + if (forc_t(g) > tfrz + 2._kind_phys) then + bifall=50._kind_phys + 1.7_kind_phys*(17.0_kind_phys)**1.5_kind_phys + else if (forc_t(g) > tfrz - 15._kind_phys) then + bifall=50._kind_phys + 1.7_kind_phys*(forc_t(g) - tfrz + 15._kind_phys)**1.5_kind_phys + else + bifall=50._kind_phys + end if + dz_snowf = qflx_snow_grnd_col(c)/bifall + snowdp(c) = snowdp(c) + dz_snowf*dtime + h2osno(c) = h2osno(c) + qflx_snow_grnd_col(c)*dtime ! snow water equivalent (mm) + end if + + ! if (itype(l)==istwet .and. t_grnd(c)>tfrz) then + ! h2osno(c)=0._kind_phys + ! snowdp(c)=0._kind_phys + ! snowage(c)=0._kind_phys + ! end if + ! Take care of this later in function. + + ! When the snow accumulation exceeds 10 mm, initialize snow layer + ! Currently, the water temperature for the precipitation is simply set + ! as the surface air temperature + + newnode = 0 ! flag for when snow node will be initialized + if (snl(c) == 0 .and. qflx_snow_grnd_col(c) > 0.0_kind_phys .and. snowdp(c) >= 0.01_kind_phys) then + newnode = 1 + snl(c) = -1 + dz(c,0) = snowdp(c) ! meter + z(c,0) = -0.5_kind_phys*dz(c,0) + zi(c,-1) = -dz(c,0) + snowage(c) = 0._kind_phys ! snow age + t_soisno(c,0) = min(tfrz, forc_t(g)) ! K + h2osoi_ice(c,0) = h2osno(c) ! kg/m2 + h2osoi_liq(c,0) = 0._kind_phys ! kg/m2 + frac_iceold(c,0) = 1._kind_phys + end if + + ! The change of ice partial density of surface node due to precipitation. + ! Only ice part of snowfall is added here, the liquid part will be added + ! later. + + if (snl(c) < 0 .and. newnode == 0) then + h2osoi_ice(c,snl(c)+1) = h2osoi_ice(c,snl(c)+1)+dtime*qflx_snow_grnd_col(c) + dz(c,snl(c)+1) = dz(c,snl(c)+1)+dz_snowf*dtime + end if + + end do + + ! Calculate sublimation and dew, adapted from HydrologyLake and Biogeophysics2. + + !dir$ concurrent + !cdir nodep + do fp = 1,num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + jtop = snl(c)+1 + + ! Use column variables here + qflx_evap_grnd(c) = 0._kind_phys + qflx_sub_snow(c) = 0._kind_phys + qflx_dew_snow(c) = 0._kind_phys + qflx_dew_grnd(c) = 0._kind_phys + + if (jtop <= 0) then ! snow layers + j = jtop + ! Assign ground evaporation to sublimation from soil ice or to dew + ! on snow or ground + + if (qflx_evap_soi(p) >= 0._kind_phys) then + ! for evaporation partitioning between liquid evap and ice sublimation, + ! use the ratio of liquid to (liquid+ice) in the top layer to determine split + ! Since we're not limiting evap over lakes, but still can't remove more from top + ! snow layer than there is there, create temp. limited evap_soi. + qflx_evap_soi_lim = min(qflx_evap_soi(p), (h2osoi_liq(c,j)+h2osoi_ice(c,j))/dtime) + if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0._kind_phys) then + qflx_evap_grnd(c) = max(qflx_evap_soi_lim*(h2osoi_liq(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._kind_phys) + else + qflx_evap_grnd(c) = 0._kind_phys + end if + qflx_sub_snow(c) = qflx_evap_soi_lim - qflx_evap_grnd(c) + else + if (t_grnd(c) < tfrz) then + qflx_dew_snow(c) = abs(qflx_evap_soi(p)) + else + qflx_dew_grnd(c) = abs(qflx_evap_soi(p)) + end if + end if + ! Update the pft-level qflx_snowcap + ! This was moved in from Hydrology2 to keep all pft-level + ! calculations out of Hydrology2 + if (do_capsnow(c)) qflx_snowcap(p) = qflx_snowcap(p) + qflx_dew_snow(c) + qflx_dew_grnd(c) + + else ! No snow layers: do as in HydrologyLake but with actual clmtype variables + if (qflx_evap_soi(p) >= 0._kind_phys) then + ! Sublimation: do not allow for more sublimation than there is snow + ! after melt. Remaining surface evaporation used for infiltration. + qflx_sub_snow(c) = min(qflx_evap_soi(p), h2osno(c)/dtime) + qflx_evap_grnd(c) = qflx_evap_soi(p) - qflx_sub_snow(c) + else + if (t_grnd(c) < tfrz-0.1_kind_phys) then + qflx_dew_snow(c) = abs(qflx_evap_soi(p)) + else + qflx_dew_grnd(c) = abs(qflx_evap_soi(p)) + end if + end if + + ! Update snow pack for dew & sub. + h2osno_temp = h2osno(c) + if (do_capsnow(c)) then + h2osno(c) = h2osno(c) - qflx_sub_snow(c)*dtime + qflx_snowcap(p) = qflx_snowcap(p) + qflx_dew_snow(c) + qflx_dew_grnd(c) + else + h2osno(c) = h2osno(c) + (-qflx_sub_snow(c)+qflx_dew_snow(c))*dtime + end if + if (h2osno_temp > 0._kind_phys) then + snowdp(c) = snowdp(c) * h2osno(c) / h2osno_temp + else + snowdp(c) = h2osno(c)/snow_bd !Assume a constant snow bulk density = 250. + end if + + if (PERGRO) then + if (abs(h2osno(c)) < 1.e-10_kind_phys) h2osno(c) = 0._kind_phys + else + h2osno(c) = max(h2osno(c), 0._kind_phys) + endif + + end if + + qflx_snowcap_col(c) = qflx_snowcap(p) + + end do + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Determine initial snow/no-snow filters (will be modified possibly by + ! routines CombineSnowLayers and DivideSnowLayers below + + call BuildSnowFilter(lbc, ubc, num_shlakec, filter_shlakec,snl, & !i + num_shlakesnowc, filter_shlakesnowc, num_shlakenosnowc, filter_shlakenosnowc) !o + + ! Determine the change of snow mass and the snow water onto soil + + call SnowWater(lbc, ubc, num_shlakesnowc, filter_shlakesnowc, & !i + num_shlakenosnowc, filter_shlakenosnowc, & !i + snl,do_capsnow,qflx_snomelt,qflx_rain_grnd, & !i + qflx_sub_snow,qflx_evap_grnd, & !i + qflx_dew_snow,qflx_dew_grnd,dz, & !i + h2osoi_ice,h2osoi_liq, & !i&o + qflx_top_soil) !o + + + ! Determine soil hydrology + ! Here this consists only of making sure that soil is saturated even as it melts and 10% + ! of pore space opens up. Conversely, if excess ice is melting and the liquid water exceeds the + ! saturation value, then remove water. + + do j = 1,nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + if (h2osoi_vol(c,j) < watsat(c,j)) then + h2osoi_liq(c,j) = (watsat(c,j)*dz(c,j) - h2osoi_ice(c,j)/denice)*denh2o + ! h2osoi_vol will be updated below, and this water addition will come from qflx_qrgwl + else if (h2osoi_liq(c,j) > watsat(c,j)*denh2o*dz(c,j)) then + h2osoi_liq(c,j) = watsat(c,j)*denh2o*dz(c,j) + end if + + end do + end do + !!!!!!!!!! + + ! if (.not. is_perpetual()) then + if (1==1) then + + ! Natural compaction and metamorphosis. + + call SnowCompaction(lbc, ubc, num_shlakesnowc, filter_shlakesnowc, &!i + snl,imelt,frac_iceold,t_soisno, &!i + h2osoi_ice,h2osoi_liq, &!i + dz) !&o + + ! Combine thin snow elements + + call CombineSnowLayers(lbc, ubc, & !i + num_shlakesnowc, filter_shlakesnowc, & !i&o + snl,h2osno,snowdp,dz,zi, & !i&o + t_soisno,h2osoi_ice,h2osoi_liq, & !i&o + z) !o + + + ! Divide thick snow elements + + call DivideSnowLayers(lbc, ubc, & !i + num_shlakesnowc, filter_shlakesnowc, & !i&o + snl,dz,zi,t_soisno, & !i&o + h2osoi_ice,h2osoi_liq, & !i&o + z) !o + + + else + + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + h2osno(c) = 0._kind_phys + end do + do j = -nlevsnow+1,0 + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + if (j >= snl(c)+1) then + h2osno(c) = h2osno(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + end if + end do + end do + + end if + + ! Check for snow layers above lake with unfrozen top layer. Mechanically, + ! the snow will fall into the lake and melt or turn to ice. If the top layer has + ! sufficient heat to melt the snow without freezing, then that will be done. + ! Otherwise, the top layer will undergo freezing, but only if the top layer will + ! not freeze completely. Otherwise, let the snow layers persist and melt by diffusion. + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + if (t_lake(c,1) > tfrz .and. lake_icefrac(c,1) == 0._kind_phys .and. snl(c) < 0) then + unfrozen(c) = .true. + else + unfrozen(c) = .false. + end if + end do + + do j = -nlevsnow+1,0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + if (unfrozen(c)) then + if (j == -nlevsnow+1) then + sumsnowice(c) = 0._kind_phys + heatsum(c) = 0._kind_phys + end if + if (j >= snl(c)+1) then + sumsnowice(c) = sumsnowice(c) + h2osoi_ice(c,j) + heatsum(c) = heatsum(c) + h2osoi_ice(c,j)*cpice*(tfrz - t_soisno(c,j)) & + + h2osoi_liq(c,j)*cpliq*(tfrz - t_soisno(c,j)) + end if + end if + end do + end do + + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + if (unfrozen(c)) then + heatsum(c) = heatsum(c) + sumsnowice(c)*hfus + heatrem = (t_lake(c,1) - tfrz)*cpliq*denh2o*dz_lake(c,1) - heatsum(c) + + if (heatrem + denh2o*dz_lake(c,1)*hfus > 0._kind_phys) then + ! Remove snow and subtract the latent heat from the top layer. + h2osno(c) = 0._kind_phys + snl(c) = 0 + ! The rest of the bookkeeping for the removed snow will be done below. + if (LAKEDEBUG) then + print *,'Snow layers removed above unfrozen lake for column, snowice:', & + c, sumsnowice(c) + endif + if (heatrem > 0._kind_phys) then ! simply subtract the heat from the layer + t_lake(c,1) = t_lake(c,1) - heatrem/(cpliq*denh2o*dz_lake(c,1)) + else !freeze part of the layer + t_lake(c,1) = tfrz + lake_icefrac(c,1) = -heatrem/(denh2o*dz_lake(c,1)*hfus) + end if + end if + end if + end do + !!!!!!!!!!!! + + ! Set snow age to zero if no snow + + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + if (snl(c) == 0) then + snowage(c) = 0._kind_phys + end if + end do + + ! Set empty snow layers to zero + + do j = -nlevsnow+1,0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + if (j <= snl(c) .and. snl(c) > -nlevsnow) then + h2osoi_ice(c,j) = 0._kind_phys + h2osoi_liq(c,j) = 0._kind_phys + t_soisno(c,j) = 0._kind_phys + dz(c,j) = 0._kind_phys + z(c,j) = 0._kind_phys + zi(c,j-1) = 0._kind_phys + end if + end do + end do + + ! Build new snow filter + + call BuildSnowFilter(lbc, ubc, num_shlakec, filter_shlakec, snl,& !i + num_shlakesnowc, filter_shlakesnowc, num_shlakenosnowc, filter_shlakenosnowc) !o + + ! Vertically average t_soisno and sum of h2osoi_liq and h2osoi_ice + ! over all snow layers for history output + + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + t_snow(c) = 0._kind_phys + snowice(c) = 0._kind_phys + snowliq(c) = 0._kind_phys + end do + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakenosnowc + c = filter_shlakenosnowc(fc) + t_snow(c) = spval + snowice(c) = spval + snowliq(c) = spval + end do + + do j = -nlevsnow+1, 0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakesnowc + c = filter_shlakesnowc(fc) + if (j >= snl(c)+1) then + t_snow(c) = t_snow(c) + t_soisno(c,j) + snowice(c) = snowice(c) + h2osoi_ice(c,j) + snowliq(c) = snowliq(c) + h2osoi_liq(c,j) + end if + end do + end do + + ! Determine ending water balance and volumetric soil water + + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + + c = filter_shlakec(fc) + if (snl(c) < 0) t_snow(c) = t_snow(c)/abs(snl(c)) + endwb(c) = h2osno(c) + end do + + do j = 1, nlevsoil + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + endwb(c) = endwb(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + h2osoi_vol(c,j) = h2osoi_liq(c,j)/(dz(c,j)*denh2o) + h2osoi_ice(c,j)/(dz(c,j)*denice) + end do + end do + + check_add_snow_water: if(LAKEDEBUG) then + allocate(snow_water(lbc:ubc)) + ! Check to make sure snow water adds up correctly. + do j = -nlevsnow+1,0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_shlakec + c = filter_shlakec(fc) + + jtop = snl(c)+1 + if(j == jtop) snow_water(c) = 0._kind_phys + if(j >= jtop) then + snow_water(c) = snow_water(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + if(j == 0 .and. abs(snow_water(c)-h2osno(c))>1.e-7_kind_phys) then + write(message,*)'h2osno does not equal sum of snow layers in ShalLakeHydrology:', & + 'column, h2osno, sum of snow layers =', c, h2osno(c), snow_water(c) + errmsg=trim(message) + errflg=1 + ! FIXME: PUT THIS BACK: return + end if + end if + end do + end do + deallocate(snow_water) + end if check_add_snow_water + + !!!!!!!!!!!!! + ! Do history variables and set special landunit runoff (adapted from end of HydrologyLake) + !dir$ concurrent + !cdir nodep + do fp = 1,num_shlakep + p = filter_shlakep(fp) + c = pcolumn(p) + g = pgridcell(p) + + qflx_infl(c) = 0._kind_phys + qflx_surf(c) = 0._kind_phys + qflx_drain(c) = 0._kind_phys + rootr_column(c,:) = spval + soilalpha(c) = spval + zwt(c) = spval + fcov(c) = spval + qcharge(c) = spval + ! h2osoi_vol(c,:) = spval + + ! Insure water balance using qflx_qrgwl + qflx_qrgwl(c) = forc_rain(g) + forc_snow(g) - qflx_evap_tot(p) - (endwb(c)-begwb(c))/dtime + if (LAKEDEBUG) then + print *,'c, rain, snow, evap, endwb, begwb, qflx_qrgwl:', & + c, forc_rain(g), forc_snow(g), qflx_evap_tot(p), endwb(c), begwb(c), qflx_qrgwl(c) + endif + + ! The pft average must be done here for output to history tape + qflx_evap_tot_col(c) = qflx_evap_tot(p) + end do + + end subroutine ShalLakeHydrology + + subroutine QSat (T, p, es, esdT, qs, qsdT) + ! + ! !DESCRIPTION: + ! Computes saturation mixing ratio and the change in saturation + ! mixing ratio with respect to temperature. + ! Reference: Polynomial approximations from: + ! Piotr J. Flatau, et al.,1992: Polynomial fits to saturation + ! vapor pressure. Journal of Applied Meteorology, 31, 1507-1513. + ! + ! !USES: + ! + ! !ARGUMENTS: + implicit none + real(kind_phys), intent(in) :: T ! temperature (K) + real(kind_phys), intent(in) :: p ! surface atmospheric pressure (pa) + real(kind_phys), intent(out) :: es ! vapor pressure (pa) + real(kind_phys), intent(out) :: esdT ! d(es)/d(T) + real(kind_phys), intent(out) :: qs ! humidity (kg/kg) + real(kind_phys), intent(out) :: qsdT ! d(qs)/d(T) + ! + ! !CALLED FROM: + ! subroutine Biogeophysics1 in module Biogeophysics1Mod + ! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod + ! subroutine CanopyFluxesMod CanopyFluxesMod + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! + !EOP + ! + ! !LOCAL VARIABLES: + ! + real(kind_phys) :: T_limit + real(kind_phys) :: td,vp,vp1,vp2 + ! + ! For water vapor (temperature range 0C-100C) + ! + real(kind_phys), parameter :: a0 = 6.11213476 + real(kind_phys), parameter :: a1 = 0.444007856 + real(kind_phys), parameter :: a2 = 0.143064234e-01 + real(kind_phys), parameter :: a3 = 0.264461437e-03 + real(kind_phys), parameter :: a4 = 0.305903558e-05 + real(kind_phys), parameter :: a5 = 0.196237241e-07 + real(kind_phys), parameter :: a6 = 0.892344772e-10 + real(kind_phys), parameter :: a7 = -0.373208410e-12 + real(kind_phys), parameter :: a8 = 0.209339997e-15 + ! + ! For derivative:water vapor + ! + real(kind_phys), parameter :: b0 = 0.444017302 + real(kind_phys), parameter :: b1 = 0.286064092e-01 + real(kind_phys), parameter :: b2 = 0.794683137e-03 + real(kind_phys), parameter :: b3 = 0.121211669e-04 + real(kind_phys), parameter :: b4 = 0.103354611e-06 + real(kind_phys), parameter :: b5 = 0.404125005e-09 + real(kind_phys), parameter :: b6 = -0.788037859e-12 + real(kind_phys), parameter :: b7 = -0.114596802e-13 + real(kind_phys), parameter :: b8 = 0.381294516e-16 + ! + ! For ice (temperature range -75C-0C) + ! + real(kind_phys), parameter :: c0 = 6.11123516 + real(kind_phys), parameter :: c1 = 0.503109514 + real(kind_phys), parameter :: c2 = 0.188369801e-01 + real(kind_phys), parameter :: c3 = 0.420547422e-03 + real(kind_phys), parameter :: c4 = 0.614396778e-05 + real(kind_phys), parameter :: c5 = 0.602780717e-07 + real(kind_phys), parameter :: c6 = 0.387940929e-09 + real(kind_phys), parameter :: c7 = 0.149436277e-11 + real(kind_phys), parameter :: c8 = 0.262655803e-14 + ! + ! For derivative:ice + ! + real(kind_phys), parameter :: d0 = 0.503277922 + real(kind_phys), parameter :: d1 = 0.377289173e-01 + real(kind_phys), parameter :: d2 = 0.126801703e-02 + real(kind_phys), parameter :: d3 = 0.249468427e-04 + real(kind_phys), parameter :: d4 = 0.313703411e-06 + real(kind_phys), parameter :: d5 = 0.257180651e-08 + real(kind_phys), parameter :: d6 = 0.133268878e-10 + real(kind_phys), parameter :: d7 = 0.394116744e-13 + real(kind_phys), parameter :: d8 = 0.498070196e-16 + !----------------------------------------------------------------------- + + T_limit = T - tfrz + if (T_limit > 100.0) T_limit=100.0 + if (T_limit < -75.0) T_limit=-75.0 + + td = T_limit + if (td >= 0.0) then + es = a0 + td*(a1 + td*(a2 + td*(a3 + td*(a4 & + + td*(a5 + td*(a6 + td*(a7 + td*a8))))))) + esdT = b0 + td*(b1 + td*(b2 + td*(b3 + td*(b4 & + + td*(b5 + td*(b6 + td*(b7 + td*b8))))))) + else + es = c0 + td*(c1 + td*(c2 + td*(c3 + td*(c4 & + + td*(c5 + td*(c6 + td*(c7 + td*c8))))))) + esdT = d0 + td*(d1 + td*(d2 + td*(d3 + td*(d4 & + + td*(d5 + td*(d6 + td*(d7 + td*d8))))))) + endif + + es = es * 100. ! pa + esdT = esdT * 100. ! pa/K + + vp = 1.0 / (p - 0.378*es) + vp1 = 0.622 * vp + vp2 = vp1 * vp + + qs = es * vp1 ! kg/kg + qsdT = esdT * vp2 * p ! 1 / K + + end subroutine QSat + + + subroutine Tridiagonal (lbc, ubc, lbj, ubj, jtop, numf, filter, & + a, b, c, r, u) + ! + ! !DESCRIPTION: + ! Tridiagonal matrix solution + ! + ! !ARGUMENTS: + implicit none + integer , intent(in) :: lbc, ubc ! lbinning and ubing column indices + integer , intent(in) :: lbj, ubj ! lbinning and ubing level indices + integer , intent(in) :: jtop(lbc:ubc) ! top level for each column + integer , intent(in) :: numf ! filter dimension + integer , intent(in) :: filter(1:numf) ! filter + real(kind_phys), intent(in) :: a(lbc:ubc, lbj:ubj) ! "a" left off diagonal of tridiagonal matrix + real(kind_phys), intent(in) :: b(lbc:ubc, lbj:ubj) ! "b" diagonal column for tridiagonal matrix + real(kind_phys), intent(in) :: c(lbc:ubc, lbj:ubj) ! "c" right off diagonal tridiagonal matrix + real(kind_phys), intent(in) :: r(lbc:ubc, lbj:ubj) ! "r" forcing term of tridiagonal matrix + real(kind_phys), intent(inout) :: u(lbc:ubc, lbj:ubj) ! solution + ! + ! !CALLED FROM: + ! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod + ! subroutine SoilTemperature in module SoilTemperatureMod + ! subroutine SoilWater in module HydrologyMod + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! 1 July 2003: Mariana Vertenstein; modified for vectorization + ! + !EOP + ! + ! !OTHER LOCAL VARIABLES: + ! + integer :: j,ci,fc !indices + real(kind_phys) :: gam(lbc:ubc,lbj:ubj) !temporary + real(kind_phys) :: bet(lbc:ubc) !temporary + !----------------------------------------------------------------------- + + ! Solve the matrix + + !dir$ concurrent + !cdir nodep + do fc = 1,numf + ci = filter(fc) + bet(ci) = b(ci,jtop(ci)) + end do + + do j = lbj, ubj + !dir$ prefervector + !dir$ concurrent + !cdir nodep + do fc = 1,numf + ci = filter(fc) + if (j >= jtop(ci)) then + if (j == jtop(ci)) then + u(ci,j) = r(ci,j) / bet(ci) + else + gam(ci,j) = c(ci,j-1) / bet(ci) + bet(ci) = b(ci,j) - a(ci,j) * gam(ci,j) + u(ci,j) = (r(ci,j) - a(ci,j)*u(ci,j-1)) / bet(ci) + end if + end if + end do + end do + + !Cray X1 unroll directive used here as work-around for compiler issue 2003/10/20 + !dir$ unroll 0 + do j = ubj-1,lbj,-1 + !dir$ prefervector + !dir$ concurrent + !cdir nodep + do fc = 1,numf + ci = filter(fc) + if (j >= jtop(ci)) then + u(ci,j) = u(ci,j) - gam(ci,j+1) * u(ci,j+1) + end if + end do + end do + + end subroutine Tridiagonal + + + subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i + num_nosnowc, filter_nosnowc, & !i + snl,do_capsnow,qflx_snomelt,qflx_rain_grnd, & !i + qflx_sub_snow,qflx_evap_grnd, & !i + qflx_dew_snow,qflx_dew_grnd,dz, & !i + h2osoi_ice,h2osoi_liq, & !i&o + qflx_top_soil) !o + !=============================================================================== + ! !DESCRIPTION: + ! Evaluate the change of snow mass and the snow water onto soil. + ! Water flow within snow is computed by an explicit and non-physical + ! based scheme, which permits a part of liquid water over the holding + ! capacity (a tentative value is used, i.e. equal to 0.033*porosity) to + ! percolate into the underlying layer. Except for cases where the + ! porosity of one of the two neighboring layers is less than 0.05, zero + ! flow is assumed. The water flow out of the bottom of the snow pack will + ! participate as the input of the soil water and runoff. This subroutine + ! uses a filter for columns containing snow which must be constructed prior + ! to being called. + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! 15 November 2000: Mariana Vertenstein + ! 2/26/02, Peter Thornton: Migrated to new data structures. + !============================================================================= + ! !USES: + ! use clmtype + + implicit none + + !in: + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_snowc ! number of snow points in column filter + integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer, intent(in) :: num_nosnowc ! number of non-snow points in column filter + integer, intent(in) :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points + + integer , intent(in) :: snl(1) !number of snow layers + logical , intent(in) :: do_capsnow(1) !true => do snow capping + real(kind_phys), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) + real(kind_phys), intent(in) :: qflx_rain_grnd(1) !rain on ground after interception (mm H2O/s) [+] + real(kind_phys), intent(in) :: qflx_sub_snow(1) !sublimation rate from snow pack (mm H2O /s) [+] + real(kind_phys), intent(in) :: qflx_evap_grnd(1) !ground surface evaporation rate (mm H2O/s) [+] + real(kind_phys), intent(in) :: qflx_dew_snow(1) !surface dew added to snow pack (mm H2O /s) [+] + real(kind_phys), intent(in) :: qflx_dew_grnd(1) !ground surface dew formation (mm H2O /s) [+] + real(kind_phys), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + + + !inout: + + real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + + !out: + + real(kind_phys), intent(out) :: qflx_top_soil(1) !net water input into soil from top (mm/s) + + + ! OTHER LOCAL VARIABLES: + + integer :: c, j, fc !do loop/array indices + real(kind_phys) :: qin(lbc:ubc) !water flow into the elmement (mm/s) + real(kind_phys) :: qout(lbc:ubc) !water flow out of the elmement (mm/s) + real(kind_phys) :: wgdif !ice mass after minus sublimation + real(kind_phys) :: vol_liq(lbc:ubc,-nlevsnow+1:0) !partial volume of liquid water in layer + real(kind_phys) :: vol_ice(lbc:ubc,-nlevsnow+1:0) !partial volume of ice lens in layer + real(kind_phys) :: eff_porosity(lbc:ubc,-nlevsnow+1:0) !effective porosity = porosity - vol_ice + !----------------------------------------------------------------------- + ! Renew the mass of ice lens (h2osoi_ice) and liquid (h2osoi_liq) in the + ! surface snow layer resulting from sublimation (frost) / evaporation (condense) + + !dir$ concurrent + !cdir nodep + do fc = 1,num_snowc + c = filter_snowc(fc) + if (do_capsnow(c)) then + wgdif = h2osoi_ice(c,snl(c)+1) - qflx_sub_snow(c)*dtime + h2osoi_ice(c,snl(c)+1) = wgdif + if (wgdif < 0.) then + h2osoi_ice(c,snl(c)+1) = 0. + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + wgdif + end if + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) - qflx_evap_grnd(c) * dtime + else + wgdif = h2osoi_ice(c,snl(c)+1) + (qflx_dew_snow(c) - qflx_sub_snow(c)) * dtime + h2osoi_ice(c,snl(c)+1) = wgdif + if (wgdif < 0.) then + h2osoi_ice(c,snl(c)+1) = 0. + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + wgdif + end if + h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + & + (qflx_rain_grnd(c) + qflx_dew_grnd(c) - qflx_evap_grnd(c)) * dtime + end if + h2osoi_liq(c,snl(c)+1) = max(0._kind_phys, h2osoi_liq(c,snl(c)+1)) + end do + + ! Porosity and partial volume + + do j = -nlevsnow+1, 0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + vol_ice(c,j) = min(1._kind_phys, h2osoi_ice(c,j)/(dz(c,j)*denice)) + eff_porosity(c,j) = 1. - vol_ice(c,j) + vol_liq(c,j) = min(eff_porosity(c,j),h2osoi_liq(c,j)/(dz(c,j)*denh2o)) + end if + end do + end do + + ! Capillary forces within snow are usually two or more orders of magnitude + ! less than those of gravity. Only gravity terms are considered. + ! the genernal expression for water flow is "K * ss**3", however, + ! no effective parameterization for "K". Thus, a very simple consideration + ! (not physically based) is introduced: + ! when the liquid water of layer exceeds the layer's holding + ! capacity, the excess meltwater adds to the underlying neighbor layer. + + qin(:) = 0._kind_phys + + do j = -nlevsnow+1, 0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + h2osoi_liq(c,j) = h2osoi_liq(c,j) + qin(c) + if (j <= -1) then + ! No runoff over snow surface, just ponding on surface + if (eff_porosity(c,j) < wimp .OR. eff_porosity(c,j+1) < wimp) then + qout(c) = 0._kind_phys + else + qout(c) = max(0._kind_phys,(vol_liq(c,j)-ssi*eff_porosity(c,j))*dz(c,j)) + qout(c) = min(qout(c),(1.-vol_ice(c,j+1)-vol_liq(c,j+1))*dz(c,j+1)) + end if + else + qout(c) = max(0._kind_phys,(vol_liq(c,j) - ssi*eff_porosity(c,j))*dz(c,j)) + end if + qout(c) = qout(c)*1000. + h2osoi_liq(c,j) = h2osoi_liq(c,j) - qout(c) + qin(c) = qout(c) + end if + end do + end do + + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + ! Qout from snow bottom + qflx_top_soil(c) = qout(c) / dtime + end do + + !dir$ concurrent + !cdir nodep + do fc = 1, num_nosnowc + c = filter_nosnowc(fc) + qflx_top_soil(c) = qflx_rain_grnd(c) + qflx_snomelt(c) + end do + + end subroutine SnowWater + + subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i + snl,imelt,frac_iceold,t_soisno, &!i + h2osoi_ice,h2osoi_liq, &!i + dz) !i&o + + + !================================================================================ + ! !DESCRIPTION: + ! Determine the change in snow layer thickness due to compaction and + ! settling. + ! Three metamorphisms of changing snow characteristics are implemented, + ! i.e., destructive, overburden, and melt. The treatments of the former + ! two are from SNTHERM.89 and SNTHERM.99 (1991, 1999). The contribution + ! due to melt metamorphism is simply taken as a ratio of snow ice + ! fraction after the melting versus before the melting. + ! + ! CALLED FROM: + ! subroutine Hydrology2 in module Hydrology2Mod + ! + ! REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! 2/28/02, Peter Thornton: Migrated to new data structures + !============================================================================== + ! USES: + ! use clmtype + ! + ! !ARGUMENTS: + implicit none + + !in: + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_snowc ! number of column snow points in column filter + integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer, intent(in) :: snl(1) !number of snow layers + integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 + real(kind_phys), intent(in) :: frac_iceold(1,-nlevsnow+1:nlevsoil) !fraction of ice relative to the tot water + real(kind_phys), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) + real(kind_phys), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_phys), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + + !inout: + + real(kind_phys), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + + ! OTHER LOCAL VARIABLES: + + integer :: j, c, fc ! indices + real(kind_phys), parameter :: c2 = 23.e-3 ! [m3/kg] + real(kind_phys), parameter :: c3 = 2.777e-6 ! [1/s] + real(kind_phys), parameter :: c4 = 0.04 ! [1/K] + real(kind_phys), parameter :: c5 = 2.0 ! + real(kind_phys), parameter :: dm = 100.0 ! Upper Limit on Destructive Metamorphism Compaction [kg/m3] + real(kind_phys), parameter :: eta0 = 9.e+5 ! The Viscosity Coefficient Eta0 [kg-s/m2] + real(kind_phys) :: burden(lbc:ubc) ! pressure of overlying snow [kg/m2] + real(kind_phys) :: ddz1 ! Rate of settling of snowpack due to destructive metamorphism. + real(kind_phys) :: ddz2 ! Rate of compaction of snowpack due to overburden. + real(kind_phys) :: ddz3 ! Rate of compaction of snowpack due to melt [1/s] + real(kind_phys) :: dexpf ! expf=exp(-c4*(273.15-t_soisno)). + real(kind_phys) :: fi ! Fraction of ice relative to the total water content at current time step + real(kind_phys) :: td ! t_soisno - tfrz [K] + real(kind_phys) :: pdzdtc ! Nodal rate of change in fractional-thickness due to compaction [fraction/s] + real(kind_phys) :: void ! void (1 - vol_ice - vol_liq) + real(kind_phys) :: wx ! water mass (ice+liquid) [kg/m2] + real(kind_phys) :: bi ! partial density of ice [kg/m3] + + !----------------------------------------------------------------------- + + + ! Begin calculation - note that the following column loops are only invoked if snl(c) < 0 + + burden(:) = 0._kind_phys + + do j = -nlevsnow+1, 0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + + wx = h2osoi_ice(c,j) + h2osoi_liq(c,j) + void = 1. - (h2osoi_ice(c,j)/denice + h2osoi_liq(c,j)/denh2o) / dz(c,j) + + ! Allow compaction only for non-saturated node and higher ice lens node. + if (void > 0.001 .and. h2osoi_ice(c,j) > .1) then + bi = h2osoi_ice(c,j) / dz(c,j) + fi = h2osoi_ice(c,j) / wx + td = tfrz-t_soisno(c,j) + dexpf = exp(-c4*td) + + ! Settling as a result of destructive metamorphism + + ddz1 = -c3*dexpf + if (bi > dm) ddz1 = ddz1*exp(-46.0e-3*(bi-dm)) + + ! Liquid water term + + if (h2osoi_liq(c,j) > 0.01*dz(c,j)) ddz1=ddz1*c5 + + ! Compaction due to overburden + + ddz2 = -burden(c)*exp(-0.08*td - c2*bi)/eta0 + + ! Compaction occurring during melt + + if (imelt(c,j) == 1) then + ddz3 = - 1./dtime * max(0._kind_phys,(frac_iceold(c,j) - fi)/frac_iceold(c,j)) + else + ddz3 = 0._kind_phys + end if + + ! Time rate of fractional change in dz (units of s-1) + + pdzdtc = ddz1 + ddz2 + ddz3 + + ! The change in dz due to compaction + + dz(c,j) = dz(c,j) * (1.+pdzdtc*dtime) + end if + + ! Pressure of overlying snow + + burden(c) = burden(c) + wx + + end if + end do + end do + + end subroutine SnowCompaction + + subroutine CombineSnowLayers(lbc, ubc, & !i + num_snowc, filter_snowc, & !i&o + snl,h2osno,snowdp,dz,zi, & !i&o + t_soisno,h2osoi_ice,h2osoi_liq, & !i&o + z) !o + !========================================================================== + ! !DESCRIPTION: + ! Combine snow layers that are less than a minimum thickness or mass + ! If the snow element thickness or mass is less than a prescribed minimum, + ! then it is combined with a neighboring element. The subroutine + ! clm\_combo.f90 then executes the combination of mass and energy. + ! !CALLED FROM: + ! subroutine Hydrology2 in module Hydrology2Mod + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! 2/28/02, Peter Thornton: Migrated to new data structures. + !========================================================================= + ! !USES: + ! use clmtype + ! + ! !ARGUMENTS: + implicit none + !in: + integer, intent(in) :: lbc, ubc ! column bounds + ! integer, intent(in) :: clandunit(1) !landunit index for each column + ! integer, intent(in) :: ityplun(1) !landunit type + + !inout: + integer, intent(inout) :: num_snowc ! number of column snow points in column filter + integer, intent(inout) :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer , intent(inout) :: snl(1) !number of snow layers + real(kind_phys), intent(inout) :: h2osno(1) !snow water (mm H2O) + real(kind_phys), intent(inout) :: snowdp(1) !snow height (m) + real(kind_phys), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + real(kind_phys), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !interface level below a "z" level (m) + real(kind_phys), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) + real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + + !out: + + real(kind_phys), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !layer thickness (m) + ! + !EOP + ! + ! !OTHER LOCAL VARIABLES: + ! + integer :: c, fc ! column indices + integer :: i,k ! loop indices + integer :: j,l ! node indices + integer :: msn_old(lbc:ubc) ! number of top snow layer + integer :: mssi(lbc:ubc) ! node index + integer :: neibor ! adjacent node selected for combination + real(kind_phys):: zwice(lbc:ubc) ! total ice mass in snow + real(kind_phys):: zwliq (lbc:ubc) ! total liquid water in snow + real(kind_phys):: dzmin(5) ! minimum of top snow layer + + data dzmin /0.010, 0.015, 0.025, 0.055, 0.115/ + !----------------------------------------------------------------------- + + ! Check the mass of ice lens of snow, when the total is less than a small value, + ! combine it with the underlying neighbor. + + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + msn_old(c) = snl(c) + end do + + ! The following loop is NOT VECTORIZED + + do fc = 1, num_snowc + c = filter_snowc(fc) + ! l = clandunit(c) + do j = msn_old(c)+1,0 + if (h2osoi_ice(c,j) <= .1) then + ! if (ityplun(l) == istsoil) then + ! h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + h2osoi_liq(c,j) + ! h2osoi_ice(c,j+1) = h2osoi_ice(c,j+1) + h2osoi_ice(c,j) + ! else if (ityplun(l) /= istsoil .and. j /= 0) then + h2osoi_liq(c,j+1) = h2osoi_liq(c,j+1) + h2osoi_liq(c,j) + h2osoi_ice(c,j+1) = h2osoi_ice(c,j+1) + h2osoi_ice(c,j) + ! end if + + ! shift all elements above this down one. + if (j > snl(c)+1 .and. snl(c) < -1) then + do i = j, snl(c)+2, -1 + t_soisno(c,i) = t_soisno(c,i-1) + h2osoi_liq(c,i) = h2osoi_liq(c,i-1) + h2osoi_ice(c,i) = h2osoi_ice(c,i-1) + dz(c,i) = dz(c,i-1) + end do + end if + snl(c) = snl(c) + 1 + end if + end do + end do + + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + h2osno(c) = 0._kind_phys + snowdp(c) = 0._kind_phys + zwice(c) = 0._kind_phys + zwliq(c) = 0._kind_phys + end do + + do j = -nlevsnow+1,0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + h2osno(c) = h2osno(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) + snowdp(c) = snowdp(c) + dz(c,j) + zwice(c) = zwice(c) + h2osoi_ice(c,j) + zwliq(c) = zwliq(c) + h2osoi_liq(c,j) + end if + end do + end do + + ! Check the snow depth - all snow gone + ! The liquid water assumes ponding on soil surface. + + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + ! l = clandunit(c) + if (snowdp(c) < 0.01 .and. snowdp(c) > 0.) then + snl(c) = 0 + h2osno(c) = zwice(c) + if (h2osno(c) <= 0.) snowdp(c) = 0._kind_phys + ! if (ityplun(l) == istsoil) h2osoi_liq(c,1) = h2osoi_liq(c,1) + zwliq(c) !change by guhp + end if + end do + + ! Check the snow depth - snow layers combined + ! The following loop IS NOT VECTORIZED + + do fc = 1, num_snowc + c = filter_snowc(fc) + + ! Two or more layers + + if (snl(c) < -1) then + + msn_old(c) = snl(c) + mssi(c) = 1 + + do i = msn_old(c)+1,0 + if (dz(c,i) < dzmin(mssi(c))) then + + if (i == snl(c)+1) then + ! If top node is removed, combine with bottom neighbor. + neibor = i + 1 + else if (i == 0) then + ! If the bottom neighbor is not snow, combine with the top neighbor. + neibor = i - 1 + else + ! If none of the above special cases apply, combine with the thinnest neighbor + neibor = i + 1 + if ((dz(c,i-1)+dz(c,i)) < (dz(c,i+1)+dz(c,i))) neibor = i-1 + end if + + ! Node l and j are combined and stored as node j. + if (neibor > i) then + j = neibor + l = i + else + j = i + l = neibor + end if + + call Combo (dz(c,j), h2osoi_liq(c,j), h2osoi_ice(c,j), & + t_soisno(c,j), dz(c,l), h2osoi_liq(c,l), h2osoi_ice(c,l), t_soisno(c,l) ) + + ! Now shift all elements above this down one. + if (j-1 > snl(c)+1) then + do k = j-1, snl(c)+2, -1 + t_soisno(c,k) = t_soisno(c,k-1) + h2osoi_ice(c,k) = h2osoi_ice(c,k-1) + h2osoi_liq(c,k) = h2osoi_liq(c,k-1) + dz(c,k) = dz(c,k-1) + end do + end if + + ! Decrease the number of snow layers + snl(c) = snl(c) + 1 + if (snl(c) >= -1) EXIT + + else + + ! The layer thickness is greater than the prescribed minimum value + mssi(c) = mssi(c) + 1 + + end if + end do + + end if + + end do + + ! Reset the node depth and the depth of layer interface + + do j = 0, -nlevsnow+1, -1 + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c) + 1) then + z(c,j) = zi(c,j) - 0.5*dz(c,j) + zi(c,j-1) = zi(c,j) - dz(c,j) + end if + end do + end do + + end subroutine CombineSnowLayers + + subroutine DivideSnowLayers(lbc, ubc, & !i + num_snowc, filter_snowc, & !i&o + snl,dz,zi,t_soisno, & !i&o + h2osoi_ice,h2osoi_liq, & !i&o + z) !o + + + !============================================================================ + ! !DESCRIPTION: + ! Subdivides snow layers if they exceed their prescribed maximum thickness. + ! !CALLED FROM: + ! subroutine Hydrology2 in module Hydrology2Mod + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! 2/28/02, Peter Thornton: Migrated to new data structures. + !============================================================================ + ! !USES: + ! use clmtype + ! + ! !ARGUMENTS: + implicit none + + !in: + integer, intent(in) :: lbc, ubc ! column bounds + + !inout: + + integer, intent(inout) :: num_snowc ! number of column snow points in column filter + integer, intent(inout) :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer , intent(inout) :: snl(1) !number of snow layers + real(kind_phys), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + real(kind_phys), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !interface level below a "z" level (m) + real(kind_phys), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) + real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + + !out: + + real(kind_phys), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !layer thickness (m) + + + + ! OTHER LOCAL VARIABLES: + + integer :: j, c, fc ! indices + real(kind_phys) :: drr ! thickness of the combined [m] + integer :: msno ! number of snow layer 1 (top) to msno (bottom) + real(kind_phys) :: dzsno(lbc:ubc,nlevsnow) ! Snow layer thickness [m] + real(kind_phys) :: swice(lbc:ubc,nlevsnow) ! Partial volume of ice [m3/m3] + real(kind_phys) :: swliq(lbc:ubc,nlevsnow) ! Partial volume of liquid water [m3/m3] + real(kind_phys) :: tsno(lbc:ubc ,nlevsnow) ! Nodel temperature [K] + real(kind_phys) :: zwice ! temporary + real(kind_phys) :: zwliq ! temporary + real(kind_phys) :: propor ! temporary + !----------------------------------------------------------------------- + + ! Begin calculation - note that the following column loops are only invoked + ! for snow-covered columns + + do j = 1,nlevsnow + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j <= abs(snl(c))) then + dzsno(c,j) = dz(c,j+snl(c)) + swice(c,j) = h2osoi_ice(c,j+snl(c)) + swliq(c,j) = h2osoi_liq(c,j+snl(c)) + tsno(c,j) = t_soisno(c,j+snl(c)) + end if + end do + end do + + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + + msno = abs(snl(c)) + + if (msno == 1) then + ! Specify a new snow layer + if (dzsno(c,1) > 0.03) then + msno = 2 + dzsno(c,1) = dzsno(c,1)/2. + swice(c,1) = swice(c,1)/2. + swliq(c,1) = swliq(c,1)/2. + dzsno(c,2) = dzsno(c,1) + swice(c,2) = swice(c,1) + swliq(c,2) = swliq(c,1) + tsno(c,2) = tsno(c,1) + end if + end if + + if (msno > 1) then + if (dzsno(c,1) > 0.02) then + drr = dzsno(c,1) - 0.02 + propor = drr/dzsno(c,1) + zwice = propor*swice(c,1) + zwliq = propor*swliq(c,1) + propor = 0.02/dzsno(c,1) + swice(c,1) = propor*swice(c,1) + swliq(c,1) = propor*swliq(c,1) + dzsno(c,1) = 0.02 + + call Combo (dzsno(c,2), swliq(c,2), swice(c,2), tsno(c,2), drr, & + zwliq, zwice, tsno(c,1)) + + ! Subdivide a new layer + if (msno <= 2 .and. dzsno(c,2) > 0.07) then + msno = 3 + dzsno(c,2) = dzsno(c,2)/2. + swice(c,2) = swice(c,2)/2. + swliq(c,2) = swliq(c,2)/2. + dzsno(c,3) = dzsno(c,2) + swice(c,3) = swice(c,2) + swliq(c,3) = swliq(c,2) + tsno(c,3) = tsno(c,2) + end if + end if + end if + + if (msno > 2) then + if (dzsno(c,2) > 0.05) then + drr = dzsno(c,2) - 0.05 + propor = drr/dzsno(c,2) + zwice = propor*swice(c,2) + zwliq = propor*swliq(c,2) + propor = 0.05/dzsno(c,2) + swice(c,2) = propor*swice(c,2) + swliq(c,2) = propor*swliq(c,2) + dzsno(c,2) = 0.05 + + call Combo (dzsno(c,3), swliq(c,3), swice(c,3), tsno(c,3), drr, & + zwliq, zwice, tsno(c,2)) + + ! Subdivided a new layer + if (msno <= 3 .and. dzsno(c,3) > 0.18) then + msno = 4 + dzsno(c,3) = dzsno(c,3)/2. + swice(c,3) = swice(c,3)/2. + swliq(c,3) = swliq(c,3)/2. + dzsno(c,4) = dzsno(c,3) + swice(c,4) = swice(c,3) + swliq(c,4) = swliq(c,3) + tsno(c,4) = tsno(c,3) + end if + end if + end if + + if (msno > 3) then + if (dzsno(c,3) > 0.11) then + drr = dzsno(c,3) - 0.11 + propor = drr/dzsno(c,3) + zwice = propor*swice(c,3) + zwliq = propor*swliq(c,3) + propor = 0.11/dzsno(c,3) + swice(c,3) = propor*swice(c,3) + swliq(c,3) = propor*swliq(c,3) + dzsno(c,3) = 0.11 + + call Combo (dzsno(c,4), swliq(c,4), swice(c,4), tsno(c,4), drr, & + zwliq, zwice, tsno(c,3)) + + ! Subdivided a new layer + if (msno <= 4 .and. dzsno(c,4) > 0.41) then + msno = 5 + dzsno(c,4) = dzsno(c,4)/2. + swice(c,4) = swice(c,4)/2. + swliq(c,4) = swliq(c,4)/2. + dzsno(c,5) = dzsno(c,4) + swice(c,5) = swice(c,4) + swliq(c,5) = swliq(c,4) + tsno(c,5) = tsno(c,4) + end if + end if + end if + + if (msno > 4) then + if (dzsno(c,4) > 0.23) then + drr = dzsno(c,4) - 0.23 + propor = drr/dzsno(c,4) + zwice = propor*swice(c,4) + zwliq = propor*swliq(c,4) + propor = 0.23/dzsno(c,4) + swice(c,4) = propor*swice(c,4) + swliq(c,4) = propor*swliq(c,4) + dzsno(c,4) = 0.23 + + call Combo (dzsno(c,5), swliq(c,5), swice(c,5), tsno(c,5), drr, & + zwliq, zwice, tsno(c,4)) + end if + end if + + snl(c) = -msno + + end do + + do j = -nlevsnow+1,0 + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + dz(c,j) = dzsno(c,j-snl(c)) + h2osoi_ice(c,j) = swice(c,j-snl(c)) + h2osoi_liq(c,j) = swliq(c,j-snl(c)) + t_soisno(c,j) = tsno(c,j-snl(c)) + end if + end do + end do + + do j = 0, -nlevsnow+1, -1 + !dir$ concurrent + !cdir nodep + do fc = 1, num_snowc + c = filter_snowc(fc) + if (j >= snl(c)+1) then + z(c,j) = zi(c,j) - 0.5*dz(c,j) + zi(c,j-1) = zi(c,j) - dz(c,j) + end if + end do + end do + + end subroutine DivideSnowLayers + + subroutine Combo(dz, wliq, wice, t, dz2, wliq2, wice2, t2) + ! + ! !DESCRIPTION: + ! Combines two elements and returns the following combined + ! variables: dz, t, wliq, wice. + ! The combined temperature is based on the equation: + ! the sum of the enthalpies of the two elements = + ! that of the combined element. + ! + ! !USES: + ! + ! !ARGUMENTS: + implicit none + real(kind_phys), intent(in) :: dz2 ! nodal thickness of 2 elements being combined [m] + real(kind_phys), intent(in) :: wliq2 ! liquid water of element 2 [kg/m2] + real(kind_phys), intent(in) :: wice2 ! ice of element 2 [kg/m2] + real(kind_phys), intent(in) :: t2 ! nodal temperature of element 2 [K] + real(kind_phys), intent(inout) :: dz ! nodal thickness of 1 elements being combined [m] + real(kind_phys), intent(inout) :: wliq ! liquid water of element 1 + real(kind_phys), intent(inout) :: wice ! ice of element 1 [kg/m2] + real(kind_phys), intent(inout) :: t ! nodel temperature of elment 1 [K] + ! + ! !CALLED FROM: + ! subroutine CombineSnowLayers in this module + ! subroutine DivideSnowLayers in this module + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! June 2022: Sam Trahan; modified for CCPP + ! + !EOP + ! + ! !LOCAL VARIABLES: + ! + real(kind_phys) :: dzc ! Total thickness of nodes 1 and 2 (dzc=dz+dz2). + real(kind_phys) :: wliqc ! Combined liquid water [kg/m2] + real(kind_phys) :: wicec ! Combined ice [kg/m2] + real(kind_phys) :: tc ! Combined node temperature [K] + real(kind_phys) :: h ! enthalpy of element 1 [J/m2] + real(kind_phys) :: h2 ! enthalpy of element 2 [J/m2] + real(kind_phys) :: hc ! temporary + !----------------------------------------------------------------------- + + dzc = dz+dz2 + wicec = (wice+wice2) + wliqc = (wliq+wliq2) + h = (cpice*wice+cpliq*wliq) * (t-tfrz)+hfus*wliq + h2= (cpice*wice2+cpliq*wliq2) * (t2-tfrz)+hfus*wliq2 + + hc = h + h2 + if(hc < 0.)then + tc = tfrz + hc/(cpice*wicec + cpliq*wliqc) + else if (hc.le.hfus*wliqc) then + tc = tfrz + else + tc = tfrz + (hc - hfus*wliqc) / (cpice*wicec + cpliq*wliqc) + end if + + dz = dzc + wice = wicec + wliq = wliqc + t = tc + + end subroutine Combo + + subroutine BuildSnowFilter(lbc, ubc, num_nolakec, filter_nolakec,snl, & !i + num_snowc, filter_snowc, & !o + num_nosnowc, filter_nosnowc) !o + ! + ! !DESCRIPTION: + ! Constructs snow filter for use in vectorized loops for snow hydrology. + ! + ! !USES: + ! use clmtype + ! + ! !ARGUMENTS: + implicit none + integer, intent(in) :: lbc, ubc ! column bounds + integer, intent(in) :: num_nolakec ! number of column non-lake points in column filter + integer, intent(in) :: filter_nolakec(ubc-lbc+1) ! column filter for non-lake points + integer, intent(in) :: snl(1) ! number of snow layers + integer, intent(out) :: num_snowc ! number of column snow points in column filter + integer, intent(out) :: filter_snowc(ubc-lbc+1) ! column filter for snow points + integer, intent(out) :: num_nosnowc ! number of column non-snow points in column filter + integer, intent(out) :: filter_nosnowc(ubc-lbc+1) ! column filter for non-snow points + ! + ! !CALLED FROM: + ! subroutine Hydrology2 in Hydrology2Mod + ! subroutine CombineSnowLayers in this module + ! + ! !REVISION HISTORY: + ! 2003 July 31: Forrest Hoffman + ! 2022 June: Sam Trahan modified for CCPP + ! + ! !LOCAL VARIABLES: + ! local pointers to implicit in arguments + ! + !EOP + ! + ! !OTHER LOCAL VARIABLES: + integer :: fc, c + !----------------------------------------------------------------------- + + + ! Build snow/no-snow filters for other subroutines + + num_snowc = 0 + num_nosnowc = 0 + do fc = 1, num_nolakec + c = filter_nolakec(fc) + if (snl(c) < 0) then + num_snowc = num_snowc + 1 + filter_snowc(num_snowc) = c + else + num_nosnowc = num_nosnowc + 1 + filter_nosnowc(num_nosnowc) = c + end if + end do + + end subroutine BuildSnowFilter + + + +subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i + forc_hgt_t,forc_hgt_q, & !i + lbp, ubp, fn, filterp, & !i + displa, z0m, z0h, z0q, & !i + obu, iter, ur, um, & !i + ustar,temp1, temp2, temp12m, temp22m, & !o + u10,fv, & !o + fm) !i&o + + !============================================================================= + ! !DESCRIPTION: + ! Calculation of the friction velocity, relation for potential + ! temperature and humidity profiles of surface boundary layer. + ! The scheme is based on the work of Zeng et al. (1998): + ! Intercomparison of bulk aerodynamic algorithms for the computation + ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, + ! Vol. 11, 2628-2644. + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! 12/19/01, Peter Thornton + ! Added arguments to eliminate passing clm derived type into this function. + ! Created by Mariana Vertenstein + ! June 2022: Sam Trahan modified for CCPP + !============================================================================ + ! !USES: + ! use clmtype + !!use clm_atmlnd, only : clm_a2l + ! + ! !ARGUMENTS: + implicit none + + !in: + + integer , intent(in) :: pgridcell(1) ! pft's gridcell index + real(kind_phys), intent(in) :: forc_hgt(1) ! atmospheric reference height (m) + real(kind_phys), intent(in) :: forc_hgt_u(1) ! observational height of wind [m] + real(kind_phys), intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] + real(kind_phys), intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] + integer , intent(in) :: lbp, ubp ! pft array bounds + integer , intent(in) :: fn ! number of filtered pft elements + integer , intent(in) :: filterp(fn) ! pft filter + real(kind_phys), intent(in) :: displa(lbp:ubp) ! displacement height (m) + real(kind_phys), intent(in) :: z0m(lbp:ubp) ! roughness length over vegetation, momentum [m] + real(kind_phys), intent(in) :: z0h(lbp:ubp) ! roughness length over vegetation, sensible heat [m] + real(kind_phys), intent(in) :: z0q(lbp:ubp) ! roughness length over vegetation, latent heat [m] + real(kind_phys), intent(in) :: obu(lbp:ubp) ! monin-obukhov length (m) + integer, intent(in) :: iter ! iteration number + real(kind_phys), intent(in) :: ur(lbp:ubp) ! wind speed at reference height [m/s] + real(kind_phys), intent(in) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] + + !out: + + real(kind_phys), intent(out) :: ustar(lbp:ubp) ! friction velocity [m/s] + real(kind_phys), intent(out) :: temp1(lbp:ubp) ! relation for potential temperature profile + real(kind_phys), intent(out) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m + real(kind_phys), intent(out) :: temp2(lbp:ubp) ! relation for specific humidity profile + real(kind_phys), intent(out) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m + real(kind_phys), intent(out) :: u10(1) ! 10-m wind (m/s) (for dust model) + real(kind_phys), intent(out) :: fv(1) ! friction velocity (m/s) (for dust model) + + !inout: + real(kind_phys), intent(inout) :: fm(lbp:ubp) ! needed for DGVM only to diagnose 10m wind + + ! OTHER LOCAL VARIABLES: + + real(kind_phys), parameter :: zetam = 1.574_kind_phys ! transition point of flux-gradient relation (wind profile) + real(kind_phys), parameter :: zetat = 0.465_kind_phys ! transition point of flux-gradient relation (temp. profile) + integer :: f ! pft-filter index + integer :: p ! pft index + integer :: g ! gridcell index + real(kind_phys):: zldis(lbp:ubp) ! reference height "minus" zero displacement heght [m] + real(kind_phys):: zeta(lbp:ubp) ! dimensionless height used in Monin-Obukhov theory + + !------------------------------------------------------------------------------ + + + ! Adjustment factors for unstable (moz < 0) or stable (moz > 0) conditions. + + if_not_pergro: if(.not.PERGRO) then + + !dir$ concurrent + !cdir nodep + do f = 1, fn + p = filterp(f) + g = pgridcell(p) + + ! Wind profile + + zldis(p) = forc_hgt_u(g)-displa(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetam) then + ustar(p) = vkc*um(p)/(log(-zetam*obu(p)/z0m(p))& + - StabilityFunc1(-zetam) & + + StabilityFunc1(z0m(p)/obu(p)) & + + 1.14_kind_phys*((-zeta(p))**0.333_kind_phys-(zetam)**0.333_kind_phys)) + else if (zeta(p) < 0._kind_phys) then + ustar(p) = vkc*um(p)/(log(zldis(p)/z0m(p))& + - StabilityFunc1(zeta(p))& + + StabilityFunc1(z0m(p)/obu(p))) + else if (zeta(p) <= 1._kind_phys) then + ustar(p) = vkc*um(p)/(log(zldis(p)/z0m(p)) + 5._kind_phys*zeta(p) -5._kind_phys*z0m(p)/obu(p)) + else + ustar(p) = vkc*um(p)/(log(obu(p)/z0m(p))+5._kind_phys-5._kind_phys*z0m(p)/obu(p) & + +(5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + end if + + ! Temperature profile + + zldis(p) = forc_hgt_t(g)-displa(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetat) then + temp1(p) = vkc/(log(-zetat*obu(p)/z0h(p))& + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0h(p)/obu(p)) & + + 0.8_kind_phys*((zetat)**(-0.333_kind_phys)-(-zeta(p))**(-0.333_kind_phys))) + else if (zeta(p) < 0._kind_phys) then + temp1(p) = vkc/(log(zldis(p)/z0h(p)) & + - StabilityFunc2(zeta(p)) & + + StabilityFunc2(z0h(p)/obu(p))) + else if (zeta(p) <= 1._kind_phys) then + temp1(p) = vkc/(log(zldis(p)/z0h(p)) + 5._kind_phys*zeta(p) - 5._kind_phys*z0h(p)/obu(p)) + else + temp1(p) = vkc/(log(obu(p)/z0h(p)) + 5._kind_phys - 5._kind_phys*z0h(p)/obu(p) & + + (5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + end if + + ! Humidity profile + + if (forc_hgt_q(g) == forc_hgt_t(g) .and. z0q(p) == z0h(p)) then + temp2(p) = temp1(p) + else + zldis(p) = forc_hgt_q(g)-displa(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetat) then + temp2(p) = vkc/(log(-zetat*obu(p)/z0q(p)) & + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0q(p)/obu(p)) & + + 0.8_kind_phys*((zetat)**(-0.333_kind_phys)-(-zeta(p))**(-0.333_kind_phys))) + else if (zeta(p) < 0._kind_phys) then + temp2(p) = vkc/(log(zldis(p)/z0q(p)) & + - StabilityFunc2(zeta(p)) & + + StabilityFunc2(z0q(p)/obu(p))) + else if (zeta(p) <= 1._kind_phys) then + temp2(p) = vkc/(log(zldis(p)/z0q(p)) + 5._kind_phys*zeta(p)-5._kind_phys*z0q(p)/obu(p)) + else + temp2(p) = vkc/(log(obu(p)/z0q(p)) + 5._kind_phys - 5._kind_phys*z0q(p)/obu(p) & + + (5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + end if + endif + + ! Temperature profile applied at 2-m + + zldis(p) = 2.0_kind_phys + z0h(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetat) then + temp12m(p) = vkc/(log(-zetat*obu(p)/z0h(p))& + - StabilityFunc2(-zetat) & + + StabilityFunc2(z0h(p)/obu(p)) & + + 0.8_kind_phys*((zetat)**(-0.333_kind_phys)-(-zeta(p))**(-0.333_kind_phys))) + else if (zeta(p) < 0._kind_phys) then + temp12m(p) = vkc/(log(zldis(p)/z0h(p)) & + - StabilityFunc2(zeta(p)) & + + StabilityFunc2(z0h(p)/obu(p))) + else if (zeta(p) <= 1._kind_phys) then + temp12m(p) = vkc/(log(zldis(p)/z0h(p)) + 5._kind_phys*zeta(p) - 5._kind_phys*z0h(p)/obu(p)) + else + temp12m(p) = vkc/(log(obu(p)/z0h(p)) + 5._kind_phys - 5._kind_phys*z0h(p)/obu(p) & + + (5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + end if + + ! Humidity profile applied at 2-m + + if (z0q(p) == z0h(p)) then + temp22m(p) = temp12m(p) + else + zldis(p) = 2.0_kind_phys + z0q(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetat) then + temp22m(p) = vkc/(log(-zetat*obu(p)/z0q(p)) - & + StabilityFunc2(-zetat) + StabilityFunc2(z0q(p)/obu(p)) & + + 0.8_kind_phys*((zetat)**(-0.333_kind_phys)-(-zeta(p))**(-0.333_kind_phys))) + else if (zeta(p) < 0._kind_phys) then + temp22m(p) = vkc/(log(zldis(p)/z0q(p)) - & + StabilityFunc2(zeta(p))+StabilityFunc2(z0q(p)/obu(p))) + else if (zeta(p) <= 1._kind_phys) then + temp22m(p) = vkc/(log(zldis(p)/z0q(p)) + 5._kind_phys*zeta(p)-5._kind_phys*z0q(p)/obu(p)) + else + temp22m(p) = vkc/(log(obu(p)/z0q(p)) + 5._kind_phys - 5._kind_phys*z0q(p)/obu(p) & + + (5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + end if + end if + end do + endif if_not_pergro + + +if_pergro: if (PERGRO) then + + !=============================================================================== + ! The following only applies when PERGRO is defined + !=============================================================================== + + !dir$ concurrent + !cdir nodep + do f = 1, fn + p = filterp(f) + g = pgridcell(p) + + zldis(p) = forc_hgt_u(g)-displa(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetam) then ! zeta < -1 + ustar(p) = vkc * um(p) / log(-zetam*obu(p)/z0m(p)) + else if (zeta(p) < 0._kind_phys) then ! -1 <= zeta < 0 + ustar(p) = vkc * um(p) / log(zldis(p)/z0m(p)) + else if (zeta(p) <= 1._kind_phys) then ! 0 <= ztea <= 1 + ustar(p)=vkc * um(p)/log(zldis(p)/z0m(p)) + else ! 1 < zeta, phi=5+zeta + ustar(p)=vkc * um(p)/log(obu(p)/z0m(p)) + endif + + zldis(p) = forc_hgt_t(g)-displa(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetat) then + temp1(p)=vkc/log(-zetat*obu(p)/z0h(p)) + else if (zeta(p) < 0._kind_phys) then + temp1(p)=vkc/log(zldis(p)/z0h(p)) + else if (zeta(p) <= 1._kind_phys) then + temp1(p)=vkc/log(zldis(p)/z0h(p)) + else + temp1(p)=vkc/log(obu(p)/z0h(p)) + end if + + zldis(p) = forc_hgt_q(g)-displa(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetat) then + temp2(p)=vkc/log(-zetat*obu(p)/z0q(p)) + else if (zeta(p) < 0._kind_phys) then + temp2(p)=vkc/log(zldis(p)/z0q(p)) + else if (zeta(p) <= 1._kind_phys) then + temp2(p)=vkc/log(zldis(p)/z0q(p)) + else + temp2(p)=vkc/log(obu(p)/z0q(p)) + end if + + zldis(p) = 2.0_kind_phys + z0h(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetat) then + temp12m(p)=vkc/log(-zetat*obu(p)/z0h(p)) + else if (zeta(p) < 0._kind_phys) then + temp12m(p)=vkc/log(zldis(p)/z0h(p)) + else if (zeta(p) <= 1._kind_phys) then + temp12m(p)=vkc/log(zldis(p)/z0h(p)) + else + temp12m(p)=vkc/log(obu(p)/z0h(p)) + end if + + zldis(p) = 2.0_kind_phys + z0q(p) + zeta(p) = zldis(p)/obu(p) + if (zeta(p) < -zetat) then + temp22m(p)=vkc/log(-zetat*obu(p)/z0q(p)) + else if (zeta(p) < 0._kind_phys) then + temp22m(p)=vkc/log(zldis(p)/z0q(p)) + else if (zeta(p) <= 1._kind_phys) then + temp22m(p)=vkc/log(zldis(p)/z0q(p)) + else + temp22m(p)=vkc/log(obu(p)/z0q(p)) + end if + end do + + endif if_pergro + + end subroutine FrictionVelocity + + ! !IROUTINE: StabilityFunc + ! + ! !INTERFACE: + real(kind_phys) function StabilityFunc1(zeta) + ! + ! !DESCRIPTION: + ! Stability function for rib < 0. + ! + ! !USES: + ! use shr_const_mod, only: SHR_CONST_PI + !Zack Subin, 7/8/08 + ! + ! !ARGUMENTS: + implicit none + real(kind_phys), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory + ! + ! !CALLED FROM: + ! subroutine FrictionVelocity in this module + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! June 2022: Sam Trahan; modified for CCPP + ! + !EOP + ! + ! !LOCAL VARIABLES: + real(kind_phys) :: chik, chik2 + !------------------------------------------------------------------------------ + + chik2 = sqrt(1._kind_phys-16._kind_phys*zeta) + chik = sqrt(chik2) + StabilityFunc1 = 2._kind_phys*log((1._kind_phys+chik)*0.5_kind_phys) & + !Changed to pie, Zack Subin, 7/9/08 + !Spelling corrected, changed to pi, Sam Trahan the Killjoy, 6/2/22 + + log((1._kind_phys+chik2)*0.5_kind_phys)-2._kind_phys*atan(chik)+pi*0.5_kind_phys + + end function StabilityFunc1 + + !------------------------------------------------------------------------------ + !BOP + ! + ! !IROUTINE: StabilityFunc2 + ! + ! !INTERFACE: + real(kind_phys) function StabilityFunc2(zeta) + ! + ! !DESCRIPTION: + ! Stability function for rib < 0. + ! + ! !USES: + !Removed by Zack Subin, 7/9/08 + ! use shr_const_mod, only: SHR_CONST_PI + ! + ! !ARGUMENTS: + implicit none + real(kind_phys), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory + ! + ! !CALLED FROM: + ! subroutine FrictionVelocity in this module + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! June 2022: Sam Trahan modified for CCPP + ! + !EOP + ! + ! !LOCAL VARIABLES: + real(kind_phys) :: chik2 + !------------------------------------------------------------------------------ + + chik2 = sqrt(1._kind_phys-16._kind_phys*zeta) + StabilityFunc2 = 2._kind_phys*log((1._kind_phys+chik2)*0.5_kind_phys) + + end function StabilityFunc2 + + !----------------------------------------------------------------------- + !BOP + ! + ! !IROUTINE: MoninObukIni + ! + ! !INTERFACE: + subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) + ! + ! !DESCRIPTION: + ! Initialization of the Monin-Obukhov length. + ! The scheme is based on the work of Zeng et al. (1998): + ! Intercomparison of bulk aerodynamic algorithms for the computation + ! of sea surface fluxes using TOGA CORE and TAO data. J. Climate, + ! Vol. 11, 2628-2644. + ! + ! !USES: + ! + ! !ARGUMENTS: + implicit none + real(kind_phys), intent(in) :: ur ! wind speed at reference height [m/s] + real(kind_phys), intent(in) :: thv ! virtual potential temperature (kelvin) + real(kind_phys), intent(in) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(kind_phys), intent(in) :: zldis ! reference height "minus" zero displacement heght [m] + real(kind_phys), intent(in) :: z0m ! roughness length, momentum [m] + real(kind_phys), intent(out) :: um ! wind speed including the stability effect [m/s] + real(kind_phys), intent(out) :: obu ! monin-obukhov length (m) + ! + ! !CALLED FROM: + ! subroutine BareGroundFluxes in module BareGroundFluxesMod.F90 + ! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod.F90 + ! subroutine CanopyFluxes in module CanopyFluxesMod.F90 + ! + ! !REVISION HISTORY: + ! 15 September 1999: Yongjiu Dai; Initial code + ! 15 December 1999: Paul Houser and Jon Radakovich; F90 Revision + ! June 2022: Sam Trahan modified for CCPP + ! + !EOP + ! + ! !LOCAL VARIABLES: + ! + real(kind_phys) :: wc ! convective velocity [m/s] + real(kind_phys) :: rib ! bulk Richardson number + real(kind_phys) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(kind_phys) :: ustar ! friction velocity [m/s] + !----------------------------------------------------------------------- + + ! Initial values of u* and convective velocity + + ustar=0.06_kind_phys + wc=0.5_kind_phys + if (dthv >= 0._kind_phys) then + um=max(ur,0.1_kind_phys) + else + um=sqrt(ur*ur+wc*wc) + endif + + rib=grav*zldis*dthv/(thv*um*um) + if (PERGRO) then + rib = 0._kind_phys + endif + + if (rib >= 0._kind_phys) then ! neutral or stable + zeta = rib*log(zldis/z0m)/(1._kind_phys-5._kind_phys*min(rib,0.19_kind_phys)) + zeta = min(2._kind_phys,max(zeta,0.01_kind_phys )) + else ! unstable + zeta=rib*log(zldis/z0m) + zeta = max(-100._kind_phys,min(zeta,-0.01_kind_phys )) + endif + + obu=zldis/zeta + + end subroutine MoninObukIni + +! Some fields in lakeini are not available until runtime, so this cannot be in a CCPP init routine. + SUBROUTINE lakeini( ISLTYP, gt0, SNOW, & !i + restart, lakedepth_default, & + lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o + snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & + z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & + h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & + zi3d, watsat3d, csol3d, tkmg3d, & + xice, xice_threshold, tsfc, & + use_lake_model, use_lakedepth, con_g, con_rd, & + tkdry3d, tksatu3d, im, prsi, & + clm_lake_initialized, & + sand3d, clay3d, tg3, & + km, me, master, errmsg, errflg) + + !============================================================================== + ! This subroutine was first edited by Hongping Gu for coupling + ! 07/20/2010 + ! Long after, in June 2022, Sam Trahan updated it for CCPP + !============================================================================== + + implicit none + + INTEGER, INTENT(OUT) :: errflg + CHARACTER(*), INTENT(OUT) :: errmsg + + INTEGER , INTENT (IN) :: im, me, master, km + REAL(KIND_PHYS), INTENT(IN) :: xice_threshold, con_g, con_rd + REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: XICE,TG3 + REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc + INTEGER, DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized + + integer, dimension(IM), intent(in) :: use_lake_model + !INTEGER , INTENT (IN) :: lakeflag + !INTEGER , INTENT (INOUT) :: lake_depth_flag + LOGICAL, INTENT (IN) :: use_lakedepth + + LOGICAL , INTENT(IN) :: restart + INTEGER, DIMENSION(IM), INTENT(IN) :: ISLTYP + REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN) :: SNOW + REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0, prsi + real(kind_phys), intent(in) :: lakedepth_default + + real(kind_phys), dimension(IM),intent(inout) :: lakedepth2d + real(kind_phys), dimension(IM),intent(out) :: savedtke12d + real(kind_phys), dimension(IM),intent(out) :: snowdp2d, & + h2osno2d, & + snl2d, & + t_grnd2d + + real(kind_phys), dimension(IM,nlevlake),INTENT(out) :: t_lake3d, & + lake_icefrac3d, & + z_lake3d, & + dz_lake3d + real(kind_phys), dimension(IM,-nlevsnow+1:nlevsoil ),INTENT(out) :: t_soisno3d, & + h2osoi_ice3d, & + h2osoi_liq3d, & + h2osoi_vol3d, & + z3d, & + dz3d + real(kind_phys), dimension(IM,nlevsoil),INTENT(out) :: watsat3d, & + csol3d, & + tkmg3d, & + tkdry3d, & + tksatu3d + real(kind_phys), dimension(IM,nlevsoil),INTENT(inout) :: clay3d, & + sand3d + + real(kind_phys), dimension( IM,-nlevsnow+0:nlevsoil ),INTENT(out) :: zi3d + + !LOGICAL, DIMENSION( : ),intent(out) :: lake + !REAL(KIND_PHYS), OPTIONAL, DIMENSION( : ), INTENT(IN) :: lake_depth ! no separate variable for this in CCPP + + real, dimension( 1:im,1:nlevsoil ) :: bsw3d, & + bsw23d, & + psisat3d, & + vwcsat3d, & + watdry3d, & + watopt3d, & + hksat3d, & + sucsat3d + integer :: n,i,j,k,ib,lev,bottom ! indices + real(kind_phys),dimension(1:im ) :: bd2d ! bulk density of dry soil material [kg/m^3] + real(kind_phys),dimension(1:im ) :: tkm2d ! mineral conductivity + real(kind_phys),dimension(1:im ) :: xksat2d ! maximum hydraulic conductivity of soil [mm/s] + real(kind_phys),dimension(1:im ) :: depthratio2d ! ratio of lake depth to standard deep lake depth + real(kind_phys),dimension(1:im ) :: clay2d ! temporary + real(kind_phys),dimension(1:im ) :: sand2d ! temporary + + real(kind_phys),parameter :: scalez = 0.025_kind_phys ! Soil layer thickness discretization (m) + logical,parameter :: arbinit = .false. + real(kind_phys),parameter :: defval = -999.0 + integer :: isl + integer :: numb_lak ! for debug + character*256 :: message + real(kind_phys) :: ht + + integer, parameter :: xcheck=38 + integer, parameter :: ycheck=92 + + integer :: used_lakedepth_default, init_points + + used_lakedepth_default=0 + + if(LAKEDEBUG .and. me==0) then + write(0,*) 'clm_lake_init' + endif + + errmsg = '' + errflg = 0 + + !IF ( RESTART ) RETURN <--- should be handled by clm_lake_initialized + + init_const: if(sum(clm_lake_initialized(1:im))==0 .and. any(use_lake_model/=0)) then + + ! dzlak(1) = 0.1_kind_phys + ! dzlak(2) = 1._kind_phys + ! dzlak(3) = 2._kind_phys + ! dzlak(4) = 3._kind_phys + ! dzlak(5) = 4._kind_phys + ! dzlak(6) = 5._kind_phys + ! dzlak(7) = 7._kind_phys + ! dzlak(8) = 7._kind_phys + ! dzlak(9) = 10.45_kind_phys + ! dzlak(10)= 10.45_kind_phys + ! + ! zlak(1) = 0.05_kind_phys + ! zlak(2) = 0.6_kind_phys + ! zlak(3) = 2.1_kind_phys + ! zlak(4) = 4.6_kind_phys + ! zlak(5) = 8.1_kind_phys + ! zlak(6) = 12.6_kind_phys + ! zlak(7) = 18.6_kind_phys + ! zlak(8) = 25.6_kind_phys + ! zlak(9) = 34.325_kind_phys + ! zlak(10)= 44.775_kind_phys + dzlak(1) = 0.1_kind_phys + dzlak(2) = 0.1_kind_phys + dzlak(3) = 0.1_kind_phys + dzlak(4) = 0.1_kind_phys + dzlak(5) = 0.1_kind_phys + dzlak(6) = 0.1_kind_phys + dzlak(7) = 0.1_kind_phys + dzlak(8) = 0.1_kind_phys + dzlak(9) = 0.1_kind_phys + dzlak(10)= 0.1_kind_phys + + zlak(1) = 0.05_kind_phys + zlak(2) = 0.15_kind_phys + zlak(3) = 0.25_kind_phys + zlak(4) = 0.35_kind_phys + zlak(5) = 0.45_kind_phys + zlak(6) = 0.55_kind_phys + zlak(7) = 0.65_kind_phys + zlak(8) = 0.75_kind_phys + zlak(9) = 0.85_kind_phys + zlak(10)= 0.95_kind_phys + + ! "0" refers to soil surface and "nlevsoil" refers to the bottom of model soil + + do j = 1, nlevsoil + zsoi(j) = scalez*(exp(0.5_kind_phys*(j-0.5_kind_phys))-1._kind_phys) !node depths + enddo + + dzsoi(1) = 0.5_kind_phys*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces + do j = 2,nlevsoil-1 + dzsoi(j)= 0.5_kind_phys*(zsoi(j+1)-zsoi(j-1)) + enddo + dzsoi(nlevsoil) = zsoi(nlevsoil)-zsoi(nlevsoil-1) + + zisoi(0) = 0._kind_phys + do j = 1, nlevsoil-1 + zisoi(j) = 0.5_kind_phys*(zsoi(j)+zsoi(j+1)) !interface depths + enddo + zisoi(nlevsoil) = zsoi(nlevsoil) + 0.5_kind_phys*dzsoi(nlevsoil) + endif init_const + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + DO i=1,im + if(use_lake_model(i)==0 .or. clm_lake_initialized(i)>0) then + cycle + endif + + snowdp2d(i) = snow(i)*0.005 ! SNOW in kg/m^2 and snowdp in m + h2osno2d(i) = snow(i) ! mm + + snl2d(i) = defval + do k = -nlevsnow+1,nlevsoil + h2osoi_liq3d(i,k) = defval + h2osoi_ice3d(i,k) = defval + t_soisno3d(i,k) = defval + z3d(i,k) = defval + dz3d(i,k) = defval + enddo + do k = 1,nlevlake + t_lake3d(i,k) = defval + lake_icefrac3d(i,k) = defval + z_lake3d(i,k) = defval + dz_lake3d(i,k) = defval + enddo + + if(xice(i).gt.xice_threshold) then + lake_icefrac3d(i,1) = xice(i) + endif + + z3d(i,:) = 0.0 + dz3d(i,:) = 0.0 + zi3d(i,:) = 0.0 + h2osoi_liq3d(i,:) = 0.0 + h2osoi_ice3d(i,:) = 0.0 + lake_icefrac3d(i,:) = 0.0 + h2osoi_vol3d(i,:) = 0.0 + snl2d(i) = 0.0 + if ( use_lakedepth ) then + if (lakedepth2d(i) <= 0.0) then + lakedepth2d(i) = lakedepth_default + used_lakedepth_default = used_lakedepth_default+1 + endif + else + lakedepth2d(i) = lakedepth_default + used_lakedepth_default = used_lakedepth_default+1 + endif + + ENDDO + + if(used_lakedepth_default>0) then + print *,'used lakedepth_default: ',used_lakedepth_default + endif + + !!!!!!!!!!!!!!!!!!begin to initialize lake variables!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + init_points=0 + DO i = 1,im + + if(use_lake_model(i)==0 .or. clm_lake_initialized(i)>0) then + cycle + endif + + init_points = init_points+1 + + ! Soil hydraulic and thermal properties + isl = ISLTYP(i) + if (isl == 0 ) isl = 14 + if (isl == 14 ) isl = isl + 1 + do k = 1,nlevsoil + sand3d(i,k) = sand(isl) + clay3d(i,k) = clay(isl) + if(clay3d(i,k)>0 .and. clay3d(i,k)<1) then + write(message,*) 'bad clay3d ',clay3d(i,k) + write(0,'(A)') trim(message) + errmsg = trim(message) + errflg = 1 + return + endif + if(sand3d(i,k)>0 .and. sand3d(i,k)<1) then + write(message,*) 'bad sand3d ',sand3d(i,k) + write(0,'(A)') trim(message) + errmsg = trim(message) + errflg = 1 + return + endif + enddo + + do k = 1,nlevsoil + clay2d(i) = clay3d(i,k) + sand2d(i) = sand3d(i,k) + watsat3d(i,k) = 0.489_kind_phys - 0.00126_kind_phys*sand2d(i) + bd2d(i) = (1._kind_phys-watsat3d(i,k))*2.7e3_kind_phys + xksat2d(i) = 0.0070556_kind_phys *( 10._kind_phys**(-0.884_kind_phys+0.0153_kind_phys*sand2d(i)) ) ! mm/s + tkm2d(i) = (8.80_kind_phys*sand2d(i)+2.92_kind_phys*clay2d(i))/(sand2d(i)+clay2d(i)) ! W/(m K) + + bsw3d(i,k) = 2.91_kind_phys + 0.159_kind_phys*clay2d(i) + bsw23d(i,k) = -(3.10_kind_phys + 0.157_kind_phys*clay2d(i) - 0.003_kind_phys*sand2d(i)) + psisat3d(i,k) = -(exp((1.54_kind_phys - 0.0095_kind_phys*sand2d(i) + 0.0063_kind_phys*(100.0_kind_phys-sand2d(i) & + -clay2d(i)))*log(10.0_kind_phys))*9.8e-5_kind_phys) + vwcsat3d(i,k) = (50.5_kind_phys - 0.142_kind_phys*sand2d(i) - 0.037_kind_phys*clay2d(i))/100.0_kind_phys + hksat3d(i,k) = xksat2d(i) + sucsat3d(i,k) = 10._kind_phys * ( 10._kind_phys**(1.88_kind_phys-0.0131_kind_phys*sand2d(i)) ) + tkmg3d(i,k) = tkm2d(i) ** (1._kind_phys- watsat3d(i,k)) + tksatu3d(i,k) = tkmg3d(i,k)*0.57_kind_phys**watsat3d(i,k) + tkdry3d(i,k) = (0.135_kind_phys*bd2d(i) + 64.7_kind_phys) / (2.7e3_kind_phys - 0.947_kind_phys*bd2d(i)) + csol3d(i,k) = (2.128_kind_phys*sand2d(i)+2.385_kind_phys*clay2d(i)) / (sand2d(i)+clay2d(i))*1.e6_kind_phys ! J/(m3 K) + watdry3d(i,k) = watsat3d(i,k) * (316230._kind_phys/sucsat3d(i,k)) ** (-1._kind_phys/bsw3d(i,k)) + watopt3d(i,k) = watsat3d(i,k) * (158490._kind_phys/sucsat3d(i,k)) ** (-1._kind_phys/bsw3d(i,k)) + end do + if (lakedepth2d(i) == spval) then + if(LAKEDEBUG) then + errmsg='should not get here: lakedepth2d is spval ' + errflg=1 + return + endif + lakedepth2d(i) = zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake) + z_lake3d(i,1:nlevlake) = zlak(1:nlevlake) + dz_lake3d(i,1:nlevlake) = dzlak(1:nlevlake) + else + depthratio2d(i) = lakedepth2d(i) / (zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake)) + z_lake3d(i,1) = zlak(1) + dz_lake3d(i,1) = dzlak(1) + dz_lake3d(i,2:nlevlake) = dzlak(2:nlevlake)*depthratio2d(i) + z_lake3d(i,2:nlevlake) = zlak(2:nlevlake)*depthratio2d(i) + dz_lake3d(i,1)*(1._kind_phys - depthratio2d(i)) + end if + ! initial t_lake3d here + if(tsfc(i)<160) then + write(errmsg,'(A,F20.12,A)') 'Invalid tsfc value ',tsfc(i),' found. Was tsfc not initialized?' + write(0,'(A)') trim(errmsg) + errflg=1 + return + endif + t_soisno3d(i,1) = tsfc(i) + t_lake3d(i,1) = tsfc(i) + t_grnd2d(i) = tsfc(i) + do k = 2, nlevlake + if(z_lake3d(i,k).le.depth_c) then + t_soisno3d(i,k)=tsfc(i)+(277.0-tsfc(i))/depth_c*z_lake3d(i,k) + t_lake3d(i,k)=tsfc(i)+(277.0-tsfc(i))/depth_c*z_lake3d(i,k) + else + t_soisno3d(i,k) = tsfc(i) + t_lake3d(i,k) = tsfc(i) + end if + enddo + !end initial t_lake3d here + z3d(i,1:nlevsoil) = zsoi(1:nlevsoil) + zi3d(i,0:nlevsoil) = zisoi(0:nlevsoil) + dz3d(i,1:nlevsoil) = dzsoi(1:nlevsoil) + savedtke12d(i) = tkwat ! Initialize for first timestep. + + + if (snowdp2d(i) < 0.01_kind_phys) then + snl2d(i) = 0 + dz3d(i,-nlevsnow+1:0) = 0._kind_phys + z3d (i,-nlevsnow+1:0) = 0._kind_phys + zi3d(i,-nlevsnow+0:0) = 0._kind_phys + else + if ((snowdp2d(i) >= 0.01_kind_phys) .and. (snowdp2d(i) <= 0.03_kind_phys)) then + snl2d(i) = -1 + dz3d(i,0) = snowdp2d(i) + else if ((snowdp2d(i) > 0.03_kind_phys) .and. (snowdp2d(i) <= 0.04_kind_phys)) then + snl2d(i) = -2 + dz3d(i,-1) = snowdp2d(i)/2._kind_phys + dz3d(i, 0) = dz3d(i,-1) + else if ((snowdp2d(i) > 0.04_kind_phys) .and. (snowdp2d(i) <= 0.07_kind_phys)) then + snl2d(i) = -2 + dz3d(i,-1) = 0.02_kind_phys + dz3d(i, 0) = snowdp2d(i) - dz3d(i,-1) + else if ((snowdp2d(i) > 0.07_kind_phys) .and. (snowdp2d(i) <= 0.12_kind_phys)) then + snl2d(i) = -3 + dz3d(i,-2) = 0.02_kind_phys + dz3d(i,-1) = (snowdp2d(i) - 0.02_kind_phys)/2._kind_phys + dz3d(i, 0) = dz3d(i,-1) + else if ((snowdp2d(i) > 0.12_kind_phys) .and. (snowdp2d(i) <= 0.18_kind_phys)) then + snl2d(i) = -3 + dz3d(i,-2) = 0.02_kind_phys + dz3d(i,-1) = 0.05_kind_phys + dz3d(i, 0) = snowdp2d(i) - dz3d(i,-2) - dz3d(i,-1) + else if ((snowdp2d(i) > 0.18_kind_phys) .and. (snowdp2d(i) <= 0.29_kind_phys)) then + snl2d(i) = -4 + dz3d(i,-3) = 0.02_kind_phys + dz3d(i,-2) = 0.05_kind_phys + dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-3) - dz3d(i,-2))/2._kind_phys + dz3d(i, 0) = dz3d(i,-1) + else if ((snowdp2d(i) > 0.29_kind_phys) .and. (snowdp2d(i) <= 0.41_kind_phys)) then + snl2d(i) = -4 + dz3d(i,-3) = 0.02_kind_phys + dz3d(i,-2) = 0.05_kind_phys + dz3d(i,-1) = 0.11_kind_phys + dz3d(i, 0) = snowdp2d(i) - dz3d(i,-3) - dz3d(i,-2) - dz3d(i,-1) + else if ((snowdp2d(i) > 0.41_kind_phys) .and. (snowdp2d(i) <= 0.64_kind_phys)) then + snl2d(i) = -5 + dz3d(i,-4) = 0.02_kind_phys + dz3d(i,-3) = 0.05_kind_phys + dz3d(i,-2) = 0.11_kind_phys + dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-4) - dz3d(i,-3) - dz3d(i,-2))/2._kind_phys + dz3d(i, 0) = dz3d(i,-1) + else if (snowdp2d(i) > 0.64_kind_phys) then + snl2d(i) = -5 + dz3d(i,-4) = 0.02_kind_phys + dz3d(i,-3) = 0.05_kind_phys + dz3d(i,-2) = 0.11_kind_phys + dz3d(i,-1) = 0.23_kind_phys + dz3d(i, 0)=snowdp2d(i)-dz3d(i,-4)-dz3d(i,-3)-dz3d(i,-2)-dz3d(i,-1) + endif + end if + + do k = 0, snl2d(i)+1, -1 + z3d(i,k) = zi3d(i,k) - 0.5_kind_phys*dz3d(i,k) + zi3d(i,k-1) = zi3d(i,k) - dz3d(i,k) + end do + + ! 3:subroutine makearbinit + + if (snl2d(i) < 0) then + do k = snl2d(i)+1, 0 + ! Be careful because there may be new snow layers with bad temperatures like 0 even if + ! coming from init. con. file. + if(t_soisno3d(i,k) > 300 .or. t_soisno3d(i,k) < 200) t_soisno3d(i,k) = tsfc(i) + enddo + end if + + ! initial t_lake3d here + t_lake3d(i,1) = tsfc(i) + t_grnd2d(i) = tsfc(i) + do k = 2, nlevlake + if(z_lake3d(i,k).le.depth_c) then + t_lake3d(i,k) = tsfc(i)+(277.0-tsfc(i))/depth_c*z_lake3d(i,k) + else + t_lake3d(i,k) = 277.0 + end if + enddo + + ! initial t_soisno3d + t_soisno3d(i,1) = t_lake3d(i,nlevlake) + t_soisno3d(i,nlevsoil) = tg3(i) + do k = 2, nlevsoil-1 + t_soisno3d(i,k)=t_soisno3d(i,1)+(t_soisno3d(i,nlevsoil)-t_soisno3d(i,1))*dzsoi(k) + enddo + + do k = 1,nlevsoil + h2osoi_vol3d(i,k) = 1.0_kind_phys + h2osoi_vol3d(i,k) = min(h2osoi_vol3d(i,k),watsat3d(i,k)) + + ! soil layers + if (t_soisno3d(i,k) <= tfrz) then + h2osoi_ice3d(i,k) = dz3d(i,k)*denice*h2osoi_vol3d(i,k) + h2osoi_liq3d(i,k) = 0._kind_phys + else + h2osoi_ice3d(i,k) = 0._kind_phys + h2osoi_liq3d(i,k) = dz3d(i,k)*denh2o*h2osoi_vol3d(i,k) + endif + enddo + + do k = -nlevsnow+1, 0 + if (k > snl2d(i)) then + h2osoi_ice3d(i,k) = dz3d(i,k)*bdsno + h2osoi_liq3d(i,k) = 0._kind_phys + end if + end do + + clm_lake_initialized(i) = 1 + ENDDO + + + if(LAKEDEBUG .and. init_points>0) then + print *,'points initialized in clm_lake',init_points + end if + +END SUBROUTINE lakeini + +END MODULE clm_lake diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta new file mode 100644 index 000000000..5f2f6db3f --- /dev/null +++ b/physics/clm_lake.meta @@ -0,0 +1,680 @@ +[ccpp-table-properties] + name = clm_lake + type = scheme + dependencies = machine.F + +######################################################################## +[ccpp-arg-table] + name = clm_lake_run + type = scheme +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[first_time_step] + standard_name = flag_for_first_timestep + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical + intent = in +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[zlvl] + standard_name = height_above_ground_at_lowest_model_layer + long_name = layer 1 height above ground (not MSL) + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[gt0] + standard_name = air_temperature_of_new_state + long_name = temperature updated by physics + units = K + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[qvcurr] + standard_name = specific_humidity_of_new_state_at_surface_adjacent_layer + long_name = water vapor specific humidity at lowest model layer updated by physics + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[rho0] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[gu0] + standard_name = x_wind_of_new_state + long_name = zonal wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[gv0] + standard_name = y_wind_of_new_state + long_name = meridional wind updated by physics + units = m s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = in +[dlwsfci] + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[emiss] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[rain] + standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep + long_name = total rain at this time step + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[dswsfci] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[albedo] + standard_name = mid_day_surface_albedo_over_lake + long_name = mid day surface albedo over lake + units = fraction + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[z_lake3d] + standard_name = depth_of_lake_interface_layers + long_name = depth of lake interface layers + units = fraction + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[dz_lake3d] + standard_name = thickness_of_lake_layers + long_name = thickness of lake layers + units = fraction + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[lakedepth2d] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[watsat3d] + standard_name = saturated_volumetric_soil_water_in_lake_model + long_name = saturated volumetric soil water in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[csol3d] + standard_name = soil_heat_capacity_in_lake_model + long_name = soil heat capacity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[tkmg3d] + standard_name = soil_mineral_thermal_conductivity_in_lake_model + long_name = soil mineral thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[tkdry3d] + standard_name = dry_soil_thermal_conductivity_in_lake_model + long_name = dry soil thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[tksatu3d] + standard_name = saturated_soil_thermal_conductivity_in_lake_model + long_name = saturated soil thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = in +[xice] + standard_name = sea_ice_area_fraction_of_sea_area_fraction + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[xice_threshold] + standard_name = min_lake_ice_area_fraction + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[km] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[h2osno2d] + standard_name = water_equivalent_accumulated_snow_depth_in_clm_lake_model + long_name = water equiv of acc snow depth over lake in clm lake model + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[snowdp2d] + standard_name = actual_snow_depth_in_clm_lake_model + long_name = actual acc snow depth over lake in clm lake model + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[snl2d] + standard_name = snow_layers_in_clm_lake_model + long_name = snow layers in clm lake model (treated as integer) + units = count + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[z3d] + standard_name = snow_level_depth_in_clm_lake_model + long_name = snow level depth in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[dz3d] + standard_name = snow_level_thickness_in_clm_lake_model + long_name = snow level thickness in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[zi3d] + standard_name = snow_interface_depth_in_clm_lake_model + long_name = snow interface_depth in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[h2osoi_vol3d] + standard_name = volumetric_soil_water_in_clm_lake_model + long_name = volumetric soil water in clm lake model + units = m3 m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[h2osoi_liq3d] + standard_name = soil_liquid_water_content_in_clm_lake_model + long_name = soil liquid water content in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[h2osoi_ice3d] + standard_name = soil_ice_water_content_in_clm_lake_model + long_name = soil ice water content in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[t_grnd2d] + standard_name = skin_temperature_from_clm_lake_model + long_name = skin_temperature_from_clm_lake_model + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_soisno3d] + standard_name = soil_or_snow_layer_temperature_from_clm_lake_model + long_name = soil or snow layer temperature from clm lake model + units = K + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[t_lake3d] + standard_name = lake_layer_temperature_from_clm_lake_model + long_name = lake layer temperature from clm lake model + units = K + dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[savedtke12d] + standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model + long_name = top level eddy conductivity from previous timestep in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[lake_icefrac3d] + standard_name = lake_fractional_ice_cover_on_clm_lake_levels + long_name = lake fractional ice cover on clm lake levels + units = kg m-3 + dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_water + long_name = kinematic surface upward sensible heat flux over water + units = K m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_over_water + long_name = kinematic surface upward latent heat flux over water + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[grdflx] + standard_name = upward_heat_flux_in_soil_over_water + long_name = soil heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[lake_t2m] + standard_name = temperature_at_2m_from_clm_lake + long_name = temperature at 2m from clm lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[lake_q2m] + standard_name = specific_humidity_at_2m_from_clm_lake + long_name = specific humidity at 2m from clm lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[clm_lake_initialized] + standard_name = flag_for_clm_lake_initialization + long_name = set to true in clm_lake_run after likeini is called, as a workaround for ccpp limitation + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = inout +[isltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = inout +[snow] + standard_name = surface_snow_thickness_water_equivalent_over_land + long_name = water equivalent snow depth over land + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[use_lakedepth] + standard_name = flag_for_initializing_clm_lake_depth_from_lake_depth + long_name = flag for initializing clm lake depth from lake depth + units = flag + dimensions = () + type = logical + intent = in +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in +[lakedepth_default] + standard_name = default_lake_depth_in_clm_lake_model + long_name = default lake depth in clm lake model + units = m + dimensions = () + type = real + kind = kind_phys + intent = in +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = inout +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[clay3d] + standard_name = clm_lake_percent_clay + long_name = percent clay in clm lake model + units = percent + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + type = integer + intent = inout +[sand3d] + standard_name = clm_lake_percent_sand + long_name = percent sand in clm lake model + units = percent + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + type = integer + intent = inout +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[snwdph] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[hice] + standard_name = sea_ice_thickness + long_name = sea ice thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_sfc] + standard_name = surface_skin_temperature_over_water + long_name = surface skin temperature over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[lflx] + standard_name = surface_upward_potential_latent_heat_flux_over_water + long_name = surface upward potential latent heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[ustar] + standard_name = surface_friction_velocity_over_water + long_name = surface friction velocity over water + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[qsfc] + standard_name = surface_specific_humidity_over_water + long_name = surface air saturation specific humidity over water + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_water + long_name = surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_water + long_name = surface exchange coeff for momentum over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[chh] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water + long_name = thermal exchange coefficient over water + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[cmm] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_water + long_name = momentum exchange coefficient over water + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[T_snow] + standard_name = temperature_of_snow_on_lake + long_name = the temperature of snow on a lake + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[T_ice] + standard_name = surface_skin_temperature_over_ice + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[xlon_d] + standard_name = longitude_in_degree + long_name = longitude in degree east + units = degree_east + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out diff --git a/physics/flake_driver.F90 b/physics/flake_driver.F90 index a78c6acf6..e27d32ff3 100644 --- a/physics/flake_driver.F90 +++ b/physics/flake_driver.F90 @@ -51,7 +51,7 @@ SUBROUTINE flake_driver_run ( & ! ---- Inputs im, ps, t1, q1, wind, min_lakeice, & dlwflx, dswsfc, lakedepth, lakefrac, & - use_flake, snow, xlat, delt, zlvl, elev, & + use_lake_model, snow, xlat, delt, zlvl, elev, & wet, yearlen, julian, imon, & flag_iter, first_time_step, flag_restart, & weasd, & @@ -103,7 +103,7 @@ SUBROUTINE flake_driver_run ( & real (kind=kind_phys), intent(in) :: julian logical, dimension(:), intent(in) :: flag_iter, wet - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model logical, intent(in) :: flag_restart, first_time_step character(len=*), intent(out) :: errmsg @@ -223,7 +223,7 @@ SUBROUTINE flake_driver_run ( & do_flake = .false. do i = 1, im - flag(i) = flag_iter(i) .and. use_flake(i) .gt. 0 + flag(i) = flag_iter(i) .and. use_lake_model(i) .gt. 0 do_flake = flag(i) .or. do_flake enddo if (.not. do_flake) return @@ -308,13 +308,13 @@ SUBROUTINE flake_driver_run ( & ! w_extinc(i) = 3.0 ! write(0,1002) julian,xlat(i),w_albedo(I),w_extinc(i),elev(i),tsurf(i),T_sfc(i),t_bot1(i) -! write(0,1003) use_flake(i),i,lakefrac(i),lakedepth(i), snwdph(i), hice(i), fice(i) +! write(0,1003) use_lake_model(i),i,lakefrac(i),lakedepth(i), snwdph(i), hice(i), fice(i) ! write(0,1004) ps(i), wind(i), t1(i), q1(i), dlwflx(i), dswsfc(i), zlvl(i) endif !flag enddo 1002 format ( 'julian=',F6.2,1x,F8.3,1x,2(E7.2,1x),E7.2,1x,3(E7.2,1x)) - 1003 format ( 'use_flake=',I2,1x,I3,1x,F6.4,1x,F9.4,1x,2(F8.4,1x),F7.4) + 1003 format ( 'use_lake_model=',I2,1x,I3,1x,F6.4,1x,F9.4,1x,2(F8.4,1x),F7.4) 1004 format ( 'pressure',F12.2,1x,F6.2,1x,F7.2,1x,F7.4,1x,2(F8.2,1x),F8.4) ! ! call lake interface @@ -429,7 +429,7 @@ SUBROUTINE flake_driver_run ( & ! fice(i) = 1.0 ! endif enddo !iter loop -! endif !endif use_flake +! endif !endif use_lake_model endif !endif of flag @@ -462,8 +462,8 @@ end subroutine flake_driver_post_finalize !> \section arg_table_flake_driver_post Argument Table !! \htmlinclude flake_driver_post.html !! -subroutine flake_driver_post_run (im, use_flake, h_ML, T_wML, Tsurf, & - lakedepth, xz, zm, tref, tsfco, & +subroutine flake_driver_post_run (im, use_lake_model, h_ML, T_wML, & + Tsurf, lakedepth, xz, zm, tref, tsfco, & errmsg, errflg) !use machine , only : kind_phys @@ -479,7 +479,7 @@ subroutine flake_driver_post_run (im, use_flake, h_ML, T_wML, Tsurf, & real (kind=kind_phys),dimension(:),intent(inout) :: & & xz, zm, tref, tsfco - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -490,8 +490,8 @@ subroutine flake_driver_post_run (im, use_flake, h_ML, T_wML, Tsurf, & errflg = 0 do I=1, im - if(use_flake(i).eq.2) then - write(0,*)'flake-post-use-flake= ',use_flake(i) + if(use_lake_model(i).eq.2) then + write(0,*)'flake-post-use-lake-model= ',use_lake_model(i) xz(i) = lakedepth(i) zm(i) = h_ML(i) tref(i) = tsurf(i) diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index 67822df05..834bfd0a4 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -126,9 +126,9 @@ type = real kind = kind_phys intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index ffda6fd89..559009850 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -27,7 +27,7 @@ ! (sfcalb) ! ! ! ! 'setemis' -- set up surface emissivity for lw radiation ! -! ( lsm,lsm_noahmp,lsm_ruc,frac_grid,cplice,use_flake, ! +! ( lsm,lsm_noahmp,lsm_ruc,frac_grid,cplice,use_lake_model, ! ! --- inputs: ! lakefrac,xlon,xlat,slmsk,snodl,snodi,sncovr,sncovr_ice, ! ! zorlf,tsknf,tairf,hprif, ! @@ -731,7 +731,7 @@ end subroutine setalb !! @{ !----------------------------------- subroutine setemis & - & ( lsm,lsm_noahmp,lsm_ruc,frac_grid,cplice,use_flake, & ! --- inputs: + & ( lsm,lsm_noahmp,lsm_ruc,frac_grid,cplice,use_lake_model, & ! --- inputs: & lakefrac,xlon,xlat,slmsk,snodl,snodi,sncovr,sncovr_ice, & & zorlf,tsknf,tairf,hprif, & & semis_lnd,semis_ice,semis_wat,IMAX,fracl,fraco,fraci,icy, & @@ -794,7 +794,7 @@ subroutine setemis & integer, intent(in) :: IMAX integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in) :: frac_grid, cplice - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model real (kind=kind_phys), dimension(:), intent(in) :: lakefrac real (kind=kind_phys), dimension(:), intent(in) :: & @@ -959,7 +959,7 @@ subroutine setemis & sfcemis_ice = semis_ice(i) ! output from CICE endif elseif (lsm == lsm_ruc) then - if (use_flake(i)>0) then + if (use_lake_model(i)>0) then if (sncovr_ice(i) > f_zero) then sfcemis_ice = emsref(7) * (f_one-sncovr_ice(i)) & & + emsref(8) * sncovr_ice(i) diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/scm_sfc_flux_spec.F90 index bb2c47f48..5dfec59b1 100644 --- a/physics/scm_sfc_flux_spec.F90 +++ b/physics/scm_sfc_flux_spec.F90 @@ -55,7 +55,7 @@ end subroutine scm_sfc_flux_spec_finalize subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, spec_sh_flux, spec_lh_flux, & exner_inverse, T_surf, cp, grav, hvap, rd, fvirt, vonKarman, tgice, islmsk, dry, frland, cice, icy, tisfc,& oceanfrac, min_seaice, cplflx, cplice, flag_cice, wet, min_lakeice, tsfcl, tsfc_wat, slmsk, lakefrac, lkm,& - lakedepth, use_flake, sh_flux, lh_flux, sh_flux_chs, u_star, sfc_stress, cm, ch, & + lakedepth, use_lake_model, sh_flux, lh_flux, sh_flux_chs, u_star, sfc_stress, cm, ch, & fm, fh, rb, u10m, v10m, wind1, qss, t2m, q2m, errmsg, errflg) use machine, only: kind_phys @@ -63,7 +63,7 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, integer, intent(in) :: im, lkm integer, intent(inout) :: islmsk(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_flake(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:) @@ -215,12 +215,12 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, do i = 1, im if ((wet(i) .or. icy(i)) .and. lakefrac(i) > 0.0_kind_phys) then if (lkm == 1 .and. lakefrac(i) >= 0.15 .and. lakedepth(i) > 1.0_kind_phys) then - use_flake(i) = .true. + use_lake_model(i) = .true. else - use_flake(i) = .false. + use_lake_model(i) = .false. endif else - use_flake(i) = .false. + use_lake_model(i) = .false. endif enddo ! diff --git a/physics/scm_sfc_flux_spec.meta b/physics/scm_sfc_flux_spec.meta index 03e3205f5..52722f1c4 100644 --- a/physics/scm_sfc_flux_spec.meta +++ b/physics/scm_sfc_flux_spec.meta @@ -315,8 +315,8 @@ kind = kind_phys intent = in [lkm] - standard_name = control_for_lake_surface_scheme - long_name = flag for lake surface model + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst units = flag dimensions = () type = integer @@ -329,12 +329,12 @@ type = real kind = kind_phys intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer intent = inout [sh_flux] standard_name = surface_upward_temperature_flux diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 7a7a4496c..89941e79f 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -84,7 +84,8 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & fm10_wat, fm10_lnd, fm10_ice, & !intent(inout) & fh2_wat, fh2_lnd, fh2_ice, & !intent(inout) & ztmax_wat, ztmax_lnd, ztmax_ice, & !intent(inout) - & zvfun, use_flake, & !intent(out) + & zvfun, & !intent(out) + & use_lake_model, & !intent(in) & errmsg, errflg) !intent(out) ! implicit none @@ -94,7 +95,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean integer, dimension(:), intent(in) :: vegtype - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy @@ -174,7 +175,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! surface roughness length is converted to m from cm ! do i=1,im - if(use_flake(i) > 0) wet(i) = .true. + if(use_lake_model(i) > 0) wet(i) = .true. enddo ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 33149eb16..e0fedfa45 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -565,9 +565,9 @@ type = real kind = kind_phys intent = inout -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index e8e3627c5..0795be00c 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -17,7 +17,7 @@ subroutine sfc_nst_run & & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: & pi, tgice, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & & lseaspray, fm, fm10, & - & prsl1, prslki, prsik1, prslk1, wet, use_flake, xlon, & + & prsl1, prslki, prsik1, prslk1, wet, use_lake_model, xlon, & & sinlat, stress, & & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & @@ -37,7 +37,7 @@ subroutine sfc_nst_run & ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tref, cm, ch, ! ! lseaspray, fm, fm10, ! -! prsl1, prslki, wet, use_flake, xlon, sinlat, stress, ! +! prsl1, prslki, wet, use_lake_model, xlon, sinlat, stress, ! ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! ! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! ! nstf_name5, lprnt, ipr, thsfc_loc, ! @@ -88,7 +88,7 @@ subroutine sfc_nst_run & ! prsik1 - real, im ! ! prslk1 - real, im ! ! wet - logical, =T if any ocn/lake water (F otherwise) im ! -! use_flake- logical, =T if flake model is used for lake im ! +! use_lake_model- logical, =T if flake model is used for lake im ! ! icy - logical, =T if any ice im ! ! xlon - real, longitude (radians) im ! ! sinlat - real, sin of latitude im ! @@ -194,7 +194,7 @@ subroutine sfc_nst_run & logical, intent(in) :: lseaspray ! logical, dimension(:), intent(in) :: flag_iter, flag_guess, wet - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model ! &, icy logical, intent(in) :: lprnt logical, intent(in) :: thsfc_loc @@ -276,7 +276,7 @@ subroutine sfc_nst_run & do_nst = .false. do i = 1, im ! flag(i) = wet(i) .and. .not.icy(i) .and. flag_iter(i) - flag(i) = wet(i) .and. flag_iter(i) .and. use_flake(i)/=1 + flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1 do_nst = do_nst .or. flag(i) enddo if (.not. do_nst) return @@ -285,7 +285,7 @@ subroutine sfc_nst_run & ! do i=1, im ! if(wet(i) .and. .not.icy(i) .and. flag_guess(i)) then - if(wet(i) .and. flag_guess(i) .and. use_flake(i)/=1) then + if(wet(i) .and. flag_guess(i) .and. use_lake_model(i)/=1) then xt_old(i) = xt(i) xs_old(i) = xs(i) xu_old(i) = xu(i) @@ -604,7 +604,7 @@ subroutine sfc_nst_run & ! restore nst-related prognostic fields for guess run do i=1, im ! if (wet(i) .and. .not.icy(i)) then - if (wet(i) .and. use_flake(i)/=1) then + if (wet(i) .and. use_lake_model(i)/=1) then if (flag_guess(i)) then ! when it is guess of xt(i) = xt_old(i) xs(i) = xs_old(i) diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index 3f281231c..dc35ec959 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -236,9 +236,9 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer diff --git a/physics/sfc_nst_post.f b/physics/sfc_nst_post.f index b316dccd0..83bc2f273 100644 --- a/physics/sfc_nst_post.f +++ b/physics/sfc_nst_post.f @@ -15,8 +15,8 @@ module sfc_nst_post ! \section NSST_detailed_post_algorithm Detailed Algorithm ! @{ subroutine sfc_nst_post_run & - & ( im, kdt, rlapse, tgice, wet, use_flake, icy, oro, oro_uf, & - & nstf_name1, & + & ( im, kdt, rlapse, tgice, wet, use_lake_model, icy, oro, & + & oro_uf, nstf_name1, & & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & & tsurf_wat, tsfc_wat, nthreads, dtzm, errmsg, errflg & & ) @@ -31,7 +31,7 @@ subroutine sfc_nst_post_run & ! --- inputs: integer, intent(in) :: im, kdt, nthreads logical, dimension(:), intent(in) :: wet, icy - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model real (kind=kind_phys), intent(in) :: rlapse, tgice real (kind=kind_phys), dimension(:), intent(in) :: oro, oro_uf integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 @@ -76,7 +76,7 @@ subroutine sfc_nst_post_run & do i = 1, im ! if (wet(i) .and. .not.icy(i)) then ! if (wet(i) .and. (frac_grid .or. .not. icy(i))) then - if (wet(i) .and. use_flake(i) /=1) then + if (wet(i) .and. use_lake_model(i) /=1) then tsfc_wat(i) = max(tgice, tref(i) + dtzm(i)) ! tsfc_wat(i) = max(271.2, tref(i) + dtzm(i)) - & ! (oro(i)-oro_uf(i))*rlapse diff --git a/physics/sfc_nst_post.meta b/physics/sfc_nst_post.meta index 45257fe41..7f66118e9 100644 --- a/physics/sfc_nst_post.meta +++ b/physics/sfc_nst_post.meta @@ -45,9 +45,9 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 574388317..97934e9a7 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -28,7 +28,7 @@ subroutine sfc_ocean_run & ! --- inputs: & ( im, hvap, cp, rd, eps, epsm1, rvrdm1, ps, u1, v1, t1, q1, & & tskin, cm, ch, lseaspray, fm, fm10, & - & prsl1, prslki, wet, use_flake, wind, &, ! --- inputs + & prsl1, prslki, wet, use_lake_model, wind, &, ! --- inputs & flag_iter, use_med_flux, dqsfc_med, dtsfc_med, & & qsurf, cmm, chh, gflux, evap, hflx, ep, & ! --- outputs & errmsg, errflg & @@ -42,7 +42,7 @@ subroutine sfc_ocean_run & ! call sfc_ocean ! ! inputs: ! ! ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10, ! -! prsl1, prslki, wet, use_flake, wind, flag_iter, ! +! prsl1, prslki, wet, use_lake_model, wind, flag_iter, ! ! use_med_flux, ! ! outputs: ! ! qsurf, cmm, chh, gflux, evap, hflx, ep ) ! @@ -118,7 +118,7 @@ subroutine sfc_ocean_run & logical, intent(in) :: lseaspray ! logical, dimension(:), intent(in) :: flag_iter, wet - integer, dimension(:), intent(in) :: use_flake + integer, dimension(:), intent(in) :: use_lake_model ! logical, intent(in) :: use_med_flux @@ -167,7 +167,7 @@ subroutine sfc_ocean_run & ! ! --- ... flag for open water do i = 1, im - flag(i) = (wet(i) .and. flag_iter(i) .and. use_flake(i) /=1) + flag(i) = (wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1) ! --- ... initialize variables. all units are supposedly m.k.s. unless specified ! ps is in pascals, wind is wind speed, ! rho is density, qss is sat. hum. at surface diff --git a/physics/sfc_ocean.meta b/physics/sfc_ocean.meta index f30be6ea8..15812e723 100644 --- a/physics/sfc_ocean.meta +++ b/physics/sfc_ocean.meta @@ -172,9 +172,9 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index 195ebec80..64b457283 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -45,7 +45,7 @@ subroutine sfc_sice_run & & t0c, rd, ps, t1, q1, delt, & & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & & cm, ch, prsl1, prslki, prsik1, prslk1, wind, & - & flag_iter, use_flake, lprnt, ipr, thsfc_loc, & + & flag_iter, use_lake_model, lprnt, ipr, thsfc_loc, & & hice, fice, tice, weasd, tsfc_wat, tprcp, tiice, ep, & ! --- input/outputs: & snwdph, qss_i, qss_w, snowmt, gflux, cmm, chh, & & evapi, evapw, hflxi, hflxw, islmsk, & @@ -111,7 +111,7 @@ subroutine sfc_sice_run & ! islimsk - integer, sea/land/ice mask (=0/1/2) im ! ! wind - real, im ! ! flag_iter- logical, im ! -! use_flake- logical, true for lakes when when lkm > 0 im ! +! use_lake_model- logical, true for lakes when when lkm > 0 im ! ! thsfc_loc- logical, reference pressure for potential temp im ! ! ! ! input/outputs: ! @@ -168,7 +168,7 @@ subroutine sfc_sice_run & real (kind=kind_phys), intent(in) :: delt logical, dimension(im), intent(in) :: flag_iter - integer, dimension(im), intent(in) :: use_flake + integer, dimension(im), intent(in) :: use_lake_model ! --- input/outputs: real (kind=kind_phys), dimension(:), intent(inout) :: hice, & @@ -216,7 +216,7 @@ subroutine sfc_sice_run & do_sice = .false. do i = 1, im flag(i) = islmsk(i) == 2 .and. flag_iter(i) & - & .and. use_flake(i) /=1 + & .and. use_lake_model(i) /=1 do_sice = do_sice .or. flag(i) ! if (flag_iter(i) .and. islmsk(i) < 2) then ! hice(i) = zero diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index 489c3758b..75aab21a4 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -236,9 +236,9 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer From 0f2b5a7d8463f76b30870f71c3b7b8f82f550d79 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 16 Aug 2022 22:47:50 +0000 Subject: [PATCH 03/46] bug fixes --- physics/clm_lake.f90 | 472 ++++++++++++++++++++++++------------------ physics/clm_lake.meta | 138 +++++++++++- physics/physcons.F90 | 1 + physics/sfc_diag.f | 54 +++-- physics/sfc_diag.meta | 37 ++++ 5 files changed, 469 insertions(+), 233 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 384faf419..a07f48d40 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -31,22 +31,18 @@ MODULE clm_lake implicit none - logical, parameter :: LAKEDEBUG = .true. ! Enable lots of checks and debug prints + logical, parameter :: LAKEDEBUG = .true. ! Enable lots of checks and debug prints and errors - real(kind_phys), parameter :: zero_h2o = 1e-12 - - ! FIXME: REMOVE OR DOCUMENT PERGRO logical, parameter :: PERGRO = .false. - ! FIXME: REMOVE OR DOCUMENT ETALAKE logical, parameter :: USE_ETALAKE = .false. real, parameter :: ETALAKE = 1.1925*50**(-0.424) ! Set this to your desired value if USE_ETALAKE=.true. - real(kind_phys), parameter :: snow_bd = 250._kind_phys !constant snow bulk density (only used in special case here) [kg/m^3] - + ! Level counts must be consistent with model (GFS_Typedefs.F90) integer, parameter :: nlevsoil = 10 ! number of soil layers integer, parameter :: nlevlake = 10 ! number of lake layers integer, parameter :: nlevsnow = 5 ! maximum number of snow layers + real(kind_phys), parameter :: scalez = 0.025_kind_phys ! Soil layer thickness discretization (m) integer,parameter :: lbp = 1 ! pft-index bounds integer,parameter :: ubp = 1 @@ -73,70 +69,56 @@ MODULE clm_lake integer,parameter :: column =1 logical,parameter :: lakpoi(1) = .true. - - - - !Initialize physical constants: - ! FIXME: GET THESE FROM THE MODEL - real(kind_phys), parameter :: vkc = 0.4_kind_phys !von Karman constant [-] - real(kind_phys), parameter :: pi = 3.141592653589793_kind_phys ! pi - real(kind_phys), parameter :: grav = 9.80616_kind_phys !gravity constant [m/s2] - real(kind_phys), parameter :: sb = 5.67e-8_kind_phys !stefan-boltzmann constant [W/m2/K4] - real(kind_phys), parameter :: tfrz = 273.16_kind_phys !freezing temperature [K] - real(kind_phys), parameter :: denh2o = 1.000e3_kind_phys !density of liquid water [kg/m3] - real(kind_phys), parameter :: denice = 0.917e3_kind_phys !density of ice [kg/m3] - real(kind_phys), parameter :: cpice = 2.11727e3_kind_phys !Specific heat of ice [J/kg-K] - real(kind_phys), parameter :: cpliq = 4.188e3_kind_phys !Specific heat of water [J/kg-K] - real(kind_phys), parameter :: hfus = 3.337e5_kind_phys !Latent heat of fusion for ice [J/kg] - real(kind_phys), parameter :: hvap = 2.501e6_kind_phys !Latent heat of evap for water [J/kg] - real(kind_phys), parameter :: hsub = 2.501e6_kind_phys+3.337e5_kind_phys !Latent heat of sublimation [J/kg] - real(kind_phys), parameter :: rair = 287.0423_kind_phys !gas constant for dry air [J/kg/K] - real(kind_phys), parameter :: cpair = 1.00464e3_kind_phys !specific heat of dry air [J/kg/K] + !Initialize physical constants not available from model: real(kind_phys), parameter :: tcrit = 2.5 !critical temperature to determine rain or snow real(kind_phys), parameter :: tkwat = 0.6 !thermal conductivity of water [W/m/k] real(kind_phys), parameter :: tkice = 2.290 !thermal conductivity of ice [W/m/k] real(kind_phys), parameter :: tkairc = 0.023 !thermal conductivity of air [W/m/k] - real(kind_phys), parameter :: bdsno = 250. !bulk density snow (kg/m**3) + real(kind_phys), parameter :: snow_bd = 250 !constant snow bulk density (only used in special case here) [kg/m^3] + + ! Constants that are copied from model values by clm_lake_init: + real(kind_phys) :: pi !ratio of the circumference of a circle to its diameter + real(kind_phys) :: vkc !von Karman constant [-] + real(kind_phys) :: grav !gravity constant [m/s2] + real(kind_phys) :: sb !stefan-boltzmann constant [W/m2/K4] + real(kind_phys) :: tfrz !freezing temperature [K] + real(kind_phys) :: denh2o !density of liquid water [kg/m3] + real(kind_phys) :: denice !density of ice [kg/m3] + real(kind_phys) :: cpice !Specific heat of ice [J/kg-K] + real(kind_phys) :: cpliq !Specific heat of water [J/kg-K] + real(kind_phys) :: hfus !Latent heat of fusion for ice [J/kg] + real(kind_phys) :: hvap !Latent heat of evap for water [J/kg] + real(kind_phys) :: hsub !Latent heat of sublimation [J/kg] + real(kind_phys) :: rair !gas constant for dry air [J/kg/K] + real(kind_phys) :: cpair !specific heat of dry air [J/kg/K] - real(kind_phys), public, parameter :: spval = 1.e36 !special value for missing data (ocean) - - real(kind_phys), parameter :: depth_c = 50. ! below the level t_lake3d will be 277.0 !mchen - + real(kind_phys), public, parameter :: spval = 1.e36 !special value for missing data (ocean) + real(kind_phys), parameter :: depth_c = 50. !below the level t_lake3d will be 277.0 !mchen + real(kind_phys), parameter :: zero_h2o = 1e-12 !lower mixing ratio is is treated as zero ! These are tunable constants real(kind_phys), parameter :: wimp = 0.05 !Water impermeable if porosity less than wimp real(kind_phys), parameter :: ssi = 0.033 !Irreducible water saturation of snow real(kind_phys), parameter :: cnfac = 0.5 !Crank Nicholson factor between 0 and 1 - ! Initialize water type constants integer,parameter :: istsoil = 1 !soil "water" type - integer, private :: i ! loop index - real(kind_phys) :: dtime ! land model time step (sec) + ! percent sand + real(kind_phys), parameter :: sand(19) = & + (/92.,80.,66.,20.,5.,43.,60.,10.,32.,51., 6.,22.,39.7,0.,100.,54.,17.,100.,92./) + + ! percent clay + real(kind_phys), parameter :: clay(19) = & + (/ 3., 5.,10.,15.,5.,18.,27.,33.,33.,41.,47.,58.,14.7,0., 0., 8.5,54., 0., 3./) + + ! These are initialized in clm_lake_init and are not modified elsewhere real(kind_phys) :: zlak(1:nlevlake) !lake z (layers) real(kind_phys) :: dzlak(1:nlevlake) !lake dz (thickness) real(kind_phys) :: zsoi(1:nlevsoil) !soil z (layers) real(kind_phys) :: dzsoi(1:nlevsoil) !soil dz (thickness) real(kind_phys) :: zisoi(0:nlevsoil) !soil zi (interfaces) - - real(kind_phys) :: sand(19) ! percent sand - real(kind_phys) :: clay(19) ! percent clay - - data(sand(i), i=1,19)/92.,80.,66.,20.,5.,43.,60.,& - 10.,32.,51., 6.,22.,39.7,0.,100.,54.,17.,100.,92./ - - data(clay(i), i=1,19)/ 3., 5.,10.,15.,5.,18.,27.,& - 33.,33.,41.,47.,58.,14.7,0., 0., 8.5,54., 0., 3./ - - - ! real(kind_phys) :: dtime ! land model time step (sec) - real(kind_phys) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_phys) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_phys) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_phys) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_phys) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) CONTAINS !> \section arg_table_clm_lake_run Argument Table @@ -155,7 +137,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& h2osoi_ice3d ,t_grnd2d ,t_soisno3d ,t_lake3d ,& savedtke12d ,lake_icefrac3d ,use_lake_model ,& iopt_lake ,iopt_lake_clm ,& - con_cp ,& + con_cp ,icy ,& hflx ,evap ,grdflx ,tsfc ,& !o lake_t2m ,lake_q2m ,clm_lake_initialized ,& isltyp ,snow ,use_lakedepth ,& @@ -165,7 +147,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& weasd ,snwdph ,hice ,tsurf ,& t_sfc ,lflx ,ustar ,qsfc ,& ch ,cm ,chh ,cmm ,& - T_snow ,T_ice ,tsurf_ice ,wind ,& + lake_t_snow ,tisfc ,tsurf_ice ,wind ,& ! xlon_d ,kdt ,tg3 ,& me ,master ,errmsg ,errflg ) @@ -185,8 +167,9 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& CHARACTER(*), INTENT(OUT) :: errmsg INTEGER , INTENT (IN) :: im,km,me,master LOGICAL, INTENT(IN) :: restart,use_lakedepth,first_time_step - INTEGER, INTENT(INOUT) :: clm_lake_initialized(:) + REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) REAL(KIND_PHYS), INTENT(IN) :: xice_threshold, con_rd,con_g,con_cp,lakedepth_default + logical, intent(inout) :: icy(:) REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: XICE REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN):: tg3 REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: SNOW, ZLVL @@ -197,7 +180,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT) :: & weasd ,snwdph ,hice ,tsurf ,& t_sfc ,lflx ,ustar ,qsfc ,& - chh ,cmm ,T_snow ,T_ice ,& + chh ,cmm ,lake_t_snow ,tisfc ,& tsurf_ice ,wind LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: gt0 @@ -254,7 +237,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& !local variable: - REAL(kind_phys) :: SFCTMP,PBOT,PSFC,Q2K,LWDN,PRCP,SOLDN,SOLNET + REAL(kind_phys) :: SFCTMP,PBOT,PSFC,Q2K,LWDN,PRCP,SOLDN,SOLNET,dtime INTEGER :: C,i,j,k @@ -315,24 +298,49 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& real(kind_phys) :: discard1, discard2, discard3 ! for unused temporary data + real(kind_phys) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_phys) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_phys) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_phys) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + integer :: lake_points character*255 :: message logical, parameter :: feedback_to_atmosphere = .true. ! FIXME: REMOVE + + ! Functionality to print extra values at problematic points specified by user logical :: was_unhappy,is_unhappy + ! Points come from this file + character(*), parameter :: unhappy_txt = "unhappy.txt" + + ! Special values of the unhappy_count to indicate data is unavailable integer, parameter :: HAVE_NOT_READ_UNHAPPY_POINTS_YET = -1 integer, parameter :: FAILED_TO_READ_UNHAPPY_POINTS = -2 + ! These "save" variables are protected by an OMP CRITICAL to + ! ensure they're only initialized once. + + ! Number of unhappy points integer, save :: unhappy_count = HAVE_NOT_READ_UNHAPPY_POINTS_YET + + ! The latitude and longitude of unhappy points. real(kind_phys), allocatable, save :: unhappy_lat(:),unhappy_lon(:) - character(*), parameter :: unhappy_txt = "unhappy.txt" errmsg = ' ' errflg = 0 + dtime=dtp + if(LAKEDEBUG) then + ! Have we read the unhappy points? + ! The first "if" ensures we don't initiate an OMP CRITICAL unless we have to. if(unhappy_count==HAVE_NOT_READ_UNHAPPY_POINTS_YET) then !$OMP CRITICAL + + ! Check unhappy_count again since it probably changed + ! during the setup of the omp critical, when another + ! thread read in the unhappy points. if(unhappy_count==HAVE_NOT_READ_UNHAPPY_POINTS_YET) then call read_unhappy_points if(unhappy_count>0) then @@ -346,16 +354,14 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif !$OMP END CRITICAL endif - if(unhappy_count==FAILED_TO_READ_UNHAPPY_POINTS) then - write(message,'(A)') "ERROR: Could not read unhappy points" - errmsg=message - errflg=1 - return + ! At this point, at least one thread should have read in the unhappy points. + if(unhappy_count==FAILED_TO_READ_UNHAPPY_POINTS .and. kdt<2) then + write(0,'(A)') "ERROR: Could not read unhappy points" endif endif ! Still have some points to initialize - call lakeini( ISLTYP, gt0, SNOW, & !i + call lakeini(kdt, ISLTYP, gt0, SNOW, & !i restart, lakedepth_default, & lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & @@ -386,8 +392,6 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& lake_points=0 - dtime = dtp - lake_top_loop: DO I = 1,im if_lake_is_here: if (flag_iter(i) .and. use_lake_model(i)/=0) THEN @@ -397,7 +401,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& PSFC = prsi(i,1) Q2K = qvcurr(i) LWDN = DLWSFCI(I)*EMISS(I) - PRCP = RAIN(i)*1000.0_kind_phys/dtp ! use physics timestep since PRCP comes from non-surface schemes + PRCP = RAIN(i)*1000.0_kind_phys/dtime ! use physics timestep since PRCP comes from non-surface schemes SOLDN = DSWSFCI(I) ! SOLDN is total incoming solar SOLNET = SOLDN*(1.-ALBEDO(I)) ! use mid-day albedo to determine net downward solar ! (no solar zenith angle correction) @@ -472,7 +476,8 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& savedtke1,lake_icefrac, & eflx_lwrad_net,eflx_gnet, & !O eflx_sh_tot,eflx_lh_tot, & - t_ref2m,q_ref2m, & + t_ref2m,q_ref2m, dtime, & + watsat, tksatu, tkmg, tkdry, csol, & taux,tauy,ram1,z0mg,ustar_out,errmsg,errflg, & xlat_d(i),xlon_d(i),is_unhappy) if(LAKEDEBUG) then @@ -540,11 +545,12 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + ( (1.0-lake_icefrac3d(i,1)) * 0.08) xice(i) = lake_icefrac3d(i,1) - if(xice(i)>0) then + if(xice(i)>xice_threshold) then weasd(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice snwdph(i) = h2osno(c)/snow_bd*1000 ! surface_snow_thickness_water_equivalent_over_ice - T_ice(i) = t_grnd(c) ! surface_skin_temperature_over_ice + tisfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice + icy(i)=.true. ! Assume that, if a layer has ice, the entire layer thickness is ice. hice(I) = 0 @@ -556,13 +562,14 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& else weasd(i) = 0 snwdph(i) = 0 - T_ice(i) = tsurf(i) - tsurf_ice(i) = T_ice(i) + tisfc(i) = tsurf(i) + tsurf_ice(i) = tisfc(i) hice(i) = 0 endif if(snl2d(i)>0) then - T_snow(i) = t_grnd(c) ! temperature_of_snow_on_lake + lake_t_snow(i) = t_grnd(c) + tisfc(i) = lake_t_snow(i) endif ustar = ustar_out(1) ! surface_friction_velocity_over_water @@ -661,8 +668,8 @@ subroutine read_unhappy_points 1001 continue ! Error handler, whether file was opened or not write(0,'(A)') message - errmsg=message - errflg=1 + ! errmsg=message + ! errflg=1 if(allocated(unhappy_lat)) deallocate(unhappy_lat) if(allocated(unhappy_lon)) deallocate(unhappy_lon) unhappy_count=FAILED_TO_READ_UNHAPPY_POINTS @@ -682,7 +689,8 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I savedtke1,lake_icefrac, & eflx_lwrad_net,eflx_gnet, & !O eflx_sh_tot,eflx_lh_tot, & - t_ref2m,q_ref2m, & + t_ref2m,q_ref2m, dtime, & + watsat, tksatu, tkmg, tkdry, csol, & taux,tauy,ram1,z0mg,ustar_out,errmsg,errflg, xlat_d,xlon_d,unhappy) implicit none !in: @@ -690,7 +698,8 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I logical :: unhappy integer, intent(inout) :: errflg character(*), intent(inout) :: errmsg - real(kind_phys),intent(in) :: xlat_d, xlon_d ! grid location for debugging + real(kind_phys),intent(in) :: dtime ! timestep + real(kind_phys),intent(in) :: xlat_d, xlon_d ! grid location for debugging real(kind_phys),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) real(kind_phys),intent(in) :: forc_pbot(1) ! atm bottom level pressure (Pa) real(kind_phys),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) @@ -714,6 +723,11 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I ! real(kind_phys), intent(in) :: watsat(1,1:nlevsoil) ! volumetric soil water at saturation (porosity) !!!!!!!!!!!!!!!!hydro logical , intent(in) :: do_capsnow(1) ! true => do snow capping + real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_phys), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_phys), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_phys), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) @@ -830,7 +844,7 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I eflx_lh_grnd,t_veg,t_ref2m,q_ref2m,taux,tauy, & ram1,ws,ks,eflx_gnet,z0mg,ustar_out,errmsg,errflg,xlat_d,xlon_d,unhappy) if(errflg/=0) then - !return ! State is invalid now, so pass error to caller. + return ! State is invalid now, so pass error to caller. endif CALL ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & !i @@ -839,9 +853,10 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I eflx_sh_grnd,eflx_sh_tot,eflx_soil_grnd, & !o t_lake,t_soisno,h2osoi_liq, & h2osoi_ice,savedtke1, & + watsat, tksatu, tkmg, tkdry, csol, dtime, & frac_iceold,qflx_snomelt,imelt,errmsg,errflg) if(errflg/=0) then - !return ! State is invalid now, so pass error to caller. + return ! State is invalid now, so pass error to caller. endif CALL ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & !i @@ -858,9 +873,10 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I qflx_evap_tot_col,soilalpha,zwt,fcov, & rootr_column,qflx_evap_grnd,qflx_sub_snow, & qflx_dew_snow,qflx_dew_grnd,qflx_rain_grnd_col, & - errmsg,errflg) + watsat, tksatu, tkmg, tkdry, csol, & + dtime,errmsg,errflg) if(errflg/=0) then - !return ! State is invalid now, so pass error to caller. + return ! State is invalid now, so pass error to caller. endif !================================================================================== @@ -981,7 +997,6 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, integer :: iter ! iteration index integer :: nmozsgn(lbp:ubp) ! number of times moz changes sign integer :: jtop(lbc:ubc) ! top level for each column (no longer all 1) - ! real(kind_phys) :: dtime ! land model time step (sec) real(kind_phys) :: ax ! used in iteration loop for calculating t_grnd (numerator of NR solution) real(kind_phys) :: bx ! used in iteration loop for calculating t_grnd (denomin. of NR solution) real(kind_phys) :: degdT ! d(eg)/dT @@ -1044,8 +1059,6 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, unhappy=.false. - ! dtime = get_step_size() - ! Begin calculations !dir$ concurrent @@ -1368,8 +1381,9 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, .or. abs(t_grnd(c)-288)>200 ) then 840 format('CLM_Lake ShalLakeFluxes: t_grnd is out of range: eflx_sh_tot(p)=',G20.12,' eflx_lh_tot(p)=',G20.12,' t_grnd(c)=',G20.12,' at p=',I0,' c=',I0,' xlat_d=',F10.3,' xlon_d=',F10.3) write(message,840) eflx_sh_tot(p),eflx_lh_tot(p),t_grnd(c),p,c,xlat_d,xlon_d - errmsg=message - errflg=1 + ! errmsg=message + ! errflg=1 + write(0,'(A)') trim(message) unhappy = .true. endif endif @@ -1433,6 +1447,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! eflx_sh_grnd,eflx_sh_tot,eflx_soil_grnd, & !o t_lake,t_soisno,h2osoi_liq, & h2osoi_ice,savedtke1, & + watsat, tksatu, tkmg, tkdry, csol, dtime, & frac_iceold,qflx_snomelt,imelt,errmsg,errflg) !======================================================================================================= ! !DESCRIPTION: @@ -1522,6 +1537,11 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !in: integer, intent(inout) :: errflg + real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_phys), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_phys), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_phys), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) character(*), intent(inout) :: errmsg real(kind_phys), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) real(kind_phys), intent(inout) :: h2osno(1) ! snow water (mm H2O) @@ -1541,6 +1561,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) real(kind_phys), intent(inout) :: snowdp(1) !snow height (m) + real(kind_phys), intent(in) :: dtime !timestep !out: real(kind_phys), intent(out) :: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] @@ -1565,7 +1586,6 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! integer , parameter :: islak = 2 ! index of lake, 1 = deep lake, 2 = shallow lake real(kind_phys), parameter :: p0 = 1._kind_phys ! neutral value of turbulent prandtl number integer :: i,j,fc,fp,g,c,p ! do loop or array index - ! real(kind_phys) :: dtime ! land model time step (sec) real(kind_phys) :: beta(2) ! fraction solar rad absorbed at surface: depends on lake type real(kind_phys) :: za(2) ! base of surface absorption layer (m): depends on lake type real(kind_phys) :: eta(2) ! light extinction coefficient (/m): depends on lake type @@ -1648,8 +1668,6 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! 1!) Initialization ! Determine step size - ! dtime = get_step_size() - ! Initialize constants cwat = cpliq*denh2o ! water heat capacity per unit volume cice_eff = cpice*denh2o !use water density because layer depth is not adjusted @@ -1860,7 +1878,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! For snow / soil call SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & - tk, cv, tktopsoillay,errmsg,errflg) + watsat, tksatu, tkmg, tkdry, csol, tk, cv, tktopsoillay,errmsg,errflg) if(errflg/=0) then ! State is no longer valid, so return error to caller ! FIXME: PUT THIS BACK return @@ -1903,8 +1921,9 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! if(abs(t_soisno(c,j)-288) > 150) then 48 format('WARNING: At c=',I0,' level=',I0,' extreme t_soisno = ',F15.10) WRITE(message,48) c,j,t_soisno(c,j) - errmsg=trim(message) - errflg=1 + ! errmsg=trim(message) + ! errflg=1 + write(0,'(A)') trim(message) endif end if end do @@ -2115,6 +2134,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! column during Tridiagonal Solution,', 'error (W/m^2):', c, errsoi(c) errmsg=trim(message) errflg=1 + return end if end do ! This has to be done before convective mixing because the heat capacities for each layer @@ -2176,6 +2196,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! c, errsoi(c) errmsg=trim(message) errflg=1 + return end if end do @@ -2194,6 +2215,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! 'column, error (kg/m^2):', c, wsum_end(c)-wsum(c) errmsg=trim(message) errflg=1 + return end if end if end do @@ -2328,7 +2350,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! For snow / soil ! call SoilThermProp_Lake(lbc, ubc, num_shlakec, filter_shlakec, tk, cv, tktopsoillay) call SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & - tk, cv, tktopsoillay,errmsg,errflg) + watsat, tksatu, tkmg, tkdry, csol, tk, cv, tktopsoillay,errmsg,errflg) ! Do as above to sum energy content @@ -2400,7 +2422,7 @@ end subroutine ShalLakeTemperature ! ! !INTERFACE: subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & - tk, cv, tktopsoillay,errmsg,errflg) + watsat, tksatu, tkmg, tkdry, csol, tk, cv, tktopsoillay,errmsg,errflg) ! ! !DESCRIPTION: @@ -2428,11 +2450,11 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & character(*), intent(inout) :: errmsg integer , intent(in) :: snl(1) ! number of snow layers ! real(kind_phys), intent(in) :: h2osno(1) ! snow water (mm H2O) - ! real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - ! real(kind_phys), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - ! real(kind_phys), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - ! real(kind_phys), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - ! real(kind_phys), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_phys), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_phys), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_phys), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) real(kind_phys), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness (m) real(kind_phys), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) real(kind_phys), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) @@ -2500,8 +2522,9 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & ! satw = min(1._kind_phys, satw) if (satw < 0.999_kind_phys) then write(message,*)'WARNING: soil layer unsaturated in SoilThermProp_Lake, satw, j = ', satw, j - errmsg=trim(message) - errflg=1 + ! errmsg=trim(message) + ! errflg=1 + write(0,'(A)') trim(message) end if ! Could use denice because if it starts out frozen, the volume of water will go below sat., ! since we're not yet doing excess ice. @@ -2513,9 +2536,10 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & fl = h2osoi_liq(c,j)/denom else write(message,'(A,I0)') 'WARNING: zero h2osoi_ice+h2osoi_liq at j = ', j - errmsg=trim(message) - errflg=1 + ! errmsg=trim(message) + ! errflg=1 fl = 0 + write(0,'(A)') trim(message) endif if (t_soisno(c,j) >= tfrz) then ! Unfrozen soil dke = max(0._kind_phys, log10(satw) + 1.0_kind_phys) @@ -2675,7 +2699,6 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i integer :: j,c,g !do loop index integer :: fc !lake filtered column indices - ! real(kind_phys) :: dtime !land model time step (sec) real(kind_phys) :: heatavail !available energy for melting or freezing (J/m^2) real(kind_phys) :: heatrem !energy residual or loss after melting or freezing real(kind_phys) :: melt !actual melting (+) or freezing (-) [kg/m2] @@ -2683,8 +2706,6 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i logical :: dophasechangeflag !----------------------------------------------------------------------- - ! dtime = get_step_size() - ! Initialization !dir$ concurrent @@ -2846,7 +2867,8 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & qflx_evap_tot_col,soilalpha,zwt,fcov, & rootr_column,qflx_evap_grnd,qflx_sub_snow, & qflx_dew_snow,qflx_dew_grnd,qflx_rain_grnd_col, & - errmsg,errflg) + watsat, tksatu, tkmg, tkdry, csol, & + dtime,errmsg,errflg) !================================================================================== ! !DESCRIPTION: @@ -2892,9 +2914,15 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & integer, intent(inout) :: errflg character(*), intent(inout) :: errmsg + real(kind_phys) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_phys) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_phys) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_phys) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + ! integer , intent(in) :: clandunit(1) ! column's landunit ! integer , intent(in) :: ityplun(1) ! landunit type - ! real(kind_phys), intent(in) :: watsat(1,1:nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_phys), intent(in) :: dtime ! timestep real(kind_phys), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) real(kind_phys), intent(in) :: forc_rain(1) ! rain rate [mm/s] real(kind_phys), intent(in) :: forc_snow(1) ! snow rate [mm/s] @@ -2976,7 +3004,6 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & integer :: filter_shlakesnowc(ubc-lbc+1) ! column filter for snow points integer :: num_shlakenosnowc ! number of column non-snow points integer :: filter_shlakenosnowc(ubc-lbc+1) ! column filter for non-snow points - ! real(kind_phys) :: dtime ! land model time step (sec) integer :: newnode ! flag when new snow node is set, (1=yes, 0=no) real(kind_phys) :: dz_snowf ! layer thickness rate change due to precipitation [mm/s] real(kind_phys) :: bifall ! bulk density of newly fallen dry snow [kg/m3] @@ -2998,8 +3025,6 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & ! Determine step size - ! dtime = get_step_size() - ! Add soil water to water balance. do j = 1, nlevsoil !dir$ concurrent @@ -3215,7 +3240,7 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & num_shlakenosnowc, filter_shlakenosnowc, & !i snl,do_capsnow,qflx_snomelt,qflx_rain_grnd, & !i qflx_sub_snow,qflx_evap_grnd, & !i - qflx_dew_snow,qflx_dew_grnd,dz, & !i + qflx_dew_snow,qflx_dew_grnd,dz,dtime, & !i h2osoi_ice,h2osoi_liq, & !i&o qflx_top_soil) !o @@ -3249,7 +3274,7 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & call SnowCompaction(lbc, ubc, num_shlakesnowc, filter_shlakesnowc, &!i snl,imelt,frac_iceold,t_soisno, &!i - h2osoi_ice,h2osoi_liq, &!i + h2osoi_ice,h2osoi_liq,dtime, &!i dz) !&o ! Combine thin snow elements @@ -3457,9 +3482,9 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & if(j == 0 .and. abs(snow_water(c)-h2osno(c))>1.e-7_kind_phys) then write(message,*)'h2osno does not equal sum of snow layers in ShalLakeHydrology:', & 'column, h2osno, sum of snow layers =', c, h2osno(c), snow_water(c) - errmsg=trim(message) - errflg=1 - ! FIXME: PUT THIS BACK: return + ! errmsg=trim(message) + ! errflg=1 + write(0,'(A)') trim(message) end if end if end do @@ -3700,7 +3725,7 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i num_nosnowc, filter_nosnowc, & !i snl,do_capsnow,qflx_snomelt,qflx_rain_grnd, & !i qflx_sub_snow,qflx_evap_grnd, & !i - qflx_dew_snow,qflx_dew_grnd,dz, & !i + qflx_dew_snow,qflx_dew_grnd,dz,dtime, & !i h2osoi_ice,h2osoi_liq, & !i&o qflx_top_soil) !o !=============================================================================== @@ -3736,6 +3761,7 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i integer , intent(in) :: snl(1) !number of snow layers logical , intent(in) :: do_capsnow(1) !true => do snow capping + real(kind_phys), intent(in) :: dtime !timestep real(kind_phys), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) real(kind_phys), intent(in) :: qflx_rain_grnd(1) !rain on ground after interception (mm H2O/s) [+] real(kind_phys), intent(in) :: qflx_sub_snow(1) !sublimation rate from snow pack (mm H2O /s) [+] @@ -3862,7 +3888,7 @@ end subroutine SnowWater subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i snl,imelt,frac_iceold,t_soisno, &!i - h2osoi_ice,h2osoi_liq, &!i + h2osoi_ice,h2osoi_liq,dtime, &!i dz) !i&o @@ -3896,6 +3922,7 @@ subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points integer, intent(in) :: snl(1) !number of snow layers integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 + real(kind_phys), intent(in) :: dtime real(kind_phys), intent(in) :: frac_iceold(1,-nlevsnow+1:nlevsoil) !fraction of ice relative to the tot water real(kind_phys), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) real(kind_phys), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) @@ -4990,8 +5017,105 @@ subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) end subroutine MoninObukIni + !> \section arg_table_clm_lake_init Argument Table + !! \htmlinclude clm_lake_init.html + !! + subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,con_cliq, & + con_hfus,con_hvap,con_rd,con_cp,rhoice,errmsg,errflg) + implicit none + real(kind_phys), intent(in) :: con_pi,karman,con_g,con_sbc,con_t0c, & + rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp,rhoice + INTEGER, INTENT(OUT) :: errflg + CHARACTER(*), INTENT(OUT) :: errmsg + integer :: i, j + + if(LAKEDEBUG) then + write(0,*) 'clm_lake_init' + endif + + errflg=0 + errmsg='' + + pi = con_pi + vkc = karman + grav = con_g + sb = con_sbc + tfrz = con_t0c + denh2o = rhowater + denice = rhoice + cpice = con_csol + cpliq = con_cliq + hfus = con_hfus + hvap = con_hvap + hsub = con_hfus+con_hvap + rair = con_rd + cpair = con_cp + + ! dzlak(1) = 0.1_kind_phys + ! dzlak(2) = 1._kind_phys + ! dzlak(3) = 2._kind_phys + ! dzlak(4) = 3._kind_phys + ! dzlak(5) = 4._kind_phys + ! dzlak(6) = 5._kind_phys + ! dzlak(7) = 7._kind_phys + ! dzlak(8) = 7._kind_phys + ! dzlak(9) = 10.45_kind_phys + ! dzlak(10)= 10.45_kind_phys + ! + ! zlak(1) = 0.05_kind_phys + ! zlak(2) = 0.6_kind_phys + ! zlak(3) = 2.1_kind_phys + ! zlak(4) = 4.6_kind_phys + ! zlak(5) = 8.1_kind_phys + ! zlak(6) = 12.6_kind_phys + ! zlak(7) = 18.6_kind_phys + ! zlak(8) = 25.6_kind_phys + ! zlak(9) = 34.325_kind_phys + ! zlak(10)= 44.775_kind_phys + dzlak(1) = 0.1_kind_phys + dzlak(2) = 0.1_kind_phys + dzlak(3) = 0.1_kind_phys + dzlak(4) = 0.1_kind_phys + dzlak(5) = 0.1_kind_phys + dzlak(6) = 0.1_kind_phys + dzlak(7) = 0.1_kind_phys + dzlak(8) = 0.1_kind_phys + dzlak(9) = 0.1_kind_phys + dzlak(10)= 0.1_kind_phys + + zlak(1) = 0.05_kind_phys + zlak(2) = 0.15_kind_phys + zlak(3) = 0.25_kind_phys + zlak(4) = 0.35_kind_phys + zlak(5) = 0.45_kind_phys + zlak(6) = 0.55_kind_phys + zlak(7) = 0.65_kind_phys + zlak(8) = 0.75_kind_phys + zlak(9) = 0.85_kind_phys + zlak(10)= 0.95_kind_phys + + ! "0" refers to soil surface and "nlevsoil" refers to the bottom of model soil + + do j = 1, nlevsoil + zsoi(j) = scalez*(exp(0.5_kind_phys*(j-0.5_kind_phys))-1._kind_phys) !node depths + enddo + + dzsoi(1) = 0.5_kind_phys*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces + do j = 2,nlevsoil-1 + dzsoi(j)= 0.5_kind_phys*(zsoi(j+1)-zsoi(j-1)) + enddo + dzsoi(nlevsoil) = zsoi(nlevsoil)-zsoi(nlevsoil-1) + + zisoi(0) = 0._kind_phys + do j = 1, nlevsoil-1 + zisoi(j) = 0.5_kind_phys*(zsoi(j)+zsoi(j+1)) !interface depths + enddo + zisoi(nlevsoil) = zsoi(nlevsoil) + 0.5_kind_phys*dzsoi(nlevsoil) + + end subroutine clm_lake_init + ! Some fields in lakeini are not available until runtime, so this cannot be in a CCPP init routine. - SUBROUTINE lakeini( ISLTYP, gt0, SNOW, & !i + SUBROUTINE lakeini(kdt, ISLTYP, gt0, SNOW, & !i restart, lakedepth_default, & lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & @@ -5016,11 +5140,11 @@ SUBROUTINE lakeini( ISLTYP, gt0, SNOW, INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg - INTEGER , INTENT (IN) :: im, me, master, km + INTEGER , INTENT (IN) :: im, me, master, km, kdt REAL(KIND_PHYS), INTENT(IN) :: xice_threshold, con_g, con_rd REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: XICE,TG3 REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc - INTEGER, DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized + REAL(KIND_PHYS), DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized integer, dimension(IM), intent(in) :: use_lake_model !INTEGER , INTENT (IN) :: lakeflag @@ -5079,7 +5203,6 @@ SUBROUTINE lakeini( ISLTYP, gt0, SNOW, real(kind_phys),dimension(1:im ) :: clay2d ! temporary real(kind_phys),dimension(1:im ) :: sand2d ! temporary - real(kind_phys),parameter :: scalez = 0.025_kind_phys ! Soil layer thickness discretization (m) logical,parameter :: arbinit = .false. real(kind_phys),parameter :: defval = -999.0 integer :: isl @@ -5094,83 +5217,30 @@ SUBROUTINE lakeini( ISLTYP, gt0, SNOW, used_lakedepth_default=0 - if(LAKEDEBUG .and. me==0) then - write(0,*) 'clm_lake_init' - endif - errmsg = '' errflg = 0 - !IF ( RESTART ) RETURN <--- should be handled by clm_lake_initialized - - init_const: if(sum(clm_lake_initialized(1:im))==0 .and. any(use_lake_model/=0)) then - - ! dzlak(1) = 0.1_kind_phys - ! dzlak(2) = 1._kind_phys - ! dzlak(3) = 2._kind_phys - ! dzlak(4) = 3._kind_phys - ! dzlak(5) = 4._kind_phys - ! dzlak(6) = 5._kind_phys - ! dzlak(7) = 7._kind_phys - ! dzlak(8) = 7._kind_phys - ! dzlak(9) = 10.45_kind_phys - ! dzlak(10)= 10.45_kind_phys - ! - ! zlak(1) = 0.05_kind_phys - ! zlak(2) = 0.6_kind_phys - ! zlak(3) = 2.1_kind_phys - ! zlak(4) = 4.6_kind_phys - ! zlak(5) = 8.1_kind_phys - ! zlak(6) = 12.6_kind_phys - ! zlak(7) = 18.6_kind_phys - ! zlak(8) = 25.6_kind_phys - ! zlak(9) = 34.325_kind_phys - ! zlak(10)= 44.775_kind_phys - dzlak(1) = 0.1_kind_phys - dzlak(2) = 0.1_kind_phys - dzlak(3) = 0.1_kind_phys - dzlak(4) = 0.1_kind_phys - dzlak(5) = 0.1_kind_phys - dzlak(6) = 0.1_kind_phys - dzlak(7) = 0.1_kind_phys - dzlak(8) = 0.1_kind_phys - dzlak(9) = 0.1_kind_phys - dzlak(10)= 0.1_kind_phys - - zlak(1) = 0.05_kind_phys - zlak(2) = 0.15_kind_phys - zlak(3) = 0.25_kind_phys - zlak(4) = 0.35_kind_phys - zlak(5) = 0.45_kind_phys - zlak(6) = 0.55_kind_phys - zlak(7) = 0.65_kind_phys - zlak(8) = 0.75_kind_phys - zlak(9) = 0.85_kind_phys - zlak(10)= 0.95_kind_phys - - ! "0" refers to soil surface and "nlevsoil" refers to the bottom of model soil - - do j = 1, nlevsoil - zsoi(j) = scalez*(exp(0.5_kind_phys*(j-0.5_kind_phys))-1._kind_phys) !node depths - enddo - - dzsoi(1) = 0.5_kind_phys*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces - do j = 2,nlevsoil-1 - dzsoi(j)= 0.5_kind_phys*(zsoi(j+1)-zsoi(j-1)) - enddo - dzsoi(nlevsoil) = zsoi(nlevsoil)-zsoi(nlevsoil-1) - - zisoi(0) = 0._kind_phys - do j = 1, nlevsoil-1 - zisoi(j) = 0.5_kind_phys*(zsoi(j)+zsoi(j+1)) !interface depths - enddo - zisoi(nlevsoil) = zsoi(nlevsoil) + 0.5_kind_phys*dzsoi(nlevsoil) - endif init_const - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DO i=1,im - if(use_lake_model(i)==0 .or. clm_lake_initialized(i)>0) then + if(use_lake_model(i)==0) then + cycle + endif + + if(kdt<2) then + ! To handle restarts with bad lakedepth2d + if ( use_lakedepth ) then + if (lakedepth2d(i) <= 0.0) then + lakedepth2d(i) = lakedepth_default + used_lakedepth_default = used_lakedepth_default+1 + endif + else + lakedepth2d(i) = lakedepth_default + used_lakedepth_default = used_lakedepth_default+1 + endif + endif + + if(clm_lake_initialized(i)>0) then cycle endif @@ -5204,15 +5274,6 @@ SUBROUTINE lakeini( ISLTYP, gt0, SNOW, lake_icefrac3d(i,:) = 0.0 h2osoi_vol3d(i,:) = 0.0 snl2d(i) = 0.0 - if ( use_lakedepth ) then - if (lakedepth2d(i) <= 0.0) then - lakedepth2d(i) = lakedepth_default - used_lakedepth_default = used_lakedepth_default+1 - endif - else - lakedepth2d(i) = lakedepth_default - used_lakedepth_default = used_lakedepth_default+1 - endif ENDDO @@ -5238,6 +5299,8 @@ SUBROUTINE lakeini( ISLTYP, gt0, SNOW, do k = 1,nlevsoil sand3d(i,k) = sand(isl) clay3d(i,k) = clay(isl) + + ! Cannot continue if either of these checks fail. if(clay3d(i,k)>0 .and. clay3d(i,k)<1) then write(message,*) 'bad clay3d ',clay3d(i,k) write(0,'(A)') trim(message) @@ -5277,11 +5340,6 @@ SUBROUTINE lakeini( ISLTYP, gt0, SNOW, watopt3d(i,k) = watsat3d(i,k) * (158490._kind_phys/sucsat3d(i,k)) ** (-1._kind_phys/bsw3d(i,k)) end do if (lakedepth2d(i) == spval) then - if(LAKEDEBUG) then - errmsg='should not get here: lakedepth2d is spval ' - errflg=1 - return - endif lakedepth2d(i) = zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake) z_lake3d(i,1:nlevlake) = zlak(1:nlevlake) dz_lake3d(i,1:nlevlake) = dzlak(1:nlevlake) @@ -5423,7 +5481,7 @@ SUBROUTINE lakeini( ISLTYP, gt0, SNOW, do k = -nlevsnow+1, 0 if (k > snl2d(i)) then - h2osoi_ice3d(i,k) = dz3d(i,k)*bdsno + h2osoi_ice3d(i,k) = dz3d(i,k)*snow_bd h2osoi_liq3d(i,k) = 0._kind_phys end if end do diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 5f2f6db3f..9fd286afd 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -439,7 +439,8 @@ long_name = set to true in clm_lake_run after likeini is called, as a workaround for ccpp limitation units = flag dimensions = (horizontal_loop_extent) - type = integer + type = real + kind = kind_phys intent = inout [isltyp] standard_name = soil_type_classification @@ -609,7 +610,7 @@ type = real kind = kind_phys intent = inout -[T_snow] +[lake_t_snow] standard_name = temperature_of_snow_on_lake long_name = the temperature of snow on a lake units = K @@ -617,7 +618,7 @@ type = real kind = kind_phys intent = inout -[T_ice] +[tisfc] standard_name = surface_skin_temperature_over_ice long_name = surface skin temperature over ice units = K @@ -663,6 +664,137 @@ dimensions = () type = integer intent = in +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-arg-table] + name = clm_lake_init + type = scheme +[con_pi] + standard_name = pi + long_name = ratio of a circle's circumference to its diameter + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[karman] + standard_name = von_karman_constant + long_name = Von Karman constant + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_sbc] + standard_name = stefan_boltzmann_constant + long_name = Stefan-Boltzmann constant + units = W m-2 K-4 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degree Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in +[rhowater] + standard_name = fresh_liquid_water_density_at_0c + long_name = density of liquid water + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_rd] + standard_name = gas_constant_of_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in +[rhoice] + standard_name = density_of_ice_on_lake + long_name = density of ice on a lake + units = kg m-3 + dimensions = () + type = real + kind = kind_phys + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/physcons.F90 b/physics/physcons.F90 index 41d37491a..a8792eed3 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -139,6 +139,7 @@ module physcons real(kind=kind_phys),parameter:: rhowater = 1000._kind_phys !< density of water (kg/m^3) real(kind=kind_phys),parameter:: rhosnow = 100._kind_phys !< density of snow (kg/m^3) real(kind=kind_phys),parameter:: rhoair = 1.28_kind_phys !< density of air near surface (kg/m^3) + real(kind=kind_phys),parameter:: rhoice = 0.917e3_kind_phys !< density of ice on lake (kg/m^3) ! Decorrelation length constant (km) for iovr = 4 or 5 and idcor = 0 real(kind=kind_phys),parameter:: decorr_con = 2.50_kind_phys diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index c21d3a989..31bd4aaf2 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -24,6 +24,8 @@ end subroutine sfc_diag_finalize subroutine sfc_diag_run & & (im,grav,cp,eps,epsm1,ps,u1,v1,t1,q1,prslki, & & evap,fm,fh,fm10,fh2,tskin,qsurf,thsfc_loc, & + & use_lake_model,iopt_lake,iopt_lake_clm, & + & lake_t2m,lake_q2m, & & f10m,u10m,v10m,t2m,q2m,errmsg,errflg & & ) ! @@ -31,14 +33,16 @@ subroutine sfc_diag_run & use funcphys, only : fpvs implicit none ! - integer, intent(in) :: im + integer, intent(in) :: im, iopt_lake, iopt_lake_clm logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. real(kind=kind_phys), intent(in) :: grav,cp,eps,epsm1 real(kind=kind_phys), dimension(:), intent(in) :: & & ps, u1, v1, t1, q1, tskin, & & qsurf, prslki, evap, fm, fh, fm10, fh2 real(kind=kind_phys), dimension(:), intent(out) :: & - & f10m, u10m, v10m, t2m, q2m + & f10m, u10m, v10m, t2m, q2m, lake_t2m, & + & lake_q2m + integer, dimension(:), intent(in) :: use_lake_model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -48,6 +52,7 @@ subroutine sfc_diag_run & integer :: k,i ! real(kind=kind_phys) :: fhi, qss, wrk + ! real(kind=kind_phys) sig2k, fhi, qss ! ! real, parameter :: g=grav @@ -69,29 +74,32 @@ subroutine sfc_diag_run & ! f10m(i) = min(f10m(i),1.) u10m(i) = f10m(i) * u1(i) v10m(i) = f10m(i) * v1(i) - fhi = fh2(i) / fh(i) -! t2m(i) = tskin(i)*(1. - fhi) + t1(i) * prslki(i) * fhi -! sig2k = 1. - (grav+grav) / (cp * t2m(i)) -! t2m(i) = t2m(i) * sig2k - wrk = 1.0 - fhi - - - if(thsfc_loc) then ! Use local potential temperature - t2m(i) = tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp - else ! Use potential temperature referenced to 1000 hPa - t2m(i) = tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp - endif + if(use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then + t2m(i) = lake_t2m(i) + q2m(i) = lake_q2m(i) + else + fhi = fh2(i) / fh(i) +! t2m(i) = tskin(i)*(1. - fhi) + t1(i) * prslki(i) * fhi +! sig2k = 1. - (grav+grav) / (cp * t2m(i)) +! t2m(i) = t2m(i) * sig2k + wrk = 1.0 - fhi + if(thsfc_loc) then ! Use local potential temperature + t2m(i) = tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp + else ! Use potential temperature referenced to 1000 hPa + t2m(i) = tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp + endif - if(evap(i) >= 0.) then ! for evaporation>0, use inferred qsurf to deduce q2m - q2m(i) = qsurf(i)*wrk + max(qmin,q1(i))*fhi - else ! for dew formation, use saturated q at tskin - qss = fpvs(tskin(i)) - qss = eps * qss / (ps(i) + epsm1 * qss) - q2m(i) = qss*wrk + max(qmin,q1(i))*fhi + if(evap(i) >= 0.) then ! for evaporation>0, use inferred qsurf to deduce q2m + q2m(i) = qsurf(i)*wrk + max(qmin,q1(i))*fhi + else ! for dew formation, use saturated q at tskin + qss = fpvs(tskin(i)) + qss = eps * qss / (ps(i) + epsm1 * qss) + q2m(i) = qss*wrk + max(qmin,q1(i))*fhi + endif + qss = fpvs(t2m(i)) + qss = eps * qss / (ps(i) + epsm1 * qss) + q2m(i) = min(q2m(i),qss) endif - qss = fpvs(t2m(i)) - qss = eps * qss / (ps(i) + epsm1 * qss) - q2m(i) = min(q2m(i),qss) enddo return diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index dd3bf79b8..3bbb5de03 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -157,6 +157,43 @@ dimensions = () type = logical intent = in +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[lake_t2m] + standard_name = temperature_at_2m_from_clm_lake + long_name = temperature at 2m from clm lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[lake_q2m] + standard_name = specific_humidity_at_2m_from_clm_lake + long_name = specific humidity at 2m from clm lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [f10m] standard_name = ratio_of_wind_at_surface_adjacent_layer_to_wind_at_10m long_name = ratio of fm10 and fm From ab90e244ec689589d16bc0cd3e33547466af3124 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 18 Aug 2022 22:03:27 +0000 Subject: [PATCH 04/46] lsm_ruc bugfix: flag_for_using_flake => flag_for_using_lake_model --- physics/lsm_ruc.meta | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/lsm_ruc.meta b/physics/lsm_ruc.meta index 9e56e2941..067e13424 100644 --- a/physics/lsm_ruc.meta +++ b/physics/lsm_ruc.meta @@ -780,8 +780,8 @@ type = logical intent = in [use_lake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer From be305d579b35c779d096df969906a2c22bbf23b4 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 25 Aug 2022 18:31:36 +0000 Subject: [PATCH 05/46] various snow bug fixes --- physics/clm_lake.f90 | 74 ++++++++++++++++++++++++------------------- physics/clm_lake.meta | 50 +++++++++++++++++++++-------- physics/sfc_diag.f | 22 ++++++++++--- physics/sfc_diag.meta | 16 +++++++++- 4 files changed, 110 insertions(+), 52 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index a07f48d40..2efce1431 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -131,7 +131,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& xlat_d ,z_lake3d ,dz_lake3d ,lakedepth2d ,& watsat3d ,csol3d ,tkmg3d ,tkdry3d ,& tksatu3d ,phii ,& - xice, xice_threshold ,im,km ,& + fice ,min_lakeice ,im,km ,& h2osno2d ,snowdp2d ,snl2d ,z3d ,& !h dz3d ,zi3d ,h2osoi_vol3d ,h2osoi_liq3d ,& h2osoi_ice3d ,t_grnd2d ,t_soisno3d ,t_lake3d ,& @@ -140,11 +140,11 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& con_cp ,icy ,& hflx ,evap ,grdflx ,tsfc ,& !o lake_t2m ,lake_q2m ,clm_lake_initialized ,& - isltyp ,snow ,use_lakedepth ,& + weasd ,isltyp ,snowd ,use_lakedepth ,& restart ,lakedepth_default ,& - sand3d ,clay3d ,& + rainnc ,rainc ,sand3d ,clay3d ,& ! Flake output variables - weasd ,snwdph ,hice ,tsurf ,& + weasdi ,snodi ,hice ,tsurf ,& t_sfc ,lflx ,ustar ,qsfc ,& ch ,cm ,chh ,cmm ,& lake_t_snow ,tisfc ,tsurf_ice ,wind ,& @@ -168,17 +168,18 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& INTEGER , INTENT (IN) :: im,km,me,master LOGICAL, INTENT(IN) :: restart,use_lakedepth,first_time_step REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) - REAL(KIND_PHYS), INTENT(IN) :: xice_threshold, con_rd,con_g,con_cp,lakedepth_default + REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_rd,con_g,con_cp,lakedepth_default logical, intent(inout) :: icy(:) - REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: XICE + REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: fice + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: weasd, snowd REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN):: tg3 - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: SNOW, ZLVL + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: ZLVL, RAINC, RAINNC INTEGER, DIMENSION(:), INTENT(IN) :: use_lake_model real(kind_phys), dimension(:), intent(in) :: rho0 ! air density at surface REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT) :: & - weasd ,snwdph ,hice ,tsurf ,& + weasdi ,snodi ,hice ,tsurf ,& t_sfc ,lflx ,ustar ,qsfc ,& chh ,cmm ,lake_t_snow ,tisfc ,& tsurf_ice ,wind @@ -304,7 +305,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& real(kind_phys) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) real(kind_phys) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) - integer :: lake_points + integer :: lake_points, snow_points, ice_points character*255 :: message logical, parameter :: feedback_to_atmosphere = .true. ! FIXME: REMOVE @@ -361,18 +362,18 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif ! Still have some points to initialize - call lakeini(kdt, ISLTYP, gt0, SNOW, & !i - restart, lakedepth_default, & + call lakeini(kdt, ISLTYP, gt0, snowd, & !i + weasd, restart, lakedepth_default, & lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & zi3d, watsat3d, csol3d, tkmg3d, & - xice, xice_threshold, tsfc, & + fice, min_lakeice, tsfc, & use_lake_model, use_lakedepth, con_g, con_rd, & tkdry3d, tksatu3d, im, prsi, & clm_lake_initialized, & - sand3d, clay3d, tg3, & + sand3d, clay3d, tg3, & km, me, master, errmsg, errflg) if(errflg/=0) then return @@ -391,6 +392,8 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif lake_points=0 + snow_points=0 + ice_points=0 lake_top_loop: DO I = 1,im @@ -401,6 +404,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& PSFC = prsi(i,1) Q2K = qvcurr(i) LWDN = DLWSFCI(I)*EMISS(I) + PRCP = denh2o * (rainc(i)+rainnc(i))*1000.0_kind_phys/dtime PRCP = RAIN(i)*1000.0_kind_phys/dtime ! use physics timestep since PRCP comes from non-surface schemes SOLDN = DSWSFCI(I) ! SOLDN is total incoming solar SOLNET = SOLDN*(1.-ALBEDO(I)) ! use mid-day albedo to determine net downward solar @@ -543,14 +547,15 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& !TH2(I) = T2(I)*(1.E5/PSFC)**RCP ! potential temperature (CCPP doesn't want this) lake_q2m(I) = q_ref2m(c) ! [frac] specific humidity albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + ( (1.0-lake_icefrac3d(i,1)) * 0.08) - xice(i) = lake_icefrac3d(i,1) + fice(i) = lake_icefrac3d(i,1) - if(xice(i)>xice_threshold) then - weasd(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice - snwdph(i) = h2osno(c)/snow_bd*1000 ! surface_snow_thickness_water_equivalent_over_ice + if(fice(i)>=min_lakeice) then + weasdi(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice + snodi(i) = snowdp(c) ! surface_snow_thickness_water_equivalent_over_ice tisfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice icy(i)=.true. + ice_points = ice_points+1 ! Assume that, if a layer has ice, the entire layer thickness is ice. hice(I) = 0 @@ -560,16 +565,19 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif end do else - weasd(i) = 0 - snwdph(i) = 0 + weasdi(i) = 0 + snodi(i) = 0 tisfc(i) = tsurf(i) tsurf_ice(i) = tisfc(i) hice(i) = 0 endif - if(snl2d(i)>0) then + if(snl2d(i)<0) then lake_t_snow(i) = t_grnd(c) tisfc(i) = lake_t_snow(i) + snow_points = snow_points+1 + else + lake_t_snow(i) = -9999 endif ustar = ustar_out(1) ! surface_friction_velocity_over_water @@ -586,9 +594,9 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif if_lake_is_here ENDDO lake_top_loop - if(LAKEDEBUG .and. lake_points>0) then -3082 format('lake points processed in timestep ',I0,' by rank ',I0,' = ',I0) - print 3082,kdt,me,lake_points + if(LAKEDEBUG .and. lake_points>0 .and. (kdt<3 .or. mod(kdt,30)==3)) then +3082 format('lake points processed in timestep ',I0,' by rank ',I0,' = ',I0,' snow=',I0,' ice=',I0) + print 3082,kdt,me,lake_points,snow_points,ice_points endif CONTAINS @@ -5115,14 +5123,14 @@ subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,c end subroutine clm_lake_init ! Some fields in lakeini are not available until runtime, so this cannot be in a CCPP init routine. - SUBROUTINE lakeini(kdt, ISLTYP, gt0, SNOW, & !i - restart, lakedepth_default, & + SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, & !i + weasd, restart, lakedepth_default, & lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & zi3d, watsat3d, csol3d, tkmg3d, & - xice, xice_threshold, tsfc, & + fice, min_lakeice, tsfc, & use_lake_model, use_lakedepth, con_g, con_rd, & tkdry3d, tksatu3d, im, prsi, & clm_lake_initialized, & @@ -5141,8 +5149,8 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, SNOW, CHARACTER(*), INTENT(OUT) :: errmsg INTEGER , INTENT (IN) :: im, me, master, km, kdt - REAL(KIND_PHYS), INTENT(IN) :: xice_threshold, con_g, con_rd - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: XICE,TG3 + REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_g, con_rd + REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: FICE,TG3 REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc REAL(KIND_PHYS), DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized @@ -5153,7 +5161,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, SNOW, LOGICAL , INTENT(IN) :: restart INTEGER, DIMENSION(IM), INTENT(IN) :: ISLTYP - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN) :: SNOW + REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN) :: snowd,weasd REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0, prsi real(kind_phys), intent(in) :: lakedepth_default @@ -5244,8 +5252,8 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, SNOW, cycle endif - snowdp2d(i) = snow(i)*0.005 ! SNOW in kg/m^2 and snowdp in m - h2osno2d(i) = snow(i) ! mm + snowdp2d(i) = snowd(i) ! SNOW in kg/m^2 and snowdp in m + h2osno2d(i) = weasd(i) ! mm snl2d(i) = defval do k = -nlevsnow+1,nlevsoil @@ -5262,8 +5270,8 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, SNOW, dz_lake3d(i,k) = defval enddo - if(xice(i).gt.xice_threshold) then - lake_icefrac3d(i,1) = xice(i) + if(fice(i)>min_lakeice) then + lake_icefrac3d(i,1) = fice(i) endif z3d(i,:) = 0.0 diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 9fd286afd..0fd782856 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -7,6 +7,22 @@ [ccpp-arg-table] name = clm_lake_run type = scheme +[rainnc] + standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep + long_name = explicit rainfall from previous timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[rainc] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_previous_timestep + long_name = convective_precipitation_amount from previous timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [tg3] standard_name = deep_soil_temperature long_name = deep soil temperature @@ -236,7 +252,7 @@ type = real kind = kind_phys intent = in -[xice] +[fice] standard_name = sea_ice_area_fraction_of_sea_area_fraction long_name = ice fraction over open water units = frac @@ -244,7 +260,7 @@ type = real kind = kind_phys intent = inout -[xice_threshold] +[min_lakeice] standard_name = min_lake_ice_area_fraction long_name = minimum lake ice value units = frac @@ -421,7 +437,7 @@ [lake_t2m] standard_name = temperature_at_2m_from_clm_lake long_name = temperature at 2m from clm lake - units = frac + units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -449,14 +465,6 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout -[snow] - standard_name = surface_snow_thickness_water_equivalent_over_land - long_name = water equivalent snow depth over land - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [use_lakedepth] standard_name = flag_for_initializing_clm_lake_depth_from_lake_depth long_name = flag for initializing clm lake depth from lake depth @@ -515,14 +523,30 @@ type = integer intent = inout [weasd] + standard_name = lwe_thickness_of_surface_snow_amount + long_name = water equiv of acc snow depth over land and sea ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[snowd] + standard_name = lwe_surface_snow + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[weasdi] standard_name = water_equivalent_accumulated_snow_depth_over_ice - long_name = water equiv of acc snow depth over ice + long_name = water equiv of acc snow depth over land units = mm dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[snwdph] +[snodi] standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice units = mm diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 31bd4aaf2..1312395e2 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -5,8 +5,11 @@ !! @{ module sfc_diag - contains + + logical, parameter :: LAKEDEBUG = .true. + contains + subroutine sfc_diag_init end subroutine sfc_diag_init @@ -25,7 +28,7 @@ subroutine sfc_diag_run & & (im,grav,cp,eps,epsm1,ps,u1,v1,t1,q1,prslki, & & evap,fm,fh,fm10,fh2,tskin,qsurf,thsfc_loc, & & use_lake_model,iopt_lake,iopt_lake_clm, & - & lake_t2m,lake_q2m, & + & lake_t2m,lake_q2m,kdt,me, & & f10m,u10m,v10m,t2m,q2m,errmsg,errflg & & ) ! @@ -33,14 +36,15 @@ subroutine sfc_diag_run & use funcphys, only : fpvs implicit none ! - integer, intent(in) :: im, iopt_lake, iopt_lake_clm + integer, intent(in) :: im, iopt_lake, iopt_lake_clm, kdt, me logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. real(kind=kind_phys), intent(in) :: grav,cp,eps,epsm1 real(kind=kind_phys), dimension(:), intent(in) :: & & ps, u1, v1, t1, q1, tskin, & & qsurf, prslki, evap, fm, fh, fm10, fh2 real(kind=kind_phys), dimension(:), intent(out) :: & - & f10m, u10m, v10m, t2m, q2m, lake_t2m, & + & f10m, u10m, v10m, t2m, q2m + real(kind=kind_phys), dimension(:), intent(in) :: lake_t2m, & & lake_q2m integer, dimension(:), intent(in) :: use_lake_model character(len=*), intent(out) :: errmsg @@ -49,7 +53,7 @@ subroutine sfc_diag_run & ! locals ! real(kind=kind_phys), parameter :: qmin=1.0e-8 - integer :: k,i + integer :: k,i, clm_t2m_count ! real(kind=kind_phys) :: fhi, qss, wrk @@ -69,6 +73,7 @@ subroutine sfc_diag_run & ! ps is in pascals ! !! + clm_t2m_count=0 do i = 1, im f10m(i) = fm10(i) / fm(i) ! f10m(i) = min(f10m(i),1.) @@ -77,6 +82,7 @@ subroutine sfc_diag_run & if(use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then t2m(i) = lake_t2m(i) q2m(i) = lake_q2m(i) + clm_t2m_count=clm_t2m_count+1 else fhi = fh2(i) / fh(i) ! t2m(i) = tskin(i)*(1. - fhi) + t1(i) * prslki(i) * fhi @@ -102,6 +108,12 @@ subroutine sfc_diag_run & endif enddo + if(LAKEDEBUG .and. clm_t2m_count>0 .and. kdt<5) then +3082 format('lake 2m points processed in timestep ',I0, & + & ' by rank ',I0,' = ',I0) + print 3082,kdt,me,clm_t2m_count + endif + return end subroutine sfc_diag_run !> @} diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index 3bbb5de03..00f725cb8 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -181,7 +181,7 @@ [lake_t2m] standard_name = temperature_at_2m_from_clm_lake long_name = temperature at 2m from clm lake - units = frac + units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -194,6 +194,20 @@ type = real kind = kind_phys intent = in +[kdt] + standard_name = index_of_timestep + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in [f10m] standard_name = ratio_of_wind_at_surface_adjacent_layer_to_wind_at_10m long_name = ratio of fm10 and fm From 0c1f94999109915823e9b1824dfa889ce1791ff7 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 25 Aug 2022 19:11:16 +0000 Subject: [PATCH 06/46] rainnc and rainc do not exist --- physics/clm_lake.f90 | 5 ++--- physics/clm_lake.meta | 16 ---------------- 2 files changed, 2 insertions(+), 19 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 2efce1431..43c6711be 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -142,7 +142,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& lake_t2m ,lake_q2m ,clm_lake_initialized ,& weasd ,isltyp ,snowd ,use_lakedepth ,& restart ,lakedepth_default ,& - rainnc ,rainc ,sand3d ,clay3d ,& + sand3d ,clay3d ,& ! Flake output variables weasdi ,snodi ,hice ,tsurf ,& t_sfc ,lflx ,ustar ,qsfc ,& @@ -173,7 +173,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: fice REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: weasd, snowd REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN):: tg3 - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: ZLVL, RAINC, RAINNC + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: ZLVL INTEGER, DIMENSION(:), INTENT(IN) :: use_lake_model real(kind_phys), dimension(:), intent(in) :: rho0 ! air density at surface @@ -404,7 +404,6 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& PSFC = prsi(i,1) Q2K = qvcurr(i) LWDN = DLWSFCI(I)*EMISS(I) - PRCP = denh2o * (rainc(i)+rainnc(i))*1000.0_kind_phys/dtime PRCP = RAIN(i)*1000.0_kind_phys/dtime ! use physics timestep since PRCP comes from non-surface schemes SOLDN = DSWSFCI(I) ! SOLDN is total incoming solar SOLNET = SOLDN*(1.-ALBEDO(I)) ! use mid-day albedo to determine net downward solar diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 0fd782856..8e213f06c 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -7,22 +7,6 @@ [ccpp-arg-table] name = clm_lake_run type = scheme -[rainnc] - standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep - long_name = explicit rainfall from previous timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[rainc] - standard_name = lwe_thickness_of_convective_precipitation_amount_on_previous_timestep - long_name = convective_precipitation_amount from previous timestep - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [tg3] standard_name = deep_soil_temperature long_name = deep soil temperature From 0ecd6207a41f3e806fc6fa062247e96743f6fbf5 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 25 Aug 2022 19:33:40 +0000 Subject: [PATCH 07/46] remove bad unit conversion --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 43c6711be..4002f941d 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -404,7 +404,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& PSFC = prsi(i,1) Q2K = qvcurr(i) LWDN = DLWSFCI(I)*EMISS(I) - PRCP = RAIN(i)*1000.0_kind_phys/dtime ! use physics timestep since PRCP comes from non-surface schemes + PRCP = RAIN(i)/dtime ! [mm/s] use physics timestep since PRCP comes from non-surface schemes SOLDN = DSWSFCI(I) ! SOLDN is total incoming solar SOLNET = SOLDN*(1.-ALBEDO(I)) ! use mid-day albedo to determine net downward solar ! (no solar zenith angle correction) From bbe1a16d30037b33849e1ebed64cb888da383a20 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 25 Aug 2022 20:23:52 +0000 Subject: [PATCH 08/46] unit conversion issue --- physics/clm_lake.f90 | 2 +- physics/clm_lake.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 4002f941d..cfaea7cfc 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -5251,7 +5251,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, cycle endif - snowdp2d(i) = snowd(i) ! SNOW in kg/m^2 and snowdp in m + snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m h2osno2d(i) = weasd(i) ! mm snl2d(i) = defval diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 8e213f06c..8cc2accb4 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -277,7 +277,7 @@ [snowdp2d] standard_name = actual_snow_depth_in_clm_lake_model long_name = actual acc snow depth over lake in clm lake model - units = mm + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys From 9a07ae9abbe47516b5415997712a0f887a8aa57f Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 25 Aug 2022 21:19:57 +0000 Subject: [PATCH 09/46] LAKEDEBUG is now clm_lake_debug namelist parameter --- physics/clm_lake.f90 | 8 +++++--- physics/clm_lake.meta | 8 ++++++++ physics/sfc_diag.f | 8 -------- 3 files changed, 13 insertions(+), 11 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index cfaea7cfc..9b8db78b8 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -31,7 +31,7 @@ MODULE clm_lake implicit none - logical, parameter :: LAKEDEBUG = .true. ! Enable lots of checks and debug prints and errors + logical :: LAKEDEBUG = .false. ! Enable lots of checks and debug prints and errors logical, parameter :: PERGRO = .false. @@ -357,7 +357,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif ! At this point, at least one thread should have read in the unhappy points. if(unhappy_count==FAILED_TO_READ_UNHAPPY_POINTS .and. kdt<2) then - write(0,'(A)') "ERROR: Could not read unhappy points" + write(0,'(A)') "Could not read unhappy points. Will not print unhappy point data." endif endif @@ -5028,14 +5028,16 @@ end subroutine MoninObukIni !! \htmlinclude clm_lake_init.html !! subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,con_cliq, & - con_hfus,con_hvap,con_rd,con_cp,rhoice,errmsg,errflg) + con_hfus,con_hvap,con_rd,con_cp,rhoice,clm_lake_debug,errmsg,errflg) implicit none real(kind_phys), intent(in) :: con_pi,karman,con_g,con_sbc,con_t0c, & rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp,rhoice INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg + logical, intent(in) :: clm_lake_debug integer :: i, j + LAKEDEBUG = clm_lake_debug if(LAKEDEBUG) then write(0,*) 'clm_lake_init' endif diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 8cc2accb4..1fd67984c 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -803,6 +803,14 @@ type = real kind = kind_phys intent = in +[clm_lake_debug] + standard_name = flag_for_verbose_debugging_in_clm_lake_model + long_name = flag for verbose debugging in clm lake model + units = flag + dimensions = () + type = logical + active = (control_for_lake_model_selection == 3) + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 1312395e2..a8e87b9ac 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -6,8 +6,6 @@ module sfc_diag - logical, parameter :: LAKEDEBUG = .true. - contains subroutine sfc_diag_init @@ -108,12 +106,6 @@ subroutine sfc_diag_run & endif enddo - if(LAKEDEBUG .and. clm_t2m_count>0 .and. kdt<5) then -3082 format('lake 2m points processed in timestep ',I0, & - & ' by rank ',I0,' = ',I0) - print 3082,kdt,me,clm_t2m_count - endif - return end subroutine sfc_diag_run !> @} From 757a4eb2a18d62fcad2df6112b9865b915b12b7a Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Fri, 26 Aug 2022 19:30:17 +0000 Subject: [PATCH 10/46] tweaks for salty lakes --- physics/clm_lake.f90 | 213 ++++++++++++++++++++++++++++++++++++++---- physics/clm_lake.meta | 22 +++++ 2 files changed, 216 insertions(+), 19 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 9b8db78b8..1a2f88d80 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -31,6 +31,10 @@ MODULE clm_lake implicit none + private + + public :: clm_lake_run, clm_lake_init, LAKEDEBUG + logical :: LAKEDEBUG = .false. ! Enable lots of checks and debug prints and errors logical, parameter :: PERGRO = .false. @@ -119,8 +123,122 @@ MODULE clm_lake real(kind_phys) :: dzsoi(1:nlevsoil) !soil dz (thickness) real(kind_phys) :: zisoi(0:nlevsoil) !soil zi (interfaces) + real, parameter :: SaltLk_T(1:25) = (/0.5, 0.,-0.5, 3., 4., 7., 8., 12., 13., 16., 19., 21., & + 23.5, 25.,26.,24.,23.,20.5,18.,15., 11.5, 8., 4., 1., 0.5/) + real, parameter :: julm(1:13) = (/0,31,59,90,120,151,181,212,243,273,304,334,365/) + CONTAINS + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + subroutine get_month_and_day(IDATE,month,day_of_month,day_of_year,fhour) + implicit none + integer, intent(in) :: IDATE(4) + integer, intent(out) :: month,day_of_month,day_of_year + real(kind_phys), intent(in) :: fhour + + integer :: idat(8),jdat(8), w3kindreal, w3kindint, jdow, jdoy, jday + real(8) :: rinc(5) + real(4) :: rinc4(5) + + idat = 0 + idat(1) = idate(4) + idat(2) = idate(2) + idat(3) = idate(3) + idat(5) = idate(1) + rinc = 0. + rinc(2) = fhour + call w3kind(w3kindreal,w3kindint) + if(w3kindreal==4) then + rinc4 = rinc + CALL W3MOVDAT(RINC4,IDAT,JDAT) + else + CALL W3MOVDAT(RINC,IDAT,JDAT) + endif +! + jdow = 0 + jdoy = 0 + jday = 0 + call w3doxdat(jdat,jdow,jdoy,jday) + + day_of_year = jday + day_of_month = IDATE(3) + month = IDATE(2) + end subroutine get_month_and_day + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function limit_temperature_by_climatology(xlat_d,xlon_positive) + implicit none + real(kind_phys), intent(in) :: xlat_d, xlon_positive + real(kind_phys) :: xlon_d + + xlon_d = xlon_positive + if(xlon_d>180) xlon_d = xlon_d - 360 + + limit_temperature_by_climatology=.false. + + !tgs - 7nov19 - salinity effect on freezing point (Tanya, Stan, Trevor). + ! --- The Great Salt Lake (GSL), Utah lat/long (39.5-42.0,-111.5- -117.7). + ! --- THe GSL's salinity is 270 ppt above ~41.22 N with freezing point of -24 C, + ! --- and 150 ppt south of ~41.22 N with freezing point -10 C (info from Trevor Alcott). + ! --- The fresh-water Willard Bay should be excluded from the box around the Great Salt + ! --- Lake: lat/long 41.3539, -112.102, HRRR i,j = 494,667 (info from Stan and Trevor). + ! --- + ! --- 1jun2020: reset the GSL freezing point to be -5 C, + ! --- and add a check (after call to LakeMain) to keep the lake ice free for the whole year. + if ((xlon_d.gt.-117.7 .and. xlon_d.lt.-111.5) .and. & + ! excludes Willard Bay + .not. (xlon_d.gt.-112.104 .and. xlon_d.lt.-112.100))then + + if(xlat_d.gt.39.5 .and. xlat_d.lt.41.22) then + if(lakedebug) then + print *,'The Great Salt Lake south of 41.22 N, lat,lon',xlat_d,xlon_d + endif + limit_temperature_by_climatology = .true. + + elseif(( xlat_d.ge.41.22 .and. xlat_d.lt.42.) .and. .not. & + ! excludes Willard Bay + (xlat_d.gt.41.352 .and. xlat_d.lt.41.354)) then + if(lakedebug) then + print *,'The Great Salt Lake north of 41.22 N xlat_d,xlon_d ',xlat_d,xlon_d + endif + !print *,'Ice fraction on the GSL ', i,j,lake_icefrac3d(i,:,j) + limit_temperature_by_climatology = .true. + + endif ! xlat_d + + endif ! xlon_d + + !if(i==495.and.j==668) print *,'Willard Bay salty=',i,j,limit_temperature_by_climatology,xlat_d,xlon_d + + end function limit_temperature_by_climatology + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + logical function is_salty(xlat_d,xlon_positive) + implicit none + real(kind_phys), intent(in) :: xlat_d, xlon_positive + real(kind_phys) :: xlon_d + + xlon_d = xlon_positive + if(xlon_d>180) xlon_d = xlon_d - 360 + + is_salty=limit_temperature_by_climatology(xlat_d,xlon_d) + + ! --- The Mono Lake in California, salinity is 75 ppt with freezing point at + ! --- -4.2 C (Stan). The Mono Lake lat/long (37.9-38.2, -119.3 - 118.8) + if (xlon_d.gt.-119.3.and. xlon_d.lt.-118.8) then + if(xlat_d.gt.37.9 .and. xlat_d.lt.38.2) then + is_salty = .true. + print *,'Mono Lake, i,j',xlat_d,xlon_d + endif ! xlat_d + endif ! xlon_d + !tgs --- end of special treatment for salty lakes + end function is_salty + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !> \section arg_table_clm_lake_run Argument Table !! \htmlinclude clm_lake_run.html !! @@ -136,8 +254,8 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& dz3d ,zi3d ,h2osoi_vol3d ,h2osoi_liq3d ,& h2osoi_ice3d ,t_grnd2d ,t_soisno3d ,t_lake3d ,& savedtke12d ,lake_icefrac3d ,use_lake_model ,& - iopt_lake ,iopt_lake_clm ,& - con_cp ,icy ,& + iopt_lake ,iopt_lake_clm ,fhour ,& + con_cp ,icy ,IDATE ,& hflx ,evap ,grdflx ,tsfc ,& !o lake_t2m ,lake_q2m ,clm_lake_initialized ,& weasd ,isltyp ,snowd ,use_lakedepth ,& @@ -149,7 +267,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& ch ,cm ,chh ,cmm ,& lake_t_snow ,tisfc ,tsurf_ice ,wind ,& ! - xlon_d ,kdt ,tg3 ,& + xlon_d ,kdt ,tg3 ,salty ,& me ,master ,errmsg ,errflg ) !============================================================================== @@ -162,13 +280,13 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& !in: - INTEGER, INTENT(IN) :: iopt_lake, iopt_lake_clm, kdt + INTEGER, INTENT(IN) :: iopt_lake, iopt_lake_clm, kdt, IDATE(4) INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg INTEGER , INTENT (IN) :: im,km,me,master LOGICAL, INTENT(IN) :: restart,use_lakedepth,first_time_step REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) - REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_rd,con_g,con_cp,lakedepth_default + REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_rd,con_g,con_cp,lakedepth_default, fhour logical, intent(inout) :: icy(:) REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: fice REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: weasd, snowd @@ -199,6 +317,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: rain REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: albedo INTEGER, DIMENSION( : ), INTENT(IN) :: ISLTYP + INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty REAL(KIND_PHYS), INTENT(IN) :: dtp REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: z_lake3d REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: dz_lake3d @@ -363,17 +482,17 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& ! Still have some points to initialize call lakeini(kdt, ISLTYP, gt0, snowd, & !i - weasd, restart, lakedepth_default, & + weasd, restart, lakedepth_default, fhour, & lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & zi3d, watsat3d, csol3d, tkmg3d, & - fice, min_lakeice, tsfc, & + IDATE, fice, min_lakeice, tsfc, & use_lake_model, use_lakedepth, con_g, con_rd, & tkdry3d, tksatu3d, im, prsi, & - clm_lake_initialized, & - sand3d, clay3d, tg3, & + xlat_d, xlon_d, clm_lake_initialized, & + sand3d, clay3d, tg3, salty, & km, me, master, errmsg, errflg) if(errflg/=0) then return @@ -399,6 +518,9 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& if_lake_is_here: if (flag_iter(i) .and. use_lake_model(i)/=0) THEN + + + SFCTMP = gt0(i,1) PBOT = prsi(i,2) PSFC = prsi(i,1) @@ -437,7 +559,13 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& t_grnd(c) = t_grnd2d(i) do k = 1,nlevlake t_lake(c,k) = t_lake3d(i,k) - lake_icefrac(c,k) = lake_icefrac3d(i,k) + !-- If T of salty lakes is above the freezing point, keep them ice free + if(salty(i)==1 .and. t_lake(c,k) > tfrz .and. lake_icefrac3d(i,k) > 0.) then + lake_icefrac(c,k) = 0. + else + lake_icefrac(c,k) = lake_icefrac3d(i,k) + endif + !lake_icefrac(c,k) = lake_icefrac3d(i,k) z_lake(c,k) = z_lake3d(i,k) dz_lake(c,k) = dz_lake3d(i,k) enddo @@ -5125,17 +5253,17 @@ end subroutine clm_lake_init ! Some fields in lakeini are not available until runtime, so this cannot be in a CCPP init routine. SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, & !i - weasd, restart, lakedepth_default, & + weasd, restart, lakedepth_default, fhour, & lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & zi3d, watsat3d, csol3d, tkmg3d, & - fice, min_lakeice, tsfc, & + IDATE, fice, min_lakeice, tsfc, & use_lake_model, use_lakedepth, con_g, con_rd, & tkdry3d, tksatu3d, im, prsi, & - clm_lake_initialized, & - sand3d, clay3d, tg3, & + xlat_d, xlon_d, clm_lake_initialized, & + sand3d, clay3d, tg3, salty, & km, me, master, errmsg, errflg) !============================================================================== @@ -5149,12 +5277,12 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg - INTEGER , INTENT (IN) :: im, me, master, km, kdt - REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_g, con_rd - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: FICE,TG3 + INTEGER , INTENT (IN) :: im, me, master, km, kdt, IDATE(4) + REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_g, con_rd, fhour + REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: FICE,TG3, xlat_d, xlon_d REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc REAL(KIND_PHYS), DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized - + INTEGER, DIMENSION(IM) ,INTENT(INOUT) :: salty integer, dimension(IM), intent(in) :: use_lake_model !INTEGER , INTENT (IN) :: lakeflag !INTEGER , INTENT (INOUT) :: lake_depth_flag @@ -5219,16 +5347,43 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, character*256 :: message real(kind_phys) :: ht + logical :: climatology_limits + integer, parameter :: xcheck=38 integer, parameter :: ycheck=92 - integer :: used_lakedepth_default, init_points + integer :: used_lakedepth_default, init_points, month, julday + integer :: mon, iday, num2, num1, juld, day2, day1, wght1, wght2 + real(kind_phys) :: Tclim used_lakedepth_default=0 errmsg = '' errflg = 0 + call get_month_and_day(IDATE,month,iday,julday,fhour) + + !-- Compute weight for the current day + mon = month + if(iday > 15) mon=mon+1 + if(mon == 1) mon=13 + + num2 = month * 2 + if(iday > 15) num2=num2+1 + if(num2 == 1) num2=25 + num1 = num2 - 1 + + juld = julday + if (juld < 7) juld = juld + 365 + day2 = julm(mon)+15 + day1 = julm(mon) + wght1=(day2-julday)/float(day2-day1) + wght2=(julday-day1)/float(day2-day1) + + if(LAKEDEBUG .and. me==0) then + print *,'month,num1,num2,day1,day2,wght1,wght2',month,num1,num2,day1,day2,wght1,wght2 + endif + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! DO i=1,im @@ -5253,6 +5408,12 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, cycle endif + if(is_salty(xlat_d(i),xlon_d(i))) then + salty(i) = 1 + else + salty(i) = 0 + endif + snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m h2osno2d(i) = weasd(i) ! mm @@ -5274,6 +5435,20 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, if(fice(i)>min_lakeice) then lake_icefrac3d(i,1) = fice(i) endif + + !-- Check on the Great Salt Lake (GSL) when the model is cycled + !-- Bound the GSL temperature with +/- 3 C from climatology + if(limit_temperature_by_climatology(xlat_d(i),xlon_d(i))) then + Tclim = tfrz + wght1*saltlk_t(num1) & + + wght2*saltlk_t(num2) + if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,tsfc(i),t_lake3d(i,:),t_soisno3d(i,:) + t_grnd2d(i) = min(Tclim+3.0_kind_phys,(max(tsfc(i),Tclim-3.0_kind_phys))) + do k = 1,nlevlake + t_lake3d(i,k) = min(Tclim+3.0_kind_phys,(max(t_lake3d(i,k),Tclim-3.0_kind_phys))) + enddo + t_soisno3d(i,1) = min(Tclim+3.0_kind_phys,(max(t_soisno3d(i,1),Tclim-3.0_kind_phys))) + if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,tsfc(i),t_lake3d(i,:),t_soisno3d(i,:) + endif z3d(i,:) = 0.0 dz3d(i,:) = 0.0 diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 1fd67984c..d2fc08d81 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -7,6 +7,28 @@ [ccpp-arg-table] name = clm_lake_run type = scheme +[fhour] + standard_name = forecast_time + long_name = current forecast time + units = h + dimensions = () + type = real + kind = kind_phys + intent = in +[idate] + standard_name = date_and_time_at_model_initialization_in_united_states_order + long_name = initial date with different size and ordering + units = none + dimensions = (4) + type = integer + intent = in +[salty] + standard_name = clm_lake_is_salty + long_name = lake at this point is salty (1) or not (0) + units = 1 + dimensions = (horizontal_loop_extent) + type = integer + intent = inout [tg3] standard_name = deep_soil_temperature long_name = deep soil temperature From 9470375468f8495c38474dcd96be1d29ed67878a Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Fri, 26 Aug 2022 20:37:11 +0000 Subject: [PATCH 11/46] fix bugs in salty code and add Caspian & Dead seas --- physics/clm_lake.f90 | 41 +++++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 1a2f88d80..a472e47bd 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -231,10 +231,27 @@ logical function is_salty(xlat_d,xlon_positive) if (xlon_d.gt.-119.3.and. xlon_d.lt.-118.8) then if(xlat_d.gt.37.9 .and. xlat_d.lt.38.2) then is_salty = .true. - print *,'Mono Lake, i,j',xlat_d,xlon_d + if(lakedebug) then + print *,'Salty Mono Lake, i,j',xlat_d,xlon_d + endif endif ! xlat_d endif ! xlon_d - !tgs --- end of special treatment for salty lakes + + ! --- Caspian Sea and Dead Sea are salty too (Sam, Tanya) + if ( xlat_d>36.5_kind_phys .and. xlat_d<47.1_kind_phys .and. xlon_d>46.8_kind_phys .and. xlon_d<55.0_kind_phys ) then + if(lakedebug) then + print *,'Salty Caspian Sea ',xlat_d,xlon_d + endif + is_salty = .true. + end if + if ( xlon_d>35.3 .and. xlon_d<35.6 .and. xlat_d>31.3 .and. xlat_d<31.8) then + if(lakedebug) then + print *,'Salty Dead Sea ',xlat_d,xlon_d + endif + is_salty = .true. + endif + + !tgs --- end of special treatment for salty lakes end function is_salty !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -317,7 +334,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: rain REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: albedo INTEGER, DIMENSION( : ), INTENT(IN) :: ISLTYP - INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty + INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty REAL(KIND_PHYS), INTENT(IN) :: dtp REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: z_lake3d REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: dz_lake3d @@ -492,7 +509,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& use_lake_model, use_lakedepth, con_g, con_rd, & tkdry3d, tksatu3d, im, prsi, & xlat_d, xlon_d, clm_lake_initialized, & - sand3d, clay3d, tg3, salty, & + sand3d, clay3d, tg3, & km, me, master, errmsg, errflg) if(errflg/=0) then return @@ -518,8 +535,11 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& if_lake_is_here: if (flag_iter(i) .and. use_lake_model(i)/=0) THEN - - + if(is_salty(xlat_d(i),xlon_d(i))) then + salty(i) = 1 + else + salty(i) = 0 + endif SFCTMP = gt0(i,1) PBOT = prsi(i,2) @@ -5263,7 +5283,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, use_lake_model, use_lakedepth, con_g, con_rd, & tkdry3d, tksatu3d, im, prsi, & xlat_d, xlon_d, clm_lake_initialized, & - sand3d, clay3d, tg3, salty, & + sand3d, clay3d, tg3, & km, me, master, errmsg, errflg) !============================================================================== @@ -5282,7 +5302,6 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: FICE,TG3, xlat_d, xlon_d REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc REAL(KIND_PHYS), DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized - INTEGER, DIMENSION(IM) ,INTENT(INOUT) :: salty integer, dimension(IM), intent(in) :: use_lake_model !INTEGER , INTENT (IN) :: lakeflag !INTEGER , INTENT (INOUT) :: lake_depth_flag @@ -5408,12 +5427,6 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, cycle endif - if(is_salty(xlat_d(i),xlon_d(i))) then - salty(i) = 1 - else - salty(i) = 0 - endif - snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m h2osno2d(i) = weasd(i) ! mm From 405621763e00169e7edd7253491b5ea21aea9f29 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 16 Sep 2022 00:52:37 +0000 Subject: [PATCH 12/46] fix some bugs and make some more --- physics/clm_lake.f90 | 88 +++++++++++++++++++++++-------------- physics/flake_driver.F90 | 6 +-- physics/flake_driver.meta | 8 ---- physics/myjsfc_wrapper.F90 | 4 +- physics/myjsfc_wrapper.meta | 8 ---- physics/sfc_diag.f | 12 ++--- 6 files changed, 67 insertions(+), 59 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index a472e47bd..dcb97de44 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -616,6 +616,19 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& print *,'Unhappy point before LakeMain t_soilsno = ',t_soisno(1,:) endif endif + + eflx_lwrad_net = -9999 + eflx_gnet = -9999 + eflx_sh_tot = -9999 + eflx_lh_tot = -9999 + t_ref2m = -9999 + q_ref2m = -9999 + taux = -9999 + tauy = -9999 + ram1 = -9999 + z0mg = -9999 + ustar_out = -9999 + is_unhappy=.false. CALL LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I forc_hgt_t,forc_hgt_u,forc_q, forc_u, & @@ -730,6 +743,10 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& ustar = ustar_out(1) ! surface_friction_velocity_over_water ! Calculate qsfc from t_grnd: (surface_specific_humidity_over_water) + PSFC = prsi(i,1) + discard1 = -9999 + discard2 = -9999 + discard3 = -9999 call QSat(t_grnd(c),psfc,discard1,discard2,qsfc(i),discard3) ! From flake driver: @@ -1191,7 +1208,6 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! real(kind_phys) :: z0mg(lbp:ubp) ! roughness length over ground, momentum [m] real(kind_phys) :: z0hg(lbp:ubp) ! roughness length over ground, sensible heat [m] real(kind_phys) :: z0qg(lbp:ubp) ! roughness length over ground, latent heat [m] - real(kind_phys) :: beta(2) ! fraction solar rad absorbed at surface: depends on lake type real(kind_phys) :: u2m ! 2 m wind speed (m/s) real(kind_phys) :: u10(1) ! 10-m wind (m/s) (for dust model) real(kind_phys) :: fv(1) ! friction velocity (m/s) (for dust model) @@ -1206,7 +1222,8 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! ! Constants for lake temperature model ! - data beta/0.4_kind_phys, 0.4_kind_phys/ ! (deep lake, shallow lake) + real(kind_phys), parameter :: beta(2) = & ! fraction solar rad absorbed at surface: depends on lake type + (/0.4_kind_phys, 0.4_kind_phys/) ! (deep lake, shallow lake) ! This is the energy absorbed at the lake surface if no snow. ! data za /0.6_kind_phys, 0.5_kind_phys/ ! data eta /0.1_kind_phys, 0.5_kind_phys/ @@ -1741,8 +1758,6 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! integer , parameter :: islak = 2 ! index of lake, 1 = deep lake, 2 = shallow lake real(kind_phys), parameter :: p0 = 1._kind_phys ! neutral value of turbulent prandtl number integer :: i,j,fc,fp,g,c,p ! do loop or array index - real(kind_phys) :: beta(2) ! fraction solar rad absorbed at surface: depends on lake type - real(kind_phys) :: za(2) ! base of surface absorption layer (m): depends on lake type real(kind_phys) :: eta(2) ! light extinction coefficient (/m): depends on lake type real(kind_phys) :: cwat ! specific heat capacity of water (j/m**3/kelvin) real(kind_phys) :: cice_eff ! effective heat capacity of ice (using density of @@ -1810,8 +1825,10 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! ! Constants for lake temperature model ! - data beta/0.4_kind_phys, 0.4_kind_phys/ ! (deep lake, shallow lake) - data za /0.6_kind_phys, 0.6_kind_phys/ + real(kind_phys), parameter :: beta(2) = & ! fraction solar rad absorbed at surface: depends on lake type + (/0.4_kind_phys, 0.4_kind_phys/) ! (deep lake, shallow lake) + real(kind_phys), parameter :: za(2) = & ! base of surface absorption layer (m): depends on lake type + (/0.6_kind_phys, 0.6_kind_phys/) ! For now, keep beta and za for shallow lake the same as deep lake, until better data is found. ! It looks like eta is key and that larger values give better results for shallow lakes. Use ! empirical expression from Hakanson (below). This is still a very unconstrained parameter @@ -4229,9 +4246,8 @@ subroutine CombineSnowLayers(lbc, ubc, & !i integer :: neibor ! adjacent node selected for combination real(kind_phys):: zwice(lbc:ubc) ! total ice mass in snow real(kind_phys):: zwliq (lbc:ubc) ! total liquid water in snow - real(kind_phys):: dzmin(5) ! minimum of top snow layer - - data dzmin /0.010, 0.015, 0.025, 0.055, 0.115/ + real(kind_phys), parameter :: dzmin(5) = & ! minimum of top snow layer + (/0.010, 0.015, 0.025, 0.055, 0.115/) !----------------------------------------------------------------------- ! Check the mass of ice lens of snow, when the total is less than a small value, @@ -5374,38 +5390,21 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, integer :: used_lakedepth_default, init_points, month, julday integer :: mon, iday, num2, num1, juld, day2, day1, wght1, wght2 real(kind_phys) :: Tclim + logical :: have_date used_lakedepth_default=0 + have_date=.false. errmsg = '' errflg = 0 - call get_month_and_day(IDATE,month,iday,julday,fhour) - - !-- Compute weight for the current day - mon = month - if(iday > 15) mon=mon+1 - if(mon == 1) mon=13 - - num2 = month * 2 - if(iday > 15) num2=num2+1 - if(num2 == 1) num2=25 - num1 = num2 - 1 - - juld = julday - if (juld < 7) juld = juld + 365 - day2 = julm(mon)+15 - day1 = julm(mon) - wght1=(day2-julday)/float(day2-day1) - wght2=(julday-day1)/float(day2-day1) - if(LAKEDEBUG .and. me==0) then print *,'month,num1,num2,day1,day2,wght1,wght2',month,num1,num2,day1,day2,wght1,wght2 endif !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - DO i=1,im + do_init_part1: DO i=1,im if(use_lake_model(i)==0) then cycle endif @@ -5427,6 +5426,31 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, cycle endif + if(.not.have_date) then + !$OMP CRITICAL + call get_month_and_day(IDATE,month,iday,julday,fhour) + !$OMP END CRITICAL + + have_date = .true. + + !-- Compute weight for the current day + mon = month + if(iday > 15) mon=mon+1 + if(mon == 1) mon=13 + + num2 = month * 2 + if(iday > 15) num2=num2+1 + if(num2 == 1) num2=25 + num1 = num2 - 1 + + juld = julday + if (juld < 7) juld = juld + 365 + day2 = julm(mon)+15 + day1 = julm(mon) + wght1=(day2-julday)/float(day2-day1) + wght2=(julday-day1)/float(day2-day1) + endif + snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m h2osno2d(i) = weasd(i) ! mm @@ -5472,7 +5496,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, h2osoi_vol3d(i,:) = 0.0 snl2d(i) = 0.0 - ENDDO + ENDDO do_init_part1 if(used_lakedepth_default>0) then print *,'used lakedepth_default: ',used_lakedepth_default @@ -5481,7 +5505,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, !!!!!!!!!!!!!!!!!!begin to initialize lake variables!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! init_points=0 - DO i = 1,im + do_init_part2: DO i = 1,im if(use_lake_model(i)==0 .or. clm_lake_initialized(i)>0) then cycle @@ -5684,7 +5708,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, end do clm_lake_initialized(i) = 1 - ENDDO + ENDDO do_init_part2 if(LAKEDEBUG .and. init_points>0) then diff --git a/physics/flake_driver.F90 b/physics/flake_driver.F90 index e27d32ff3..a277783fb 100644 --- a/physics/flake_driver.F90 +++ b/physics/flake_driver.F90 @@ -50,7 +50,7 @@ end subroutine flake_driver_finalize SUBROUTINE flake_driver_run ( & ! ---- Inputs im, ps, t1, q1, wind, min_lakeice, & - dlwflx, dswsfc, lakedepth, lakefrac, & + dlwflx, dswsfc, lakedepth, & use_lake_model, snow, xlat, delt, zlvl, elev, & wet, yearlen, julian, imon, & flag_iter, first_time_step, flag_restart, & @@ -91,7 +91,7 @@ SUBROUTINE flake_driver_run ( & real (kind=kind_phys), intent(in) :: delt, min_lakeice real (kind=kind_phys), dimension(:), intent(in) :: & - & xlat, lakedepth, lakefrac, snow + & xlat, lakedepth, snow real (kind=kind_phys), dimension(:), intent(in) :: weasd @@ -308,7 +308,7 @@ SUBROUTINE flake_driver_run ( & ! w_extinc(i) = 3.0 ! write(0,1002) julian,xlat(i),w_albedo(I),w_extinc(i),elev(i),tsurf(i),T_sfc(i),t_bot1(i) -! write(0,1003) use_lake_model(i),i,lakefrac(i),lakedepth(i), snwdph(i), hice(i), fice(i) +! write(0,1003) use_lake_model(i),i,lakedepth(i), snwdph(i), hice(i), fice(i) ! write(0,1004) ps(i), wind(i), t1(i), q1(i), dlwflx(i), dswsfc(i), zlvl(i) endif !flag diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index 834bfd0a4..94335a62d 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -118,14 +118,6 @@ type = real kind = kind_phys intent = in -[lakefrac] - standard_name = lake_area_fraction - long_name = fraction of horizontal grid area occupied by lake - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [use_lake_model] standard_name = flag_for_using_lake_model long_name = flag indicating lake points using a lake model diff --git a/physics/myjsfc_wrapper.F90 b/physics/myjsfc_wrapper.F90 index d7737e911..fa729d088 100644 --- a/physics/myjsfc_wrapper.F90 +++ b/physics/myjsfc_wrapper.F90 @@ -52,7 +52,7 @@ SUBROUTINE myjsfc_wrapper_run( & & phy_myj_a1u, phy_myj_a1t, phy_myj_a1q, & & pblh, slmsk, zorl, ustar, rib, & & cm,ch,stress,ffm,ffh,fm10,fh2, & - & landfrac,lakefrac,oceanfrac,fice, & + & landfrac, oceanfrac,fice, & & z0rl_wat, z0rl_lnd, z0rl_ice, & ! intent(inout) & ustar_wat, ustar_lnd, ustar_ice, & ! intent(inout) & cm_wat, cm_lnd, cm_ice, & ! intent(inout) @@ -121,7 +121,7 @@ SUBROUTINE myjsfc_wrapper_run( & real(kind=kind_phys),dimension(:),intent(inout) :: & & cm, ch, stress, ffm, ffh, fm10, fh2 real(kind=kind_phys), dimension(:), intent(inout) :: & - & landfrac, lakefrac, oceanfrac, fice + & landfrac, oceanfrac, fice real(kind=kind_phys), dimension(:), intent(inout) :: & & z0rl_wat, z0rl_lnd, z0rl_ice, & & ustar_wat, ustar_lnd, ustar_ice, & diff --git a/physics/myjsfc_wrapper.meta b/physics/myjsfc_wrapper.meta index 65ccc7dd9..40b6b78f3 100644 --- a/physics/myjsfc_wrapper.meta +++ b/physics/myjsfc_wrapper.meta @@ -421,14 +421,6 @@ type = real kind = kind_phys intent = inout -[lakefrac] - standard_name = lake_area_fraction - long_name = fraction of horizontal grid area occupied by lake - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [oceanfrac] standard_name = sea_area_fraction long_name = fraction of horizontal grid area occupied by ocean diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index a8e87b9ac..7018d395c 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -77,11 +77,11 @@ subroutine sfc_diag_run & ! f10m(i) = min(f10m(i),1.) u10m(i) = f10m(i) * u1(i) v10m(i) = f10m(i) * v1(i) - if(use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then - t2m(i) = lake_t2m(i) - q2m(i) = lake_q2m(i) - clm_t2m_count=clm_t2m_count+1 - else + ! use_clm_2m: if(use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then + ! t2m(i) = lake_t2m(i) + ! q2m(i) = lake_q2m(i) + ! clm_t2m_count=clm_t2m_count+1 + ! else fhi = fh2(i) / fh(i) ! t2m(i) = tskin(i)*(1. - fhi) + t1(i) * prslki(i) * fhi ! sig2k = 1. - (grav+grav) / (cp * t2m(i)) @@ -103,7 +103,7 @@ subroutine sfc_diag_run & qss = fpvs(t2m(i)) qss = eps * qss / (ps(i) + epsm1 * qss) q2m(i) = min(q2m(i),qss) - endif + ! endif use_clm_2m enddo return From 2014d7b54491a965d462ab83f047fd9847c1f1d6 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 19 Sep 2022 22:04:54 +0000 Subject: [PATCH 13/46] set roughness length over ice & water in clm lake model --- physics/clm_lake.f90 | 7 +++++-- physics/clm_lake.meta | 16 ++++++++++++++++ 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index dcb97de44..c46642b1d 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -277,7 +277,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& lake_t2m ,lake_q2m ,clm_lake_initialized ,& weasd ,isltyp ,snowd ,use_lakedepth ,& restart ,lakedepth_default ,& - sand3d ,clay3d ,& + zorlw ,zorli ,sand3d ,clay3d ,& ! Flake output variables weasdi ,snodi ,hice ,tsurf ,& t_sfc ,lflx ,ustar ,qsfc ,& @@ -332,7 +332,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: dswsfci REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: emiss REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: rain - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: albedo + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: albedo, zorlw, zorli INTEGER, DIMENSION( : ), INTENT(IN) :: ISLTYP INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty REAL(KIND_PHYS), INTENT(IN) :: dtp @@ -717,6 +717,8 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& icy(i)=.true. ice_points = ice_points+1 + zorli(i) = z0mg(c) + ! Assume that, if a layer has ice, the entire layer thickness is ice. hice(I) = 0 do k=1,nlevlake @@ -725,6 +727,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif end do else + zorlw(i) = z0mg(c) weasdi(i) = 0 snodi(i) = 0 tisfc(i) = tsurf(i) diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index d2fc08d81..5953677e5 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -7,6 +7,22 @@ [ccpp-arg-table] name = clm_lake_run type = scheme +[zorlw] + standard_name = surface_roughness_length_over_water + long_name = surface roughness length over water + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [fhour] standard_name = forecast_time long_name = current forecast time From 789ddb933c1e4ca238a31cabd8a26901230e972a Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 11 Oct 2022 18:48:53 +0000 Subject: [PATCH 14/46] several fixes to initialization --- physics/clm_lake.f90 | 247 ++++++++++++++++++++---------------------- physics/clm_lake.meta | 29 ++++- physics/sfc_diag.f | 4 +- 3 files changed, 146 insertions(+), 134 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index c46642b1d..97cbe025f 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -123,9 +123,11 @@ MODULE clm_lake real(kind_phys) :: dzsoi(1:nlevsoil) !soil dz (thickness) real(kind_phys) :: zisoi(0:nlevsoil) !soil zi (interfaces) - real, parameter :: SaltLk_T(1:25) = (/0.5, 0.,-0.5, 3., 4., 7., 8., 12., 13., 16., 19., 21., & - 23.5, 25.,26.,24.,23.,20.5,18.,15., 11.5, 8., 4., 1., 0.5/) + real, parameter :: SaltLk_T(1:25) = (/ 0.5, 0.,-0.5, 3., 4., 7., 8., 12., 13., 16., 19., 21., & + 23.5, 25., 26.,24.,23.,20.5,18., 15., 11.5, 8., 4., 1., 0.5/) + real, parameter :: month_length(12) = (/ 31, 29, 31, 30, 31, 30, 31, 30, 30, 31, 30, 31 /) real, parameter :: julm(1:13) = (/0,31,59,90,120,151,181,212,243,273,304,334,365/) + logical, parameter :: include_all_salty_locations = .false. CONTAINS @@ -226,6 +228,7 @@ logical function is_salty(xlat_d,xlon_positive) is_salty=limit_temperature_by_climatology(xlat_d,xlon_d) + if(include_all_salty_locations) then ! --- The Mono Lake in California, salinity is 75 ppt with freezing point at ! --- -4.2 C (Stan). The Mono Lake lat/long (37.9-38.2, -119.3 - 118.8) if (xlon_d.gt.-119.3.and. xlon_d.lt.-118.8) then @@ -250,7 +253,7 @@ logical function is_salty(xlat_d,xlon_positive) endif is_salty = .true. endif - + endif !tgs --- end of special treatment for salty lakes end function is_salty @@ -263,9 +266,9 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& gt0 ,prsi ,con_rd,con_g ,qvcurr ,& !i gu0 ,gv0 ,dlwsfci ,emiss ,& rain ,dtp ,dswsfci ,albedo ,& - xlat_d ,z_lake3d ,dz_lake3d ,lakedepth2d ,& + xlat_d ,z_lake3d ,dz_lake3d ,oro_lakedepth ,& watsat3d ,csol3d ,tkmg3d ,tkdry3d ,& - tksatu3d ,phii ,& + tksatu3d ,wet ,phii ,clm_lakedepth ,& fice ,min_lakeice ,im,km ,& h2osno2d ,snowdp2d ,snl2d ,z3d ,& !h dz3d ,zi3d ,h2osoi_vol3d ,h2osoi_liq3d ,& @@ -276,7 +279,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& hflx ,evap ,grdflx ,tsfc ,& !o lake_t2m ,lake_q2m ,clm_lake_initialized ,& weasd ,isltyp ,snowd ,use_lakedepth ,& - restart ,lakedepth_default ,& + restart ,lakedepth_default ,pgr ,& zorlw ,zorli ,sand3d ,clay3d ,& ! Flake output variables weasdi ,snodi ,hice ,tsurf ,& @@ -304,10 +307,10 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& LOGICAL, INTENT(IN) :: restart,use_lakedepth,first_time_step REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_rd,con_g,con_cp,lakedepth_default, fhour - logical, intent(inout) :: icy(:) + logical, intent(inout) :: icy(:), wet(:) REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: fice - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: weasd, snowd - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN):: tg3 + REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT) :: weasd, snowd + REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN):: tg3, pgr REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: ZLVL INTEGER, DIMENSION(:), INTENT(IN) :: use_lake_model @@ -343,7 +346,8 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkmg3d REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkdry3d REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tksatu3d - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: lakedepth2d + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: clm_lakedepth + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN ) :: oro_lakedepth !feedback to atmosphere: REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: hflx @@ -464,6 +468,9 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& ! The latitude and longitude of unhappy points. real(kind_phys), allocatable, save :: unhappy_lat(:),unhappy_lon(:) + integer :: month,num1,num2,day_of_month + real(kind_phys) :: wght1,wght2,Tclim + errmsg = ' ' errflg = 0 @@ -498,18 +505,18 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif ! Still have some points to initialize - call lakeini(kdt, ISLTYP, gt0, snowd, & !i + call lakeini(kdt, ISLTYP, gt0, snowd, & weasd, restart, lakedepth_default, fhour, & - lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o + oro_lakedepth, savedtke12d, snowdp2d, h2osno2d, & snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & zi3d, watsat3d, csol3d, tkmg3d, & - IDATE, fice, min_lakeice, tsfc, & + fice, min_lakeice, tsfc, & use_lake_model, use_lakedepth, con_g, con_rd, & tkdry3d, tksatu3d, im, prsi, & xlat_d, xlon_d, clm_lake_initialized, & - sand3d, clay3d, tg3, & + sand3d, clay3d, tg3, clm_lakedepth, & km, me, master, errmsg, errflg) if(errflg/=0) then return @@ -531,6 +538,28 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& snow_points=0 ice_points=0 + month = IDATE(2) + day_of_month = IDATE(3) + + num1 = month*2-1 + if(day_of_month>15) then + num1 = num1 + 1 + endif + num2 = num1+1 + + wght2 = day_of_month/month_length(month) + if(wght2<0 .or. wght2>1) then + if(lakedebug) then + write(0,*) 'Warning: wght2 is not 0..1: ',wght2 + endif + wght2 = max(0.0_kind_phys,min(1.0_kind_phys,wght2)) + endif + wght1 = 1.0_kind_phys - wght2 + + if(LAKEDEBUG .and. me==0) then + print *,'month,num1,num2,wght1,wght2',month,num1,num2,wght1,wght2 + endif + lake_top_loop: DO I = 1,im if_lake_is_here: if (flag_iter(i) .and. use_lake_model(i)/=0) THEN @@ -541,9 +570,21 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& salty(i) = 0 endif + if(salty(i)/=0) then + Tclim = tfrz + wght1*saltlk_T(num1) & + + wght2*saltlk_T(num2) + if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,tsfc(i),t_lake3d(i,:),t_soisno3d(i,:) + t_grnd2d(i) = min(Tclim+3.0_kind_phys,(max(tsfc(i),Tclim-3.0_kind_phys))) + do k = 1,nlevlake + t_lake3d(i,k) = min(Tclim+3.0_kind_phys,(max(t_lake3d(i,k),Tclim-3.0_kind_phys))) + enddo + t_soisno3d(i,1) = min(Tclim+3.0_kind_phys,(max(t_soisno3d(i,1),Tclim-3.0_kind_phys))) + if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,tsfc(i),t_lake3d(i,:),t_soisno3d(i,:) + endif + SFCTMP = gt0(i,1) - PBOT = prsi(i,2) - PSFC = prsi(i,1) + PBOT = prsi(i,1) + PSFC = pgr(i) Q2K = qvcurr(i) LWDN = DLWSFCI(I)*EMISS(I) PRCP = RAIN(i)/dtime ! [mm/s] use physics timestep since PRCP comes from non-surface schemes @@ -571,7 +612,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& lat(c) = XLAT_D(I)*pi/180 ! [radian] do_capsnow(c) = .false. - lakedepth(c) = lakedepth2d(i) + lakedepth(c) = clm_lakedepth(i) savedtke1(c) = savedtke12d(i) snowdp(c) = snowdp2d(i) h2osno(c) = h2osno2d(i) @@ -691,7 +732,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& ! No equivalent in CCPP: ! LH(I) = eflx_lh_tot(c)/rho1(i) ![kg*m/(kg*s)] - + !-- The CLM output is combined for fractional ice and water if( t_grnd(c) >= tfrz ) then qfx = eflx_lh_tot(c)/hvap else @@ -709,12 +750,19 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + ( (1.0-lake_icefrac3d(i,1)) * 0.08) fice(i) = lake_icefrac3d(i,1) + zorlw(i) = z0mg(c) + if(fice(i)>=min_lakeice) then weasdi(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice snodi(i) = snowdp(c) ! surface_snow_thickness_water_equivalent_over_ice tisfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice icy(i)=.true. + if(fice(i)==1.) then + wet(i) = .false. + else + wet(i) = .true. + endif ice_points = ice_points+1 zorli(i) = z0mg(c) @@ -727,12 +775,14 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif end do else - zorlw(i) = z0mg(c) + icy(i)=.false. + wet(i)=.true. weasdi(i) = 0 snodi(i) = 0 tisfc(i) = tsurf(i) tsurf_ice(i) = tisfc(i) hice(i) = 0 + fice(i) = 0 endif if(snl2d(i)<0) then @@ -752,7 +802,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& discard3 = -9999 call QSat(t_grnd(c),psfc,discard1,discard2,qsfc(i),discard3) - ! From flake driver: + ! From flake driver - combined ice/water: chh(i)=ch(i)*wind(i)*1.225 ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water cmm(i)=cm(i)*wind(i) ! surface_drag_wind_speed_for_momentum_in_air_over_water @@ -5293,16 +5343,16 @@ end subroutine clm_lake_init ! Some fields in lakeini are not available until runtime, so this cannot be in a CCPP init routine. SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, & !i weasd, restart, lakedepth_default, fhour, & - lakedepth2d, savedtke12d, snowdp2d, h2osno2d, & !o + oro_lakedepth, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & zi3d, watsat3d, csol3d, tkmg3d, & - IDATE, fice, min_lakeice, tsfc, & + fice, min_lakeice, tsfc, & use_lake_model, use_lakedepth, con_g, con_rd, & tkdry3d, tksatu3d, im, prsi, & xlat_d, xlon_d, clm_lake_initialized, & - sand3d, clay3d, tg3, & + sand3d, clay3d, tg3, clm_lakedepth, & km, me, master, errmsg, errflg) !============================================================================== @@ -5316,9 +5366,10 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg - INTEGER , INTENT (IN) :: im, me, master, km, kdt, IDATE(4) + INTEGER , INTENT (IN) :: im, me, master, km, kdt REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_g, con_rd, fhour - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: FICE,TG3, xlat_d, xlon_d + REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT):: FICE + REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: TG3, xlat_d, xlon_d REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc REAL(KIND_PHYS), DIMENSION(IM) ,INTENT(INOUT) :: clm_lake_initialized integer, dimension(IM), intent(in) :: use_lake_model @@ -5328,11 +5379,12 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, LOGICAL , INTENT(IN) :: restart INTEGER, DIMENSION(IM), INTENT(IN) :: ISLTYP - REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN) :: snowd,weasd + REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT) :: snowd,weasd REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0, prsi real(kind_phys), intent(in) :: lakedepth_default - real(kind_phys), dimension(IM),intent(inout) :: lakedepth2d + real(kind_phys), dimension(IM),intent(inout) :: clm_lakedepth + real(kind_phys), dimension(IM),intent(in) :: oro_lakedepth real(kind_phys), dimension(IM),intent(out) :: savedtke12d real(kind_phys), dimension(IM),intent(out) :: snowdp2d, & h2osno2d, & @@ -5393,67 +5445,39 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, integer :: used_lakedepth_default, init_points, month, julday integer :: mon, iday, num2, num1, juld, day2, day1, wght1, wght2 real(kind_phys) :: Tclim - logical :: have_date used_lakedepth_default=0 - have_date=.false. errmsg = '' errflg = 0 - if(LAKEDEBUG .and. me==0) then - print *,'month,num1,num2,day1,day2,wght1,wght2',month,num1,num2,day1,day2,wght1,wght2 - endif - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!begin to initialize lake variables!!!!!!!!!!!!!!!!!! - do_init_part1: DO i=1,im - if(use_lake_model(i)==0) then + init_points=0 + do_init: DO i=1,im + if(use_lake_model(i)==0 .or. clm_lake_initialized(i)>0) then cycle endif - if(kdt<2) then ! To handle restarts with bad lakedepth2d if ( use_lakedepth ) then - if (lakedepth2d(i) <= 0.0) then - lakedepth2d(i) = lakedepth_default + if (oro_lakedepth(i) == 10.0 .or. oro_lakedepth(i) <= 0.) then + !- 10.0 is the fill value for lake depth, in this case set to default value + clm_lakedepth(i) = lakedepth_default used_lakedepth_default = used_lakedepth_default+1 + else + clm_lakedepth(i) = oro_lakedepth(i) endif else - lakedepth2d(i) = lakedepth_default + !- all lakes are initialized with the default lake depth + clm_lakedepth(i) = lakedepth_default used_lakedepth_default = used_lakedepth_default+1 endif - endif if(clm_lake_initialized(i)>0) then cycle endif - if(.not.have_date) then - !$OMP CRITICAL - call get_month_and_day(IDATE,month,iday,julday,fhour) - !$OMP END CRITICAL - - have_date = .true. - - !-- Compute weight for the current day - mon = month - if(iday > 15) mon=mon+1 - if(mon == 1) mon=13 - - num2 = month * 2 - if(iday > 15) num2=num2+1 - if(num2 == 1) num2=25 - num1 = num2 - 1 - - juld = julday - if (juld < 7) juld = juld + 365 - day2 = julm(mon)+15 - day1 = julm(mon) - wght1=(day2-julday)/float(day2-day1) - wght2=(julday-day1)/float(day2-day1) - endif - snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m h2osno2d(i) = weasd(i) ! mm @@ -5474,20 +5498,14 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, if(fice(i)>min_lakeice) then lake_icefrac3d(i,1) = fice(i) - endif - - !-- Check on the Great Salt Lake (GSL) when the model is cycled - !-- Bound the GSL temperature with +/- 3 C from climatology - if(limit_temperature_by_climatology(xlat_d(i),xlon_d(i))) then - Tclim = tfrz + wght1*saltlk_t(num1) & - + wght2*saltlk_t(num2) - if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,tsfc(i),t_lake3d(i,:),t_soisno3d(i,:) - t_grnd2d(i) = min(Tclim+3.0_kind_phys,(max(tsfc(i),Tclim-3.0_kind_phys))) - do k = 1,nlevlake - t_lake3d(i,k) = min(Tclim+3.0_kind_phys,(max(t_lake3d(i,k),Tclim-3.0_kind_phys))) - enddo - t_soisno3d(i,1) = min(Tclim+3.0_kind_phys,(max(t_soisno3d(i,1),Tclim-3.0_kind_phys))) - if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,tsfc(i),t_lake3d(i,:),t_soisno3d(i,:) + snowdp2d(i) = snowd(i)*1e-3 ! SNOW in kg/m^2 and snowdp in m + h2osno2d(i) = weasd(i) ! mm + else + fice(i) = 0. + snowd(i) = 0. + weasd(i) = 0. + snowdp2d(i) = 0. + h2osno2d(i) = 0. endif z3d(i,:) = 0.0 @@ -5499,23 +5517,6 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, h2osoi_vol3d(i,:) = 0.0 snl2d(i) = 0.0 - ENDDO do_init_part1 - - if(used_lakedepth_default>0) then - print *,'used lakedepth_default: ',used_lakedepth_default - endif - - !!!!!!!!!!!!!!!!!!begin to initialize lake variables!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - - init_points=0 - do_init_part2: DO i = 1,im - - if(use_lake_model(i)==0 .or. clm_lake_initialized(i)>0) then - cycle - endif - - init_points = init_points+1 - ! Soil hydraulic and thermal properties isl = ISLTYP(i) if (isl == 0 ) isl = 14 @@ -5563,37 +5564,17 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, watdry3d(i,k) = watsat3d(i,k) * (316230._kind_phys/sucsat3d(i,k)) ** (-1._kind_phys/bsw3d(i,k)) watopt3d(i,k) = watsat3d(i,k) * (158490._kind_phys/sucsat3d(i,k)) ** (-1._kind_phys/bsw3d(i,k)) end do - if (lakedepth2d(i) == spval) then - lakedepth2d(i) = zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake) + if (clm_lakedepth(i) == spval) then + clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake) z_lake3d(i,1:nlevlake) = zlak(1:nlevlake) dz_lake3d(i,1:nlevlake) = dzlak(1:nlevlake) else - depthratio2d(i) = lakedepth2d(i) / (zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake)) + depthratio2d(i) = clm_lakedepth(i) / (zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake)) z_lake3d(i,1) = zlak(1) dz_lake3d(i,1) = dzlak(1) dz_lake3d(i,2:nlevlake) = dzlak(2:nlevlake)*depthratio2d(i) z_lake3d(i,2:nlevlake) = zlak(2:nlevlake)*depthratio2d(i) + dz_lake3d(i,1)*(1._kind_phys - depthratio2d(i)) end if - ! initial t_lake3d here - if(tsfc(i)<160) then - write(errmsg,'(A,F20.12,A)') 'Invalid tsfc value ',tsfc(i),' found. Was tsfc not initialized?' - write(0,'(A)') trim(errmsg) - errflg=1 - return - endif - t_soisno3d(i,1) = tsfc(i) - t_lake3d(i,1) = tsfc(i) - t_grnd2d(i) = tsfc(i) - do k = 2, nlevlake - if(z_lake3d(i,k).le.depth_c) then - t_soisno3d(i,k)=tsfc(i)+(277.0-tsfc(i))/depth_c*z_lake3d(i,k) - t_lake3d(i,k)=tsfc(i)+(277.0-tsfc(i))/depth_c*z_lake3d(i,k) - else - t_soisno3d(i,k) = tsfc(i) - t_lake3d(i,k) = tsfc(i) - end if - enddo - !end initial t_lake3d here z3d(i,1:nlevsoil) = zsoi(1:nlevsoil) zi3d(i,0:nlevsoil) = zisoi(0:nlevsoil) dz3d(i,1:nlevsoil) = dzsoi(1:nlevsoil) @@ -5663,15 +5644,15 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, ! 3:subroutine makearbinit - if (snl2d(i) < 0) then - do k = snl2d(i)+1, 0 - ! Be careful because there may be new snow layers with bad temperatures like 0 even if - ! coming from init. con. file. - if(t_soisno3d(i,k) > 300 .or. t_soisno3d(i,k) < 200) t_soisno3d(i,k) = tsfc(i) - enddo - end if - ! initial t_lake3d here + if(tsfc(i)<160) then + write(errmsg,'(A,F20.12,A)') 'Invalid tsfc value ',tsfc(i),' found. Was tsfc not initialized?' + write(0,'(A)') trim(errmsg) + errflg=1 + return + endif + + t_lake3d(i,1) = tsfc(i) t_grnd2d(i) = tsfc(i) do k = 2, nlevlake @@ -5689,6 +5670,14 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, t_soisno3d(i,k)=t_soisno3d(i,1)+(t_soisno3d(i,nlevsoil)-t_soisno3d(i,1))*dzsoi(k) enddo + if (snl2d(i) < 0) then + do k = snl2d(i)+1, 0 + ! Be careful because there may be new snow layers with bad temperatures like 0 even if + ! coming from init. con. file. + if(t_soisno3d(i,k) > 300 .or. t_soisno3d(i,k) < 200) t_soisno3d(i,k) = min(tfrz,tsfc(i)) + enddo + end if + do k = 1,nlevsoil h2osoi_vol3d(i,k) = 1.0_kind_phys h2osoi_vol3d(i,k) = min(h2osoi_vol3d(i,k),watsat3d(i,k)) @@ -5711,7 +5700,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, end do clm_lake_initialized(i) = 1 - ENDDO do_init_part2 + ENDDO do_init if(LAKEDEBUG .and. init_points>0) then diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 5953677e5..5a2cd9565 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = clm_lake_run type = scheme +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [zorlw] standard_name = surface_roughness_length_over_water long_name = surface roughness length over water @@ -218,7 +226,15 @@ type = real kind = kind_phys intent = inout -[lakedepth2d] +[clm_lakedepth] + standard_name = clm_lake_depth + long_name = clm internal copy of lake depth with 10.0 replaced by default lake depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[oro_lakedepth] standard_name = lake_depth long_name = lake depth units = m @@ -551,7 +567,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout [snowd] standard_name = lwe_surface_snow long_name = water equivalent snow depth @@ -559,7 +575,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout [weasdi] standard_name = water_equivalent_accumulated_snow_depth_over_ice long_name = water equiv of acc snow depth over land @@ -710,6 +726,13 @@ dimensions = () type = integer intent = in +[wet] + standard_name = flag_nonzero_wet_surface_fraction + long_name = flag indicating presence of some ocean or lake surface area fraction + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout [icy] standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 7018d395c..9b78cad88 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -88,9 +88,9 @@ subroutine sfc_diag_run & ! t2m(i) = t2m(i) * sig2k wrk = 1.0 - fhi if(thsfc_loc) then ! Use local potential temperature - t2m(i) = tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp + t2m(i)= tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp else ! Use potential temperature referenced to 1000 hPa - t2m(i) = tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp + t2m(i)= tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp endif if(evap(i) >= 0.) then ! for evaporation>0, use inferred qsurf to deduce q2m From 3acd145d13e076e0dc5a55ace0975fc6070818d8 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 17 Oct 2022 22:27:04 +0000 Subject: [PATCH 15/46] more updates from tanya --- physics/GFS_surface_composites_post.F90 | 191 +++++++++++++---------- physics/GFS_surface_composites_post.meta | 35 +++++ physics/GFS_surface_composites_pre.F90 | 27 ++-- physics/GFS_surface_composites_pre.meta | 16 +- physics/clm_lake.f90 | 54 +------ physics/clm_lake.meta | 7 - 6 files changed, 179 insertions(+), 151 deletions(-) diff --git a/physics/GFS_surface_composites_post.F90 b/physics/GFS_surface_composites_post.F90 index 62c014417..c05113f7f 100644 --- a/physics/GFS_surface_composites_post.F90 +++ b/physics/GFS_surface_composites_post.F90 @@ -24,7 +24,7 @@ module GFS_surface_composites_post !! subroutine GFS_surface_composites_post_run ( & im, kice, km, rd, rvrdm1, cplflx, cplwav2atm, frac_grid, flag_cice, thsfc_loc, islmsk, dry, wet, icy, wind, t1, q1, prsl1, & - landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, garea, & + landfrac, lakefrac, oceanfrac, zorl, zorlo, zorll, zorli, garea, frac_ice, & cd, cd_wat, cd_lnd, cd_ice, cdq, cdq_wat, cdq_lnd, cdq_ice, rb, rb_wat, rb_lnd, rb_ice, stress, stress_wat, stress_lnd, & stress_ice, ffmm, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh, ffhh_wat, ffhh_lnd, ffhh_ice, uustar, uustar_wat, uustar_lnd, & uustar_ice, fm10, fm10_wat, fm10_lnd, fm10_ice, fh2, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice, & @@ -32,17 +32,17 @@ subroutine GFS_surface_composites_post_run ( ep1d_lnd, ep1d_ice, weasd, weasd_lnd, weasd_ice, snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd, & qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice, & - sigmaf, zvfun, lheatstrg, h0facu, h0facs, hflxq, hffac, stc, & + sigmaf, zvfun, lheatstrg, h0facu, h0facs, hflxq, hffac, stc, lkm, iopt_lake, iopt_lake_clm, use_lake_model, & grav, prsik1, prslk1, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, huge, errmsg, errflg) implicit none - integer, intent(in) :: im, kice, km - logical, intent(in) :: cplflx, frac_grid, cplwav2atm + integer, intent(in) :: im, kice, km, lkm, iopt_lake, iopt_lake_clm + logical, intent(in) :: cplflx, frac_grid, cplwav2atm, frac_ice logical, intent(in) :: lheatstrg logical, dimension(:), intent(in) :: flag_cice, dry, icy logical, dimension(:), intent(inout) :: wet - integer, dimension(:), intent(in) :: islmsk + integer, dimension(:), intent(in) :: islmsk, use_lake_model real(kind=kind_phys), dimension(:), intent(in) :: wind, t1, q1, prsl1, landfrac, lakefrac, oceanfrac, & cd_wat, cd_lnd, cd_ice, cdq_wat, cdq_lnd, cdq_ice, rb_wat, rb_lnd, rb_ice, stress_wat, & stress_lnd, stress_ice, ffmm_wat, ffmm_lnd, ffmm_ice, ffhh_wat, ffhh_lnd, ffhh_ice, uustar_wat, uustar_lnd, uustar_ice, & @@ -88,13 +88,13 @@ subroutine GFS_surface_composites_post_run ( errflg = 0 ! --- generate ocean/land/ice composites - do i=1, im - if(lakefrac(i)>0.0) then + do i=1, im + if(use_lake_model(i) > 0.0) then wet(i) = .true. endif - enddo + enddo - if (frac_grid) then + if_frac_grid: if (frac_grid) then do i=1, im @@ -266,7 +266,7 @@ subroutine GFS_surface_composites_post_run ( endif enddo - else + else ! not fractional grid do i=1,im ! if (islmsk(i) == 1) then @@ -299,89 +299,110 @@ subroutine GFS_surface_composites_post_run ( ! elseif (islmsk(i) == 0) then elseif (wet(i)) then !-- water - zorl(i) = zorlo(i) - cd(i) = cd_wat(i) - cdq(i) = cdq_wat(i) - rb(i) = rb_wat(i) - stress(i) = stress_wat(i) - ffmm(i) = ffmm_wat(i) - ffhh(i) = ffhh_wat(i) - uustar(i) = uustar_wat(i) - fm10(i) = fm10_wat(i) - fh2(i) = fh2_wat(i) - tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) - tsfc(i) = tsfco(i) - tsfcl(i) = tsfc(i) - tisfc(i) = tsfc(i) - cmm(i) = cmm_wat(i) - chh(i) = chh_wat(i) - gflx(i) = gflx_wat(i) - ep1d(i) = ep1d_wat(i) - weasd(i) = zero - snowd(i) = zero - evap(i) = evap_wat(i) - hflx(i) = hflx_wat(i) - qss(i) = qss_wat(i) - hice(i) = zero - cice(i) = zero + call composite_wet else ! islmsk(i) == 2 !-- ice - zorl(i) = zorli(i) - cd(i) = cd_ice(i) - cdq(i) = cdq_ice(i) - rb(i) = rb_ice(i) - ffmm(i) = ffmm_ice(i) - ffhh(i) = ffhh_ice(i) - uustar(i) = uustar_ice(i) - fm10(i) = fm10_ice(i) - fh2(i) = fh2_ice(i) - stress(i) = stress_ice(i) - cmm(i) = cmm_ice(i) - chh(i) = chh_ice(i) - gflx(i) = gflx_ice(i) - ep1d(i) = ep1d_ice(i) - weasd(i) = weasd_ice(i) * cice(i) - snowd(i) = snowd_ice(i) * cice(i) - qss(i) = qss_ice(i) - evap(i) = evap_ice(i) - hflx(i) = hflx_ice(i) -! - txi = cice(i) - txo = one - txi - evap(i) = txi * evap_ice(i) + txo * evap_wat(i) - hflx(i) = txi * hflx_ice(i) + txo * hflx_wat(i) - tsfc(i) = txi * tisfc(i) + txo * tsfc_wat(i) - stress(i) = txi * stress_ice(i) + txo * stress_wat(i) - qss(i) = txi * qss_ice(i) + txo * qss_wat(i) - ep1d(i) = txi * ep1d_ice(i) + txo * ep1d_wat(i) - - lnzorli = zero ; lnzorlo = zero - if (zorli(i) /= huge) then - lnzorli = log(zorli(i)) - endif - if (zorlo(i) /= huge) then - lnzorlo = log(zorlo(i)) - endif - zorl(i) = exp(txi*lnzorli + txo*lnzorlo) -! zorl(i) = exp(txi*log(zorli(i)) + txo*log(zorlo(i))) -! - if (wet(i)) then - tsfco(i) = tsfc_wat(i) - else - tsfco(i) = tsfc(i) - endif - tsfcl(i) = tsfc(i) - do k=1,min(kice,km) ! store tiice in stc to reduce output in the nonfrac grid case - stc(i,k) = tiice(i,k) - enddo + call composite_icy(.true.) + call composite_combine_wet_icy endif - enddo - endif ! if (frac_grid) + endif if_frac_grid ! --- compositing done + contains + + subroutine composite_wet + implicit none + zorl(i) = zorlo(i) + cd(i) = cd_wat(i) + cdq(i) = cdq_wat(i) + rb(i) = rb_wat(i) + stress(i) = stress_wat(i) + ffmm(i) = ffmm_wat(i) + ffhh(i) = ffhh_wat(i) + uustar(i) = uustar_wat(i) + fm10(i) = fm10_wat(i) + fh2(i) = fh2_wat(i) + tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) + tsfc(i) = tsfco(i) + tsfcl(i) = tsfc(i) + tisfc(i) = tsfc(i) + cmm(i) = cmm_wat(i) + chh(i) = chh_wat(i) + gflx(i) = gflx_wat(i) + ep1d(i) = ep1d_wat(i) + weasd(i) = zero + snowd(i) = zero + evap(i) = evap_wat(i) + hflx(i) = hflx_wat(i) + qss(i) = qss_wat(i) + hice(i) = zero + cice(i) = zero + end subroutine composite_wet + + subroutine composite_icy(cice_weighting) + implicit none + logical, intent(in) :: cice_weighting + zorl(i) = zorli(i) + cd(i) = cd_ice(i) + cdq(i) = cdq_ice(i) + rb(i) = rb_ice(i) + ffmm(i) = ffmm_ice(i) + ffhh(i) = ffhh_ice(i) + uustar(i) = uustar_ice(i) + fm10(i) = fm10_ice(i) + fh2(i) = fh2_ice(i) + stress(i) = stress_ice(i) + cmm(i) = cmm_ice(i) + chh(i) = chh_ice(i) + gflx(i) = gflx_ice(i) + ep1d(i) = ep1d_ice(i) + if(cice_weighting) then + weasd(i) = weasd_ice(i) * cice(i) + snowd(i) = snowd_ice(i) * cice(i) + else + weasd(i) = weasd_ice(i) + snowd(i) = snowd_ice(i) + endif + qss(i) = qss_ice(i) + evap(i) = evap_ice(i) + hflx(i) = hflx_ice(i) + end subroutine composite_icy + + subroutine composite_combine_wet_icy + implicit none + txi = cice(i) + txo = one - txi + evap(i) = txi * evap_ice(i) + txo * evap_wat(i) + hflx(i) = txi * hflx_ice(i) + txo * hflx_wat(i) + tsfc(i) = txi * tisfc(i) + txo * tsfc_wat(i) + stress(i) = txi * stress_ice(i) + txo * stress_wat(i) + qss(i) = txi * qss_ice(i) + txo * qss_wat(i) + ep1d(i) = txi * ep1d_ice(i) + txo * ep1d_wat(i) + + lnzorli = zero ; lnzorlo = zero + if (zorli(i) /= huge) then + lnzorli = log(zorli(i)) + endif + if (zorlo(i) /= huge) then + lnzorlo = log(zorlo(i)) + endif + zorl(i) = exp(txi*lnzorli + txo*lnzorlo) + ! zorl(i) = exp(txi*log(zorli(i)) + txo*log(zorlo(i))) + ! + if (wet(i)) then + tsfco(i) = tsfc_wat(i) + else + tsfco(i) = tsfc(i) + endif + tsfcl(i) = tsfc(i) + do k=1,min(kice,km) ! store tiice in stc to reduce output in the nonfrac grid case + stc(i,k) = tiice(i,k) + enddo + end subroutine composite_combine_wet_icy + end subroutine GFS_surface_composites_post_run end module GFS_surface_composites_post diff --git a/physics/GFS_surface_composites_post.meta b/physics/GFS_surface_composites_post.meta index c7e8c6476..a78610cc7 100644 --- a/physics/GFS_surface_composites_post.meta +++ b/physics/GFS_surface_composites_post.meta @@ -29,6 +29,34 @@ dimensions = () type = integer intent = in +[lkm] + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst + units = flag + dimensions = () + type = integer + intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = in [rd] standard_name = gas_constant_of_dry_air long_name = ideal gas constant for dry air @@ -66,6 +94,13 @@ dimensions = () type = logical intent = in +[frac_ice] + standard_name = flag_for_fractional_ice_when_fractional_landmask_is_disabled + long_name = flag for fractional ice when fractional landmask is disabled + units = flag + dimensions = () + type = logical + intent = in [flag_cice] standard_name = flag_for_cice long_name = flag for cice diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/GFS_surface_composites_pre.F90 index 862ba2b6c..9a34fddf7 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/GFS_surface_composites_pre.F90 @@ -21,7 +21,7 @@ module GFS_surface_composites_pre !> \section arg_table_GFS_surface_composites_pre_run Argument Table !! \htmlinclude GFS_surface_composites_pre_run.html !! - subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, & + subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_lake_clm, & flag_cice, cplflx, cplice, cplwav2atm, lsm, lsm_ruc, & landfrac, lakefrac, lakedepth, oceanfrac, frland, & dry, icy, lake, use_lake_model, wet, hice, cice, zorlo, zorll, zorli, & @@ -35,11 +35,11 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, implicit none ! Interface variables - integer, intent(in ) :: im, lkm, kdt, lsm, lsm_ruc + integer, intent(in ) :: im, lkm, kdt, lsm, lsm_ruc, iopt_lake, iopt_lake_clm logical, intent(in ) :: cplflx, cplice, cplwav2atm, frac_grid logical, dimension(:), intent(inout) :: flag_cice logical, dimension(:), intent(inout) :: dry, icy, lake, wet - integer, dimension(:), intent(inout) :: use_lake_model + integer, dimension(:), intent(in ) :: use_lake_model real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac real(kind=kind_phys), dimension(:), intent(inout) :: cice, hice real(kind=kind_phys), dimension(:), intent( out) :: frland @@ -67,16 +67,17 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, ! Local variables integer :: i + logical :: is_clm ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - do i=1,im + do i=1,im if(use_lake_model(i) > 0.0) then wet(i) = .true. endif - enddo + enddo if (frac_grid) then ! cice is ice fraction wrt water area do i=1,im @@ -183,10 +184,13 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, if (icy(i)) tsfco(i) = max(tisfc(i), tgice) endif endif - else + else ! Not ocean and not land + is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 if (cice(i) >= min_lakeice) then icy(i) = .true. - tisfc(i) = max(timin, min(tisfc(i), tgice)) + if(.not.is_clm) then + tisfc(i) = max(timin, min(tisfc(i), tgice)) + endif islmsk(i) = 2 else cice(i) = zero @@ -198,7 +202,9 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice(i) = .false. if (cice(i) < one) then wet(i) = .true. ! some open lake - if (icy(i)) tsfco(i) = max(tisfc(i), tgice) + if (icy(i) .and. .not.is_clm) then + tsfco(i) = max(tisfc(i), tgice) + endif endif endif endif @@ -233,7 +239,10 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, endif if (icy(i)) then ! Ice uustar_ice(i) = uustar(i) - if(lsm /= lsm_ruc) weasd_ice(i) = weasd(i) + is_clm = lkm>0 .and. iopt_lake==iopt_lake_clm .and. use_lake_model(i)>0 + if(lsm /= lsm_ruc .and. .not.is_clm) then + weasd_ice(i) = weasd(i) + endif tsurf_ice(i) = tisfc(i) ep1d_ice(i) = zero gflx_ice(i) = zero diff --git a/physics/GFS_surface_composites_pre.meta b/physics/GFS_surface_composites_pre.meta index 6a56b35b8..d62076e4b 100644 --- a/physics/GFS_surface_composites_pre.meta +++ b/physics/GFS_surface_composites_pre.meta @@ -137,7 +137,21 @@ units = flag dimensions = (horizontal_loop_extent) type = integer - intent = inout + intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in [wet] standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 97cbe025f..e444b9453 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -42,7 +42,7 @@ MODULE clm_lake logical, parameter :: USE_ETALAKE = .false. real, parameter :: ETALAKE = 1.1925*50**(-0.424) ! Set this to your desired value if USE_ETALAKE=.true. - ! Level counts must be consistent with model (GFS_Typedefs.F90) + ! Level counts must be consistent with model (GFS_typedefs.F90) integer, parameter :: nlevsoil = 10 ! number of soil layers integer, parameter :: nlevlake = 10 ! number of lake layers integer, parameter :: nlevsnow = 5 ! maximum number of snow layers @@ -126,50 +126,12 @@ MODULE clm_lake real, parameter :: SaltLk_T(1:25) = (/ 0.5, 0.,-0.5, 3., 4., 7., 8., 12., 13., 16., 19., 21., & 23.5, 25., 26.,24.,23.,20.5,18., 15., 11.5, 8., 4., 1., 0.5/) real, parameter :: month_length(12) = (/ 31, 29, 31, 30, 31, 30, 31, 30, 30, 31, 30, 31 /) - real, parameter :: julm(1:13) = (/0,31,59,90,120,151,181,212,243,273,304,334,365/) logical, parameter :: include_all_salty_locations = .false. CONTAINS !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - subroutine get_month_and_day(IDATE,month,day_of_month,day_of_year,fhour) - implicit none - integer, intent(in) :: IDATE(4) - integer, intent(out) :: month,day_of_month,day_of_year - real(kind_phys), intent(in) :: fhour - - integer :: idat(8),jdat(8), w3kindreal, w3kindint, jdow, jdoy, jday - real(8) :: rinc(5) - real(4) :: rinc4(5) - - idat = 0 - idat(1) = idate(4) - idat(2) = idate(2) - idat(3) = idate(3) - idat(5) = idate(1) - rinc = 0. - rinc(2) = fhour - call w3kind(w3kindreal,w3kindint) - if(w3kindreal==4) then - rinc4 = rinc - CALL W3MOVDAT(RINC4,IDAT,JDAT) - else - CALL W3MOVDAT(RINC,IDAT,JDAT) - endif -! - jdow = 0 - jdoy = 0 - jday = 0 - call w3doxdat(jdat,jdow,jdoy,jday) - - day_of_year = jday - day_of_month = IDATE(3) - month = IDATE(2) - end subroutine get_month_and_day - - !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - logical function limit_temperature_by_climatology(xlat_d,xlon_positive) implicit none real(kind_phys), intent(in) :: xlat_d, xlon_positive @@ -228,7 +190,7 @@ logical function is_salty(xlat_d,xlon_positive) is_salty=limit_temperature_by_climatology(xlat_d,xlon_d) - if(include_all_salty_locations) then + other_locations: if(include_all_salty_locations) then ! --- The Mono Lake in California, salinity is 75 ppt with freezing point at ! --- -4.2 C (Stan). The Mono Lake lat/long (37.9-38.2, -119.3 - 118.8) if (xlon_d.gt.-119.3.and. xlon_d.lt.-118.8) then @@ -253,7 +215,7 @@ logical function is_salty(xlat_d,xlon_positive) endif is_salty = .true. endif - endif + endif other_locations !tgs --- end of special treatment for salty lakes end function is_salty @@ -268,7 +230,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& rain ,dtp ,dswsfci ,albedo ,& xlat_d ,z_lake3d ,dz_lake3d ,oro_lakedepth ,& watsat3d ,csol3d ,tkmg3d ,tkdry3d ,& - tksatu3d ,wet ,phii ,clm_lakedepth ,& + tksatu3d , phii ,clm_lakedepth ,& fice ,min_lakeice ,im,km ,& h2osno2d ,snowdp2d ,snl2d ,z3d ,& !h dz3d ,zi3d ,h2osoi_vol3d ,h2osoi_liq3d ,& @@ -307,7 +269,7 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& LOGICAL, INTENT(IN) :: restart,use_lakedepth,first_time_step REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_rd,con_g,con_cp,lakedepth_default, fhour - logical, intent(inout) :: icy(:), wet(:) + logical, intent(inout) :: icy(:) REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: fice REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT) :: weasd, snowd REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN):: tg3, pgr @@ -758,11 +720,6 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& tisfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice icy(i)=.true. - if(fice(i)==1.) then - wet(i) = .false. - else - wet(i) = .true. - endif ice_points = ice_points+1 zorli(i) = z0mg(c) @@ -776,7 +733,6 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& end do else icy(i)=.false. - wet(i)=.true. weasdi(i) = 0 snodi(i) = 0 tisfc(i) = tsurf(i) diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 5a2cd9565..5224b3616 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -726,13 +726,6 @@ dimensions = () type = integer intent = in -[wet] - standard_name = flag_nonzero_wet_surface_fraction - long_name = flag indicating presence of some ocean or lake surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = inout [icy] standard_name = flag_nonzero_sea_ice_surface_fraction long_name = flag indicating presence of some sea ice surface area fraction From 833905039101dc13ccf6a46ec94b47470f4b5a78 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 20 Oct 2022 16:52:38 +0000 Subject: [PATCH 16/46] rework variables and add fractional ice --- physics/GFS_surface_composites_post.F90 | 105 +-- physics/clm_lake.f90 | 407 ++++++----- physics/clm_lake.meta | 904 +++++++++++++----------- 3 files changed, 780 insertions(+), 636 deletions(-) diff --git a/physics/GFS_surface_composites_post.F90 b/physics/GFS_surface_composites_post.F90 index c05113f7f..eb6b2e32e 100644 --- a/physics/GFS_surface_composites_post.F90 +++ b/physics/GFS_surface_composites_post.F90 @@ -94,7 +94,7 @@ subroutine GFS_surface_composites_post_run ( endif enddo - if_frac_grid: if (frac_grid) then + fractional_grid: if (frac_grid) then do i=1, im @@ -269,49 +269,70 @@ subroutine GFS_surface_composites_post_run ( else ! not fractional grid do i=1,im -! if (islmsk(i) == 1) then + + ! This code assumes points are always 100% lake or 0% lake, + ! and lake points must have wet(i)=true, even if they have + ! 100% ice cover. The only fractional coverage allowed is + ! fractional ice on lake points that ran the CLM Lake + ! Model (frac_ice). For more general fractional grid support, use + ! frac_grid. + if (dry(i)) then - !-- land - zorl(i) = zorll(i) - cd(i) = cd_lnd(i) - cdq(i) = cdq_lnd(i) - rb(i) = rb_lnd(i) - stress(i) = stress_lnd(i) - ffmm(i) = ffmm_lnd(i) - ffhh(i) = ffhh_lnd(i) - uustar(i) = uustar_lnd(i) - fm10(i) = fm10_lnd(i) - fh2(i) = fh2_lnd(i) - tsfc(i) = tsfcl(i) - tsfco(i) = tsfc(i) - tisfc(i) = tsfc(i) - cmm(i) = cmm_lnd(i) - chh(i) = chh_lnd(i) - gflx(i) = gflx_lnd(i) - ep1d(i) = ep1d_lnd(i) - weasd(i) = weasd_lnd(i) - snowd(i) = snowd_lnd(i) - evap(i) = evap_lnd(i) - hflx(i) = hflx_lnd(i) - qss(i) = qss_lnd(i) - hice(i) = zero - cice(i) = zero -! elseif (islmsk(i) == 0) then - elseif (wet(i)) then - !-- water + ! This is a land point. + call composite_land + elseif(frac_ice .and. use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then + ! This is a lake point where the CLM Lake Model was run with frac_ice. + if(icy(i)) then + ! Lake point has more than min_lakeice ice. + call composite_icy(.true.) + call composite_wet_and_icy + else + ! Lake point has less than min_lakeice ice. + call composite_wet + endif + else if (wet(i)) then + ! Wet point that is not a lake, or lake point with frac_ice disabled. call composite_wet else ! islmsk(i) == 2 - !-- ice - call composite_icy(.true.) - call composite_combine_wet_icy + ! This is not a lake point, and it is icy. + call composite_icy(.false.) + call composite_wet_and_icy endif enddo - endif if_frac_grid + endif fractional_grid ! --- compositing done contains + + subroutine composite_land + implicit none + zorl(i) = zorll(i) + cd(i) = cd_lnd(i) + cdq(i) = cdq_lnd(i) + rb(i) = rb_lnd(i) + stress(i) = stress_lnd(i) + ffmm(i) = ffmm_lnd(i) + ffhh(i) = ffhh_lnd(i) + uustar(i) = uustar_lnd(i) + fm10(i) = fm10_lnd(i) + fh2(i) = fh2_lnd(i) + tsfc(i) = tsfcl(i) + tsfco(i) = tsfc(i) + tisfc(i) = tsfc(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) + gflx(i) = gflx_lnd(i) + ep1d(i) = ep1d_lnd(i) + weasd(i) = weasd_lnd(i) + snowd(i) = snowd_lnd(i) + evap(i) = evap_lnd(i) + hflx(i) = hflx_lnd(i) + qss(i) = qss_lnd(i) + hice(i) = zero + cice(i) = zero + end subroutine composite_land subroutine composite_wet implicit none @@ -342,9 +363,9 @@ subroutine composite_wet cice(i) = zero end subroutine composite_wet - subroutine composite_icy(cice_weighting) + subroutine composite_icy(is_clm) implicit none - logical, intent(in) :: cice_weighting + logical, intent(in) :: is_clm zorl(i) = zorli(i) cd(i) = cd_ice(i) cdq(i) = cdq_ice(i) @@ -359,19 +380,19 @@ subroutine composite_icy(cice_weighting) chh(i) = chh_ice(i) gflx(i) = gflx_ice(i) ep1d(i) = ep1d_ice(i) - if(cice_weighting) then - weasd(i) = weasd_ice(i) * cice(i) - snowd(i) = snowd_ice(i) * cice(i) - else + if(is_clm) then weasd(i) = weasd_ice(i) snowd(i) = snowd_ice(i) + else + weasd(i) = weasd_ice(i) * cice(i) + snowd(i) = snowd_ice(i) * cice(i) endif qss(i) = qss_ice(i) evap(i) = evap_ice(i) hflx(i) = hflx_ice(i) end subroutine composite_icy - subroutine composite_combine_wet_icy + subroutine composite_wet_and_icy implicit none txi = cice(i) txo = one - txi @@ -401,7 +422,7 @@ subroutine composite_combine_wet_icy do k=1,min(kice,km) ! store tiice in stc to reduce output in the nonfrac grid case stc(i,k) = tiice(i,k) enddo - end subroutine composite_combine_wet_icy + end subroutine composite_wet_and_icy end subroutine GFS_surface_composites_post_run diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index e444b9453..3d4cb6d9a 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -224,33 +224,37 @@ end function is_salty !> \section arg_table_clm_lake_run Argument Table !! \htmlinclude clm_lake_run.html !! - SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& - gt0 ,prsi ,con_rd,con_g ,qvcurr ,& !i - gu0 ,gv0 ,dlwsfci ,emiss ,& - rain ,dtp ,dswsfci ,albedo ,& - xlat_d ,z_lake3d ,dz_lake3d ,oro_lakedepth ,& - watsat3d ,csol3d ,tkmg3d ,tkdry3d ,& - tksatu3d , phii ,clm_lakedepth ,& - fice ,min_lakeice ,im,km ,& - h2osno2d ,snowdp2d ,snl2d ,z3d ,& !h - dz3d ,zi3d ,h2osoi_vol3d ,h2osoi_liq3d ,& - h2osoi_ice3d ,t_grnd2d ,t_soisno3d ,t_lake3d ,& - savedtke12d ,lake_icefrac3d ,use_lake_model ,& - iopt_lake ,iopt_lake_clm ,fhour ,& - con_cp ,icy ,IDATE ,& - hflx ,evap ,grdflx ,tsfc ,& !o - lake_t2m ,lake_q2m ,clm_lake_initialized ,& - weasd ,isltyp ,snowd ,use_lakedepth ,& - restart ,lakedepth_default ,pgr ,& - zorlw ,zorli ,sand3d ,clay3d ,& -! Flake output variables - weasdi ,snodi ,hice ,tsurf ,& - t_sfc ,lflx ,ustar ,qsfc ,& - ch ,cm ,chh ,cmm ,& - lake_t_snow ,tisfc ,tsurf_ice ,wind ,& -! - xlon_d ,kdt ,tg3 ,salty ,& - me ,master ,errmsg ,errflg ) + SUBROUTINE clm_lake_run( & + ! Model time and metadata: + im, km, me, master, restart, first_time_step, fhour, IDATE, kdt, & + + ! Configuration and initialization: + iopt_lake, iopt_lake_clm, min_lakeice, lakedepth_default, use_lakedepth, & + dtp, use_lake_model, clm_lake_initialized, frac_grid, frac_ice, & + + ! Atmospheric model state inputs: + tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & + ch, cm, dlwsfci, dswsfci, emiss, rain, oro_lakedepth, wind, rho0, tsfc, & + flag_iter, ISLTYP, & + + ! Feedback to atmosphere: + evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & + ep1d_water, ep1d_ice, tsurf_water, tsurf_ice, tsfc_wat, tisfc, & + weasdi, snodi, hice, qss_water, qss_ice, & + cmm_water, cmm_ice, chh_water, chh_ice, & + uustar_water, uustar_ice, lake_t_snow, albedo, zorlw, & + zorli, lake_t2m, lake_q2m, weasd, snowd, fice, & + icy, & + + ! Lake model internal state stored by caller: + + salty, savedtke12d, snowdp2d, h2osno2d, snl2d, t_grnd2d, t_lake3d, & + lake_icefrac3d, t_soisno3d, h2osoi_ice3d, h2osoi_liq3d, h2osoi_vol3d, & + z3d, dz3d, zi3d, z_lake3d, dz_lake3d, watsat3d, csol3d, sand3d, clay3d, & + tkmg3d, tkdry3d, tksatu3d, clm_lakedepth, & + + ! Error reporting: + errflg, errmsg) !============================================================================== ! This subroutine was first edited by Hongping Gu and Jiming Jin for coupling @@ -260,72 +264,56 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& IMPLICIT NONE - !in: - - INTEGER, INTENT(IN) :: iopt_lake, iopt_lake_clm, kdt, IDATE(4) - INTEGER, INTENT(OUT) :: errflg - CHARACTER(*), INTENT(OUT) :: errmsg + ! + ! Model time and metadata: + ! INTEGER , INTENT (IN) :: im,km,me,master - LOGICAL, INTENT(IN) :: restart,use_lakedepth,first_time_step - REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) - REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_rd,con_g,con_cp,lakedepth_default, fhour - logical, intent(inout) :: icy(:) - REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT):: fice - REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT) :: weasd, snowd - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN):: tg3, pgr - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: ZLVL + LOGICAL, INTENT(IN) :: restart,first_time_step + INTEGER, INTENT(IN) :: IDATE(4), kdt + REAL, INTENT(IN) :: fhour + ! + ! Configuration and initialization: + ! + INTEGER, INTENT(IN) :: iopt_lake, iopt_lake_clm + REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, lakedepth_default, dtp + LOGICAL, INTENT(IN) :: use_lakedepth INTEGER, DIMENSION(:), INTENT(IN) :: use_lake_model - real(kind_phys), dimension(:), intent(in) :: rho0 ! air density at surface - - REAL(KIND_PHYS), DIMENSION( : ), INTENT(INOUT) :: & - weasdi ,snodi ,hice ,tsurf ,& - t_sfc ,lflx ,ustar ,qsfc ,& - chh ,cmm ,lake_t_snow ,tisfc ,& - tsurf_ice ,wind - LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter - REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: gt0 - REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: prsi - REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: phii - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: qvcurr - REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: gu0 - REAL(KIND_PHYS), DIMENSION( :, : ),INTENT(IN) :: gv0 - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: xlat_d, xlon_d - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: ch - REAL(KIND_PHYS), DIMENSION( : ), INTENT(IN) :: cm - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: dlwsfci - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: dswsfci - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: emiss - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN) :: rain - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: albedo, zorlw, zorli - INTEGER, DIMENSION( : ), INTENT(IN) :: ISLTYP + REAL(KIND_PHYS), INTENT(INOUT) :: clm_lake_initialized(:) + LOGICAL, INTENT(IN) :: frac_grid, frac_ice + + ! + ! Atmospheric model state inputs: + ! + REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: & + tg3, pgr, zlvl, qvcurr, xlat_d, xlon_d, ch, cm, & + dlwsfci, dswsfci, emiss, rain, oro_lakedepth, wind, rho0, tsfc + REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii + LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter + INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP + + ! + ! Feedback to atmosphere: + ! + REAL(KIND_PHYS), DIMENSION(:), INTENT(INOUT) :: & + evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & + ep1d_water, ep1d_ice, tsurf_water, tsurf_ice, tsfc_wat, tisfc, & + weasdi, snodi, hice, qss_water, qss_ice, & + cmm_water, cmm_ice, chh_water, chh_ice, & + uustar_water, uustar_ice, lake_t_snow, albedo, zorlw, & + zorli, lake_t2m, lake_q2m, weasd, snowd, fice + LOGICAL, INTENT(INOUT) :: icy(:) + + ! + ! Lake model internal state stored by caller: + ! INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty - REAL(KIND_PHYS), INTENT(IN) :: dtp - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: z_lake3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: dz_lake3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: watsat3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: csol3d, sand3d, clay3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkmg3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkdry3d - REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tksatu3d - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: clm_lakedepth - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN ) :: oro_lakedepth - - !feedback to atmosphere: - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: hflx - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: evap - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: GRDFLX - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(IN ) :: tsfc - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: lake_t2m - REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(OUT) :: lake_q2m - - !in&out: - - real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d - real(kind_phys), dimension(: ) ,intent(inout) :: snowdp2d, & - h2osno2d, & - snl2d, & - t_grnd2d + + real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d, & + snowdp2d, & + h2osno2d, & + snl2d, & + t_grnd2d real(kind_phys), dimension( :,: ) ,INTENT(inout) :: t_lake3d, & lake_icefrac3d @@ -336,15 +324,33 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& z3d, & dz3d real(kind_phys), dimension( :,-nlevsnow+0: ) ,INTENT(inout) :: zi3d + + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: z_lake3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: dz_lake3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: watsat3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: csol3d, sand3d, clay3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkmg3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tkdry3d + REAL(KIND_PHYS), DIMENSION( :,: ),INTENT(INOUT) :: tksatu3d + REAL(KIND_PHYS), DIMENSION( : ) ,INTENT(INOUT) :: clm_lakedepth + + ! + ! Error reporting: + ! + INTEGER, INTENT(OUT) :: errflg + CHARACTER(*), INTENT(OUT) :: errmsg + - !local variable: + ! + !local variables: + ! REAL(kind_phys) :: SFCTMP,PBOT,PSFC,Q2K,LWDN,PRCP,SOLDN,SOLNET,dtime INTEGER :: C,i,j,k - !tempory varibles in: + !temporary varibles in: real(kind_phys) :: forc_t(1) ! atmospheric temperature (Kelvin) real(kind_phys) :: forc_pbot(1) ! atm bottom level pressure (Pa) real(kind_phys) :: forc_psrf(1) ! atmospheric surface pressure (Pa) @@ -466,20 +472,21 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& endif endif - ! Still have some points to initialize - call lakeini(kdt, ISLTYP, gt0, snowd, & - weasd, restart, lakedepth_default, fhour, & - oro_lakedepth, savedtke12d, snowdp2d, h2osno2d, & - snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & - z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & - h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & - zi3d, watsat3d, csol3d, tkmg3d, & - fice, min_lakeice, tsfc, & - use_lake_model, use_lakedepth, con_g, con_rd, & - tkdry3d, tksatu3d, im, prsi, & - xlat_d, xlon_d, clm_lake_initialized, & - sand3d, clay3d, tg3, clm_lakedepth, & - km, me, master, errmsg, errflg) + ! Initialize any uninitialized lake points. + call lakeini(kdt=kdt, ISLTYP=ISLTYP, gt0=gt0, snowd=snowd, weasd=weasd, & + restart=restart, lakedepth_default=lakedepth_default, fhour=fhour, & + oro_lakedepth=oro_lakedepth, savedtke12d=savedtke12d, snowdp2d=snowdp2d, & + h2osno2d=h2osno2d, snl2d=snl2d, t_grnd2d=t_grnd2d, t_lake3d=t_lake3d, & + lake_icefrac3d=lake_icefrac3d, z_lake3d=z_lake3d, dz_lake3d=dz_lake3d, & + t_soisno3d=t_soisno3d, h2osoi_ice3d=h2osoi_ice3d, h2osoi_liq3d=h2osoi_liq3d, & + h2osoi_vol3d=h2osoi_vol3d, z3d=z3d, dz3d=dz3d, zi3d=zi3d, watsat3d=watsat3d, & + csol3d=csol3d, tkmg3d=tkmg3d, fice=fice, min_lakeice=min_lakeice, & + tsfc=tsfc, & + use_lake_model=use_lake_model, use_lakedepth=use_lakedepth, tkdry3d=tkdry3d, & + tksatu3d=tksatu3d, im=im, prsi=prsi, xlat_d=xlat_d, xlon_d=xlon_d, & + clm_lake_initialized=clm_lake_initialized, sand3d=sand3d, clay3d=clay3d, & + tg3=tg3, clm_lakedepth=clm_lakedepth, km=km, me=me, master=master, & + errmsg=errmsg, errflg=errflg) if(errflg/=0) then return endif @@ -535,13 +542,13 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& if(salty(i)/=0) then Tclim = tfrz + wght1*saltlk_T(num1) & + wght2*saltlk_T(num2) - if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,tsfc(i),t_lake3d(i,:),t_soisno3d(i,:) - t_grnd2d(i) = min(Tclim+3.0_kind_phys,(max(tsfc(i),Tclim-3.0_kind_phys))) + if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,tsfc_wat(i),t_lake3d(i,:),t_soisno3d(i,:) + t_grnd2d(i) = min(Tclim+3.0_kind_phys,(max(tsfc_wat(i),Tclim-3.0_kind_phys))) do k = 1,nlevlake t_lake3d(i,k) = min(Tclim+3.0_kind_phys,(max(t_lake3d(i,k),Tclim-3.0_kind_phys))) enddo t_soisno3d(i,1) = min(Tclim+3.0_kind_phys,(max(t_soisno3d(i,1),Tclim-3.0_kind_phys))) - if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,tsfc(i),t_lake3d(i,:),t_soisno3d(i,:) + if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,tsfc_wat(i),t_lake3d(i,:),t_soisno3d(i,:) endif SFCTMP = gt0(i,1) @@ -688,81 +695,99 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& enddo - if(feedback_to_atmosphere) then + feedback: if(feedback_to_atmosphere) then c = 1 - ! No equivalent in CCPP: - ! LH(I) = eflx_lh_tot(c)/rho1(i) ![kg*m/(kg*s)] - !-- The CLM output is combined for fractional ice and water if( t_grnd(c) >= tfrz ) then qfx = eflx_lh_tot(c)/hvap else - qfx = eflx_lh_tot(c)/hsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) + qfx = eflx_lh_tot(c)/hsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) endif - evap(i) = qfx/rho0(i) ! kinematic_surface_upward_latent_heat_flux_over_water - HFLX(i)=eflx_sh_tot(c)/(rho0(i)*con_cp) ! kinematic_surface_upward_sensible_heat_flux_over_water - GRDFLX(I) = eflx_gnet(c) ![W/m/m] upward_heat_flux_in_soil_over_water - lflx(i) = eflx_lh_tot(c) ![W/m/m] surface_upward_potential_latent_heat_flux_over_water - tsurf(I) = t_grnd(c) ![K] surface skin temperature after iteration over water - t_sfc(I) = t_grnd(c) ![K] surface skin temperature over water - lake_t2m(I) = t_ref2m(c) - !TH2(I) = T2(I)*(1.E5/PSFC)**RCP ! potential temperature (CCPP doesn't want this) - lake_q2m(I) = q_ref2m(c) ! [frac] specific humidity - albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + ( (1.0-lake_icefrac3d(i,1)) * 0.08) - fice(i) = lake_icefrac3d(i,1) - - zorlw(i) = z0mg(c) - - if(fice(i)>=min_lakeice) then - weasdi(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice - snodi(i) = snowdp(c) ! surface_snow_thickness_water_equivalent_over_ice - tisfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice - tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice - icy(i)=.true. + evap_wat(i) = qfx/rho0(i) ! kinematic_surface_upward_latent_heat_flux_over_water + hflx_wat(i)=eflx_sh_tot(c)/(rho0(i)*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water + gflx_wat(I) = eflx_gnet(c) ![W/m/m] upward_heat_flux_in_soil_over_water + ep1d_water(i) = eflx_lh_tot(c) ![W/m/m] surface_upward_potential_latent_heat_flux_over_water + tsurf_water(I) = t_grnd(c) ![K] surface skin temperature after iteration over water + tsfc_wat(i) = t_grnd(c) ![K] surface skin temperature over water + lake_t2m(I) = t_ref2m(c) ![K] temperature_at_2m_from_clm_lake + lake_q2m(I) = q_ref2m(c) ! [frac] specific_humidity_at_2m_from_clm_lake + albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + & ! mid_day_surface_albedo_over_lake + ( (1.0-lake_icefrac3d(i,1)) * 0.08) + fice(i) = lake_icefrac3d(i,1) ! sea_ice_area_fraction_of_sea_area_fraction + uustar_water(i) = ustar_out(c) ! surface_friction_velocity_over_water + zorlw(i) = z0mg(c) ! surface_roughness_length_over_water + + ! WRF variables with no equivalent in CCPP: + ! LH(I) = eflx_lh_tot(c)/rho1(i) ![kg*m/(kg*s)] + !TH2(I) = T2(I)*(1.E5/PSFC)**RCP ! potential temperature + + ! Calculate qsfc from t_grnd: ! surface_specific_humidity_over_water + PSFC = prsi(i,1) + discard1 = -9999 + discard2 = -9999 + discard3 = -9999 + call QSat(t_grnd(c),psfc,discard1,discard2,qss_water(i),discard3) + + ! Combined water-ice chh and cmm calculations come from Flake model: + chh_water(i) = ch(i)*wind(i)*1.225 ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water + cmm_water(i) = cm(i)*wind(i) ! surface_drag_wind_speed_for_momentum_in_air_over_water + + ice_point: if(fice(i)>=min_lakeice) then + ! Most ice variables are identical to water variables. + if(frac_ice .or. frac_grid) then + evap_ice(i) = evap_wat(i) ! kinematic_surface_upward_latent_heat_flux_over_ice + hflx_ice(i) = hflx_wat(i) ! kinematic_surface_upward_sensible_heat_flux_over_ice + gflx_ice(i) = gflx_wat(i) ! upward_heat_flux_in_soil_over_ice + ep1d_ice(i) = ep1d_water(i) ! surface_upward_potential_latent_heat_flux_over_ice + chh_ice(i) = chh_water(i) ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + cmm_ice(i) = cmm_water(i) ! surface_drag_wind_speed_for_momentum_in_air_over_ice + qss_ice(i) = qss_water(i) ! surface_specific_humidity_over_ice + uustar_ice(i) = uustar_water(c) ! surface_friction_velocity_over_ice + endif + + tsurf_ice(i) = tsurf_water(i) ! surface_skin_temperature_after_iteration_over_ice + tisfc(i) = t_grnd(c) ! surface_skin_temperature_over_ice + weasdi(i) = h2osno(c) ! water_equivalent_accumulated_snow_depth_over_ice + snodi(i) = snowdp(c) ! surface_snow_thickness_water_equivalent_over_ice + tsurf_ice(i) = t_grnd(c) ! surface_skin_temperature_after_iteration_over_ice + + ! Ice points are icy: + icy(i)=.true. ! flag_nonzero_sea_ice_surface_fraction ice_points = ice_points+1 - zorli(i) = z0mg(c) + zorli(i) = z0mg(c) ! surface_roughness_length_over_ice ! Assume that, if a layer has ice, the entire layer thickness is ice. - hice(I) = 0 + hice(I) = 0 ! sea_ice_thickness do k=1,nlevlake if(lake_icefrac3d(i,k)>0) then hice(i) = hice(i) + dz_lake3d(i,k) endif end do - else + else ! Not an ice point + ! On non-icy lake points, set variables relevant to + ! lake ice to reasonable defaults. Let LSM fill in + ! other variables. icy(i)=.false. weasdi(i) = 0 snodi(i) = 0 - tisfc(i) = tsurf(i) + tisfc(i) = t_grnd(c) tsurf_ice(i) = tisfc(i) hice(i) = 0 fice(i) = 0 - endif + endif ice_point if(snl2d(i)<0) then - lake_t_snow(i) = t_grnd(c) - tisfc(i) = lake_t_snow(i) + ! If there is snow, ice surface temperature should be snow temperature. + lake_t_snow(i) = t_grnd(c) ! surface_skin_temperature_over_ice + tisfc(i) = lake_t_snow(i) ! temperature_of_snow_on_lake snow_points = snow_points+1 else lake_t_snow(i) = -9999 endif - ustar = ustar_out(1) ! surface_friction_velocity_over_water - - ! Calculate qsfc from t_grnd: (surface_specific_humidity_over_water) - PSFC = prsi(i,1) - discard1 = -9999 - discard2 = -9999 - discard3 = -9999 - call QSat(t_grnd(c),psfc,discard1,discard2,qsfc(i),discard3) - - ! From flake driver - combined ice/water: - chh(i)=ch(i)*wind(i)*1.225 ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water - cmm(i)=cm(i)*wind(i) ! surface_drag_wind_speed_for_momentum_in_air_over_water - - endif + endif feedback endif if_lake_is_here ENDDO lake_top_loop @@ -775,28 +800,62 @@ SUBROUTINE clm_lake_run( flag_iter ,zlvl ,rho0 ,first_time_step ,& CONTAINS logical function point_is_unhappy(xlat_d,xlon_d) + ! Is this point near one of the points read in from the unhappy_txt file? + ! If lakedebug is false, then it will return false immediately. implicit none integer :: j real, intent(in) :: xlat_d,xlon_d - do j=1,unhappy_count - if(abs(xlat_d-unhappy_lat(j))<.015 .and. abs(xlon_d-unhappy_lon(j))<.015) then - point_is_unhappy=.true. -1444 format('Now processing unhappy point ',I0,' location xlat_d=',F20.12,' xlon_d=',F20.12,' close to xlat_d=',F20.12,' xlon_d=',F20.12) - print 1444,j,xlat_d,xlon_d,unhappy_lat(j),unhappy_lon(j) - return - endif - enddo + if(lakedebug) then + do j=1,unhappy_count + if(abs(xlat_d-unhappy_lat(j))<.015 .and. abs(xlon_d-unhappy_lon(j))<.015) then + point_is_unhappy=.true. +1444 format('Now processing unhappy point ',I0,' location xlat_d=',F20.12,' xlon_d=',F20.12,' close to xlat_d=',F20.12,' xlon_d=',F20.12) + print 1444,j,xlat_d,xlon_d,unhappy_lat(j),unhappy_lon(j) + return + endif + enddo + endif - ! No points matched + ! No points matched or lakedebug is disabled. point_is_unhappy=.false. end function point_is_unhappy subroutine read_unhappy_points + ! Reads points from unhappy_txt file into unhappy_lat and unhappy lon. + ! Sets unhappy_count to the number of points read in. + ! On error, sets unhappy_count to FAILED_TO_READ_UNHAPPY_POINTS + ! + ! Also allocates unhappy_lat and unhappy_lon. Their size may + ! be larger than the number of unhappy points if the header + ! line with the point count has a higher count than the + ! number of data lines. + ! + ! File format is: + ! ------------------------------------------ + ! |5 | number of points to read in. + ! |12.34567890000000000 12.34567890000000000| Lat and lon, exactly 20 characters each, with one space between + ! | 18.70411 134.4567890000000000| Lat and lon, exactly 20 characters each, with one space between + ! |-19.8567890000000000 -134.05| Lat and lon, exactly 20 characters each, with one space between + ! |36.34567890000000000 28.34567890000000000| Lat and lon, exactly 20 characters each, with one space between + ! |-85.4567890000000000 -41.4567890000000000| Lat and lon, exactly 20 characters each, with one space between + ! ------------------------------------------- + ! + ! Longitudes must be between -180 and +180 degrees. + ! + ! If the lat and lon fields are not exactly 20 characters, + ! with one space between them, the code will not work. You + ! can space-pad them before the number or put lots of zeros + ! after the decimal point. use ISO_FORTRAN_ENV, only: iostat_end, iostat_eor implicit none integer :: i,unhappy_iostat,unhappy_unit,expect_count,actual_count + ! This uses GOTOs to mimics a try-catch construct. Do not + ! remove the GOTOs. They are the cleanest and most + ! maintainable way to implement error handlers in Fortran + ! when a long cleanup block is required in multiple places. + ! Number of points actually read in is 0 since we haven't read yet. actual_count=0 @@ -844,13 +903,17 @@ subroutine read_unhappy_points return ! Success! + ! Error handlers. + + ! Theses do not set errmsg or error flag because this is + ! just an error in setting up a diagnostic, not in the model + ! itself. + 1000 continue ! Error handler, after file is opened close(unhappy_iostat) 1001 continue ! Error handler, whether file was opened or not write(0,'(A)') message - ! errmsg=message - ! errflg=1 if(allocated(unhappy_lat)) deallocate(unhappy_lat) if(allocated(unhappy_lon)) deallocate(unhappy_lon) unhappy_count=FAILED_TO_READ_UNHAPPY_POINTS @@ -5296,7 +5359,6 @@ subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,c end subroutine clm_lake_init -! Some fields in lakeini are not available until runtime, so this cannot be in a CCPP init routine. SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, & !i weasd, restart, lakedepth_default, fhour, & oro_lakedepth, savedtke12d, snowdp2d, h2osno2d, & !o @@ -5304,13 +5366,20 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & h2osoi_liq3d, h2osoi_vol3d, z3d, dz3d, & zi3d, watsat3d, csol3d, tkmg3d, & - fice, min_lakeice, tsfc, & - use_lake_model, use_lakedepth, con_g, con_rd, & + fice, min_lakeice, tsfc, & + use_lake_model, use_lakedepth, & tkdry3d, tksatu3d, im, prsi, & xlat_d, xlon_d, clm_lake_initialized, & sand3d, clay3d, tg3, clm_lakedepth, & km, me, master, errmsg, errflg) + ! Some fields in lakeini are not available during initialization, + ! so clm_lake_init cannot complete the initialization. What is not + ! in clm_lake_init, is initialized in lakeini on points where + ! use_lake_model(i)>0. The clm_lake_initialized(i) guards against + ! initializing a point twice. For that to work, + ! clm_lake_initialized must be a restart variable. + !============================================================================== ! This subroutine was first edited by Hongping Gu for coupling ! 07/20/2010 @@ -5323,7 +5392,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, CHARACTER(*), INTENT(OUT) :: errmsg INTEGER , INTENT (IN) :: im, me, master, km, kdt - REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, con_g, con_rd, fhour + REAL(KIND_PHYS), INTENT(IN) :: min_lakeice, fhour REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT):: FICE REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: TG3, xlat_d, xlon_d REAL(KIND_PHYS), DIMENSION(IM), INTENT(IN):: tsfc diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 5224b3616..e7e3f8ba3 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -7,30 +7,48 @@ [ccpp-arg-table] name = clm_lake_run type = scheme -[pgr] - standard_name = surface_air_pressure - long_name = surface pressure - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[km] + standard_name = vertical_layer_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in +[master] + standard_name = mpi_root + long_name = master MPI-rank + units = index + dimensions = () + type = integer + intent = in +[restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in +[first_time_step] + standard_name = flag_for_first_timestep + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical intent = in -[zorlw] - standard_name = surface_roughness_length_over_water - long_name = surface roughness length over water - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[zorli] - standard_name = surface_roughness_length_over_ice - long_name = surface roughness length over ice - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [fhour] standard_name = forecast_time long_name = current forecast time @@ -46,21 +64,6 @@ dimensions = (4) type = integer intent = in -[salty] - standard_name = clm_lake_is_salty - long_name = lake at this point is salty (1) or not (0) - units = 1 - dimensions = (horizontal_loop_extent) - type = integer - intent = inout -[tg3] - standard_name = deep_soil_temperature - long_name = deep soil temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [kdt] standard_name = index_of_timestep long_name = current forecast iteration @@ -68,20 +71,96 @@ dimensions = () type = integer intent = in -[first_time_step] - standard_name = flag_for_first_timestep - long_name = flag for first time step for time integration loop (cold/warmstart) +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[min_lakeice] + standard_name = min_lake_ice_area_fraction + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in +[lakedepth_default] + standard_name = default_lake_depth_in_clm_lake_model + long_name = default lake depth in clm lake model + units = m + dimensions = () + type = real + kind = kind_phys + intent = in +[use_lakedepth] + standard_name = flag_for_initializing_clm_lake_depth_from_lake_depth + long_name = flag for initializing clm lake depth from lake depth units = flag dimensions = () type = logical intent = in -[flag_iter] - standard_name = flag_for_iteration - long_name = flag for iteration +[dtp] + standard_name = timestep_for_physics + long_name = physics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = inout +[clm_lake_initialized] + standard_name = flag_for_clm_lake_initialization + long_name = set to true in clm_lake_run after likeini is called, as a workaround for ccpp limitation units = flag dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[frac_grid] + standard_name = flag_for_fractional_landmask + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in +[frac_ice] + standard_name = flag_for_fractional_ice_when_fractional_landmask_is_disabled + long_name = flag for fractional ice when fractional landmask is disabled + units = flag + dimensions = () type = logical intent = in +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[pgr] + standard_name = surface_air_pressure + long_name = surface pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [zlvl] standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) @@ -106,19 +185,11 @@ type = real kind = kind_phys intent = in -[con_rd] - standard_name = gas_constant_of_dry_air - long_name = ideal gas constant for dry air - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[con_g] - standard_name = gravitational_acceleration - long_name = gravitational acceleration - units = m s-2 - dimensions = () +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) type = real kind = kind_phys intent = in @@ -130,14 +201,6 @@ type = real kind = kind_phys intent = in -[rho0] - standard_name = air_pressure_at_surface_adjacent_layer - long_name = mean pressure at lowest model layer - units = Pa - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [gu0] standard_name = x_wind_of_new_state long_name = zonal wind updated by physics @@ -154,6 +217,38 @@ type = real kind = kind_phys intent = in +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[xlon_d] + standard_name = longitude_in_degree + long_name = longitude in degree east + units = degree_east + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[ch] + standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_water + long_name = surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[cm] + standard_name = surface_drag_coefficient_for_momentum_in_air_over_water + long_name = surface exchange coeff for momentum over water + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [dlwsfci] standard_name = surface_downwelling_longwave_flux long_name = surface downwelling longwave flux at current time @@ -162,6 +257,14 @@ type = real kind = kind_phys intent = in +[dswsfci] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [emiss] standard_name = surface_longwave_emissivity long_name = surface lw emissivity in fraction @@ -178,297 +281,265 @@ type = real kind = kind_phys intent = in -[dtp] - standard_name = timestep_for_physics - long_name = physics timestep - units = s - dimensions = () +[oro_lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in -[dswsfci] - standard_name = surface_downwelling_shortwave_flux - long_name = surface downwelling shortwave flux at current time - units = W m-2 +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in -[albedo] - standard_name = mid_day_surface_albedo_over_lake - long_name = mid day surface albedo over lake - units = fraction +[rho0] + standard_name = air_pressure_at_surface_adjacent_layer + long_name = mean pressure at lowest model layer + units = Pa dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[xlat_d] - standard_name = latitude_in_degree - long_name = latitude in degree north - units = degree_north + intent = in +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in -[z_lake3d] - standard_name = depth_of_lake_interface_layers - long_name = depth of lake interface layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[isltyp] + standard_name = soil_type_classification + long_name = soil type at each grid cell + units = index + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[evap_wat] + standard_name = kinematic_surface_upward_latent_heat_flux_over_water + long_name = kinematic surface upward latent heat flux over water + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[dz_lake3d] - standard_name = thickness_of_lake_layers - long_name = thickness of lake layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) +[evap_ice] + standard_name = kinematic_surface_upward_latent_heat_flux_over_ice + long_name = kinematic surface upward latent heat flux over ice + units = kg kg-1 m s-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[clm_lakedepth] - standard_name = clm_lake_depth - long_name = clm internal copy of lake depth with 10.0 replaced by default lake depth - units = m +[hflx_wat] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_water + long_name = kinematic surface upward sensible heat flux over water + units = K m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in -[oro_lakedepth] - standard_name = lake_depth - long_name = lake depth - units = m + intent = inout +[hflx_ice] + standard_name = kinematic_surface_upward_sensible_heat_flux_over_ice + long_name = kinematic surface upward sensible heat flux over ice + units = K m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[watsat3d] - standard_name = saturated_volumetric_soil_water_in_lake_model - long_name = saturated volumetric soil water in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) +[gflx_wat] + standard_name = upward_heat_flux_in_soil_over_water + long_name = soil heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[csol3d] - standard_name = soil_heat_capacity_in_lake_model - long_name = soil heat capacity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) +[gflx_ice] + standard_name = upward_heat_flux_in_soil_over_ice + long_name = soil heat flux over ice + units = W m-2 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[tkmg3d] - standard_name = soil_mineral_thermal_conductivity_in_lake_model - long_name = soil mineral thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) +[ep1d_water] + standard_name = surface_upward_potential_latent_heat_flux_over_water + long_name = surface upward potential latent heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[tkdry3d] - standard_name = dry_soil_thermal_conductivity_in_lake_model - long_name = dry soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) +[ep1d_ice] + standard_name = surface_upward_potential_latent_heat_flux_over_ice + long_name = surface upward potential latent heat flux over ice + units = W m-2 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[tksatu3d] - standard_name = saturated_soil_thermal_conductivity_in_lake_model - long_name = saturated soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) +[tsurf_water] + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water + units = K + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[phii] - standard_name = geopotential_at_interface - long_name = geopotential at model layer interfaces - units = m2 s-2 - dimensions = (horizontal_loop_extent,vertical_interface_dimension) +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in -[fice] - standard_name = sea_ice_area_fraction_of_sea_area_fraction - long_name = ice fraction over open water - units = frac + intent = inout +[tsfc_wat] + standard_name = surface_skin_temperature_over_water + long_name = surface skin temperature over water + units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[min_lakeice] - standard_name = min_lake_ice_area_fraction - long_name = minimum lake ice value - units = frac - dimensions = () +[tisfc] + standard_name = surface_skin_temperature_over_ice + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[km] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in -[h2osno2d] - standard_name = water_equivalent_accumulated_snow_depth_in_clm_lake_model - long_name = water equiv of acc snow depth over lake in clm lake model + intent = inout +[weasdi] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over land units = mm dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[snowdp2d] - standard_name = actual_snow_depth_in_clm_lake_model - long_name = actual acc snow depth over lake in clm lake model +[snodi] + standard_name = surface_snow_thickness_water_equivalent_over_ice + long_name = water equivalent snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[hice] + standard_name = sea_ice_thickness + long_name = sea ice thickness units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[snl2d] - standard_name = snow_layers_in_clm_lake_model - long_name = snow layers in clm lake model (treated as integer) - units = count +[qss_water] + standard_name = surface_specific_humidity_over_water + long_name = surface air saturation specific humidity over water + units = kg kg-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[z3d] - standard_name = snow_level_depth_in_clm_lake_model - long_name = snow level depth in clm lake model - units = m - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) +[qss_ice] + standard_name = surface_specific_humidity_over_ice + long_name = surface air saturation specific humidity over ice + units = kg kg-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[dz3d] - standard_name = snow_level_thickness_in_clm_lake_model - long_name = snow level thickness in clm lake model - units = m - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) +[cmm_water] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_water + long_name = momentum exchange coefficient over water + units = m s-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[zi3d] - standard_name = snow_interface_depth_in_clm_lake_model - long_name = snow interface_depth in clm lake model - units = m - dimensions = (horizontal_loop_extent,snow_plus_soil_vertical_dimension_for_clm_lake_model) +[cmm_ice] + standard_name = surface_drag_wind_speed_for_momentum_in_air_over_ice + long_name = momentum exchange coefficient over ice + units = m s-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[h2osoi_vol3d] - standard_name = volumetric_soil_water_in_clm_lake_model - long_name = volumetric soil water in clm lake model - units = m3 m-3 - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) +[chh_water] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water + long_name = thermal exchange coefficient over water + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[h2osoi_liq3d] - standard_name = soil_liquid_water_content_in_clm_lake_model - long_name = soil liquid water content in clm lake model - units = kg m-3 - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) +[chh_ice] + standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice + long_name = thermal exchange coefficient over ice + units = kg m-2 s-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[h2osoi_ice3d] - standard_name = soil_ice_water_content_in_clm_lake_model - long_name = soil ice water content in clm lake model - units = kg m-3 - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) +[uustar_water] + standard_name = surface_friction_velocity_over_water + long_name = surface friction velocity over water + units = m s-1 + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[t_grnd2d] - standard_name = skin_temperature_from_clm_lake_model - long_name = skin_temperature_from_clm_lake_model - units = K +[uustar_ice] + standard_name = surface_friction_velocity_over_ice + long_name = surface friction velocity over ice + units = m s-1 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[t_soisno3d] - standard_name = soil_or_snow_layer_temperature_from_clm_lake_model - long_name = soil or snow layer temperature from clm lake model +[lake_t_snow] + standard_name = temperature_of_snow_on_lake + long_name = the temperature of snow on a lake units = K - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[t_lake3d] - standard_name = lake_layer_temperature_from_clm_lake_model - long_name = lake layer temperature from clm lake model - units = K - dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) +[albedo] + standard_name = mid_day_surface_albedo_over_lake + long_name = mid day surface albedo over lake + units = fraction + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[savedtke12d] - standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model - long_name = top level eddy conductivity from previous timestep in clm lake model - units = kg m-3 +[zorlw] + standard_name = surface_roughness_length_over_water + long_name = surface roughness length over water + units = cm dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[lake_icefrac3d] - standard_name = lake_fractional_ice_cover_on_clm_lake_levels - long_name = lake fractional ice cover on clm lake levels - units = kg m-3 - dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - intent = inout -[con_cp] - standard_name = specific_heat_of_dry_air_at_constant_pressure - long_name = specific heat of dry air at constant pressure - units = J kg-1 K-1 - dimensions = () - type = real - kind = kind_phys - intent = in -[hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux_over_water - long_name = kinematic surface upward sensible heat flux over water - units = K m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[evap] - standard_name = kinematic_surface_upward_latent_heat_flux_over_water - long_name = kinematic surface upward latent heat flux over water - units = kg kg-1 m s-1 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[grdflx] - standard_name = upward_heat_flux_in_soil_over_water - long_name = soil heat flux over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[tsfc] - standard_name = surface_skin_temperature - long_name = surface skin temperature - units = K - dimensions = (horizontal_loop_extent) +[zorli] + standard_name = surface_roughness_length_over_ice + long_name = surface roughness length over ice + units = cm + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout @@ -488,251 +559,234 @@ type = real kind = kind_phys intent = out -[clm_lake_initialized] - standard_name = flag_for_clm_lake_initialization - long_name = set to true in clm_lake_run after likeini is called, as a workaround for ccpp limitation - units = flag +[weasd] + standard_name = lwe_thickness_of_surface_snow_amount + long_name = water equiv of acc snow depth over land and sea ice + units = mm dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[isltyp] - standard_name = soil_type_classification - long_name = soil type at each grid cell - units = index +[snowd] + standard_name = lwe_surface_snow + long_name = water equivalent snow depth + units = mm dimensions = (horizontal_loop_extent) - type = integer + type = real + kind = kind_phys intent = inout -[use_lakedepth] - standard_name = flag_for_initializing_clm_lake_depth_from_lake_depth - long_name = flag for initializing clm lake depth from lake depth - units = flag - dimensions = () - type = logical - intent = in -[restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - units = flag - dimensions = () - type = logical - intent = in -[lakedepth_default] - standard_name = default_lake_depth_in_clm_lake_model - long_name = default lake depth in clm lake model - units = m - dimensions = () +[fice] + standard_name = sea_ice_area_fraction_of_sea_area_fraction + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in -[use_lake_model] - standard_name = flag_for_using_lake_model - long_name = flag indicating lake points using a lake model + intent = inout +[icy] + standard_name = flag_nonzero_sea_ice_surface_fraction + long_name = flag indicating presence of some sea ice surface area fraction units = flag dimensions = (horizontal_loop_extent) - type = integer + type = logical intent = inout -[iopt_lake] - standard_name = control_for_lake_model_selection - long_name = control for lake model selection - units = 1 - dimensions = () - type = integer - intent = in -[iopt_lake_clm] - standard_name = clm_lake_model_control_selection_value - long_name = value that indicates clm lake model in the control for lake model selection +[salty] + standard_name = clm_lake_is_salty + long_name = lake at this point is salty (1) or not (0) units = 1 - dimensions = () - type = integer - intent = in -[clay3d] - standard_name = clm_lake_percent_clay - long_name = percent clay in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer - intent = inout -[sand3d] - standard_name = clm_lake_percent_sand - long_name = percent sand in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + dimensions = (horizontal_loop_extent) type = integer intent = inout -[weasd] - standard_name = lwe_thickness_of_surface_snow_amount - long_name = water equiv of acc snow depth over land and sea ice - units = mm +[savedtke12d] + standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model + long_name = top level eddy conductivity from previous timestep in clm lake model + units = kg m-3 dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[snowd] - standard_name = lwe_surface_snow - long_name = water equivalent snow depth - units = mm +[snowdp2d] + standard_name = actual_snow_depth_in_clm_lake_model + long_name = actual acc snow depth over lake in clm lake model + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[weasdi] - standard_name = water_equivalent_accumulated_snow_depth_over_ice - long_name = water equiv of acc snow depth over land +[h2osno2d] + standard_name = water_equivalent_accumulated_snow_depth_in_clm_lake_model + long_name = water equiv of acc snow depth over lake in clm lake model units = mm dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[snodi] - standard_name = surface_snow_thickness_water_equivalent_over_ice - long_name = water equivalent snow depth over ice - units = mm +[snl2d] + standard_name = snow_layers_in_clm_lake_model + long_name = snow layers in clm lake model (treated as integer) + units = count dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[hice] - standard_name = sea_ice_thickness - long_name = sea ice thickness - units = m +[t_grnd2d] + standard_name = skin_temperature_from_clm_lake_model + long_name = skin_temperature_from_clm_lake_model + units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = inout -[tsurf] - standard_name = surface_skin_temperature_after_iteration_over_water - long_name = surface skin temperature after iteration over water +[t_lake3d] + standard_name = lake_layer_temperature_from_clm_lake_model + long_name = lake layer temperature from clm lake model units = K - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[t_sfc] - standard_name = surface_skin_temperature_over_water - long_name = surface skin temperature over water +[lake_icefrac3d] + standard_name = lake_fractional_ice_cover_on_clm_lake_levels + long_name = lake fractional ice cover on clm lake levels + units = kg m-3 + dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[t_soisno3d] + standard_name = soil_or_snow_layer_temperature_from_clm_lake_model + long_name = soil or snow layer temperature from clm lake model units = K - dimensions = (horizontal_loop_extent) + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[lflx] - standard_name = surface_upward_potential_latent_heat_flux_over_water - long_name = surface upward potential latent heat flux over water - units = W m-2 - dimensions = (horizontal_loop_extent) +[h2osoi_ice3d] + standard_name = soil_ice_water_content_in_clm_lake_model + long_name = soil ice water content in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[ustar] - standard_name = surface_friction_velocity_over_water - long_name = surface friction velocity over water - units = m s-1 - dimensions = (horizontal_loop_extent) +[h2osoi_liq3d] + standard_name = soil_liquid_water_content_in_clm_lake_model + long_name = soil liquid water content in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[qsfc] - standard_name = surface_specific_humidity_over_water - long_name = surface air saturation specific humidity over water - units = kg kg-1 - dimensions = (horizontal_loop_extent) +[h2osoi_vol3d] + standard_name = volumetric_soil_water_in_clm_lake_model + long_name = volumetric soil water in clm lake model + units = m3 m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[ch] - standard_name = surface_drag_coefficient_for_heat_and_moisture_in_air_over_water - long_name = surface exchange coeff heat surface exchange coeff heat & moisture over ocean moisture over water - units = none - dimensions = (horizontal_loop_extent) +[z3d] + standard_name = snow_level_depth_in_clm_lake_model + long_name = snow level depth in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[cm] - standard_name = surface_drag_coefficient_for_momentum_in_air_over_water - long_name = surface exchange coeff for momentum over water - units = none - dimensions = (horizontal_loop_extent) +[dz3d] + standard_name = snow_level_thickness_in_clm_lake_model + long_name = snow level thickness in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[chh] - standard_name = surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water - long_name = thermal exchange coefficient over water - units = kg m-2 s-1 - dimensions = (horizontal_loop_extent) +[zi3d] + standard_name = snow_interface_depth_in_clm_lake_model + long_name = snow interface_depth in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[cmm] - standard_name = surface_drag_wind_speed_for_momentum_in_air_over_water - long_name = momentum exchange coefficient over water - units = m s-1 - dimensions = (horizontal_loop_extent) +[z_lake3d] + standard_name = depth_of_lake_interface_layers + long_name = depth of lake interface layers + units = fraction + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[lake_t_snow] - standard_name = temperature_of_snow_on_lake - long_name = the temperature of snow on a lake - units = K - dimensions = (horizontal_loop_extent) +[dz_lake3d] + standard_name = thickness_of_lake_layers + long_name = thickness of lake layers + units = fraction + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[tisfc] - standard_name = surface_skin_temperature_over_ice - long_name = surface skin temperature over ice - units = K - dimensions = (horizontal_loop_extent) +[watsat3d] + standard_name = saturated_volumetric_soil_water_in_lake_model + long_name = saturated volumetric soil water in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[tsurf_ice] - standard_name = surface_skin_temperature_after_iteration_over_ice - long_name = surface skin temperature after iteration over ice - units = K - dimensions = (horizontal_loop_extent) +[csol3d] + standard_name = soil_heat_capacity_in_lake_model + long_name = soil heat capacity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys intent = inout -[wind] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_loop_extent) +[sand3d] + standard_name = clm_lake_percent_sand + long_name = percent sand in clm lake model + units = percent + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + type = integer + intent = inout +[clay3d] + standard_name = clm_lake_percent_clay + long_name = percent clay in clm lake model + units = percent + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + type = integer + intent = inout +[tkmg3d] + standard_name = soil_mineral_thermal_conductivity_in_lake_model + long_name = soil mineral thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - intent = in -[xlon_d] - standard_name = longitude_in_degree - long_name = longitude in degree east - units = degree_east + intent = inout +[tkdry3d] + standard_name = dry_soil_thermal_conductivity_in_lake_model + long_name = dry soil thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[tksatu3d] + standard_name = saturated_soil_thermal_conductivity_in_lake_model + long_name = saturated soil thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + intent = inout +[clm_lakedepth] + standard_name = clm_lake_depth + long_name = clm internal copy of lake depth with 10.0 replaced by default lake depth + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in -[master] - standard_name = mpi_root - long_name = master MPI-rank - units = index - dimensions = () - type = integer - intent = in -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 217a8bf497c484842a0d26c3fa3425160d3f2e7e Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 20 Oct 2022 19:52:49 +0000 Subject: [PATCH 17/46] bug fixes to get fractional ice working --- physics/GFS_surface_composites_pre.F90 | 9 +++++++-- physics/clm_lake.f90 | 4 ++-- 2 files changed, 9 insertions(+), 4 deletions(-) diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/GFS_surface_composites_pre.F90 index 9a34fddf7..fa0398d94 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/GFS_surface_composites_pre.F90 @@ -200,9 +200,14 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l endif islmsk_cice(i) = islmsk(i) flag_cice(i) = .false. - if (cice(i) < one) then + if(is_clm) then + wet(i) = .true. + if (icy(i)) then + tsfco(i) = max(tisfc(i), tgice) + endif + else if(cice(i) < one) then wet(i) = .true. ! some open lake - if (icy(i) .and. .not.is_clm) then + if (icy(i)) then tsfco(i) = max(tisfc(i), tgice) endif endif diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 3d4cb6d9a..fee6d9cc8 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -715,7 +715,7 @@ SUBROUTINE clm_lake_run( & albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + & ! mid_day_surface_albedo_over_lake ( (1.0-lake_icefrac3d(i,1)) * 0.08) fice(i) = lake_icefrac3d(i,1) ! sea_ice_area_fraction_of_sea_area_fraction - uustar_water(i) = ustar_out(c) ! surface_friction_velocity_over_water + !uustar_water(i) = ustar_out(c) ! surface_friction_velocity_over_water zorlw(i) = z0mg(c) ! surface_roughness_length_over_water ! WRF variables with no equivalent in CCPP: @@ -743,7 +743,7 @@ SUBROUTINE clm_lake_run( & chh_ice(i) = chh_water(i) ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_ice cmm_ice(i) = cmm_water(i) ! surface_drag_wind_speed_for_momentum_in_air_over_ice qss_ice(i) = qss_water(i) ! surface_specific_humidity_over_ice - uustar_ice(i) = uustar_water(c) ! surface_friction_velocity_over_ice +! uustar_ice(i) = uustar_water(i) ! surface_friction_velocity_over_ice endif tsurf_ice(i) = tsurf_water(i) ! surface_skin_temperature_after_iteration_over_ice From c34a3d381b5930d1a3f8eb83e9e5c163f4e24b31 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 24 Oct 2022 19:30:22 +0000 Subject: [PATCH 18/46] bug fixes for restart (not enough though) --- physics/GFS_MP_generic_post.F90 | 12 +++++++----- physics/GFS_MP_generic_post.meta | 21 +++++++++++++++++++++ physics/clm_lake.f90 | 20 ++++++++++---------- physics/clm_lake.meta | 28 +++++++++++----------------- 4 files changed, 49 insertions(+), 32 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index 0940ab7b6..b0178b5ef 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -28,7 +28,7 @@ subroutine GFS_MP_generic_post_run( graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, dfi_radar_max_intervals, & dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d,dqdt_qmicro, lssav, num_dfi_radar, & fh_dfi_radar,index_of_process_dfi_radar, ix_dfi_radar, dfi_radar_tten, radar_tten_limits, fhour, prevsq, & - errmsg, errflg) + iopt_lake, iopt_lake_clm, lkm, errmsg, errflg) ! use machine, only: kind_phys use calpreciptype_mod, only: calpreciptype @@ -36,7 +36,7 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: im, levs, kdt, nrcm, nncl, ntcw, ntrac, num_dfi_radar, index_of_process_dfi_radar integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires - integer, intent(in) :: imp_physics_nssl + integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, progsigma integer, intent(in) :: index_of_temperature,index_of_process_mp @@ -138,9 +138,10 @@ subroutine GFS_MP_generic_post_run( ice = frain*rain1*sr ! time-step ice end if - if (lsm==lsm_ruc .or. lsm==lsm_noahmp) then - raincprv(:) = rainc(:) - rainncprv(:) = frain * rain1(:) + if (lsm==lsm_ruc .or. lsm==lsm_noahmp .or. (lkm>0 .and. iopt_lake==iopt_lake_clm)) then + raincprv(:) = rainc(:) + rainncprv(:) = frain * rain1(:) + if(lsm==lsm_ruc .or. lsm==lsm_noahmp) then iceprv(:) = ice(:) snowprv(:) = snow(:) graupelprv(:) = graupel(:) @@ -155,6 +156,7 @@ subroutine GFS_MP_generic_post_run( dgraupelprv(:) = tem * graupelprv(:) diceprv(:) = tem * iceprv(:) end if + end if end if if (cal_pre) then ! hchuang: add dominant precipitation type algorithm diff --git a/physics/GFS_MP_generic_post.meta b/physics/GFS_MP_generic_post.meta index 7ba09363a..b52e1dcd8 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/GFS_MP_generic_post.meta @@ -754,6 +754,27 @@ dimensions = () type = logical intent = in +[lkm] + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst + units = flag + dimensions = () + type = integer + intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index fee6d9cc8..0b1498395 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -226,7 +226,7 @@ end function is_salty !! SUBROUTINE clm_lake_run( & ! Model time and metadata: - im, km, me, master, restart, first_time_step, fhour, IDATE, kdt, & + im, km, me, master, fhour, IDATE, kdt, & ! Configuration and initialization: iopt_lake, iopt_lake_clm, min_lakeice, lakedepth_default, use_lakedepth, & @@ -234,8 +234,8 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & - ch, cm, dlwsfci, dswsfci, emiss, rain, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, ISLTYP, & + ch, cm, dlwsfci, dswsfci, emiss, oro_lakedepth, wind, rho0, tsfc, & + flag_iter, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & @@ -268,7 +268,6 @@ SUBROUTINE clm_lake_run( & ! Model time and metadata: ! INTEGER , INTENT (IN) :: im,km,me,master - LOGICAL, INTENT(IN) :: restart,first_time_step INTEGER, INTENT(IN) :: IDATE(4), kdt REAL, INTENT(IN) :: fhour @@ -287,7 +286,8 @@ SUBROUTINE clm_lake_run( & ! REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: & tg3, pgr, zlvl, qvcurr, xlat_d, xlon_d, ch, cm, & - dlwsfci, dswsfci, emiss, rain, oro_lakedepth, wind, rho0, tsfc + dlwsfci, dswsfci, emiss, oro_lakedepth, wind, rho0, tsfc, & + rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP @@ -362,7 +362,7 @@ SUBROUTINE clm_lake_run( & real(kind_phys) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) real(kind_phys) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) real(kind_phys) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) - real(kind_phys) :: prec(1) ! snow or rain rate [mm/s] + real(kind_phys) :: prec(1) ! snow or rain rate [mm/s] real(kind_phys) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) real(kind_phys) :: lat(1) ! latitude (radians) real(kind_phys) :: z_lake(1,nlevlake) ! layer depth for lake (m) @@ -474,7 +474,7 @@ SUBROUTINE clm_lake_run( & ! Initialize any uninitialized lake points. call lakeini(kdt=kdt, ISLTYP=ISLTYP, gt0=gt0, snowd=snowd, weasd=weasd, & - restart=restart, lakedepth_default=lakedepth_default, fhour=fhour, & + lakedepth_default=lakedepth_default, fhour=fhour, & oro_lakedepth=oro_lakedepth, savedtke12d=savedtke12d, snowdp2d=snowdp2d, & h2osno2d=h2osno2d, snl2d=snl2d, t_grnd2d=t_grnd2d, t_lake3d=t_lake3d, & lake_icefrac3d=lake_icefrac3d, z_lake3d=z_lake3d, dz_lake3d=dz_lake3d, & @@ -556,7 +556,8 @@ SUBROUTINE clm_lake_run( & PSFC = pgr(i) Q2K = qvcurr(i) LWDN = DLWSFCI(I)*EMISS(I) - PRCP = RAIN(i)/dtime ! [mm/s] use physics timestep since PRCP comes from non-surface schemes + ! FIXME: Should multiply PRCP by 1000 + PRCP = (raincprv(i)+rainncprv(i))/dtime ! [mm/s] use physics timestep since PRCP comes from non-surface schemes SOLDN = DSWSFCI(I) ! SOLDN is total incoming solar SOLNET = SOLDN*(1.-ALBEDO(I)) ! use mid-day albedo to determine net downward solar ! (no solar zenith angle correction) @@ -5360,7 +5361,7 @@ subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,c end subroutine clm_lake_init SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, & !i - weasd, restart, lakedepth_default, fhour, & + weasd, lakedepth_default, fhour, & oro_lakedepth, savedtke12d, snowdp2d, h2osno2d, & !o snl2d, t_grnd2d, t_lake3d, lake_icefrac3d, & z_lake3d, dz_lake3d, t_soisno3d, h2osoi_ice3d, & @@ -5402,7 +5403,6 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, !INTEGER , INTENT (INOUT) :: lake_depth_flag LOGICAL, INTENT (IN) :: use_lakedepth - LOGICAL , INTENT(IN) :: restart INTEGER, DIMENSION(IM), INTENT(IN) :: ISLTYP REAL(KIND_PHYS), DIMENSION(IM), INTENT(INOUT) :: snowd,weasd REAL(kind_phys), DIMENSION(IM,KM), INTENT(IN) :: gt0, prsi diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index e7e3f8ba3..d2d477490 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -35,20 +35,6 @@ dimensions = () type = integer intent = in -[restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - units = flag - dimensions = () - type = logical - intent = in -[first_time_step] - standard_name = flag_for_first_timestep - long_name = flag for first time step for time integration loop (cold/warmstart) - units = flag - dimensions = () - type = logical - intent = in [fhour] standard_name = forecast_time long_name = current forecast time @@ -273,9 +259,17 @@ type = real kind = kind_phys intent = in -[rain] - standard_name = lwe_thickness_of_precipitation_amount_on_dynamics_timestep - long_name = total rain at this time step +[raincprv] + standard_name = lwe_thickness_of_convective_precipitation_amount_on_previous_timestep + long_name = convective_precipitation_amount from previous timestep + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[rainncprv] + standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep + long_name = explicit rainfall from previous timestep units = m dimensions = (horizontal_loop_extent) type = real From e079dc7abc2964b6e232cf4dcee779e1a5581636 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 17:19:09 +0000 Subject: [PATCH 19/46] revert some changes --- physics/GFS_MP_generic_post.F90 | 19 +- physics/GFS_MP_generic_post.meta | 7 + physics/GFS_surface_composites_post.F90 | 247 ++++++++++-------------- physics/clm_lake.f90 | 6 +- physics/clm_lake.meta | 2 +- physics/physcons.F90 | 2 +- physics/sfc_diag.f | 60 +++--- physics/sfc_diag.meta | 51 ----- 8 files changed, 149 insertions(+), 245 deletions(-) diff --git a/physics/GFS_MP_generic_post.F90 b/physics/GFS_MP_generic_post.F90 index a1df2a880..65ec9f67e 100644 --- a/physics/GFS_MP_generic_post.F90 +++ b/physics/GFS_MP_generic_post.F90 @@ -28,7 +28,7 @@ subroutine GFS_MP_generic_post_run( graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, dfi_radar_max_intervals, & dtend, dtidx, index_of_temperature, index_of_process_mp,ldiag3d, qdiag3d,dqdt_qmicro, lssav, num_dfi_radar, & fh_dfi_radar,index_of_process_dfi_radar, ix_dfi_radar, dfi_radar_tten, radar_tten_limits, fhour, prevsq, & - iopt_lake, iopt_lake_clm, lkm, errmsg, errflg) + iopt_lake, iopt_lake_clm, lkm, use_lake_model, errmsg, errflg) ! use machine, only: kind_phys use calpreciptype_mod, only: calpreciptype @@ -38,7 +38,7 @@ subroutine GFS_MP_generic_post_run( integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_mg, imp_physics_fer_hires integer, intent(in) :: imp_physics_nssl, iopt_lake_clm, iopt_lake, lkm logical, intent(in) :: cal_pre, lssav, ldiag3d, qdiag3d, cplflx, cplchm, cpllnd, progsigma - integer, intent(in) :: index_of_temperature,index_of_process_mp + integer, intent(in) :: index_of_temperature,index_of_process_mp,use_lake_model(:) integer :: dfi_radar_max_intervals real(kind=kind_phys), intent(in) :: fh_dfi_radar(:), fhour @@ -138,10 +138,9 @@ subroutine GFS_MP_generic_post_run( ice = frain*rain1*sr ! time-step ice end if - if (lsm==lsm_ruc .or. lsm==lsm_noahmp .or. (lkm>0 .and. iopt_lake==iopt_lake_clm)) then - raincprv(:) = rainc(:) - rainncprv(:) = frain * rain1(:) - if(lsm==lsm_ruc .or. lsm==lsm_noahmp) then + if (lsm==lsm_ruc .or. lsm==lsm_noahmp) then + raincprv(:) = rainc(:) + rainncprv(:) = frain * rain1(:) iceprv(:) = ice(:) snowprv(:) = snow(:) graupelprv(:) = graupel(:) @@ -156,7 +155,13 @@ subroutine GFS_MP_generic_post_run( dgraupelprv(:) = tem * graupelprv(:) diceprv(:) = tem * iceprv(:) end if - end if + else if(lkm>0 .and. iopt_lake==iopt_lake_clm) then + do i=1,im + if(use_lake_model(i)>0) then + raincprv(i) = rainc(i) + rainncprv(i) = frain * rain1(i) + end if + end do end if if (cal_pre) then ! hchuang: add dominant precipitation type algorithm diff --git a/physics/GFS_MP_generic_post.meta b/physics/GFS_MP_generic_post.meta index 4cc0579be..1287dd68a 100644 --- a/physics/GFS_MP_generic_post.meta +++ b/physics/GFS_MP_generic_post.meta @@ -782,6 +782,13 @@ dimensions = () type = integer intent = in +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_composites_post.F90 b/physics/GFS_surface_composites_post.F90 index eb6b2e32e..868db390f 100644 --- a/physics/GFS_surface_composites_post.F90 +++ b/physics/GFS_surface_composites_post.F90 @@ -269,34 +269,109 @@ subroutine GFS_surface_composites_post_run ( else ! not fractional grid do i=1,im - - ! This code assumes points are always 100% lake or 0% lake, - ! and lake points must have wet(i)=true, even if they have - ! 100% ice cover. The only fractional coverage allowed is - ! fractional ice on lake points that ran the CLM Lake - ! Model (frac_ice). For more general fractional grid support, use - ! frac_grid. - - if (dry(i)) then - ! This is a land point. - call composite_land - elseif(frac_ice .and. use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then - ! This is a lake point where the CLM Lake Model was run with frac_ice. - if(icy(i)) then - ! Lake point has more than min_lakeice ice. - call composite_icy(.true.) - call composite_wet_and_icy + if (islmsk(i) == 1) then + !-- land + zorl(i) = zorll(i) + cd(i) = cd_lnd(i) + cdq(i) = cdq_lnd(i) + rb(i) = rb_lnd(i) + stress(i) = stress_lnd(i) + ffmm(i) = ffmm_lnd(i) + ffhh(i) = ffhh_lnd(i) + uustar(i) = uustar_lnd(i) + fm10(i) = fm10_lnd(i) + fh2(i) = fh2_lnd(i) + tsfc(i) = tsfcl(i) + tsfco(i) = tsfc(i) + tisfc(i) = tsfc(i) + cmm(i) = cmm_lnd(i) + chh(i) = chh_lnd(i) + gflx(i) = gflx_lnd(i) + ep1d(i) = ep1d_lnd(i) + weasd(i) = weasd_lnd(i) + snowd(i) = snowd_lnd(i) + evap(i) = evap_lnd(i) + hflx(i) = hflx_lnd(i) + qss(i) = qss_lnd(i) + hice(i) = zero + cice(i) = zero + elseif (islmsk(i) == 0) then + !-- water + zorl(i) = zorlo(i) + cd(i) = cd_wat(i) + cdq(i) = cdq_wat(i) + rb(i) = rb_wat(i) + stress(i) = stress_wat(i) + ffmm(i) = ffmm_wat(i) + ffhh(i) = ffhh_wat(i) + uustar(i) = uustar_wat(i) + fm10(i) = fm10_wat(i) + fh2(i) = fh2_wat(i) + tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) + tsfc(i) = tsfco(i) + tsfcl(i) = tsfc(i) + tisfc(i) = tsfc(i) + cmm(i) = cmm_wat(i) + chh(i) = chh_wat(i) + gflx(i) = gflx_wat(i) + ep1d(i) = ep1d_wat(i) + weasd(i) = zero + snowd(i) = zero + evap(i) = evap_wat(i) + hflx(i) = hflx_wat(i) + qss(i) = qss_wat(i) + hice(i) = zero + cice(i) = zero + else ! islmsk(i) == 2 + !-- ice + zorl(i) = zorli(i) + cd(i) = cd_ice(i) + cdq(i) = cdq_ice(i) + rb(i) = rb_ice(i) + ffmm(i) = ffmm_ice(i) + ffhh(i) = ffhh_ice(i) + uustar(i) = uustar_ice(i) + fm10(i) = fm10_ice(i) + fh2(i) = fh2_ice(i) + stress(i) = stress_ice(i) + cmm(i) = cmm_ice(i) + chh(i) = chh_ice(i) + gflx(i) = gflx_ice(i) + ep1d(i) = ep1d_ice(i) + weasd(i) = weasd_ice(i) * cice(i) + snowd(i) = snowd_ice(i) * cice(i) + qss(i) = qss_ice(i) + evap(i) = evap_ice(i) + hflx(i) = hflx_ice(i) +! + txi = cice(i) + txo = one - txi + evap(i) = txi * evap_ice(i) + txo * evap_wat(i) + hflx(i) = txi * hflx_ice(i) + txo * hflx_wat(i) + tsfc(i) = txi * tisfc(i) + txo * tsfc_wat(i) + stress(i) = txi * stress_ice(i) + txo * stress_wat(i) + qss(i) = txi * qss_ice(i) + txo * qss_wat(i) + ep1d(i) = txi * ep1d_ice(i) + txo * ep1d_wat(i) + + lnzorli = zero ; lnzorlo = zero + if (zorli(i) /= huge) then + lnzorli = log(zorli(i)) + endif + if (zorlo(i) /= huge) then + lnzorlo = log(zorlo(i)) + endif + zorl(i) = exp(txi*lnzorli + txo*lnzorlo) +! zorl(i) = exp(txi*log(zorli(i)) + txo*log(zorlo(i))) +! + if (wet(i)) then + tsfco(i) = tsfc_wat(i) else - ! Lake point has less than min_lakeice ice. - call composite_wet + tsfco(i) = tsfc(i) endif - else if (wet(i)) then - ! Wet point that is not a lake, or lake point with frac_ice disabled. - call composite_wet - else ! islmsk(i) == 2 - ! This is not a lake point, and it is icy. - call composite_icy(.false.) - call composite_wet_and_icy + tsfcl(i) = tsfc(i) + do k=1,min(kice,km) ! store tiice in stc to reduce output in the nonfrac grid case + stc(i,k) = tiice(i,k) + enddo endif enddo @@ -304,126 +379,6 @@ subroutine GFS_surface_composites_post_run ( ! --- compositing done - contains - - subroutine composite_land - implicit none - zorl(i) = zorll(i) - cd(i) = cd_lnd(i) - cdq(i) = cdq_lnd(i) - rb(i) = rb_lnd(i) - stress(i) = stress_lnd(i) - ffmm(i) = ffmm_lnd(i) - ffhh(i) = ffhh_lnd(i) - uustar(i) = uustar_lnd(i) - fm10(i) = fm10_lnd(i) - fh2(i) = fh2_lnd(i) - tsfc(i) = tsfcl(i) - tsfco(i) = tsfc(i) - tisfc(i) = tsfc(i) - cmm(i) = cmm_lnd(i) - chh(i) = chh_lnd(i) - gflx(i) = gflx_lnd(i) - ep1d(i) = ep1d_lnd(i) - weasd(i) = weasd_lnd(i) - snowd(i) = snowd_lnd(i) - evap(i) = evap_lnd(i) - hflx(i) = hflx_lnd(i) - qss(i) = qss_lnd(i) - hice(i) = zero - cice(i) = zero - end subroutine composite_land - - subroutine composite_wet - implicit none - zorl(i) = zorlo(i) - cd(i) = cd_wat(i) - cdq(i) = cdq_wat(i) - rb(i) = rb_wat(i) - stress(i) = stress_wat(i) - ffmm(i) = ffmm_wat(i) - ffhh(i) = ffhh_wat(i) - uustar(i) = uustar_wat(i) - fm10(i) = fm10_wat(i) - fh2(i) = fh2_wat(i) - tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) - tsfc(i) = tsfco(i) - tsfcl(i) = tsfc(i) - tisfc(i) = tsfc(i) - cmm(i) = cmm_wat(i) - chh(i) = chh_wat(i) - gflx(i) = gflx_wat(i) - ep1d(i) = ep1d_wat(i) - weasd(i) = zero - snowd(i) = zero - evap(i) = evap_wat(i) - hflx(i) = hflx_wat(i) - qss(i) = qss_wat(i) - hice(i) = zero - cice(i) = zero - end subroutine composite_wet - - subroutine composite_icy(is_clm) - implicit none - logical, intent(in) :: is_clm - zorl(i) = zorli(i) - cd(i) = cd_ice(i) - cdq(i) = cdq_ice(i) - rb(i) = rb_ice(i) - ffmm(i) = ffmm_ice(i) - ffhh(i) = ffhh_ice(i) - uustar(i) = uustar_ice(i) - fm10(i) = fm10_ice(i) - fh2(i) = fh2_ice(i) - stress(i) = stress_ice(i) - cmm(i) = cmm_ice(i) - chh(i) = chh_ice(i) - gflx(i) = gflx_ice(i) - ep1d(i) = ep1d_ice(i) - if(is_clm) then - weasd(i) = weasd_ice(i) - snowd(i) = snowd_ice(i) - else - weasd(i) = weasd_ice(i) * cice(i) - snowd(i) = snowd_ice(i) * cice(i) - endif - qss(i) = qss_ice(i) - evap(i) = evap_ice(i) - hflx(i) = hflx_ice(i) - end subroutine composite_icy - - subroutine composite_wet_and_icy - implicit none - txi = cice(i) - txo = one - txi - evap(i) = txi * evap_ice(i) + txo * evap_wat(i) - hflx(i) = txi * hflx_ice(i) + txo * hflx_wat(i) - tsfc(i) = txi * tisfc(i) + txo * tsfc_wat(i) - stress(i) = txi * stress_ice(i) + txo * stress_wat(i) - qss(i) = txi * qss_ice(i) + txo * qss_wat(i) - ep1d(i) = txi * ep1d_ice(i) + txo * ep1d_wat(i) - - lnzorli = zero ; lnzorlo = zero - if (zorli(i) /= huge) then - lnzorli = log(zorli(i)) - endif - if (zorlo(i) /= huge) then - lnzorlo = log(zorlo(i)) - endif - zorl(i) = exp(txi*lnzorli + txo*lnzorlo) - ! zorl(i) = exp(txi*log(zorli(i)) + txo*log(zorlo(i))) - ! - if (wet(i)) then - tsfco(i) = tsfc_wat(i) - else - tsfco(i) = tsfc(i) - endif - tsfcl(i) = tsfc(i) - do k=1,min(kice,km) ! store tiice in stc to reduce output in the nonfrac grid case - stc(i,k) = tiice(i,k) - enddo - end subroutine composite_wet_and_icy - end subroutine GFS_surface_composites_post_run end module GFS_surface_composites_post diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 0b1498395..3128519bb 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -5265,10 +5265,10 @@ end subroutine MoninObukIni !! \htmlinclude clm_lake_init.html !! subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,con_cliq, & - con_hfus,con_hvap,con_rd,con_cp,rhoice,clm_lake_debug,errmsg,errflg) + con_hfus,con_hvap,con_rd,con_cp,rholakeice,clm_lake_debug,errmsg,errflg) implicit none real(kind_phys), intent(in) :: con_pi,karman,con_g,con_sbc,con_t0c, & - rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp,rhoice + rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp,rholakeice INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg logical, intent(in) :: clm_lake_debug @@ -5288,7 +5288,7 @@ subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,c sb = con_sbc tfrz = con_t0c denh2o = rhowater - denice = rhoice + denice = rholakeice cpice = con_csol cpliq = con_cliq hfus = con_hfus diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index d2d477490..0c8a3af33 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -897,7 +897,7 @@ type = real kind = kind_phys intent = in -[rhoice] +[rholakeice] standard_name = density_of_ice_on_lake long_name = density of ice on a lake units = kg m-3 diff --git a/physics/physcons.F90 b/physics/physcons.F90 index a8792eed3..9051af1a6 100644 --- a/physics/physcons.F90 +++ b/physics/physcons.F90 @@ -139,7 +139,7 @@ module physcons real(kind=kind_phys),parameter:: rhowater = 1000._kind_phys !< density of water (kg/m^3) real(kind=kind_phys),parameter:: rhosnow = 100._kind_phys !< density of snow (kg/m^3) real(kind=kind_phys),parameter:: rhoair = 1.28_kind_phys !< density of air near surface (kg/m^3) - real(kind=kind_phys),parameter:: rhoice = 0.917e3_kind_phys !< density of ice on lake (kg/m^3) + real(kind=kind_phys),parameter:: rholakeice = 0.917e3_kind_phys !< density of ice on lake (kg/m^3) ! Decorrelation length constant (km) for iovr = 4 or 5 and idcor = 0 real(kind=kind_phys),parameter:: decorr_con = 2.50_kind_phys diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 2d69a7ecb..045ad75b0 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -2,7 +2,6 @@ !! This file contains the land surface diagnose calculation scheme. module sfc_diag - contains !> \defgroup sfc_diag_mod GFS sfc_diag module @@ -14,8 +13,6 @@ module sfc_diag subroutine sfc_diag_run & & (im,grav,cp,eps,epsm1,ps,u1,v1,t1,q1,prslki, & & evap,fm,fh,fm10,fh2,tskin,qsurf,thsfc_loc, & - & use_lake_model,iopt_lake,iopt_lake_clm, & - & lake_t2m,lake_q2m,kdt,me, & & f10m,u10m,v10m,t2m,q2m,errmsg,errflg & & ) ! @@ -23,7 +20,7 @@ subroutine sfc_diag_run & use funcphys, only : fpvs implicit none ! - integer, intent(in) :: im, iopt_lake, iopt_lake_clm, kdt, me + integer, intent(in) :: im logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. real(kind=kind_phys), intent(in) :: grav,cp,eps,epsm1 real(kind=kind_phys), dimension(:), intent(in) :: & @@ -31,19 +28,15 @@ subroutine sfc_diag_run & & qsurf, prslki, evap, fm, fh, fm10, fh2 real(kind=kind_phys), dimension(:), intent(out) :: & & f10m, u10m, v10m, t2m, q2m - real(kind=kind_phys), dimension(:), intent(in) :: lake_t2m, & - & lake_q2m - integer, dimension(:), intent(in) :: use_lake_model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! ! locals ! real(kind=kind_phys), parameter :: qmin=1.0e-8 - integer :: k,i, clm_t2m_count + integer :: k,i ! real(kind=kind_phys) :: fhi, qss, wrk - ! real(kind=kind_phys) sig2k, fhi, qss ! ! real, parameter :: g=grav @@ -60,39 +53,34 @@ subroutine sfc_diag_run & ! ps is in pascals ! !! - clm_t2m_count=0 do i = 1, im f10m(i) = fm10(i) / fm(i) ! f10m(i) = min(f10m(i),1.) u10m(i) = f10m(i) * u1(i) v10m(i) = f10m(i) * v1(i) - ! use_clm_2m: if(use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then - ! t2m(i) = lake_t2m(i) - ! q2m(i) = lake_q2m(i) - ! clm_t2m_count=clm_t2m_count+1 - ! else - fhi = fh2(i) / fh(i) -! t2m(i) = tskin(i)*(1. - fhi) + t1(i) * prslki(i) * fhi -! sig2k = 1. - (grav+grav) / (cp * t2m(i)) -! t2m(i) = t2m(i) * sig2k - wrk = 1.0 - fhi - if(thsfc_loc) then ! Use local potential temperature - t2m(i)= tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp - else ! Use potential temperature referenced to 1000 hPa - t2m(i)= tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp - endif + fhi = fh2(i) / fh(i) +! t2m(i) = tskin(i)*(1. - fhi) + t1(i) * prslki(i) * fhi +! sig2k = 1. - (grav+grav) / (cp * t2m(i)) +! t2m(i) = t2m(i) * sig2k + wrk = 1.0 - fhi + + + if(thsfc_loc) then ! Use local potential temperature + t2m(i) = tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp + else ! Use potential temperature referenced to 1000 hPa + t2m(i) = tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp + endif - if(evap(i) >= 0.) then ! for evaporation>0, use inferred qsurf to deduce q2m - q2m(i) = qsurf(i)*wrk + max(qmin,q1(i))*fhi - else ! for dew formation, use saturated q at tskin - qss = fpvs(tskin(i)) - qss = eps * qss / (ps(i) + epsm1 * qss) - q2m(i) = qss*wrk + max(qmin,q1(i))*fhi - endif - qss = fpvs(t2m(i)) - qss = eps * qss / (ps(i) + epsm1 * qss) - q2m(i) = min(q2m(i),qss) - ! endif use_clm_2m + if(evap(i) >= 0.) then ! for evaporation>0, use inferred qsurf to deduce q2m + q2m(i) = qsurf(i)*wrk + max(qmin,q1(i))*fhi + else ! for dew formation, use saturated q at tskin + qss = fpvs(tskin(i)) + qss = eps * qss / (ps(i) + epsm1 * qss) + q2m(i) = qss*wrk + max(qmin,q1(i))*fhi + endif + qss = fpvs(t2m(i)) + qss = eps * qss / (ps(i) + epsm1 * qss) + q2m(i) = min(q2m(i),qss) enddo return diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index 00f725cb8..dd3bf79b8 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -157,57 +157,6 @@ dimensions = () type = logical intent = in -[use_lake_model] - standard_name = flag_for_using_lake_model - long_name = flag indicating lake points using a lake model - units = flag - dimensions = (horizontal_loop_extent) - type = integer - intent = in -[iopt_lake] - standard_name = control_for_lake_model_selection - long_name = control for lake model selection - units = 1 - dimensions = () - type = integer - intent = in -[iopt_lake_clm] - standard_name = clm_lake_model_control_selection_value - long_name = value that indicates clm lake model in the control for lake model selection - units = 1 - dimensions = () - type = integer - intent = in -[lake_t2m] - standard_name = temperature_at_2m_from_clm_lake - long_name = temperature at 2m from clm lake - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[lake_q2m] - standard_name = specific_humidity_at_2m_from_clm_lake - long_name = specific humidity at 2m from clm lake - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[kdt] - standard_name = index_of_timestep - long_name = current forecast iteration - units = index - dimensions = () - type = integer - intent = in -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in [f10m] standard_name = ratio_of_wind_at_surface_adjacent_layer_to_wind_at_10m long_name = ratio of fm10 and fm From 405fc8518a54b4527c0bda30c4efc6c5c9c3a20c Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 19:23:53 +0000 Subject: [PATCH 20/46] remove flake changes --- physics/GFS_phys_time_vary.fv3.F90 | 2 +- physics/flake.F90 | 83 ++------ physics/flake_driver.F90 | 314 ++++++++++------------------- physics/flake_driver.meta | 272 ++----------------------- 4 files changed, 154 insertions(+), 517 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index f55416738..6a10a837f 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -677,7 +677,7 @@ subroutine GFS_phys_time_vary_init ( endif lsm_init !Lake model - if((lkm==1 .or. lkm==2) .and. (iopt_lake==iopt_lake_flake .or. iopt_lake==iopt_lake_clm)) then + if(lkm>0 .and. iopt_lake>0) then ! A lake model is enabled. do i = 1, im !if (lakefrac(i) > 0.0 .and. lakedepth(i) > 1.0 ) then diff --git a/physics/flake.F90 b/physics/flake.F90 index 1117afa16..557e22949 100644 --- a/physics/flake.F90 +++ b/physics/flake.F90 @@ -87,8 +87,7 @@ MODULE flake_albedo_ref albedo_water_ref = 0.07 , & ! Water albedo_whiteice_ref = 0.60 , & ! White ice albedo_blueice_ref = 0.10 , & ! Blue ice -! albedo_drysnow_ref = 0.60 , & ! Dry snow - albedo_drysnow_ref = 0.90 , & ! Dry snow + albedo_drysnow_ref = 0.60 , & ! Dry snow albedo_meltingsnow_ref = 0.10 ! Melting snow ! Empirical parameters. @@ -1531,11 +1530,7 @@ SUBROUTINE flake_main ( depthw, depthbs, T_bs, par_Coriolis, & flk_str_1 = flk_str_1 - CTT/CT*( (Q_bot_flk+I_bot_flk-I_HH_flk)/tpl_rho_w_r/tpl_c_w - & depth_bs * ( 1.0 - CT ) * (T_bot_n_flk-T_bot_p_flk)/del_time ) flk_str_2 = CTT * (T_bot_p_flk-T_bot_2_in) - if(abs(flk_str_2)<0.01) then - d_h_D_dt = 0.0 - else - d_h_D_dt = flk_str_1/flk_str_2 - endif + d_h_D_dt = flk_str_1/flk_str_2 ! compute d_T_H_dt flk_str_1 = (Q_bot_flk+I_bot_flk-I_HH_flk)/tpl_rho_w_r/tpl_c_w @@ -1860,8 +1855,7 @@ MODULE SfcFlx ! similarity relations and in the expressions for the roughness lengths. REAL (KIND = kind_phys), PARAMETER :: & c_Karman = 0.40 , & ! The von Karman constant -! Pr_neutral = 1.0 , & ! Turbulent Prandtl number at neutral static stability - Pr_neutral = 0.9 , & ! Turbulent Prandtl number at neutral static stability + Pr_neutral = 1.0 , & ! Turbulent Prandtl number at neutral static stability Sc_neutral = 1.0 , & ! Turbulent Schmidt number at neutral static stability c_MO_u_stab = 5.0 , & ! Constant of the MO theory (wind, stable stratification) c_MO_t_stab = 5.0 , & ! Constant of the MO theory (temperature, stable stratification) @@ -2472,37 +2466,18 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & ELSE ! Convection psi_u = (1.0-c_MO_t_conv*R_z*ZoL)**c_MO_t_exp psi_t = (1.0-c_MO_t_conv*R_z*ZoL*MIN(z0t_sf/height_tq, 1.0))**c_MO_t_exp -! psi_t = 2.0*LOG((1.0+psi_t)/(1.0+psi_u)) - psi_t = abs(2.0*LOG((1.0+psi_t)/(1.0+psi_u))) + psi_t = 2.0*LOG((1.0+psi_t)/(1.0+psi_u)) psi_u = (1.0-c_MO_q_conv*R_z*ZoL)**c_MO_q_exp psi_q = (1.0-c_MO_q_conv*R_z*ZoL*MIN(z0q_sf/height_tq, 1.0))**c_MO_q_exp -! psi_q = 2.0*LOG((1.0+psi_q)/(1.0+psi_u)) - psi_q = abs(2.0*LOG((1.0+psi_q)/(1.0+psi_u))) -! write(0,*) 'psi_q= ',psi_q + psi_q = 2.0*LOG((1.0+psi_q)/(1.0+psi_u)) !_dbg ! print*(*,*) 'CONV: psi_t = ', psi_t, ' psi_q = ', psi_q !_dbg END IF Q_sen_tur = -(T_a-T_s)*u_star_st*c_Karman/Pr_neutral & / MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) -if(MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) .lt. 10E-6) then - write(0,*)'inside flake' - write(0,*) Q_sen_tur, T_a, T_s, u_star_st, c_Karman, Pr_neutral - write(0,*) c_small_sf,height_tq,z0t_sf,psi_t - write(0,*) 'nominator= ', (T_a-T_s)*u_star_st*c_Karman/Pr_neutral - write(0,*) 'denominator= ',MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) -endif Q_lat_tur = -(q_a-q_s)*u_star_st*c_Karman/Sc_neutral & / MAX(c_small_sf, LOG(height_tq/z0q_sf)+psi_q) -if(Q_lat_tur .gt. 6.0E-4) then - Q_lat_tur = -(q_a-q_s)*u_star_st*c_Karman/3.0 & - / MAX(c_small_sf, LOG(height_tq/z0q_sf)+psi_q) - write(0,*) 'Q_lat_tur= ',Q_lat_tur - write(0,135) q_a,q_s,u_star_st,c_Karman - write(0,136) MAX(c_small_sf,LOG(height_tq/z0q_sf)+psi_q),c_small_sf, LOG(height_tq/z0q_sf),psi_q -endif -135 format(1x,4(f16.4)) -136 format(1x,4(f16.4)) END IF Turb_Fluxes @@ -2547,19 +2522,13 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & Q_momentum = Q_momentum*rho_a !Q_sensible = Q_sensible*rho_a*tpsf_c_a_p -!write(0,*) 'Q_sensible= ',Q_sensible Q_watvap = Q_latent*rho_a -!Q_latent = tpsf_L_evap +Q_latent = tpsf_L_evap IF(h_ice.GE.h_Ice_min_flk) Q_latent = Q_latent + tpl_L_f ! Add latent heat of fusion over ice -!Q_latent = Q_watvap*Q_latent -Q_latent = Q_watvap*tpsf_L_evap -if(Q_latent .gt. 2000.00) then - write(0,145) 'final Q_watvap= ',Q_watvap, 'tpsf_L_evap= ',tpsf_L_evap, 'Q_latent= ', Q_latent -endif -!Q_latent = Q_watvap*Q_latent -145 format(A17,E12.5,1x,A13,1x,f10.2,1x,A10,1x,E12.4) +Q_latent = Q_watvap*Q_latent + ! Set "*_sf" variables to make fluxes accessible to driving routines that use "SfcFlx" u_star_a_sf = u_star_st Q_mom_a_sf = Q_momentum @@ -2568,7 +2537,7 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & Q_watvap_a_sf = Q_watvap !write(85,127) Q_sensible, Q_watvap, Q_latent - 127 format(1x, 3(f16.5,1x)) + 127 format(1x, 3(f16.9,1x)) !------------------------------------------------------------------------------ ! End calculations @@ -2962,7 +2931,7 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he T_snow_out, T_ice_out, T_mnw_out, T_wML_out, T_bot_out, & T_B1_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & - H_B1_out, T_sfc_n, hflx_out, evap_out, gflx_out, lflx_out, & + H_B1_out, T_sfc_n, hflx_out, evap_out, & T_bot_2_in, T_bot_2_out,ustar, q_sfc, chh, cmm ) @@ -3004,11 +2973,11 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he USE flake_derivedtypes ! Definitions of several derived TYPEs -!USE flake_parameters , ONLY : & -! tpl_T_f , & ! Fresh water freezing point [K] -! tpl_rho_w_r , & ! Maximum density of fresh water [kg m^{-3}] -! h_Snow_min_flk , & ! Minimum snow thickness [m] -! h_Ice_min_flk ! Minimum ice thickness [m] +USE flake_parameters , ONLY : & + tpl_T_f , & ! Fresh water freezing point [K] + tpl_rho_w_r , & ! Maximum density of fresh water [kg m^{-3}] + h_Snow_min_flk , & ! Minimum snow thickness [m] + h_Ice_min_flk ! Minimum ice thickness [m] USE flake_paramoptic_ref ! Reference values of the optical characteristics ! of the lake water, lake ice and snow @@ -3134,8 +3103,6 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he T_sfc_n , & ! Updated surface temperature [K] hflx_out , & ! sensibl heat flux evap_out , & ! Latent heat flux - gflx_out , & ! flux from to water - lflx_out , & ! latent heat flux T_bot_2_out , & ! Bottom temperature ustar , & q_sfc , & @@ -3149,21 +3116,16 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he Q_sensible , & ! Sensible heat flux [W m^{-2}] Q_latent , & ! Latent heat flux [W m^{-2}] Q_watvap , & ! Flux of water vapour [kg m^{-2} s^{-1}] - Q_w_flux , & ! flux from ice to water rho_a ! ADDED by Shaobo Zhang LOGICAL lflk_botsed_use !REAL (KIND = kind_phys) :: T_bot_2_in, T_bot_2_out -REAL (KIND = kind_phys), parameter :: tpl_rho_w_r = 1.0E+03 -REAL (KIND = kind_phys), parameter :: tpl_T_f = 273.15 -REAL (KIND = kind_phys), parameter :: h_Snow_min_flk = 1.0E-5 -REAL (KIND = kind_phys), parameter :: h_Ice_min_flk = 1.0E-9 + !============================================================================== ! Start calculations !------------------------------------------------------------------------------ -! lflk_botsed_use = .TRUE. - lflk_botsed_use = .FALSE. + lflk_botsed_use = .TRUE. !------------------------------------------------------------------------------ ! Set albedos of the lake water, lake ice and snow !------------------------------------------------------------------------------ @@ -3177,10 +3139,9 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he ! Snow is not considered !albedo_snow = albedo_ice albedo_ice = albedo_whiteice_ref -!albedo_snow = albedo_ice -albedo_snow = albedo_drysnow_ref +albedo_snow = albedo_ice opticpar_water%extincoef_optic(1) = water_extinc -!write(0,*)'albedo= ',albedo_water,albedo_ice,albedo_snow +!print*,'albedo= ',albedo_water,albedo_ice,albedo_snow !------------------------------------------------------------------------------ ! Set optical characteristics of the lake water, lake ice and snow @@ -3243,8 +3204,7 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he CALL SfcFlx_momsenlat ( height_u_in, height_tq_in, fetch, & U_a_in, T_a_in, q_a_in, T_sfc_p, P_a_in, h_ice_p_flk, & Q_momentum, Q_sensible, Q_latent, Q_watvap, q_sfc, rho_a ) -!write(0,*)'tpl_rho_w_r= ', tpl_rho_w_r -!write(0,*) 'Q_momentum= ',Q_momentum + u_star_w_flk = SQRT(-Q_momentum/tpl_rho_w_r) ustar = u_star_w_flk @@ -3294,9 +3254,6 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he H_B1_out = H_B1_n_flk hflx_out = Q_sensible evap_out = Q_watvap -!evap_out = Q_latent -gflx_out = Q_w_flk -lflx_out = Q_latent chh = ch * U_a_in * rho_a cmm = cm * U_a_in diff --git a/physics/flake_driver.F90 b/physics/flake_driver.F90 index a277783fb..46065939d 100644 --- a/physics/flake_driver.F90 +++ b/physics/flake_driver.F90 @@ -49,17 +49,13 @@ end subroutine flake_driver_finalize !! SUBROUTINE flake_driver_run ( & ! ---- Inputs - im, ps, t1, q1, wind, min_lakeice, & - dlwflx, dswsfc, lakedepth, & - use_lake_model, snow, xlat, delt, zlvl, elev, & - wet, yearlen, julian, imon, & - flag_iter, first_time_step, flag_restart, & - weasd, & + im, ps, t1, q1, wind, & + dlwflx, dswsfc, weasd, lakedepth, & + use_lake_model, xlat, delt, zlvl, elev, & + wet, flag_iter, yearlen, julian, imon, & ! ---- in/outs - snwdph, hice, tsurf, t_sfc, fice, hflx, evap, & - lflx, gflx, ustar, qsfc, ch, cm, chh, cmm, & - h_ML, t_wML, t_mnw, H_B, T_B, t_bot1, & - t_bot2, c_t, T_snow, T_ice, tsurf_ice, & + snwdph, hice, tsurf, fice, T_sfc, hflx, evap, & + ustar, qsfc, ch, cm, chh, cmm, & errmsg, errflg ) !============================================================================== @@ -88,41 +84,37 @@ SUBROUTINE flake_driver_run ( & real (kind=kind_phys), dimension(:), intent(in) :: ps, wind, & & t1, q1, dlwflx, dswsfc, zlvl, elev - real (kind=kind_phys), intent(in) :: delt, min_lakeice + real (kind=kind_phys), intent(in) :: delt real (kind=kind_phys), dimension(:), intent(in) :: & - & xlat, lakedepth, snow + & xlat, weasd, lakedepth - real (kind=kind_phys), dimension(:), intent(in) :: weasd - - real (kind=kind_phys),dimension(:),intent(inout) :: & - & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, & - & ch, cm, chh, cmm, h_ML, t_wML, t_mnw, H_B, T_B, & - & t_bot1, t_bot2, c_t, T_snow, T_ice, tsurf_ice, lflx, gflx + real (kind=kind_phys),dimension(:),intent(inout) :: & + & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, & + & ch, cm, chh, cmm real (kind=kind_phys), intent(in) :: julian logical, dimension(:), intent(in) :: flag_iter, wet integer, dimension(:), intent(in) :: use_lake_model - logical, intent(in) :: flag_restart, first_time_step - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- locals - real (kind=kind_phys), parameter :: lake_pct_min = 0.1 + + real (kind=kind_phys) , parameter :: lake_pct_min = 0.1 real (kind=kind_phys), dimension(im) :: & -! T_snow , & ! Temperature at the air-snow interface [K] -! T_ice , & ! Temperature at the snow-ice or air-ice interface [K] -! T_mnw , & ! Mean temperature of the water column [K] -! T_wML , & ! Mixed-layer temperature [K] -! T_bot , & ! Temperature at the water-bottom sediment interface [K] -! T_B , & ! Temperature at the upper layer of the sediments [K] -! C_T , & ! Shape factor (thermocline) + T_snow , & ! Temperature at the air-snow interface [K] + T_ice , & ! Temperature at the snow-ice or air-ice interface [K] + T_mnw , & ! Mean temperature of the water column [K] + T_wML , & ! Mixed-layer temperature [K] + T_bot , & ! Temperature at the water-bottom sediment interface [K] + T_B1 , & ! Temperature at the upper layer of the sediments [K] + C_T , & ! Shape factor (thermocline) fetch , & ! Typical wind fetch [m] -! h_ML , & ! Thickness of the mixed-layer [m] -! H_B1 , & ! Thickness of the upper layer of bottom sediments [m] + h_ML , & ! Thickness of the mixed-layer [m] + H_B1 , & ! Thickness of the upper layer of bottom sediments [m] w_albedo , & ! w_extinc @@ -155,7 +147,7 @@ SUBROUTINE flake_driver_run ( & T_mnw_in , & ! Mean temperature of the water column [K] T_wML_in , & ! Mixed-layer temperature [K] T_bot_in , & ! Temperature at the water-bottom sediment interface [K] - T_B_in , & ! Temperature at the bottom of the upper layer of the sediments [K] + T_B1_in , & ! Temperature at the bottom of the upper layer of the sediments [K] C_T_in , & ! Shape factor (thermocline) h_snow_in , & ! Snow thickness [m] h_ice_in , & ! Ice thickness [m] @@ -173,7 +165,7 @@ SUBROUTINE flake_driver_run ( & T_mnw_out , & ! Mean temperature of the water column [K] T_wML_out , & ! Mixed-layer temperature [K] T_bot_out , & ! Temperature at the water-bottom sediment interface [K] - T_B_out , & ! Temperature at the bottom of the upper layer of the sediments [K] + T_B1_out , & ! Temperature at the bottom of the upper layer of the sediments [K] C_T_out , & ! Shape factor (thermocline) h_snow_out , & ! Snow thickness [m] h_ice_out , & ! Ice thickness [m] @@ -190,19 +182,17 @@ SUBROUTINE flake_driver_run ( & Q_momentum , & ! Momentum flux [N m^{-2}] Q_SHT_flx , & ! Sensible heat flux [W m^{-2}] Q_LHT_flx , & ! Latent heat flux [W m^{-2}] - Q_watvap , & ! Flux of water vapour [kg m^{-2} s^{-1}] - Q_gflx , & ! Flux from ice to water [W m^{-2}] - Q_lflx ! latent fluxes [W m^{-2}] + Q_watvap ! Flux of water vapour [kg m^{-2} s^{-1}] REAL (KIND = kind_phys) :: & - lake_depth_max, T_bot_2_in, T_bot_2_out, dlat,tb,tr,tt,temp,temp2 + lake_depth_max, T_bot_2_in, T_bot_2_out, dxlat,tb,tr,tt,temp,temp2 real (kind=kind_phys), parameter :: pi=4.0_kind_phys*atan(1.0_kind_phys) real (kind=kind_phys), parameter :: degrad=180.0_kind_phys/pi real (kind=kind_phys), parameter :: Kbar = 3.5_kind_phys, DelK = 3.0_kind_phys, & KbaroDelK = Kbar / DelK - REAL (KIND = kind_phys) :: x, y, w !temperarory variables used for Tbot and Tsfc + REAL (KIND = kind_phys) :: x, y !temperarory variables used for Tbot and Tsfc !initilizations INTEGER :: i,ipr,iter @@ -215,17 +205,15 @@ SUBROUTINE flake_driver_run ( & ! Start calculations !------------------------------------------------------------------------------ ! FLake_write need to assign original value to make the model somooth - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 ! --- ... set flag for lake points do_flake = .false. do i = 1, im - flag(i) = flag_iter(i) .and. use_lake_model(i) .gt. 0 - do_flake = flag(i) .or. do_flake + flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)>0 + do_flake = flag(i) .or. do_flake enddo + if (.not. do_flake) return lake_depth_max = 60.0 @@ -242,61 +230,61 @@ SUBROUTINE flake_driver_run ( & temp2 = sin((pi+pi)*(julian-151)/244) do i = 1, im - if (flag(i) .and. lakedepth(i) >1.0) then - if(.not.flag_restart .and. first_time_step) then - T_ice(i) = 273.15 - T_snow(i) = 273.15 - C_T(i) = 0.50 - dlat = abs(xlat(i)) - if(dlat .lt. 1.40) then - tt = (((21.181*dlat-51.376)*dlat+20.808)*dlat-3.8408)*dlat+29.554 - tt = tt -0.0038*elev(i)+273.15 - tb = (((-29.794*dlat+96.91)*dlat-86.129)*dlat-7.1921)*dlat+28.176 - tb = tb -0.0038*elev(i)+273.15 - w = (((2.5467*dlat-7.4683)*dlat+5.2465)*dlat+0.4360)*dlat+0.0643 - else - tt = 4.0+273.15-0.0038*elev(i) - tb = 0.05+273.15-0.0038*elev(i) - w = 0.207312 - endif - if(tsurf(i) > 400.00) then - write(0,*) tsurf(i) - write(0,*) 'Surface temperature initial is bad' - tsurf(i) = tt - write(0,*) tsurf(i) - endif - T_sfc(i) = 0.05*tt + 0.95* tsurf(i) - + if (flag(i)) then + T_ice(i) = 273.15 + T_snow(i) = 273.15 + fetch(i) = 2.0E+03 + C_T(i) = 0.50 + + dxlat = degrad*abs(xlat(i)) + tt = 29.275+(0.0813-0.0052*dxlat)*dxlat-0.0038*elev(i)+273.15 + tb = 29.075-(0.7566-0.0051*dxlat)*dxlat-0.0038*elev(i)+273.15 +! if (fice(i).le.0.0) then +! h_ice(i) = 0.0 +! h_snow(i)= 0.0 +! endif + if (snwdph(i) > 0.0 .or. hice(i) > 0.0) then + if (tsurf(i) < T_ice(i)) then + T_sfc(i) = T_ice(i) + else + T_sfc(i) = tsurf(i) + endif + else +! if (tsurf(i) < tt) then +! T_sfc(i) = tt +! else +! T_sfc(i) = tsurf(i) +! endif + T_sfc(i) = 0.1*tt + 0.9* tsurf(i) + endif +! ! Add empirical climatology of lake Tsfc and Tbot to the current Tsfc and Tbot ! to make sure Tsfc and Tbot are warmer than Tair in Winter or colder than Tair ! in Summer - if (xlat(i) >= 0.0) then - T_sfc(i) = T_sfc(i) + 0.05*y*w - tb = tb + 0.005*y*w - else - T_sfc(i) = T_sfc(i) - 0.5*y*w - tb = tb - 0.005*y*w - endif - - t_bot1(i) = tb - t_bot2(i) = tb - T_B(i) = tb - - T_mnw(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*t_bot1(i) - T_wML(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*t_bot1(i) - h_ML(i) = C_T(i)* min ( lakedepth(i), lake_depth_max ) - H_B(i) = min ( lakedepth(i),4.0) - hflx(i) = 0.0 - lflx(i) = 0.0 - evap(i) = 0.0 - chh = ch(i) * wind(i) * 1.225 !(kg/m3) - cmm = cm(i) * wind(i) - endif !end of .not.flag_restart + if (xlat(i) >= 0.0) then + T_sfc(i) = T_sfc(i) + 0.3*y + tb = tb + 0.05*y + else + T_sfc(i) = T_sfc(i) - 0.3*y + tb = tb - 0.05*y + endif + T_bot(i) = tb + T_B1(i) = tb + +! if (lakedepth(i) < 10.0) then +! T_bot(i) = T_sfc(i) +! T_B1(i) = T_bot(i) +! endif + + T_mnw(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*T_bot(i) + T_wML(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*T_bot(i) + h_ML(i) = C_T(i)* min ( lakedepth(i), lake_depth_max ) + H_B1(i) = min ( lakedepth(i),4.0) + hflx(i) = 0.0 + evap(i) = 0.0 - fetch(i) = 2.0E+03 ! compute albedo as a function of julian day and latitude -! write(0,*) ' xlat= ',xlat(i), temp w_albedo(I) = 0.06/cos((xlat(i)-temp)/1.2) ! w_albedo(I) = 0.06 ! compute water extinction coefficient as a function of julian day @@ -307,26 +295,24 @@ SUBROUTINE flake_driver_run ( & endif ! w_extinc(i) = 3.0 -! write(0,1002) julian,xlat(i),w_albedo(I),w_extinc(i),elev(i),tsurf(i),T_sfc(i),t_bot1(i) -! write(0,1003) use_lake_model(i),i,lakedepth(i), snwdph(i), hice(i), fice(i) -! write(0,1004) ps(i), wind(i), t1(i), q1(i), dlwflx(i), dswsfc(i), zlvl(i) +! write(65,1002) julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) +! print 1002 julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) +! print*,'inside flake driver' +! print*, julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) endif !flag enddo - 1002 format ( 'julian=',F6.2,1x,F8.3,1x,2(E7.2,1x),E7.2,1x,3(E7.2,1x)) - 1003 format ( 'use_lake_model=',I2,1x,I3,1x,F6.4,1x,F9.4,1x,2(F8.4,1x),F7.4) - 1004 format ( 'pressure',F12.2,1x,F6.2,1x,F7.2,1x,F7.4,1x,2(F8.2,1x),F8.4) + 1001 format ( 'At icount=', i5, ' x = ', f5.2,5x, 'y = ', & + 1p, e12.3) +! 1002 format ( ' julian= ',F6.2,1x,5(F8.4,1x),3(f11.4,1x)) + 1002 format (I4,1x,3(f8.4,1x),6(f11.4,1x)) + + ! ! call lake interface do i=1,im - if (flag(i) .and. lakedepth(i) > 1.0) then -! write(0,*) 'flag(i)= ', i, flag(i) -! if(weasd(i) < 0.0 .or. hice(i) < 0.0) weasd(i) =0.0 - if(snwdph(i) < 0.0) snwdph(i) =0.0 -! dMsnowdt_in = 10.0*0.001*weasd(i)/delt -! dMsnowdt_in = snow(i)/delt - dMsnowdt_in = snow(i)*0.001 - if(dMsnowdt_in < 0.0) dMsnowdt_in=0.0 + if (flag(i)) then + dMsnowdt_in = weasd(i)/delt I_atm_in = dswsfc(i) Q_atm_lw_in = dlwflx(i) height_u_in = zlvl(i) @@ -343,36 +329,27 @@ SUBROUTINE flake_driver_run ( & depth_w = min ( lakedepth(i), lake_depth_max ) depth_bs_in = max ( 4.0, min ( depth_w * 0.2, 10.0 ) ) fetch_in = fetch(i) - T_bs_in = T_bot1(i) + T_bs_in = T_bot(i) par_Coriolis = 2 * 7.2921 / 100000. * sin ( xlat(i) ) del_time = delt -! if(lakedepth(i).lt.10) then -! T_sfc(i) = t1(i) -! T_bs_in = T_sfc(i) -! T_B(i) = T_bs_in -! endif - - do iter=1,5 !interation loop + do iter=1,10 !interation loop T_snow_in = T_snow(i) T_ice_in = T_ice(i) T_mnw_in = T_mnw(i) T_wML_in = T_wML(i) - T_bot_in = t_bot1(i) - T_B_in = T_B(i) + T_bot_in = T_bot(i) + T_B1_in = T_B1(i) C_T_in = C_T(i) h_snow_in = snwdph(i) h_ice_in = hice(i) h_ML_in = h_ML(i) - H_B1_in = H_B(i) + H_B1_in = H_B1(i) T_sfc_in = T_sfc(i) - tsurf_ice(i)= T_ice(i) - T_bot_2_in = t_bot2(i) + T_bot_2_in = T_bot(i) Q_SHT_flx = hflx(i) Q_watvap = evap(i) - Q_gflx = 0.0 - Q_lflx = 0.0 !------------------------------------------------------------------------------ ! Set the rate of snow accumulation @@ -382,13 +359,13 @@ SUBROUTINE flake_driver_run ( & height_tq_in, U_a_in, T_a_in, q_a_in, P_a_in, & depth_w, fetch_in, depth_bs_in, T_bs_in, par_Coriolis, del_time, & - T_snow_in, T_ice_in, T_mnw_in, T_wML_in, T_bot_in, T_B_in, & + T_snow_in, T_ice_in, T_mnw_in, T_wML_in, T_bot_in, T_B1_in, & C_T_in, h_snow_in, h_ice_in, h_ML_in, H_B1_in, T_sfc_in, & ch_in, cm_in, albedo_water, water_extinc, & ! T_snow_out, T_ice_out, T_mnw_out, T_wML_out, T_bot_out, & - T_B_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & - H_B1_out, T_sfc_out, Q_SHT_flx, Q_watvap, Q_gflx, Q_lflx, & + T_B1_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & + H_B1_out, T_sfc_out, Q_SHT_flx, Q_watvap, & ! T_bot_2_in, T_bot_2_out,u_star, q_sfc,chh_out,cmm_out ) @@ -401,13 +378,11 @@ SUBROUTINE flake_driver_run ( & T_wML(i) = T_wML_out T_sfc(i) = T_sfc_out Tsurf(i) = T_sfc_out - tsurf_ice(i) = T_ice(i) - t_bot1(i) = T_bot_out - t_bot2(i) = T_bot_2_out - T_B(i) = T_B_out + T_bot(i) = T_bot_out + T_B1(i) = T_B1_out C_T(i) = C_T_out h_ML(i) = h_ML_out - H_B(i) = H_B1_out + H_B1(i) = H_B1_out ustar(i) = u_star qsfc(i) = q_sfc chh(i) = chh_out @@ -416,91 +391,26 @@ SUBROUTINE flake_driver_run ( & hice(i) = h_ice_out evap(i) = Q_watvap hflx(i) = Q_SHT_flx - gflx(i) = Q_gflx - lflx(i) = Q_lflx -! if(lflx(i) > 2500.00 .or. Tsurf(i) > 350.00) then -! write(0,125) i,lflx(i), Tsurf(i),ps(i), wind(i), & -! & t1(i), q1(i), dlwflx(i), dswsfc(i),hflx(i) -! endif -! fice(i) = fice(i)+0.01*(h_ice_out-h_ice_in) -! if(fice(i) .lt. min_lakeice ) then -! fice(i) = 0.0 -! elseif(fice(i) .gt. 1.0) then -! fice(i) = 1.0 -! endif + + if (hice(i) > 0.0 .or. snwdph(i) > 0.0) then + fice(i) = 1.0 + else + fice(i) = 0.0 + endif enddo !iter loop -! endif !endif use_lake_model endif !endif of flag enddo -125 format(1x,i3,1x,9(1x,f10.3)) +!125 format(1x,i2,1x,i2,1x,i2,1x,6(1x,f14.8)) !126 format(1x,i2,1x,i2,1x,6(1x,f14.8)) !127 format(1x,i2,2(1x,f16.9)) !------------------------------------------------------------------------------ ! End calculations !============================================================================== - END SUBROUTINE flake_driver_run - -end module flake_driver - -module flake_driver_post - use machine, only: kind_phys - implicit none - private - public flake_driver_post_init, flake_driver_post_finalize, flake_driver_post_run - -contains - subroutine flake_driver_post_init() - end subroutine flake_driver_post_init - - subroutine flake_driver_post_finalize() - end subroutine flake_driver_post_finalize - -!> \section arg_table_flake_driver_post Argument Table -!! \htmlinclude flake_driver_post.html -!! -subroutine flake_driver_post_run (im, use_lake_model, h_ML, T_wML, & - Tsurf, lakedepth, xz, zm, tref, tsfco, & - errmsg, errflg) - -!use machine , only : kind_phys -!============================================================================== - - implicit none - integer, intent(in) :: im -! integer, dimension(im), intent(in) :: islmsk - - real (kind=kind_phys), dimension(:), intent(in) :: & - & lakedepth, tsurf, h_ML, t_wML - - real (kind=kind_phys),dimension(:),intent(inout) :: & - & xz, zm, tref, tsfco - - integer, dimension(:), intent(in) :: use_lake_model - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - integer :: i - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - do I=1, im - if(use_lake_model(i).eq.2) then - write(0,*)'flake-post-use-lake-model= ',use_lake_model(i) - xz(i) = lakedepth(i) - zm(i) = h_ML(i) - tref(i) = tsurf(i) - tsfco(i) = t_wML(i) - endif - enddo - - -end subroutine flake_driver_post_run +END SUBROUTINE flake_driver_run !--------------------------------- -end module flake_driver_post + end module flake_driver diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index 94335a62d..c0fa96320 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -86,17 +86,9 @@ type = real kind = kind_phys intent = in -[min_lakeice] - standard_name = min_lake_ice_area_fraction - long_name = minimum lake ice value - units = frac - dimensions = () - type = real - kind = kind_phys - intent = in [dlwflx] - standard_name = surface_downwelling_longwave_flux - long_name = surface downwelling longwave flux at current time + standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_water + long_name = total sky surface downward longwave flux absorbed by the ground over water units = W m-2 dimensions = (horizontal_loop_extent) type = real @@ -110,6 +102,14 @@ type = real kind = kind_phys intent = in +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [lakedepth] standard_name = lake_depth long_name = lake depth @@ -125,14 +125,6 @@ dimensions = (horizontal_loop_extent) type = integer intent = in -[snow] - standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep - long_name = snow fall at this time step - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [xlat] standard_name = latitude long_name = latitude @@ -172,6 +164,13 @@ dimensions = (horizontal_loop_extent) type = logical intent = in +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in [yearlen] standard_name = number_of_days_in_current_year long_name = number of days in a year @@ -194,35 +193,6 @@ dimensions = () type = integer intent = in -[flag_iter] - standard_name = flag_for_iteration - long_name = flag for iteration - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = in -[first_time_step] - standard_name = flag_for_first_timestep - long_name = flag for first time step for time integration loop (cold/warmstart) - units = flag - dimensions = () - type = logical - intent = in -[flag_restart] - standard_name = flag_for_restart - long_name = flag for restart (warmstart) or coldstart - units = flag - dimensions = () - type = logical - intent = in -[weasd] - standard_name = water_equivalent_accumulated_snow_depth_over_ice - long_name = water equiv of acc snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [snwdph] standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice @@ -240,8 +210,8 @@ kind = kind_phys intent = inout [tsurf] - standard_name = surface_skin_temperature_over_water - long_name = surface skin temperature over water + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water units = K dimensions = (horizontal_loop_extent) type = real @@ -256,8 +226,8 @@ kind = kind_phys intent = inout [t_sfc] - standard_name = surface_skin_temperature_after_iteration_over_water - long_name = surface skin temperature after iteration over water + standard_name = surface_skin_temperature_over_water + long_name = surface skin temperature over water units = K dimensions = (horizontal_loop_extent) type = real @@ -279,22 +249,6 @@ type = real kind = kind_phys intent = inout -[lflx] - standard_name = surface_upward_potential_latent_heat_flux_over_water - long_name = surface upward potential latent heat flux over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[gflx] - standard_name = upward_heat_flux_in_soil_over_water - long_name = soil heat flux over water - units = W m-2 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout [ustar] standard_name = surface_friction_velocity_over_water long_name = surface friction velocity over water @@ -343,190 +297,6 @@ type = real kind = kind_phys intent = inout -[h_ML] - standard_name = mixed_layer_depth_of_lakes - long_name = depth of lake mixing layer - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[t_wML] - standard_name = lake_mixed_layer_temperature - long_name = temperature of lake mixing layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[t_mnw] - standard_name = mean_temperature_of_the_water_column - long_name = thee mean temperature of the water column - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[H_B] - standard_name = the_thermally_active_layer_depth_of_the_bottom_sediment - long_name = the depth of the thermally active layer of the bottom sediment - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[T_B] - standard_name = temperature_at_the_bottom_of_the_sediment_upper_layer - long_name = the temperature at the bottom of the sediment upper layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[t_bot1] - standard_name = lake_bottom_temperature - long_name = the temperature at the water-bottom sediment interface - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[t_bot2] - standard_name = temperature_for_bottom_layer_of_water - long_name = the temperature at the lake bottom layer water - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[c_t] - standard_name = shape_factor_of_water_temperature_vertical_profile - long_name = the shape factor of water temperature vertical profile - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[T_snow] - standard_name = temperature_of_snow_on_lake - long_name = the temperature of snow on a lake - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[T_ice] - standard_name = surface_skin_temperature_over_ice - long_name = surface skin temperature over ice - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[tsurf_ice] - standard_name = surface_skin_temperature_after_iteration_over_ice - long_name = surface skin temperature after iteration over ice - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-table-properties] - name = flake_driver_post - type = scheme - dependencies = machine.F -######################################################################## -[ccpp-arg-table] - name = flake_driver_post_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in -[lakedepth] - standard_name = lake_depth - long_name = lake depth - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[tsurf] - standard_name = surface_skin_temperature_after_iteration_over_water - long_name = surface skin temperature after iteration over water - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[h_ML] - standard_name = mixed_layer_depth_of_lakes - long_name = depth of lake mixing layer - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[t_wML] - standard_name = lake_mixed_layer_temperature - long_name = temperature of lake mixing layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[xz] - standard_name = diurnal_thermocline_layer_thickness - long_name = diurnal thermocline layer thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[zm] - standard_name = ocean_mixed_layer_thickness - long_name = mixed layer thickness - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[tref] - standard_name = reference_sea_surface_temperature - long_name = reference/foundation temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out -[tfco] - standard_name = sea_surface_temperature - long_name = sea surface temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From c4980ce8c17a66d76fdaac3404458091ec5a9116 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 29 Nov 2022 22:32:25 +0000 Subject: [PATCH 21/46] put some changes back in --- physics/GFS_surface_composites_post.F90 | 65 +++++++++++++++++++------ physics/sfc_diag.f | 14 +++++- physics/sfc_diag.meta | 44 +++++++++++++++++ 3 files changed, 108 insertions(+), 15 deletions(-) diff --git a/physics/GFS_surface_composites_post.F90 b/physics/GFS_surface_composites_post.F90 index 868db390f..c63b623d4 100644 --- a/physics/GFS_surface_composites_post.F90 +++ b/physics/GFS_surface_composites_post.F90 @@ -269,8 +269,37 @@ subroutine GFS_surface_composites_post_run ( else ! not fractional grid do i=1,im - if (islmsk(i) == 1) then + + if(frac_ice .and. use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then + if(dry(i)) then + call composite_land + else if(icy(i)) then + call composite_icy(.true.) + call composite_wet_and_icy + else + call composite_wet + endif + else if (islmsk(i) == 1) then !-- land + call composite_land + elseif (islmsk(i) == 0) then + !-- water + call composite_wet + else ! islmsk(i) == 2 + !-- ice + call composite_icy(use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) + call composite_wet_and_icy + endif + enddo + + endif fractional_grid + + ! --- compositing done + + contains + + subroutine composite_land + implicit none zorl(i) = zorll(i) cd(i) = cd_lnd(i) cdq(i) = cdq_lnd(i) @@ -295,8 +324,10 @@ subroutine GFS_surface_composites_post_run ( qss(i) = qss_lnd(i) hice(i) = zero cice(i) = zero - elseif (islmsk(i) == 0) then - !-- water + end subroutine composite_land + + subroutine composite_wet + implicit none zorl(i) = zorlo(i) cd(i) = cd_wat(i) cdq(i) = cdq_wat(i) @@ -322,8 +353,11 @@ subroutine GFS_surface_composites_post_run ( qss(i) = qss_wat(i) hice(i) = zero cice(i) = zero - else ! islmsk(i) == 2 - !-- ice + end subroutine composite_wet + + subroutine composite_icy(is_clm) + implicit none + logical, intent(in) :: is_clm zorl(i) = zorli(i) cd(i) = cd_ice(i) cdq(i) = cdq_ice(i) @@ -338,12 +372,20 @@ subroutine GFS_surface_composites_post_run ( chh(i) = chh_ice(i) gflx(i) = gflx_ice(i) ep1d(i) = ep1d_ice(i) - weasd(i) = weasd_ice(i) * cice(i) - snowd(i) = snowd_ice(i) * cice(i) + if(is_clm) then + weasd(i) = weasd_ice(i) + snowd(i) = snowd_ice(i) + else + weasd(i) = weasd_ice(i) * cice(i) + snowd(i) = snowd_ice(i) * cice(i) + endif qss(i) = qss_ice(i) evap(i) = evap_ice(i) hflx(i) = hflx_ice(i) -! + end subroutine composite_icy + + subroutine composite_wet_and_icy + implicit none txi = cice(i) txo = one - txi evap(i) = txi * evap_ice(i) + txo * evap_wat(i) @@ -372,12 +414,7 @@ subroutine GFS_surface_composites_post_run ( do k=1,min(kice,km) ! store tiice in stc to reduce output in the nonfrac grid case stc(i,k) = tiice(i,k) enddo - endif - enddo - - endif fractional_grid - - ! --- compositing done + end subroutine composite_wet_and_icy end subroutine GFS_surface_composites_post_run diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 045ad75b0..fae405048 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -13,6 +13,8 @@ module sfc_diag subroutine sfc_diag_run & & (im,grav,cp,eps,epsm1,ps,u1,v1,t1,q1,prslki, & & evap,fm,fh,fm10,fh2,tskin,qsurf,thsfc_loc, & + & use_lake_model,iopt_lake,iopt_lake_clm, & + & lake_t2m,lake_q2m,use_lake2m, & & f10m,u10m,v10m,t2m,q2m,errmsg,errflg & & ) ! @@ -20,14 +22,18 @@ subroutine sfc_diag_run & use funcphys, only : fpvs implicit none ! - integer, intent(in) :: im + integer, intent(in) :: im, iopt_lake, iopt_lake_clm logical, intent(in) :: thsfc_loc ! Flag for reference pot. temp. + logical, intent(in) :: use_lake2m real(kind=kind_phys), intent(in) :: grav,cp,eps,epsm1 real(kind=kind_phys), dimension(:), intent(in) :: & & ps, u1, v1, t1, q1, tskin, & & qsurf, prslki, evap, fm, fh, fm10, fh2 real(kind=kind_phys), dimension(:), intent(out) :: & & f10m, u10m, v10m, t2m, q2m + real(kind=kind_phys), dimension(:), intent(in) :: lake_t2m, & + & lake_q2m + integer, dimension(:), intent(in) :: use_lake_model character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -58,6 +64,11 @@ subroutine sfc_diag_run & ! f10m(i) = min(f10m(i),1.) u10m(i) = f10m(i) * u1(i) v10m(i) = f10m(i) * v1(i) + use_clm_2m: if(use_lake_model(i)>0 .and. use_lake2m .and. & + & iopt_lake==iopt_lake_clm) then + t2m(i) = lake_t2m(i) + q2m(i) = lake_q2m(i) + else fhi = fh2(i) / fh(i) ! t2m(i) = tskin(i)*(1. - fhi) + t1(i) * prslki(i) * fhi ! sig2k = 1. - (grav+grav) / (cp * t2m(i)) @@ -81,6 +92,7 @@ subroutine sfc_diag_run & qss = fpvs(t2m(i)) qss = eps * qss / (ps(i) + epsm1 * qss) q2m(i) = min(q2m(i),qss) + endif use_clm_2m enddo return diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index dd3bf79b8..a6f28c865 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -157,6 +157,50 @@ dimensions = () type = logical intent = in +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer + intent = in +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer + intent = in +[lake_t2m] + standard_name = temperature_at_2m_from_clm_lake + long_name = temperature at 2m from clm lake + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[lake_q2m] + standard_name = specific_humidity_at_2m_from_clm_lake + long_name = specific humidity at 2m from clm lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[use_lake2m] + standard_name = use_2m_diagnostics_calculated_by_lake_model + long_name = model 2m diagnostics use the temperature and humidity calculated by the lake model + units = flag + dimensions = () + type = integer + intent = in [f10m] standard_name = ratio_of_wind_at_surface_adjacent_layer_to_wind_at_10m long_name = ratio of fm10 and fm From e41e718d63dfddff8851e26aefd52648e0f967a2 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 30 Nov 2022 00:42:29 +0000 Subject: [PATCH 22/46] put flake back in --- physics/GFS_surface_composites_post.F90 | 10 +- physics/flake.F90 | 83 +++++-- physics/flake_driver.F90 | 314 +++++++++++++++--------- physics/flake_driver.meta | 272 ++++++++++++++++++-- 4 files changed, 520 insertions(+), 159 deletions(-) diff --git a/physics/GFS_surface_composites_post.F90 b/physics/GFS_surface_composites_post.F90 index c63b623d4..9683eac83 100644 --- a/physics/GFS_surface_composites_post.F90 +++ b/physics/GFS_surface_composites_post.F90 @@ -270,11 +270,9 @@ subroutine GFS_surface_composites_post_run ( do i=1,im - if(frac_ice .and. use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) then - if(dry(i)) then - call composite_land - else if(icy(i)) then - call composite_icy(.true.) + if (use_lake_model(i)>0) then + if(frac_ice .and. icy(i)) then + call composite_icy(iopt_lake==iopt_lake_clm) call composite_wet_and_icy else call composite_wet @@ -287,7 +285,7 @@ subroutine GFS_surface_composites_post_run ( call composite_wet else ! islmsk(i) == 2 !-- ice - call composite_icy(use_lake_model(i)>0 .and. iopt_lake==iopt_lake_clm) + call composite_icy(.false.) call composite_wet_and_icy endif enddo diff --git a/physics/flake.F90 b/physics/flake.F90 index 557e22949..1117afa16 100644 --- a/physics/flake.F90 +++ b/physics/flake.F90 @@ -87,7 +87,8 @@ MODULE flake_albedo_ref albedo_water_ref = 0.07 , & ! Water albedo_whiteice_ref = 0.60 , & ! White ice albedo_blueice_ref = 0.10 , & ! Blue ice - albedo_drysnow_ref = 0.60 , & ! Dry snow +! albedo_drysnow_ref = 0.60 , & ! Dry snow + albedo_drysnow_ref = 0.90 , & ! Dry snow albedo_meltingsnow_ref = 0.10 ! Melting snow ! Empirical parameters. @@ -1530,7 +1531,11 @@ SUBROUTINE flake_main ( depthw, depthbs, T_bs, par_Coriolis, & flk_str_1 = flk_str_1 - CTT/CT*( (Q_bot_flk+I_bot_flk-I_HH_flk)/tpl_rho_w_r/tpl_c_w - & depth_bs * ( 1.0 - CT ) * (T_bot_n_flk-T_bot_p_flk)/del_time ) flk_str_2 = CTT * (T_bot_p_flk-T_bot_2_in) - d_h_D_dt = flk_str_1/flk_str_2 + if(abs(flk_str_2)<0.01) then + d_h_D_dt = 0.0 + else + d_h_D_dt = flk_str_1/flk_str_2 + endif ! compute d_T_H_dt flk_str_1 = (Q_bot_flk+I_bot_flk-I_HH_flk)/tpl_rho_w_r/tpl_c_w @@ -1855,7 +1860,8 @@ MODULE SfcFlx ! similarity relations and in the expressions for the roughness lengths. REAL (KIND = kind_phys), PARAMETER :: & c_Karman = 0.40 , & ! The von Karman constant - Pr_neutral = 1.0 , & ! Turbulent Prandtl number at neutral static stability +! Pr_neutral = 1.0 , & ! Turbulent Prandtl number at neutral static stability + Pr_neutral = 0.9 , & ! Turbulent Prandtl number at neutral static stability Sc_neutral = 1.0 , & ! Turbulent Schmidt number at neutral static stability c_MO_u_stab = 5.0 , & ! Constant of the MO theory (wind, stable stratification) c_MO_t_stab = 5.0 , & ! Constant of the MO theory (temperature, stable stratification) @@ -2466,18 +2472,37 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & ELSE ! Convection psi_u = (1.0-c_MO_t_conv*R_z*ZoL)**c_MO_t_exp psi_t = (1.0-c_MO_t_conv*R_z*ZoL*MIN(z0t_sf/height_tq, 1.0))**c_MO_t_exp - psi_t = 2.0*LOG((1.0+psi_t)/(1.0+psi_u)) +! psi_t = 2.0*LOG((1.0+psi_t)/(1.0+psi_u)) + psi_t = abs(2.0*LOG((1.0+psi_t)/(1.0+psi_u))) psi_u = (1.0-c_MO_q_conv*R_z*ZoL)**c_MO_q_exp psi_q = (1.0-c_MO_q_conv*R_z*ZoL*MIN(z0q_sf/height_tq, 1.0))**c_MO_q_exp - psi_q = 2.0*LOG((1.0+psi_q)/(1.0+psi_u)) +! psi_q = 2.0*LOG((1.0+psi_q)/(1.0+psi_u)) + psi_q = abs(2.0*LOG((1.0+psi_q)/(1.0+psi_u))) +! write(0,*) 'psi_q= ',psi_q !_dbg ! print*(*,*) 'CONV: psi_t = ', psi_t, ' psi_q = ', psi_q !_dbg END IF Q_sen_tur = -(T_a-T_s)*u_star_st*c_Karman/Pr_neutral & / MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) +if(MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) .lt. 10E-6) then + write(0,*)'inside flake' + write(0,*) Q_sen_tur, T_a, T_s, u_star_st, c_Karman, Pr_neutral + write(0,*) c_small_sf,height_tq,z0t_sf,psi_t + write(0,*) 'nominator= ', (T_a-T_s)*u_star_st*c_Karman/Pr_neutral + write(0,*) 'denominator= ',MAX(c_small_sf, LOG(height_tq/z0t_sf)+psi_t) +endif Q_lat_tur = -(q_a-q_s)*u_star_st*c_Karman/Sc_neutral & / MAX(c_small_sf, LOG(height_tq/z0q_sf)+psi_q) +if(Q_lat_tur .gt. 6.0E-4) then + Q_lat_tur = -(q_a-q_s)*u_star_st*c_Karman/3.0 & + / MAX(c_small_sf, LOG(height_tq/z0q_sf)+psi_q) + write(0,*) 'Q_lat_tur= ',Q_lat_tur + write(0,135) q_a,q_s,u_star_st,c_Karman + write(0,136) MAX(c_small_sf,LOG(height_tq/z0q_sf)+psi_q),c_small_sf, LOG(height_tq/z0q_sf),psi_q +endif +135 format(1x,4(f16.4)) +136 format(1x,4(f16.4)) END IF Turb_Fluxes @@ -2522,13 +2547,19 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & Q_momentum = Q_momentum*rho_a !Q_sensible = Q_sensible*rho_a*tpsf_c_a_p +!write(0,*) 'Q_sensible= ',Q_sensible Q_watvap = Q_latent*rho_a -Q_latent = tpsf_L_evap +!Q_latent = tpsf_L_evap IF(h_ice.GE.h_Ice_min_flk) Q_latent = Q_latent + tpl_L_f ! Add latent heat of fusion over ice -Q_latent = Q_watvap*Q_latent - +!Q_latent = Q_watvap*Q_latent +Q_latent = Q_watvap*tpsf_L_evap +if(Q_latent .gt. 2000.00) then + write(0,145) 'final Q_watvap= ',Q_watvap, 'tpsf_L_evap= ',tpsf_L_evap, 'Q_latent= ', Q_latent +endif +!Q_latent = Q_watvap*Q_latent +145 format(A17,E12.5,1x,A13,1x,f10.2,1x,A10,1x,E12.4) ! Set "*_sf" variables to make fluxes accessible to driving routines that use "SfcFlx" u_star_a_sf = u_star_st Q_mom_a_sf = Q_momentum @@ -2537,7 +2568,7 @@ SUBROUTINE SfcFlx_momsenlat ( height_u, height_tq, fetch, & Q_watvap_a_sf = Q_watvap !write(85,127) Q_sensible, Q_watvap, Q_latent - 127 format(1x, 3(f16.9,1x)) + 127 format(1x, 3(f16.5,1x)) !------------------------------------------------------------------------------ ! End calculations @@ -2931,7 +2962,7 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he T_snow_out, T_ice_out, T_mnw_out, T_wML_out, T_bot_out, & T_B1_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & - H_B1_out, T_sfc_n, hflx_out, evap_out, & + H_B1_out, T_sfc_n, hflx_out, evap_out, gflx_out, lflx_out, & T_bot_2_in, T_bot_2_out,ustar, q_sfc, chh, cmm ) @@ -2973,11 +3004,11 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he USE flake_derivedtypes ! Definitions of several derived TYPEs -USE flake_parameters , ONLY : & - tpl_T_f , & ! Fresh water freezing point [K] - tpl_rho_w_r , & ! Maximum density of fresh water [kg m^{-3}] - h_Snow_min_flk , & ! Minimum snow thickness [m] - h_Ice_min_flk ! Minimum ice thickness [m] +!USE flake_parameters , ONLY : & +! tpl_T_f , & ! Fresh water freezing point [K] +! tpl_rho_w_r , & ! Maximum density of fresh water [kg m^{-3}] +! h_Snow_min_flk , & ! Minimum snow thickness [m] +! h_Ice_min_flk ! Minimum ice thickness [m] USE flake_paramoptic_ref ! Reference values of the optical characteristics ! of the lake water, lake ice and snow @@ -3103,6 +3134,8 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he T_sfc_n , & ! Updated surface temperature [K] hflx_out , & ! sensibl heat flux evap_out , & ! Latent heat flux + gflx_out , & ! flux from to water + lflx_out , & ! latent heat flux T_bot_2_out , & ! Bottom temperature ustar , & q_sfc , & @@ -3116,16 +3149,21 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he Q_sensible , & ! Sensible heat flux [W m^{-2}] Q_latent , & ! Latent heat flux [W m^{-2}] Q_watvap , & ! Flux of water vapour [kg m^{-2} s^{-1}] + Q_w_flux , & ! flux from ice to water rho_a ! ADDED by Shaobo Zhang LOGICAL lflk_botsed_use !REAL (KIND = kind_phys) :: T_bot_2_in, T_bot_2_out - +REAL (KIND = kind_phys), parameter :: tpl_rho_w_r = 1.0E+03 +REAL (KIND = kind_phys), parameter :: tpl_T_f = 273.15 +REAL (KIND = kind_phys), parameter :: h_Snow_min_flk = 1.0E-5 +REAL (KIND = kind_phys), parameter :: h_Ice_min_flk = 1.0E-9 !============================================================================== ! Start calculations !------------------------------------------------------------------------------ - lflk_botsed_use = .TRUE. +! lflk_botsed_use = .TRUE. + lflk_botsed_use = .FALSE. !------------------------------------------------------------------------------ ! Set albedos of the lake water, lake ice and snow !------------------------------------------------------------------------------ @@ -3139,9 +3177,10 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he ! Snow is not considered !albedo_snow = albedo_ice albedo_ice = albedo_whiteice_ref -albedo_snow = albedo_ice +!albedo_snow = albedo_ice +albedo_snow = albedo_drysnow_ref opticpar_water%extincoef_optic(1) = water_extinc -!print*,'albedo= ',albedo_water,albedo_ice,albedo_snow +!write(0,*)'albedo= ',albedo_water,albedo_ice,albedo_snow !------------------------------------------------------------------------------ ! Set optical characteristics of the lake water, lake ice and snow @@ -3204,7 +3243,8 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he CALL SfcFlx_momsenlat ( height_u_in, height_tq_in, fetch, & U_a_in, T_a_in, q_a_in, T_sfc_p, P_a_in, h_ice_p_flk, & Q_momentum, Q_sensible, Q_latent, Q_watvap, q_sfc, rho_a ) - +!write(0,*)'tpl_rho_w_r= ', tpl_rho_w_r +!write(0,*) 'Q_momentum= ',Q_momentum u_star_w_flk = SQRT(-Q_momentum/tpl_rho_w_r) ustar = u_star_w_flk @@ -3254,6 +3294,9 @@ SUBROUTINE flake_interface ( dMsnowdt_in, I_atm_in, Q_atm_lw_in, height_u_in, he H_B1_out = H_B1_n_flk hflx_out = Q_sensible evap_out = Q_watvap +!evap_out = Q_latent +gflx_out = Q_w_flk +lflx_out = Q_latent chh = ch * U_a_in * rho_a cmm = cm * U_a_in diff --git a/physics/flake_driver.F90 b/physics/flake_driver.F90 index 46065939d..a277783fb 100644 --- a/physics/flake_driver.F90 +++ b/physics/flake_driver.F90 @@ -49,13 +49,17 @@ end subroutine flake_driver_finalize !! SUBROUTINE flake_driver_run ( & ! ---- Inputs - im, ps, t1, q1, wind, & - dlwflx, dswsfc, weasd, lakedepth, & - use_lake_model, xlat, delt, zlvl, elev, & - wet, flag_iter, yearlen, julian, imon, & + im, ps, t1, q1, wind, min_lakeice, & + dlwflx, dswsfc, lakedepth, & + use_lake_model, snow, xlat, delt, zlvl, elev, & + wet, yearlen, julian, imon, & + flag_iter, first_time_step, flag_restart, & + weasd, & ! ---- in/outs - snwdph, hice, tsurf, fice, T_sfc, hflx, evap, & - ustar, qsfc, ch, cm, chh, cmm, & + snwdph, hice, tsurf, t_sfc, fice, hflx, evap, & + lflx, gflx, ustar, qsfc, ch, cm, chh, cmm, & + h_ML, t_wML, t_mnw, H_B, T_B, t_bot1, & + t_bot2, c_t, T_snow, T_ice, tsurf_ice, & errmsg, errflg ) !============================================================================== @@ -84,37 +88,41 @@ SUBROUTINE flake_driver_run ( & real (kind=kind_phys), dimension(:), intent(in) :: ps, wind, & & t1, q1, dlwflx, dswsfc, zlvl, elev - real (kind=kind_phys), intent(in) :: delt + real (kind=kind_phys), intent(in) :: delt, min_lakeice real (kind=kind_phys), dimension(:), intent(in) :: & - & xlat, weasd, lakedepth + & xlat, lakedepth, snow - real (kind=kind_phys),dimension(:),intent(inout) :: & - & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, & - & ch, cm, chh, cmm + real (kind=kind_phys), dimension(:), intent(in) :: weasd + + real (kind=kind_phys),dimension(:),intent(inout) :: & + & snwdph, hice, tsurf, t_sfc, hflx, evap, fice, ustar, qsfc, & + & ch, cm, chh, cmm, h_ML, t_wML, t_mnw, H_B, T_B, & + & t_bot1, t_bot2, c_t, T_snow, T_ice, tsurf_ice, lflx, gflx real (kind=kind_phys), intent(in) :: julian logical, dimension(:), intent(in) :: flag_iter, wet integer, dimension(:), intent(in) :: use_lake_model + logical, intent(in) :: flag_restart, first_time_step + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- locals - - real (kind=kind_phys) , parameter :: lake_pct_min = 0.1 + real (kind=kind_phys), parameter :: lake_pct_min = 0.1 real (kind=kind_phys), dimension(im) :: & - T_snow , & ! Temperature at the air-snow interface [K] - T_ice , & ! Temperature at the snow-ice or air-ice interface [K] - T_mnw , & ! Mean temperature of the water column [K] - T_wML , & ! Mixed-layer temperature [K] - T_bot , & ! Temperature at the water-bottom sediment interface [K] - T_B1 , & ! Temperature at the upper layer of the sediments [K] - C_T , & ! Shape factor (thermocline) +! T_snow , & ! Temperature at the air-snow interface [K] +! T_ice , & ! Temperature at the snow-ice or air-ice interface [K] +! T_mnw , & ! Mean temperature of the water column [K] +! T_wML , & ! Mixed-layer temperature [K] +! T_bot , & ! Temperature at the water-bottom sediment interface [K] +! T_B , & ! Temperature at the upper layer of the sediments [K] +! C_T , & ! Shape factor (thermocline) fetch , & ! Typical wind fetch [m] - h_ML , & ! Thickness of the mixed-layer [m] - H_B1 , & ! Thickness of the upper layer of bottom sediments [m] +! h_ML , & ! Thickness of the mixed-layer [m] +! H_B1 , & ! Thickness of the upper layer of bottom sediments [m] w_albedo , & ! w_extinc @@ -147,7 +155,7 @@ SUBROUTINE flake_driver_run ( & T_mnw_in , & ! Mean temperature of the water column [K] T_wML_in , & ! Mixed-layer temperature [K] T_bot_in , & ! Temperature at the water-bottom sediment interface [K] - T_B1_in , & ! Temperature at the bottom of the upper layer of the sediments [K] + T_B_in , & ! Temperature at the bottom of the upper layer of the sediments [K] C_T_in , & ! Shape factor (thermocline) h_snow_in , & ! Snow thickness [m] h_ice_in , & ! Ice thickness [m] @@ -165,7 +173,7 @@ SUBROUTINE flake_driver_run ( & T_mnw_out , & ! Mean temperature of the water column [K] T_wML_out , & ! Mixed-layer temperature [K] T_bot_out , & ! Temperature at the water-bottom sediment interface [K] - T_B1_out , & ! Temperature at the bottom of the upper layer of the sediments [K] + T_B_out , & ! Temperature at the bottom of the upper layer of the sediments [K] C_T_out , & ! Shape factor (thermocline) h_snow_out , & ! Snow thickness [m] h_ice_out , & ! Ice thickness [m] @@ -182,17 +190,19 @@ SUBROUTINE flake_driver_run ( & Q_momentum , & ! Momentum flux [N m^{-2}] Q_SHT_flx , & ! Sensible heat flux [W m^{-2}] Q_LHT_flx , & ! Latent heat flux [W m^{-2}] - Q_watvap ! Flux of water vapour [kg m^{-2} s^{-1}] + Q_watvap , & ! Flux of water vapour [kg m^{-2} s^{-1}] + Q_gflx , & ! Flux from ice to water [W m^{-2}] + Q_lflx ! latent fluxes [W m^{-2}] REAL (KIND = kind_phys) :: & - lake_depth_max, T_bot_2_in, T_bot_2_out, dxlat,tb,tr,tt,temp,temp2 + lake_depth_max, T_bot_2_in, T_bot_2_out, dlat,tb,tr,tt,temp,temp2 real (kind=kind_phys), parameter :: pi=4.0_kind_phys*atan(1.0_kind_phys) real (kind=kind_phys), parameter :: degrad=180.0_kind_phys/pi real (kind=kind_phys), parameter :: Kbar = 3.5_kind_phys, DelK = 3.0_kind_phys, & KbaroDelK = Kbar / DelK - REAL (KIND = kind_phys) :: x, y !temperarory variables used for Tbot and Tsfc + REAL (KIND = kind_phys) :: x, y, w !temperarory variables used for Tbot and Tsfc !initilizations INTEGER :: i,ipr,iter @@ -205,15 +215,17 @@ SUBROUTINE flake_driver_run ( & ! Start calculations !------------------------------------------------------------------------------ ! FLake_write need to assign original value to make the model somooth + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 ! --- ... set flag for lake points do_flake = .false. do i = 1, im - flag(i) = wet(i) .and. flag_iter(i) .and. use_lake_model(i)>0 - do_flake = flag(i) .or. do_flake + flag(i) = flag_iter(i) .and. use_lake_model(i) .gt. 0 + do_flake = flag(i) .or. do_flake enddo - if (.not. do_flake) return lake_depth_max = 60.0 @@ -230,61 +242,61 @@ SUBROUTINE flake_driver_run ( & temp2 = sin((pi+pi)*(julian-151)/244) do i = 1, im - if (flag(i)) then - T_ice(i) = 273.15 - T_snow(i) = 273.15 - fetch(i) = 2.0E+03 - C_T(i) = 0.50 - - dxlat = degrad*abs(xlat(i)) - tt = 29.275+(0.0813-0.0052*dxlat)*dxlat-0.0038*elev(i)+273.15 - tb = 29.075-(0.7566-0.0051*dxlat)*dxlat-0.0038*elev(i)+273.15 -! if (fice(i).le.0.0) then -! h_ice(i) = 0.0 -! h_snow(i)= 0.0 -! endif - if (snwdph(i) > 0.0 .or. hice(i) > 0.0) then - if (tsurf(i) < T_ice(i)) then - T_sfc(i) = T_ice(i) - else - T_sfc(i) = tsurf(i) - endif - else -! if (tsurf(i) < tt) then -! T_sfc(i) = tt -! else -! T_sfc(i) = tsurf(i) -! endif - T_sfc(i) = 0.1*tt + 0.9* tsurf(i) - endif -! + if (flag(i) .and. lakedepth(i) >1.0) then + if(.not.flag_restart .and. first_time_step) then + T_ice(i) = 273.15 + T_snow(i) = 273.15 + C_T(i) = 0.50 + dlat = abs(xlat(i)) + if(dlat .lt. 1.40) then + tt = (((21.181*dlat-51.376)*dlat+20.808)*dlat-3.8408)*dlat+29.554 + tt = tt -0.0038*elev(i)+273.15 + tb = (((-29.794*dlat+96.91)*dlat-86.129)*dlat-7.1921)*dlat+28.176 + tb = tb -0.0038*elev(i)+273.15 + w = (((2.5467*dlat-7.4683)*dlat+5.2465)*dlat+0.4360)*dlat+0.0643 + else + tt = 4.0+273.15-0.0038*elev(i) + tb = 0.05+273.15-0.0038*elev(i) + w = 0.207312 + endif + if(tsurf(i) > 400.00) then + write(0,*) tsurf(i) + write(0,*) 'Surface temperature initial is bad' + tsurf(i) = tt + write(0,*) tsurf(i) + endif + T_sfc(i) = 0.05*tt + 0.95* tsurf(i) + ! Add empirical climatology of lake Tsfc and Tbot to the current Tsfc and Tbot ! to make sure Tsfc and Tbot are warmer than Tair in Winter or colder than Tair ! in Summer - if (xlat(i) >= 0.0) then - T_sfc(i) = T_sfc(i) + 0.3*y - tb = tb + 0.05*y - else - T_sfc(i) = T_sfc(i) - 0.3*y - tb = tb - 0.05*y - endif - T_bot(i) = tb - T_B1(i) = tb - -! if (lakedepth(i) < 10.0) then -! T_bot(i) = T_sfc(i) -! T_B1(i) = T_bot(i) -! endif - - T_mnw(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*T_bot(i) - T_wML(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*T_bot(i) - h_ML(i) = C_T(i)* min ( lakedepth(i), lake_depth_max ) - H_B1(i) = min ( lakedepth(i),4.0) - hflx(i) = 0.0 - evap(i) = 0.0 + if (xlat(i) >= 0.0) then + T_sfc(i) = T_sfc(i) + 0.05*y*w + tb = tb + 0.005*y*w + else + T_sfc(i) = T_sfc(i) - 0.5*y*w + tb = tb - 0.005*y*w + endif + + t_bot1(i) = tb + t_bot2(i) = tb + T_B(i) = tb + + T_mnw(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*t_bot1(i) + T_wML(i) = C_T(i)*T_sfc(i) + (1-C_T(i))*t_bot1(i) + h_ML(i) = C_T(i)* min ( lakedepth(i), lake_depth_max ) + H_B(i) = min ( lakedepth(i),4.0) + hflx(i) = 0.0 + lflx(i) = 0.0 + evap(i) = 0.0 + chh = ch(i) * wind(i) * 1.225 !(kg/m3) + cmm = cm(i) * wind(i) + endif !end of .not.flag_restart + fetch(i) = 2.0E+03 ! compute albedo as a function of julian day and latitude +! write(0,*) ' xlat= ',xlat(i), temp w_albedo(I) = 0.06/cos((xlat(i)-temp)/1.2) ! w_albedo(I) = 0.06 ! compute water extinction coefficient as a function of julian day @@ -295,24 +307,26 @@ SUBROUTINE flake_driver_run ( & endif ! w_extinc(i) = 3.0 -! write(65,1002) julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) -! print 1002 julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) -! print*,'inside flake driver' -! print*, julian,xlat(i),w_albedo(I),w_extinc(i),lakedepth(i),elev(i),tb,tt,tsurf(i),T_sfc(i) +! write(0,1002) julian,xlat(i),w_albedo(I),w_extinc(i),elev(i),tsurf(i),T_sfc(i),t_bot1(i) +! write(0,1003) use_lake_model(i),i,lakedepth(i), snwdph(i), hice(i), fice(i) +! write(0,1004) ps(i), wind(i), t1(i), q1(i), dlwflx(i), dswsfc(i), zlvl(i) endif !flag enddo - 1001 format ( 'At icount=', i5, ' x = ', f5.2,5x, 'y = ', & - 1p, e12.3) -! 1002 format ( ' julian= ',F6.2,1x,5(F8.4,1x),3(f11.4,1x)) - 1002 format (I4,1x,3(f8.4,1x),6(f11.4,1x)) - - + 1002 format ( 'julian=',F6.2,1x,F8.3,1x,2(E7.2,1x),E7.2,1x,3(E7.2,1x)) + 1003 format ( 'use_lake_model=',I2,1x,I3,1x,F6.4,1x,F9.4,1x,2(F8.4,1x),F7.4) + 1004 format ( 'pressure',F12.2,1x,F6.2,1x,F7.2,1x,F7.4,1x,2(F8.2,1x),F8.4) ! ! call lake interface do i=1,im - if (flag(i)) then - dMsnowdt_in = weasd(i)/delt + if (flag(i) .and. lakedepth(i) > 1.0) then +! write(0,*) 'flag(i)= ', i, flag(i) +! if(weasd(i) < 0.0 .or. hice(i) < 0.0) weasd(i) =0.0 + if(snwdph(i) < 0.0) snwdph(i) =0.0 +! dMsnowdt_in = 10.0*0.001*weasd(i)/delt +! dMsnowdt_in = snow(i)/delt + dMsnowdt_in = snow(i)*0.001 + if(dMsnowdt_in < 0.0) dMsnowdt_in=0.0 I_atm_in = dswsfc(i) Q_atm_lw_in = dlwflx(i) height_u_in = zlvl(i) @@ -329,27 +343,36 @@ SUBROUTINE flake_driver_run ( & depth_w = min ( lakedepth(i), lake_depth_max ) depth_bs_in = max ( 4.0, min ( depth_w * 0.2, 10.0 ) ) fetch_in = fetch(i) - T_bs_in = T_bot(i) + T_bs_in = T_bot1(i) par_Coriolis = 2 * 7.2921 / 100000. * sin ( xlat(i) ) del_time = delt - do iter=1,10 !interation loop +! if(lakedepth(i).lt.10) then +! T_sfc(i) = t1(i) +! T_bs_in = T_sfc(i) +! T_B(i) = T_bs_in +! endif + + do iter=1,5 !interation loop T_snow_in = T_snow(i) T_ice_in = T_ice(i) T_mnw_in = T_mnw(i) T_wML_in = T_wML(i) - T_bot_in = T_bot(i) - T_B1_in = T_B1(i) + T_bot_in = t_bot1(i) + T_B_in = T_B(i) C_T_in = C_T(i) h_snow_in = snwdph(i) h_ice_in = hice(i) h_ML_in = h_ML(i) - H_B1_in = H_B1(i) + H_B1_in = H_B(i) T_sfc_in = T_sfc(i) + tsurf_ice(i)= T_ice(i) - T_bot_2_in = T_bot(i) + T_bot_2_in = t_bot2(i) Q_SHT_flx = hflx(i) Q_watvap = evap(i) + Q_gflx = 0.0 + Q_lflx = 0.0 !------------------------------------------------------------------------------ ! Set the rate of snow accumulation @@ -359,13 +382,13 @@ SUBROUTINE flake_driver_run ( & height_tq_in, U_a_in, T_a_in, q_a_in, P_a_in, & depth_w, fetch_in, depth_bs_in, T_bs_in, par_Coriolis, del_time, & - T_snow_in, T_ice_in, T_mnw_in, T_wML_in, T_bot_in, T_B1_in, & + T_snow_in, T_ice_in, T_mnw_in, T_wML_in, T_bot_in, T_B_in, & C_T_in, h_snow_in, h_ice_in, h_ML_in, H_B1_in, T_sfc_in, & ch_in, cm_in, albedo_water, water_extinc, & ! T_snow_out, T_ice_out, T_mnw_out, T_wML_out, T_bot_out, & - T_B1_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & - H_B1_out, T_sfc_out, Q_SHT_flx, Q_watvap, & + T_B_out, C_T_out, h_snow_out, h_ice_out, h_ML_out, & + H_B1_out, T_sfc_out, Q_SHT_flx, Q_watvap, Q_gflx, Q_lflx, & ! T_bot_2_in, T_bot_2_out,u_star, q_sfc,chh_out,cmm_out ) @@ -378,11 +401,13 @@ SUBROUTINE flake_driver_run ( & T_wML(i) = T_wML_out T_sfc(i) = T_sfc_out Tsurf(i) = T_sfc_out - T_bot(i) = T_bot_out - T_B1(i) = T_B1_out + tsurf_ice(i) = T_ice(i) + t_bot1(i) = T_bot_out + t_bot2(i) = T_bot_2_out + T_B(i) = T_B_out C_T(i) = C_T_out h_ML(i) = h_ML_out - H_B1(i) = H_B1_out + H_B(i) = H_B1_out ustar(i) = u_star qsfc(i) = q_sfc chh(i) = chh_out @@ -391,26 +416,91 @@ SUBROUTINE flake_driver_run ( & hice(i) = h_ice_out evap(i) = Q_watvap hflx(i) = Q_SHT_flx - - if (hice(i) > 0.0 .or. snwdph(i) > 0.0) then - fice(i) = 1.0 - else - fice(i) = 0.0 - endif + gflx(i) = Q_gflx + lflx(i) = Q_lflx +! if(lflx(i) > 2500.00 .or. Tsurf(i) > 350.00) then +! write(0,125) i,lflx(i), Tsurf(i),ps(i), wind(i), & +! & t1(i), q1(i), dlwflx(i), dswsfc(i),hflx(i) +! endif +! fice(i) = fice(i)+0.01*(h_ice_out-h_ice_in) +! if(fice(i) .lt. min_lakeice ) then +! fice(i) = 0.0 +! elseif(fice(i) .gt. 1.0) then +! fice(i) = 1.0 +! endif enddo !iter loop +! endif !endif use_lake_model endif !endif of flag enddo -!125 format(1x,i2,1x,i2,1x,i2,1x,6(1x,f14.8)) +125 format(1x,i3,1x,9(1x,f10.3)) !126 format(1x,i2,1x,i2,1x,6(1x,f14.8)) !127 format(1x,i2,2(1x,f16.9)) !------------------------------------------------------------------------------ ! End calculations !============================================================================== -END SUBROUTINE flake_driver_run + END SUBROUTINE flake_driver_run + +end module flake_driver + +module flake_driver_post + use machine, only: kind_phys + implicit none + private + public flake_driver_post_init, flake_driver_post_finalize, flake_driver_post_run + +contains + subroutine flake_driver_post_init() + end subroutine flake_driver_post_init + + subroutine flake_driver_post_finalize() + end subroutine flake_driver_post_finalize + +!> \section arg_table_flake_driver_post Argument Table +!! \htmlinclude flake_driver_post.html +!! +subroutine flake_driver_post_run (im, use_lake_model, h_ML, T_wML, & + Tsurf, lakedepth, xz, zm, tref, tsfco, & + errmsg, errflg) + +!use machine , only : kind_phys +!============================================================================== + + implicit none + integer, intent(in) :: im +! integer, dimension(im), intent(in) :: islmsk + + real (kind=kind_phys), dimension(:), intent(in) :: & + & lakedepth, tsurf, h_ML, t_wML + + real (kind=kind_phys),dimension(:),intent(inout) :: & + & xz, zm, tref, tsfco + + integer, dimension(:), intent(in) :: use_lake_model + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + integer :: i + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do I=1, im + if(use_lake_model(i).eq.2) then + write(0,*)'flake-post-use-lake-model= ',use_lake_model(i) + xz(i) = lakedepth(i) + zm(i) = h_ML(i) + tref(i) = tsurf(i) + tsfco(i) = t_wML(i) + endif + enddo + + +end subroutine flake_driver_post_run !--------------------------------- - end module flake_driver +end module flake_driver_post diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index c0fa96320..94335a62d 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -86,9 +86,17 @@ type = real kind = kind_phys intent = in +[min_lakeice] + standard_name = min_lake_ice_area_fraction + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in [dlwflx] - standard_name = surface_downwelling_longwave_flux_absorbed_by_ground_over_water - long_name = total sky surface downward longwave flux absorbed by the ground over water + standard_name = surface_downwelling_longwave_flux + long_name = surface downwelling longwave flux at current time units = W m-2 dimensions = (horizontal_loop_extent) type = real @@ -102,14 +110,6 @@ type = real kind = kind_phys intent = in -[weasd] - standard_name = water_equivalent_accumulated_snow_depth_over_ice - long_name = water equiv of acc snow depth over ice - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [lakedepth] standard_name = lake_depth long_name = lake depth @@ -125,6 +125,14 @@ dimensions = (horizontal_loop_extent) type = integer intent = in +[snow] + standard_name = lwe_thickness_of_snow_amount_on_dynamics_timestep + long_name = snow fall at this time step + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in [xlat] standard_name = latitude long_name = latitude @@ -164,13 +172,6 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[flag_iter] - standard_name = flag_for_iteration - long_name = flag for iteration - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = in [yearlen] standard_name = number_of_days_in_current_year long_name = number of days in a year @@ -193,6 +194,35 @@ dimensions = () type = integer intent = in +[flag_iter] + standard_name = flag_for_iteration + long_name = flag for iteration + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = in +[first_time_step] + standard_name = flag_for_first_timestep + long_name = flag for first time step for time integration loop (cold/warmstart) + units = flag + dimensions = () + type = logical + intent = in +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in +[weasd] + standard_name = water_equivalent_accumulated_snow_depth_over_ice + long_name = water equiv of acc snow depth over ice + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [snwdph] standard_name = surface_snow_thickness_water_equivalent_over_ice long_name = water equivalent snow depth over ice @@ -210,8 +240,8 @@ kind = kind_phys intent = inout [tsurf] - standard_name = surface_skin_temperature_after_iteration_over_water - long_name = surface skin temperature after iteration over water + standard_name = surface_skin_temperature_over_water + long_name = surface skin temperature over water units = K dimensions = (horizontal_loop_extent) type = real @@ -226,8 +256,8 @@ kind = kind_phys intent = inout [t_sfc] - standard_name = surface_skin_temperature_over_water - long_name = surface skin temperature over water + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water units = K dimensions = (horizontal_loop_extent) type = real @@ -249,6 +279,22 @@ type = real kind = kind_phys intent = inout +[lflx] + standard_name = surface_upward_potential_latent_heat_flux_over_water + long_name = surface upward potential latent heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[gflx] + standard_name = upward_heat_flux_in_soil_over_water + long_name = soil heat flux over water + units = W m-2 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [ustar] standard_name = surface_friction_velocity_over_water long_name = surface friction velocity over water @@ -297,6 +343,190 @@ type = real kind = kind_phys intent = inout +[h_ML] + standard_name = mixed_layer_depth_of_lakes + long_name = depth of lake mixing layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_wML] + standard_name = lake_mixed_layer_temperature + long_name = temperature of lake mixing layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_mnw] + standard_name = mean_temperature_of_the_water_column + long_name = thee mean temperature of the water column + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[H_B] + standard_name = the_thermally_active_layer_depth_of_the_bottom_sediment + long_name = the depth of the thermally active layer of the bottom sediment + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[T_B] + standard_name = temperature_at_the_bottom_of_the_sediment_upper_layer + long_name = the temperature at the bottom of the sediment upper layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_bot1] + standard_name = lake_bottom_temperature + long_name = the temperature at the water-bottom sediment interface + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[t_bot2] + standard_name = temperature_for_bottom_layer_of_water + long_name = the temperature at the lake bottom layer water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[c_t] + standard_name = shape_factor_of_water_temperature_vertical_profile + long_name = the shape factor of water temperature vertical profile + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[T_snow] + standard_name = temperature_of_snow_on_lake + long_name = the temperature of snow on a lake + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[T_ice] + standard_name = surface_skin_temperature_over_ice + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[tsurf_ice] + standard_name = surface_skin_temperature_after_iteration_over_ice + long_name = surface skin temperature after iteration over ice + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out +[errflg] + standard_name = ccpp_error_code + long_name = error code for error handling in CCPP + units = 1 + dimensions = () + type = integer + intent = out + +######################################################################## +[ccpp-table-properties] + name = flake_driver_post + type = scheme + dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = flake_driver_post_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in +[lakedepth] + standard_name = lake_depth + long_name = lake depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[tsurf] + standard_name = surface_skin_temperature_after_iteration_over_water + long_name = surface skin temperature after iteration over water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[h_ML] + standard_name = mixed_layer_depth_of_lakes + long_name = depth of lake mixing layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[t_wML] + standard_name = lake_mixed_layer_temperature + long_name = temperature of lake mixing layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[xz] + standard_name = diurnal_thermocline_layer_thickness + long_name = diurnal thermocline layer thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[zm] + standard_name = ocean_mixed_layer_thickness + long_name = mixed layer thickness + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[tref] + standard_name = reference_sea_surface_temperature + long_name = reference/foundation temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out +[tfco] + standard_name = sea_surface_temperature + long_name = sea surface temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From f44c410d78b2444cdafdc1852f0f75c0b6fe12f5 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 1 Dec 2022 03:49:36 +0000 Subject: [PATCH 23/46] skin_temperature_from_clm_lake_model -> skin_temperature_from_lake_model --- physics/clm_lake.meta | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 0c8a3af33..a7b6155b4 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -624,8 +624,8 @@ kind = kind_phys intent = inout [t_grnd2d] - standard_name = skin_temperature_from_clm_lake_model - long_name = skin_temperature_from_clm_lake_model + standard_name = skin_temperature_from_lake_model + long_name = skin_temperature_from_lake_model units = K dimensions = (horizontal_loop_extent) type = real From b214ab49d5cff293d9658c4a8ddce44210d06f91 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 1 Mar 2023 21:31:05 +0000 Subject: [PATCH 24/46] correction to a comment in clm_lake.f90 --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 3128519bb..edbfb3b58 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -5484,7 +5484,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, cycle endif - ! To handle restarts with bad lakedepth2d + ! To handle cold-start with bad lakedepth2d if ( use_lakedepth ) then if (oro_lakedepth(i) == 10.0 .or. oro_lakedepth(i) <= 0.) then !- 10.0 is the fill value for lake depth, in this case set to default value From 05e87ec99198dfd727a95f5878adb3f83a249f45 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 14:02:13 +0000 Subject: [PATCH 25/46] restart works with FV3_HRRR suite --- physics/clm_lake.f90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index edbfb3b58..afcc45521 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -559,6 +559,8 @@ SUBROUTINE clm_lake_run( & ! FIXME: Should multiply PRCP by 1000 PRCP = (raincprv(i)+rainncprv(i))/dtime ! [mm/s] use physics timestep since PRCP comes from non-surface schemes SOLDN = DSWSFCI(I) ! SOLDN is total incoming solar + albedo(i) = ( 0.6 * lake_icefrac3d(i,1) ) + & + ( (1.0-lake_icefrac3d(i,1)) * 0.08) SOLNET = SOLDN*(1.-ALBEDO(I)) ! use mid-day albedo to determine net downward solar ! (no solar zenith angle correction) From aa57582bfd7cadcefbac63d364f4050ea7cf3c25 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 15:20:31 +0000 Subject: [PATCH 26/46] do not freeze great salt lakes --- physics/clm_lake.f90 | 40 ++++++++++++++++++++++++++++++---------- physics/clm_lake.meta | 7 +++++++ 2 files changed, 37 insertions(+), 10 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index afcc45521..ab9634f33 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -180,22 +180,24 @@ end function limit_temperature_by_climatology !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - logical function is_salty(xlat_d,xlon_positive) + subroutine is_salty(xlat_d,xlon_positive, cannot_freeze, salty) implicit none real(kind_phys), intent(in) :: xlat_d, xlon_positive + logical, intent(inout) :: cannot_freeze, salty real(kind_phys) :: xlon_d xlon_d = xlon_positive if(xlon_d>180) xlon_d = xlon_d - 360 - is_salty=limit_temperature_by_climatology(xlat_d,xlon_d) + cannot_freeze = limit_temperature_by_climatology(xlat_d,xlon_d) + salty = cannot_freeze other_locations: if(include_all_salty_locations) then ! --- The Mono Lake in California, salinity is 75 ppt with freezing point at ! --- -4.2 C (Stan). The Mono Lake lat/long (37.9-38.2, -119.3 - 118.8) if (xlon_d.gt.-119.3.and. xlon_d.lt.-118.8) then if(xlat_d.gt.37.9 .and. xlat_d.lt.38.2) then - is_salty = .true. + salty = .true. if(lakedebug) then print *,'Salty Mono Lake, i,j',xlat_d,xlon_d endif @@ -207,17 +209,17 @@ logical function is_salty(xlat_d,xlon_positive) if(lakedebug) then print *,'Salty Caspian Sea ',xlat_d,xlon_d endif - is_salty = .true. + salty = .true. end if if ( xlon_d>35.3 .and. xlon_d<35.6 .and. xlat_d>31.3 .and. xlat_d<31.8) then if(lakedebug) then print *,'Salty Dead Sea ',xlat_d,xlon_d endif - is_salty = .true. + salty = .true. endif endif other_locations !tgs --- end of special treatment for salty lakes - end function is_salty + end subroutine is_salty !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -251,7 +253,7 @@ SUBROUTINE clm_lake_run( & salty, savedtke12d, snowdp2d, h2osno2d, snl2d, t_grnd2d, t_lake3d, & lake_icefrac3d, t_soisno3d, h2osoi_ice3d, h2osoi_liq3d, h2osoi_vol3d, & z3d, dz3d, zi3d, z_lake3d, dz_lake3d, watsat3d, csol3d, sand3d, clay3d, & - tkmg3d, tkdry3d, tksatu3d, clm_lakedepth, & + tkmg3d, tkdry3d, tksatu3d, clm_lakedepth, cannot_freeze, & ! Error reporting: errflg, errmsg) @@ -308,6 +310,7 @@ SUBROUTINE clm_lake_run( & ! Lake model internal state stored by caller: ! INTEGER, DIMENSION( : ), INTENT(INOUT) :: salty + INTEGER, DIMENSION( : ), INTENT(INOUT) :: cannot_freeze real(kind_phys), dimension(: ) ,intent(inout) :: savedtke12d, & snowdp2d, & @@ -439,6 +442,8 @@ SUBROUTINE clm_lake_run( & integer :: month,num1,num2,day_of_month real(kind_phys) :: wght1,wght2,Tclim + logical salty_flag, cannot_freeze_flag + errmsg = ' ' errflg = 0 @@ -533,12 +538,20 @@ SUBROUTINE clm_lake_run( & if_lake_is_here: if (flag_iter(i) .and. use_lake_model(i)/=0) THEN - if(is_salty(xlat_d(i),xlon_d(i))) then + call is_salty(xlat_d(i),xlon_d(i),salty_flag,cannot_freeze_flag) + + if(salty_flag) then salty(i) = 1 else salty(i) = 0 endif + if(cannot_freeze_flag) then + cannot_freeze(i) = 1 + else + cannot_freeze(i) = 0 + endif + if(salty(i)/=0) then Tclim = tfrz + wght1*saltlk_T(num1) & + wght2*saltlk_T(num2) @@ -674,6 +687,14 @@ SUBROUTINE clm_lake_run( & ! Renew Lake State Variables:(14) do c = 1,column + if(cannot_freeze(i) == 1) then + t_grnd(c) = max(274.5,t_grnd(c)) + do k = 1,nlevlake + t_lake(c,k) = max(274.5,t_lake(c,k)) + lake_icefrac(c,k) = 0. + enddo + endif + savedtke12d(i) = savedtke1(c) snowdp2d(i) = snowdp(c) h2osno2d(i) = h2osno(c) @@ -694,10 +715,9 @@ SUBROUTINE clm_lake_run( & do k = -nlevsnow+0,nlevsoil zi3d(i,k) = zi(c,k) enddo - enddo - + feedback: if(feedback_to_atmosphere) then c = 1 diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index a7b6155b4..06d30fb90 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -591,6 +591,13 @@ dimensions = (horizontal_loop_extent) type = integer intent = inout +[cannot_freeze] + standard_name = clm_lake_cannot_freeze + long_name = lake at this point is so salty it cannot freeze + units = 1 + dimensions = (horizontal_loop_extent) + type = integer + intent = inout [savedtke12d] standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model long_name = top level eddy conductivity from previous timestep in clm lake model From b3a058645427ce6c5894672d9de33ca2519cfa7c Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 16:31:04 +0000 Subject: [PATCH 27/46] address reviewer comments --- physics/clm_lake.f90 | 63 ++++++++++++++++++++++----------------- physics/flake_driver.F90 | 34 +-------------------- physics/flake_driver.meta | 40 ------------------------- 3 files changed, 36 insertions(+), 101 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index ab9634f33..de30a6cfa 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -40,7 +40,7 @@ MODULE clm_lake logical, parameter :: PERGRO = .false. logical, parameter :: USE_ETALAKE = .false. - real, parameter :: ETALAKE = 1.1925*50**(-0.424) ! Set this to your desired value if USE_ETALAKE=.true. + real(kind_phys), parameter :: ETALAKE = 1.1925*50**(-0.424) ! Set this to your desired value if USE_ETALAKE=.true. ! Level counts must be consistent with model (GFS_typedefs.F90) integer, parameter :: nlevsoil = 10 ! number of soil layers @@ -93,6 +93,8 @@ MODULE clm_lake real(kind_phys) :: hfus !Latent heat of fusion for ice [J/kg] real(kind_phys) :: hvap !Latent heat of evap for water [J/kg] real(kind_phys) :: hsub !Latent heat of sublimation [J/kg] + real(kind_phys) :: invhvap !1/hvap [kg/J] + real(kind_phys) :: invhsub !1/hsub [kg/J] real(kind_phys) :: rair !gas constant for dry air [J/kg/K] real(kind_phys) :: cpair !specific heat of dry air [J/kg/K] @@ -271,7 +273,7 @@ SUBROUTINE clm_lake_run( & ! INTEGER , INTENT (IN) :: im,km,me,master INTEGER, INTENT(IN) :: IDATE(4), kdt - REAL, INTENT(IN) :: fhour + REAL(kind_phys), INTENT(IN) :: fhour ! ! Configuration and initialization: @@ -439,6 +441,8 @@ SUBROUTINE clm_lake_run( & ! The latitude and longitude of unhappy points. real(kind_phys), allocatable, save :: unhappy_lat(:),unhappy_lon(:) + real(kind_phys) :: to_radians + integer :: month,num1,num2,day_of_month real(kind_phys) :: wght1,wght2,Tclim @@ -446,7 +450,6 @@ SUBROUTINE clm_lake_run( & errmsg = ' ' errflg = 0 - dtime=dtp if(LAKEDEBUG) then @@ -512,6 +515,8 @@ SUBROUTINE clm_lake_run( & snow_points=0 ice_points=0 + to_radians = pi/180 + month = IDATE(2) day_of_month = IDATE(3) @@ -594,7 +599,7 @@ SUBROUTINE clm_lake_run( & forc_lwrad(c) = LWDN ! [W/m/m] prec(c) = PRCP ! [mm/s] sabg(c) = SOLNET - lat(c) = XLAT_D(I)*pi/180 ! [radian] + lat(c) = XLAT_D(I)*to_radians ! [radian] do_capsnow(c) = .false. lakedepth(c) = clm_lakedepth(i) @@ -723,9 +728,9 @@ SUBROUTINE clm_lake_run( & !-- The CLM output is combined for fractional ice and water if( t_grnd(c) >= tfrz ) then - qfx = eflx_lh_tot(c)/hvap + qfx = eflx_lh_tot(c)*invhvap else - qfx = eflx_lh_tot(c)/hsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) + qfx = eflx_lh_tot(c)*invhsub ! heat flux (W/m^2)=>mass flux(kg/(sm^2)) endif evap_wat(i) = qfx/rho0(i) ! kinematic_surface_upward_latent_heat_flux_over_water hflx_wat(i)=eflx_sh_tot(c)/(rho0(i)*cpair) ! kinematic_surface_upward_sensible_heat_flux_over_water @@ -827,7 +832,7 @@ logical function point_is_unhappy(xlat_d,xlon_d) ! If lakedebug is false, then it will return false immediately. implicit none integer :: j - real, intent(in) :: xlat_d,xlon_d + real(kind_phys), intent(in) :: xlat_d,xlon_d if(lakedebug) then do j=1,unhappy_count @@ -1356,10 +1361,10 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, if (snl(c) < 0) then betaprime(c) = 1._kind_phys !Assume all solar rad. absorbed at the surface of the top snow layer. - dzsur(c) = dz(c,jtop(c))/2._kind_phys + dzsur(c) = dz(c,jtop(c))*0.5_kind_phys else betaprime(c) = beta(islak) - dzsur(c) = dz_lake(c,1)/2._kind_phys + dzsur(c) = dz_lake(c,1)*0.5_kind_phys end if ! Originally this was 1*dz, but shouldn't it be 1/2? @@ -2224,7 +2229,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! phix(c,j) = phi(c,j) tx(c,j) = t_lake(c,j) else !soil layer - zx(c,j) = zx(c,nlevlake) + dz_lake(c,nlevlake)/2._kind_phys + z(c,jprime) + zx(c,j) = zx(c,nlevlake) + dz_lake(c,nlevlake)*0.5_kind_phys + z(c,jprime) cvx(c,j) = cv(c,jprime) if (j == nlevlake + 1) then !top soil layer phix(c,j) = phi_soil(c) @@ -2263,7 +2268,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! else if (j == nlevlake) then !bottom lake layer dzp = zx(c,j+1) - zx(c,j) tkix(c,j) = (tktopsoillay(c)*tk_lake(c,j)*dzp / & - (tktopsoillay(c)*dz_lake(c,j)/2._kind_phys + tk_lake(c,j)*z(c,1) ) ) + (tktopsoillay(c)*dz_lake(c,j)*0.5_kind_phys + tk_lake(c,j)*z(c,1) ) ) ! tktopsoillay is the conductivity at the middle of that layer, as defined in SoilThermProp_Lake else !soil layer tkix(c,j) = tk(c,jprime) @@ -4592,9 +4597,9 @@ subroutine DivideSnowLayers(lbc, ubc, & !i ! Specify a new snow layer if (dzsno(c,1) > 0.03) then msno = 2 - dzsno(c,1) = dzsno(c,1)/2. - swice(c,1) = swice(c,1)/2. - swliq(c,1) = swliq(c,1)/2. + dzsno(c,1) = dzsno(c,1)*0.5 + swice(c,1) = swice(c,1)*0.5 + swliq(c,1) = swliq(c,1)*0.5 dzsno(c,2) = dzsno(c,1) swice(c,2) = swice(c,1) swliq(c,2) = swliq(c,1) @@ -4619,9 +4624,9 @@ subroutine DivideSnowLayers(lbc, ubc, & !i ! Subdivide a new layer if (msno <= 2 .and. dzsno(c,2) > 0.07) then msno = 3 - dzsno(c,2) = dzsno(c,2)/2. - swice(c,2) = swice(c,2)/2. - swliq(c,2) = swliq(c,2)/2. + dzsno(c,2) = dzsno(c,2)*0.5 + swice(c,2) = swice(c,2)*0.5 + swliq(c,2) = swliq(c,2)*0.5 dzsno(c,3) = dzsno(c,2) swice(c,3) = swice(c,2) swliq(c,3) = swliq(c,2) @@ -4647,9 +4652,9 @@ subroutine DivideSnowLayers(lbc, ubc, & !i ! Subdivided a new layer if (msno <= 3 .and. dzsno(c,3) > 0.18) then msno = 4 - dzsno(c,3) = dzsno(c,3)/2. - swice(c,3) = swice(c,3)/2. - swliq(c,3) = swliq(c,3)/2. + dzsno(c,3) = dzsno(c,3)*0.5 + swice(c,3) = swice(c,3)*0.5 + swliq(c,3) = swliq(c,3)*0.5 dzsno(c,4) = dzsno(c,3) swice(c,4) = swice(c,3) swliq(c,4) = swliq(c,3) @@ -4675,9 +4680,9 @@ subroutine DivideSnowLayers(lbc, ubc, & !i ! Subdivided a new layer if (msno <= 4 .and. dzsno(c,4) > 0.41) then msno = 5 - dzsno(c,4) = dzsno(c,4)/2. - swice(c,4) = swice(c,4)/2. - swliq(c,4) = swliq(c,4)/2. + dzsno(c,4) = dzsno(c,4)*0.5 + swice(c,4) = swice(c,4)*0.5 + swliq(c,4) = swliq(c,4)*0.5 dzsno(c,5) = dzsno(c,4) swice(c,5) = swice(c,4) swliq(c,5) = swliq(c,4) @@ -5316,6 +5321,8 @@ subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,c hfus = con_hfus hvap = con_hvap hsub = con_hfus+con_hvap + invhvap = 1._kind_phys/hvap + invhsub = 1._kind_phys/hsub rair = con_rd cpair = con_cp @@ -5461,7 +5468,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, !LOGICAL, DIMENSION( : ),intent(out) :: lake !REAL(KIND_PHYS), OPTIONAL, DIMENSION( : ), INTENT(IN) :: lake_depth ! no separate variable for this in CCPP - real, dimension( 1:im,1:nlevsoil ) :: bsw3d, & + real(kind_phys), dimension( 1:im,1:nlevsoil ) :: bsw3d, & bsw23d, & psisat3d, & vwcsat3d, & @@ -5639,7 +5646,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, dz3d(i,0) = snowdp2d(i) else if ((snowdp2d(i) > 0.03_kind_phys) .and. (snowdp2d(i) <= 0.04_kind_phys)) then snl2d(i) = -2 - dz3d(i,-1) = snowdp2d(i)/2._kind_phys + dz3d(i,-1) = snowdp2d(i)*0.5_kind_phys dz3d(i, 0) = dz3d(i,-1) else if ((snowdp2d(i) > 0.04_kind_phys) .and. (snowdp2d(i) <= 0.07_kind_phys)) then snl2d(i) = -2 @@ -5648,7 +5655,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, else if ((snowdp2d(i) > 0.07_kind_phys) .and. (snowdp2d(i) <= 0.12_kind_phys)) then snl2d(i) = -3 dz3d(i,-2) = 0.02_kind_phys - dz3d(i,-1) = (snowdp2d(i) - 0.02_kind_phys)/2._kind_phys + dz3d(i,-1) = (snowdp2d(i) - 0.02_kind_phys)*0.5_kind_phys dz3d(i, 0) = dz3d(i,-1) else if ((snowdp2d(i) > 0.12_kind_phys) .and. (snowdp2d(i) <= 0.18_kind_phys)) then snl2d(i) = -3 @@ -5659,7 +5666,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, snl2d(i) = -4 dz3d(i,-3) = 0.02_kind_phys dz3d(i,-2) = 0.05_kind_phys - dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-3) - dz3d(i,-2))/2._kind_phys + dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-3) - dz3d(i,-2))*0.5_kind_phys dz3d(i, 0) = dz3d(i,-1) else if ((snowdp2d(i) > 0.29_kind_phys) .and. (snowdp2d(i) <= 0.41_kind_phys)) then snl2d(i) = -4 @@ -5672,7 +5679,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, dz3d(i,-4) = 0.02_kind_phys dz3d(i,-3) = 0.05_kind_phys dz3d(i,-2) = 0.11_kind_phys - dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-4) - dz3d(i,-3) - dz3d(i,-2))/2._kind_phys + dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-4) - dz3d(i,-3) - dz3d(i,-2))*0.5_kind_phys dz3d(i, 0) = dz3d(i,-1) else if (snowdp2d(i) > 0.64_kind_phys) then snl2d(i) = -5 diff --git a/physics/flake_driver.F90 b/physics/flake_driver.F90 index a277783fb..3b5988254 100644 --- a/physics/flake_driver.F90 +++ b/physics/flake_driver.F90 @@ -8,42 +8,10 @@ module flake_driver private - public :: flake_driver_init, flake_driver_run, flake_driver_finalize + public :: flake_driver_run contains -!> \section arg_table_flake_driver_init Argument Table -!! \htmlinclude flake_driver_init.html -!! - subroutine flake_driver_init (errmsg, errflg) - - implicit none - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - end subroutine flake_driver_init - -!> \section arg_table_flake_driver_finalize Argument Table -!! \htmlinclude flake_driver_finalize.html -!! - subroutine flake_driver_finalize (errmsg, errflg) - - implicit none - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - end subroutine flake_driver_finalize - !> \section arg_table_flake_driver_run Argument Table !! \htmlinclude flake_driver_run.html !! diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index 94335a62d..e665dc962 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -3,46 +3,6 @@ type = scheme dependencies = flake.F90,machine.F -######################################################################## -[ccpp-arg-table] - name = flake_driver_init - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - -######################################################################## -[ccpp-arg-table] - name = flake_driver_finalize - type = scheme -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out -[errflg] - standard_name = ccpp_error_code - long_name = error code for error handling in CCPP - units = 1 - dimensions = () - type = integer - intent = out - ######################################################################## [ccpp-arg-table] name = flake_driver_run From ce8643f84cd1f06e62c35f2b72d9cf0b61ad88b0 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 16:41:31 +0000 Subject: [PATCH 28/46] comment to resolve reviewer confusion --- physics/clm_lake.f90 | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index de30a6cfa..3730d2429 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -322,6 +322,22 @@ SUBROUTINE clm_lake_run( & real(kind_phys), dimension( :,: ) ,INTENT(inout) :: t_lake3d, & lake_icefrac3d +! Quick education on CCPP and deferred shape arrays. + +! CCPP requires deferred shape arrays as a workaround for its design +! flaw: it needs an argument that can receive either a null pointer, +! or an automatic storage array (which is not guaranteed to exist in +! memory at all). Such a thing doesn't exist in Fortran, so the design +! of CCPP assumes a compiler will accept either as an argument to a +! deferred shape array. + +! Apparently there is a misunderstanding among developers of how a +! deferred shape array is declared. If the array dimensions do not +! have an UPPER bound, then it is deferred shape. A LOWER bound is +! acceptable; it does not cease to be a deferred shape array. + +! That is why these seven arrays fit the CCPP design. + real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout) :: t_soisno3d, & h2osoi_ice3d, & h2osoi_liq3d, & From f9e049eea04051912c865aa21e35091e4831ae32 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 2 Mar 2023 20:29:24 +0000 Subject: [PATCH 29/46] coare changes and bug fixes from tanya --- physics/clm_lake.f90 | 42 +++++++++++++++++++++++++++++++++--------- physics/clm_lake.meta | 8 -------- 2 files changed, 33 insertions(+), 17 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index ab9634f33..aa850a9c0 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -236,7 +236,7 @@ SUBROUTINE clm_lake_run( & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & - ch, cm, dlwsfci, dswsfci, emiss, oro_lakedepth, wind, rho0, tsfc, & + ch, cm, dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & flag_iter, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: @@ -288,7 +288,7 @@ SUBROUTINE clm_lake_run( & ! REAL(KIND_PHYS), DIMENSION(:), INTENT(IN):: & tg3, pgr, zlvl, qvcurr, xlat_d, xlon_d, ch, cm, & - dlwsfci, dswsfci, emiss, oro_lakedepth, wind, rho0, tsfc, & + dlwsfci, dswsfci, oro_lakedepth, wind, rho0, tsfc, & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter @@ -416,6 +416,8 @@ SUBROUTINE clm_lake_run( & real(kind_phys) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) real(kind_phys) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) +! real(kind_phys) :: emiss ! surface emissivity + integer :: lake_points, snow_points, ice_points character*255 :: message logical, parameter :: feedback_to_atmosphere = .true. ! FIXME: REMOVE @@ -568,7 +570,9 @@ SUBROUTINE clm_lake_run( & PBOT = prsi(i,1) PSFC = pgr(i) Q2K = qvcurr(i) - LWDN = DLWSFCI(I)*EMISS(I) +! EMISS = 0.99 * lake_icefrac3d(i,1) + emg * (1.0-lake_icefrac3d(i,1)) ! emg=0.97, parameter, needs to be moved to the top + LWDN = DLWSFCI(I) ! LWDN is downward LW flux, do not use EMISS here. +! LWDN = DLWSFCI(I)*EMISS(I) ! FIXME: Should multiply PRCP by 1000 PRCP = (raincprv(i)+rainncprv(i))/dtime ! [mm/s] use physics timestep since PRCP comes from non-surface schemes SOLDN = DSWSFCI(I) ! SOLDN is total incoming solar @@ -1251,7 +1255,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, integer , parameter :: islak = 2 ! index of lake, 1 = deep lake, 2 = shallow lake integer , parameter :: niters = 3 ! maximum number of iterations for surface temperature real(kind_phys), parameter :: beta1 = 1._kind_phys ! coefficient of convective velocity (in computing W_*) [-] - real(kind_phys), parameter :: emg = 0.97_kind_phys ! ground emissivity (0.97 for snow) + real(kind_phys), parameter :: emg = 0.97_kind_phys ! ground emissivity (0.97 for water) real(kind_phys), parameter :: zii = 1000._kind_phys! convective boundary height [m] real(kind_phys), parameter :: tdmax = 277._kind_phys ! temperature of maximum water density real(kind_phys) :: forc_th(1) ! atmospheric potential temperature (Kelvin) @@ -1312,6 +1316,9 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, real(kind_phys) :: t_grnd_temp ! Used in surface flux correction over frozen ground real(kind_phys) :: betaprime(lbc:ubc) ! Effective beta: 1 for snow layers, beta(islak) otherwise character*256 :: message + ! tgs COARE + real(kind_phys) :: tc, visc, ren + ! This assumes all radiation is absorbed in the top snow layer and will need ! to be changed for CLM 4. ! @@ -1407,12 +1414,25 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, else ! for frozen lake with snow z0mg(p) = 0.0024_kind_phys end if - - + !- tgs - use COARE formulation for z0hg and z0qg. + !-- suggestion from Ayumi Manome (GLERL), Aug. 2018 + !-- Charusombat et al., 2018, https://doi.org/10.5194/hess-2017-725 + tc=forc_t(g)-273.15_kind_phys + visc=1.326e-5_kind_phys*(1._kind_phys + 6.542e-3_kind_phys*tc + 8.301e-6_kind_phys*tc*tc & + - 4.84e-9_kind_phys*tc*tc*tc) + + Ren = MAX(ustar(p)*z0mg(p)/visc, 0.1_kind_phys) + z0hg(p) = (5.5e-5_kind_phys)*(Ren**(-0.60_kind_phys)) - z0hg(p) = z0mg(p) - z0qg(p) = z0mg(p) + z0hg(p) = MIN(z0hg(p),1.0e-4_kind_phys) + z0hg(p) = MAX(z0hg(p),2.0e-9_kind_phys) + + z0qg(p) = z0hg(p) + + ! end COARE + !z0hg(p) = z0mg(p) + !z0qg(p) = z0mg(p) ! Latent heat @@ -2577,15 +2597,19 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !layer will actually be. if (i == 1) zsum(c) = 0._kind_phys if ((zsum(c)+dz_lake(c,i))/nav(c) <= iceav(c)) then - lake_icefrac(c,i) = 1._kind_phys t_lake(c,i) = tav_froz(c) + tfrz + !tgs - 30jul19 - the next line is a bug and should be commented + !out. This bug prevents lake ice form completely melting. + ! lake_icefrac(c,i) = 1._kind_phys else if (zsum(c)/nav(c) < iceav(c)) then + !tgs - change ice fraction lake_icefrac(c,i) = (iceav(c)*nav(c) - zsum(c)) / dz_lake(c,i) ! Find average value that preserves correct heat content. t_lake(c,i) = ( lake_icefrac(c,i)*tav_froz(c)*cice_eff & + (1._kind_phys - lake_icefrac(c,i))*tav_unfr(c)*cwat ) & / ( lake_icefrac(c,i)*cice_eff + (1-lake_icefrac(c,i))*cwat ) + tfrz else + !tgs - remove ice lake_icefrac(c,i) = 0._kind_phys t_lake(c,i) = tav_unfr(c) + tfrz end if diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 06d30fb90..4149fd8ef 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -251,14 +251,6 @@ type = real kind = kind_phys intent = in -[emiss] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [raincprv] standard_name = lwe_thickness_of_convective_precipitation_amount_on_previous_timestep long_name = convective_precipitation_amount from previous timestep From 06d4d9e65ca955ddf73a7642e756b37308d65734 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 2 Mar 2023 21:25:01 +0000 Subject: [PATCH 30/46] further updates from tanya --- physics/clm_lake.f90 | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 521f79bde..b70313da5 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -575,18 +575,6 @@ SUBROUTINE clm_lake_run( & cannot_freeze(i) = 0 endif - if(salty(i)/=0) then - Tclim = tfrz + wght1*saltlk_T(num1) & - + wght2*saltlk_T(num2) - if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,tsfc_wat(i),t_lake3d(i,:),t_soisno3d(i,:) - t_grnd2d(i) = min(Tclim+3.0_kind_phys,(max(tsfc_wat(i),Tclim-3.0_kind_phys))) - do k = 1,nlevlake - t_lake3d(i,k) = min(Tclim+3.0_kind_phys,(max(t_lake3d(i,k),Tclim-3.0_kind_phys))) - enddo - t_soisno3d(i,1) = min(Tclim+3.0_kind_phys,(max(t_soisno3d(i,1),Tclim-3.0_kind_phys))) - if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,tsfc_wat(i),t_lake3d(i,:),t_soisno3d(i,:) - endif - SFCTMP = gt0(i,1) PBOT = prsi(i,1) PSFC = pgr(i) @@ -713,13 +701,25 @@ SUBROUTINE clm_lake_run( & do c = 1,column if(cannot_freeze(i) == 1) then - t_grnd(c) = max(274.5,t_grnd(c)) + t_grnd(c) = max(274.5_kind_phys,t_grnd(c)) do k = 1,nlevlake - t_lake(c,k) = max(274.5,t_lake(c,k)) + t_lake(c,k) = max(274.5_kind_phys,t_lake(c,k)) lake_icefrac(c,k) = 0. enddo endif - + + if(salty(i)/=0) then + Tclim = tfrz + wght1*saltlk_T(num1) & + + wght2*saltlk_T(num2) + if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,t_grnd(c),t_lake(c,:),t_soisno(c,:) + t_grnd(c) = min(Tclim+3.0_kind_phys,(max(t_grnd(c),Tclim-3.0_kind_phys))) + do k = 1,nlevlake + t_lake(c,k) = min(Tclim+3.0_kind_phys,(max(t_lake(c,k),Tclim-3.0_kind_phys))) + enddo + t_soisno(c,1) = min(Tclim+3.0_kind_phys,(max(t_soisno(c,1),Tclim-3.0_kind_phys))) + if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,t_grnd(c),t_lake(c,:),t_soisno(c,:) + endif + savedtke12d(i) = savedtke1(c) snowdp2d(i) = snowdp(c) h2osno2d(i) = h2osno(c) @@ -2706,8 +2706,8 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! p = filter_shlakep(fp) c = pcolumn(p) errsoi(c) = (ncvts(c)-ocvts(c)) / dtime - fin(c) - if( (LAKEDEBUG .and. abs(errsoi(c)) < 1._kind_phys) & - .or. (.not.LAKEDEBUG .and. abs(errsoi(c)) < 10._kind_phys)) then + if( (LAKEDEBUG .and. abs(errsoi(c)) < 1._kind_phys) ) then +! .or. (.not.LAKEDEBUG .and. abs(errsoi(c)) < 10._kind_phys)) then eflx_sh_tot(p) = eflx_sh_tot(p) - errsoi(c) eflx_sh_grnd(p) = eflx_sh_grnd(p) - errsoi(c) eflx_soil_grnd(p) = eflx_soil_grnd(p) + errsoi(c) From a029c2808fa318305ecc99f724bbd70789e61fd4 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 2 Mar 2023 21:32:01 +0000 Subject: [PATCH 31/46] disable wordy warning without LAKEDEBUG --- physics/clm_lake.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 3730d2429..904ae93dd 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -2682,8 +2682,8 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! p = filter_shlakep(fp) c = pcolumn(p) errsoi(c) = (ncvts(c)-ocvts(c)) / dtime - fin(c) - if( (LAKEDEBUG .and. abs(errsoi(c)) < 1._kind_phys) & - .or. (.not.LAKEDEBUG .and. abs(errsoi(c)) < 10._kind_phys)) then + if( (LAKEDEBUG .and. abs(errsoi(c)) < 1._kind_phys) ) then +! .or. (.not.LAKEDEBUG .and. abs(errsoi(c)) < 10._kind_phys)) then eflx_sh_tot(p) = eflx_sh_tot(p) - errsoi(c) eflx_sh_grnd(p) = eflx_sh_grnd(p) - errsoi(c) eflx_soil_grnd(p) = eflx_soil_grnd(p) + errsoi(c) From 078bf74ebd7bdd452f3b40e959d10a8c4cb4c78e Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 3 Mar 2023 05:01:33 +0000 Subject: [PATCH 32/46] use 64 bits for lake and disable broken coare code --- physics/clm_lake.f90 | 2160 +++++++++++++++++++++--------------------- 1 file changed, 1085 insertions(+), 1075 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index b70313da5..75c7eab13 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -27,7 +27,7 @@ MODULE clm_lake - use machine, only: kind_phys + use machine, only: kind_phys, kind_dbl_prec implicit none @@ -35,18 +35,20 @@ MODULE clm_lake public :: clm_lake_run, clm_lake_init, LAKEDEBUG + integer, parameter, public :: kind_lake = kind_dbl_prec + logical :: LAKEDEBUG = .false. ! Enable lots of checks and debug prints and errors logical, parameter :: PERGRO = .false. logical, parameter :: USE_ETALAKE = .false. - real(kind_phys), parameter :: ETALAKE = 1.1925*50**(-0.424) ! Set this to your desired value if USE_ETALAKE=.true. + real(kind_lake), parameter :: ETALAKE = 1.1925*50**(-0.424) ! Set this to your desired value if USE_ETALAKE=.true. ! Level counts must be consistent with model (GFS_typedefs.F90) integer, parameter :: nlevsoil = 10 ! number of soil layers integer, parameter :: nlevlake = 10 ! number of lake layers integer, parameter :: nlevsnow = 5 ! maximum number of snow layers - real(kind_phys), parameter :: scalez = 0.025_kind_phys ! Soil layer thickness discretization (m) + real(kind_lake), parameter :: scalez = 0.025_kind_lake ! Soil layer thickness discretization (m) integer,parameter :: lbp = 1 ! pft-index bounds integer,parameter :: ubp = 1 @@ -74,56 +76,56 @@ MODULE clm_lake logical,parameter :: lakpoi(1) = .true. !Initialize physical constants not available from model: - real(kind_phys), parameter :: tcrit = 2.5 !critical temperature to determine rain or snow - real(kind_phys), parameter :: tkwat = 0.6 !thermal conductivity of water [W/m/k] - real(kind_phys), parameter :: tkice = 2.290 !thermal conductivity of ice [W/m/k] - real(kind_phys), parameter :: tkairc = 0.023 !thermal conductivity of air [W/m/k] - real(kind_phys), parameter :: snow_bd = 250 !constant snow bulk density (only used in special case here) [kg/m^3] + real(kind_lake), parameter :: tcrit = 2.5 !critical temperature to determine rain or snow + real(kind_lake), parameter :: tkwat = 0.6 !thermal conductivity of water [W/m/k] + real(kind_lake), parameter :: tkice = 2.290 !thermal conductivity of ice [W/m/k] + real(kind_lake), parameter :: tkairc = 0.023 !thermal conductivity of air [W/m/k] + real(kind_lake), parameter :: snow_bd = 250 !constant snow bulk density (only used in special case here) [kg/m^3] ! Constants that are copied from model values by clm_lake_init: - real(kind_phys) :: pi !ratio of the circumference of a circle to its diameter - real(kind_phys) :: vkc !von Karman constant [-] - real(kind_phys) :: grav !gravity constant [m/s2] - real(kind_phys) :: sb !stefan-boltzmann constant [W/m2/K4] - real(kind_phys) :: tfrz !freezing temperature [K] - real(kind_phys) :: denh2o !density of liquid water [kg/m3] - real(kind_phys) :: denice !density of ice [kg/m3] - real(kind_phys) :: cpice !Specific heat of ice [J/kg-K] - real(kind_phys) :: cpliq !Specific heat of water [J/kg-K] - real(kind_phys) :: hfus !Latent heat of fusion for ice [J/kg] - real(kind_phys) :: hvap !Latent heat of evap for water [J/kg] - real(kind_phys) :: hsub !Latent heat of sublimation [J/kg] - real(kind_phys) :: invhvap !1/hvap [kg/J] - real(kind_phys) :: invhsub !1/hsub [kg/J] - real(kind_phys) :: rair !gas constant for dry air [J/kg/K] - real(kind_phys) :: cpair !specific heat of dry air [J/kg/K] + real(kind_lake) :: pi !ratio of the circumference of a circle to its diameter + real(kind_lake) :: vkc !von Karman constant [-] + real(kind_lake) :: grav !gravity constant [m/s2] + real(kind_lake) :: sb !stefan-boltzmann constant [W/m2/K4] + real(kind_lake) :: tfrz !freezing temperature [K] + real(kind_lake) :: denh2o !density of liquid water [kg/m3] + real(kind_lake) :: denice !density of ice [kg/m3] + real(kind_lake) :: cpice !Specific heat of ice [J/kg-K] + real(kind_lake) :: cpliq !Specific heat of water [J/kg-K] + real(kind_lake) :: hfus !Latent heat of fusion for ice [J/kg] + real(kind_lake) :: hvap !Latent heat of evap for water [J/kg] + real(kind_lake) :: hsub !Latent heat of sublimation [J/kg] + real(kind_lake) :: invhvap !1/hvap [kg/J] + real(kind_lake) :: invhsub !1/hsub [kg/J] + real(kind_lake) :: rair !gas constant for dry air [J/kg/K] + real(kind_lake) :: cpair !specific heat of dry air [J/kg/K] - real(kind_phys), public, parameter :: spval = 1.e36 !special value for missing data (ocean) - real(kind_phys), parameter :: depth_c = 50. !below the level t_lake3d will be 277.0 !mchen - real(kind_phys), parameter :: zero_h2o = 1e-12 !lower mixing ratio is is treated as zero + real(kind_lake), public, parameter :: spval = 1.e36 !special value for missing data (ocean) + real(kind_lake), parameter :: depth_c = 50. !below the level t_lake3d will be 277.0 !mchen + real(kind_lake), parameter :: zero_h2o = 1e-12 !lower mixing ratio is is treated as zero ! These are tunable constants - real(kind_phys), parameter :: wimp = 0.05 !Water impermeable if porosity less than wimp - real(kind_phys), parameter :: ssi = 0.033 !Irreducible water saturation of snow - real(kind_phys), parameter :: cnfac = 0.5 !Crank Nicholson factor between 0 and 1 + real(kind_lake), parameter :: wimp = 0.05 !Water impermeable if porosity less than wimp + real(kind_lake), parameter :: ssi = 0.033 !Irreducible water saturation of snow + real(kind_lake), parameter :: cnfac = 0.5 !Crank Nicholson factor between 0 and 1 ! Initialize water type constants integer,parameter :: istsoil = 1 !soil "water" type ! percent sand - real(kind_phys), parameter :: sand(19) = & + real(kind_lake), parameter :: sand(19) = & (/92.,80.,66.,20.,5.,43.,60.,10.,32.,51., 6.,22.,39.7,0.,100.,54.,17.,100.,92./) ! percent clay - real(kind_phys), parameter :: clay(19) = & + real(kind_lake), parameter :: clay(19) = & (/ 3., 5.,10.,15.,5.,18.,27.,33.,33.,41.,47.,58.,14.7,0., 0., 8.5,54., 0., 3./) ! These are initialized in clm_lake_init and are not modified elsewhere - real(kind_phys) :: zlak(1:nlevlake) !lake z (layers) - real(kind_phys) :: dzlak(1:nlevlake) !lake dz (thickness) - real(kind_phys) :: zsoi(1:nlevsoil) !soil z (layers) - real(kind_phys) :: dzsoi(1:nlevsoil) !soil dz (thickness) - real(kind_phys) :: zisoi(0:nlevsoil) !soil zi (interfaces) + real(kind_lake) :: zlak(1:nlevlake) !lake z (layers) + real(kind_lake) :: dzlak(1:nlevlake) !lake dz (thickness) + real(kind_lake) :: zsoi(1:nlevsoil) !soil z (layers) + real(kind_lake) :: dzsoi(1:nlevsoil) !soil dz (thickness) + real(kind_lake) :: zisoi(0:nlevsoil) !soil zi (interfaces) real, parameter :: SaltLk_T(1:25) = (/ 0.5, 0.,-0.5, 3., 4., 7., 8., 12., 13., 16., 19., 21., & 23.5, 25., 26.,24.,23.,20.5,18., 15., 11.5, 8., 4., 1., 0.5/) @@ -273,7 +275,7 @@ SUBROUTINE clm_lake_run( & ! INTEGER , INTENT (IN) :: im,km,me,master INTEGER, INTENT(IN) :: IDATE(4), kdt - REAL(kind_phys), INTENT(IN) :: fhour + REAL(KIND_PHYS), INTENT(IN) :: fhour ! ! Configuration and initialization: @@ -367,74 +369,74 @@ SUBROUTINE clm_lake_run( & !local variables: ! - REAL(kind_phys) :: SFCTMP,PBOT,PSFC,Q2K,LWDN,PRCP,SOLDN,SOLNET,dtime + REAL(kind_lake) :: SFCTMP,PBOT,PSFC,Q2K,LWDN,PRCP,SOLDN,SOLNET,dtime INTEGER :: C,i,j,k !temporary varibles in: - real(kind_phys) :: forc_t(1) ! atmospheric temperature (Kelvin) - real(kind_phys) :: forc_pbot(1) ! atm bottom level pressure (Pa) - real(kind_phys) :: forc_psrf(1) ! atmospheric surface pressure (Pa) - real(kind_phys) :: forc_hgt(1) ! atmospheric reference height (m) - real(kind_phys) :: forc_hgt_q(1) ! observational height of humidity [m] - real(kind_phys) :: forc_hgt_t(1) ! observational height of temperature [m] - real(kind_phys) :: forc_hgt_u(1) ! observational height of wind [m] - real(kind_phys) :: forc_q(1) ! atmospheric specific humidity (kg/kg) - real(kind_phys) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) - real(kind_phys) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) - real(kind_phys) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) - real(kind_phys) :: prec(1) ! snow or rain rate [mm/s] - real(kind_phys) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) - real(kind_phys) :: lat(1) ! latitude (radians) - real(kind_phys) :: z_lake(1,nlevlake) ! layer depth for lake (m) - real(kind_phys) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - - real(kind_phys) :: lakedepth(1) ! column lake depth (m) + real(kind_lake) :: forc_t(1) ! atmospheric temperature (Kelvin) + real(kind_lake) :: forc_pbot(1) ! atm bottom level pressure (Pa) + real(kind_lake) :: forc_psrf(1) ! atmospheric surface pressure (Pa) + real(kind_lake) :: forc_hgt(1) ! atmospheric reference height (m) + real(kind_lake) :: forc_hgt_q(1) ! observational height of humidity [m] + real(kind_lake) :: forc_hgt_t(1) ! observational height of temperature [m] + real(kind_lake) :: forc_hgt_u(1) ! observational height of wind [m] + real(kind_lake) :: forc_q(1) ! atmospheric specific humidity (kg/kg) + real(kind_lake) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) + real(kind_lake) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) + real(kind_lake) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) + real(kind_lake) :: prec(1) ! snow or rain rate [mm/s] + real(kind_lake) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) + real(kind_lake) :: lat(1) ! latitude (radians) + real(kind_lake) :: z_lake(1,nlevlake) ! layer depth for lake (m) + real(kind_lake) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + + real(kind_lake) :: lakedepth(1) ! column lake depth (m) logical :: do_capsnow(1) ! true => do snow capping !in&out - real(kind_phys) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] - real(kind_phys) :: t_grnd(1) ! ground temperature (Kelvin) - real(kind_phys) :: h2osno(1) ! snow water (mm H2O) - real(kind_phys) :: snowdp(1) ! snow height (m) - real(kind_phys) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) - real(kind_phys) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) - real(kind_phys) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) - real(kind_phys) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + real(kind_lake) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] + real(kind_lake) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_lake) :: h2osno(1) ! snow water (mm H2O) + real(kind_lake) :: snowdp(1) ! snow height (m) + real(kind_lake) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) + real(kind_lake) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) + real(kind_lake) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) + real(kind_lake) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) integer :: snl(1) ! number of snow layers - real(kind_phys) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_phys) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) - real(kind_phys) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) - real(kind_phys) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) - real(kind_phys) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_lake) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_lake) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + real(kind_lake) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) + real(kind_lake) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) + real(kind_lake) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen !out: - real(kind_phys) :: eflx_gnet(1) !net heat flux into ground (W/m**2) - real(kind_phys) :: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] - real(kind_phys) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] - real(kind_phys) :: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] - real(kind_phys) :: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) - real(kind_phys) :: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) - real(kind_phys) :: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) - real(kind_phys) :: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) - real(kind_phys) :: ram1(1) ! aerodynamical resistance (s/m) + real(kind_lake) :: eflx_gnet(1) !net heat flux into ground (W/m**2) + real(kind_lake) :: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(kind_lake) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] + real(kind_lake) :: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] + real(kind_lake) :: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) + real(kind_lake) :: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) + real(kind_lake) :: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) + real(kind_lake) :: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) + real(kind_lake) :: ram1(1) ! aerodynamical resistance (s/m) ! for calculation of decay of eddy diffusivity with depth ! Change the type variable to pass back to WRF. - real(kind_phys) :: z0mg(1) ! roughness length over ground, momentum (m( - real(kind_phys) :: qfx ! mass flux, old WRF qfx(:) variable, (kg/(sm^2)) + real(kind_lake) :: z0mg(1) ! roughness length over ground, momentum (m( + real(kind_lake) :: qfx ! mass flux, old WRF qfx(:) variable, (kg/(sm^2)) - real(kind_phys) :: ustar_out(1) ! friction velocity (temporary) [m/s] + real(kind_lake) :: ustar_out(1) ! friction velocity (temporary) [m/s] - real(kind_phys) :: discard1, discard2, discard3 ! for unused temporary data + real(kind_lake) :: discard1, discard2, discard3 ! for unused temporary data - real(kind_phys) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_phys) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_phys) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_phys) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_phys) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + real(kind_lake) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_lake) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_lake) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_lake) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) -! real(kind_phys) :: emiss ! surface emissivity +! real(kind_lake) :: emiss ! surface emissivity integer :: lake_points, snow_points, ice_points character*255 :: message @@ -457,12 +459,12 @@ SUBROUTINE clm_lake_run( & integer, save :: unhappy_count = HAVE_NOT_READ_UNHAPPY_POINTS_YET ! The latitude and longitude of unhappy points. - real(kind_phys), allocatable, save :: unhappy_lat(:),unhappy_lon(:) + real(kind_lake), allocatable, save :: unhappy_lat(:),unhappy_lon(:) - real(kind_phys) :: to_radians + real(kind_lake) :: to_radians, lat_d, lon_d, qss integer :: month,num1,num2,day_of_month - real(kind_phys) :: wght1,wght2,Tclim + real(kind_lake) :: wght1,wght2,Tclim logical salty_flag, cannot_freeze_flag @@ -549,9 +551,9 @@ SUBROUTINE clm_lake_run( & if(lakedebug) then write(0,*) 'Warning: wght2 is not 0..1: ',wght2 endif - wght2 = max(0.0_kind_phys,min(1.0_kind_phys,wght2)) + wght2 = max(0.0_kind_lake,min(1.0_kind_lake,wght2)) endif - wght1 = 1.0_kind_phys - wght2 + wght1 = 1.0_kind_lake - wght2 if(LAKEDEBUG .and. me==0) then print *,'month,num1,num2,wght1,wght2',month,num1,num2,wght1,wght2 @@ -667,6 +669,8 @@ SUBROUTINE clm_lake_run( & ram1 = -9999 z0mg = -9999 ustar_out = -9999 + lat_d = xlat_d(i) + lon_d = xlon_d(i) is_unhappy=.false. CALL LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I @@ -682,7 +686,7 @@ SUBROUTINE clm_lake_run( & t_ref2m,q_ref2m, dtime, & watsat, tksatu, tkmg, tkdry, csol, & taux,tauy,ram1,z0mg,ustar_out,errmsg,errflg, & - xlat_d(i),xlon_d(i),is_unhappy) + lat_d,lon_d,is_unhappy) if(LAKEDEBUG) then if((was_unhappy .or. is_unhappy) .and. kdt<3) then print *,'Unhappy point after LakeMain t_lake = ',t_lake(1,:) @@ -701,9 +705,9 @@ SUBROUTINE clm_lake_run( & do c = 1,column if(cannot_freeze(i) == 1) then - t_grnd(c) = max(274.5_kind_phys,t_grnd(c)) + t_grnd(c) = max(274.5_kind_lake,t_grnd(c)) do k = 1,nlevlake - t_lake(c,k) = max(274.5_kind_phys,t_lake(c,k)) + t_lake(c,k) = max(274.5_kind_lake,t_lake(c,k)) lake_icefrac(c,k) = 0. enddo endif @@ -712,11 +716,11 @@ SUBROUTINE clm_lake_run( & Tclim = tfrz + wght1*saltlk_T(num1) & + wght2*saltlk_T(num2) if(lakedebug) print *,'Tclim,tsfc,t_lake3d',i,Tclim,t_grnd(c),t_lake(c,:),t_soisno(c,:) - t_grnd(c) = min(Tclim+3.0_kind_phys,(max(t_grnd(c),Tclim-3.0_kind_phys))) + t_grnd(c) = min(Tclim+3.0_kind_lake,(max(t_grnd(c),Tclim-3.0_kind_lake))) do k = 1,nlevlake - t_lake(c,k) = min(Tclim+3.0_kind_phys,(max(t_lake(c,k),Tclim-3.0_kind_phys))) + t_lake(c,k) = min(Tclim+3.0_kind_lake,(max(t_lake(c,k),Tclim-3.0_kind_lake))) enddo - t_soisno(c,1) = min(Tclim+3.0_kind_phys,(max(t_soisno(c,1),Tclim-3.0_kind_phys))) + t_soisno(c,1) = min(Tclim+3.0_kind_lake,(max(t_soisno(c,1),Tclim-3.0_kind_lake))) if(lakedebug) print *,'After Tclim,tsfc,t_lake3d',i,Tclim,t_grnd(c),t_lake(c,:),t_soisno(c,:) endif @@ -775,7 +779,9 @@ SUBROUTINE clm_lake_run( & discard1 = -9999 discard2 = -9999 discard3 = -9999 - call QSat(t_grnd(c),psfc,discard1,discard2,qss_water(i),discard3) + qss = qss_water(i) + call QSat(t_grnd(c),psfc,discard1,discard2,qss,discard3) + qss_water(i) = qss ! Combined water-ice chh and cmm calculations come from Flake model: chh_water(i) = ch(i)*wind(i)*1.225 ! surface_drag_mass_flux_for_heat_and_moisture_in_air_over_water @@ -990,114 +996,114 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I logical :: unhappy integer, intent(inout) :: errflg character(*), intent(inout) :: errmsg - real(kind_phys),intent(in) :: dtime ! timestep - real(kind_phys),intent(in) :: xlat_d, xlon_d ! grid location for debugging - real(kind_phys),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) - real(kind_phys),intent(in) :: forc_pbot(1) ! atm bottom level pressure (Pa) - real(kind_phys),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) - real(kind_phys),intent(in) :: forc_hgt(1) ! atmospheric reference height (m) - real(kind_phys),intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] - real(kind_phys),intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] - real(kind_phys),intent(in) :: forc_hgt_u(1) ! observational height of wind [m] - real(kind_phys),intent(in) :: forc_q(1) ! atmospheric specific humidity (kg/kg) - real(kind_phys),intent(in) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) - real(kind_phys),intent(in) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) - ! real(kind_phys),intent(in) :: forc_rho(1) ! density (kg/m**3) - real(kind_phys),intent(in) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) - real(kind_phys),intent(in) :: prec(1) ! snow or rain rate [mm/s] - real(kind_phys),intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) - real(kind_phys),intent(in) :: lat(1) ! latitude (radians) - real(kind_phys),intent(in) :: z_lake(1,nlevlake) ! layer depth for lake (m) - real(kind_phys),intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - real(kind_phys),intent(out) :: ustar_out(1) ! friction velocity [m/s] - real(kind_phys), intent(in) :: lakedepth(1) ! column lake depth (m) + real(kind_lake),intent(in) :: dtime ! timestep + real(kind_lake),intent(in) :: xlat_d, xlon_d ! grid location for debugging + real(kind_lake),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) + real(kind_lake),intent(in) :: forc_pbot(1) ! atm bottom level pressure (Pa) + real(kind_lake),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) + real(kind_lake),intent(in) :: forc_hgt(1) ! atmospheric reference height (m) + real(kind_lake),intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] + real(kind_lake),intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] + real(kind_lake),intent(in) :: forc_hgt_u(1) ! observational height of wind [m] + real(kind_lake),intent(in) :: forc_q(1) ! atmospheric specific humidity (kg/kg) + real(kind_lake),intent(in) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) + real(kind_lake),intent(in) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) + ! real(kind_lake),intent(in) :: forc_rho(1) ! density (kg/m**3) + real(kind_lake),intent(in) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) + real(kind_lake),intent(in) :: prec(1) ! snow or rain rate [mm/s] + real(kind_lake),intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) + real(kind_lake),intent(in) :: lat(1) ! latitude (radians) + real(kind_lake),intent(in) :: z_lake(1,nlevlake) ! layer depth for lake (m) + real(kind_lake),intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + real(kind_lake),intent(out) :: ustar_out(1) ! friction velocity [m/s] + real(kind_lake), intent(in) :: lakedepth(1) ! column lake depth (m) !!!!!!!!!!!!!!!!tep(in),hydro(in) - ! real(kind_phys), intent(in) :: watsat(1,1:nlevsoil) ! volumetric soil water at saturation (porosity) + ! real(kind_lake), intent(in) :: watsat(1,1:nlevsoil) ! volumetric soil water at saturation (porosity) !!!!!!!!!!!!!!!!hydro logical , intent(in) :: do_capsnow(1) ! true => do snow capping - real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_phys), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_phys), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_phys), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_phys), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + real(kind_lake), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_lake), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_lake), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_lake), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) !in&out - real(kind_phys),intent(inout) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] - real(kind_phys),intent(inout) :: t_grnd(1) ! ground temperature (Kelvin) - real(kind_phys),intent(inout) :: h2osno(1) ! snow water (mm H2O) - real(kind_phys),intent(inout) :: snowdp(1) ! snow height (m) - real(kind_phys),intent(inout) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) - real(kind_phys),intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) - real(kind_phys),intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) - real(kind_phys),intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + real(kind_lake),intent(inout) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] + real(kind_lake),intent(inout) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_lake),intent(inout) :: h2osno(1) ! snow water (mm H2O) + real(kind_lake),intent(inout) :: snowdp(1) ! snow height (m) + real(kind_lake),intent(inout) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) + real(kind_lake),intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) + real(kind_lake),intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) + real(kind_lake),intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) integer ,intent(inout) :: snl(1) ! number of snow layers - real(kind_phys),intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_phys),intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) - real(kind_phys),intent(inout) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) - real(kind_phys),intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) - real(kind_phys),intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_lake),intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_lake),intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + real(kind_lake),intent(inout) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) + real(kind_lake),intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) + real(kind_lake),intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen !out: - real(kind_phys),intent(out) :: eflx_gnet(1) !net heat flux into ground (W/m**2) - real(kind_phys),intent(out) :: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] - real(kind_phys),intent(out) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] - real(kind_phys),intent(out) :: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] - real(kind_phys),intent(out) :: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) - real(kind_phys),intent(out) :: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) - real(kind_phys),intent(out) :: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) - real(kind_phys),intent(out) :: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) - real(kind_phys),intent(out) :: ram1(1) ! aerodynamical resistance (s/m) + real(kind_lake),intent(out) :: eflx_gnet(1) !net heat flux into ground (W/m**2) + real(kind_lake),intent(out) :: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(kind_lake),intent(out) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] + real(kind_lake),intent(out) :: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] + real(kind_lake),intent(out) :: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) + real(kind_lake),intent(out) :: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) + real(kind_lake),intent(out) :: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) + real(kind_lake),intent(out) :: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) + real(kind_lake),intent(out) :: ram1(1) ! aerodynamical resistance (s/m) ! for calculation of decay of eddy diffusivity with depth ! Change the type variable to pass back to WRF. - real(kind_phys),intent(out) :: z0mg(1) ! roughness length over ground, momentum (m( + real(kind_lake),intent(out) :: z0mg(1) ! roughness length over ground, momentum (m( !local output - real(kind_phys) :: begwb(1) ! water mass begining of the time step - real(kind_phys) :: t_veg(1) ! vegetation temperature (Kelvin) - real(kind_phys) :: eflx_soil_grnd(1) ! soil heat flux (W/m**2) [+ = into soil] - real(kind_phys) :: eflx_lh_grnd(1) ! ground evaporation heat flux (W/m**2) [+ to atm] - real(kind_phys) :: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] - real(kind_phys) :: eflx_lwrad_out(1) ! emitted infrared (longwave) radiation (W/m**2) - real(kind_phys) :: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg - real(kind_phys) :: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) - real(kind_phys) :: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] - real(kind_phys) :: forc_snow(1) ! snow rate [mm/s] - real(kind_phys) :: forc_rain(1) ! rain rate [mm/s] - real(kind_phys) :: ws(1) ! surface friction velocity (m/s) - real(kind_phys) :: ks(1) ! coefficient passed to ShalLakeTemperature - real(kind_phys) :: qflx_snomelt(1) !snow melt (mm H2O /s) tem(out),snowwater(in) + real(kind_lake) :: begwb(1) ! water mass begining of the time step + real(kind_lake) :: t_veg(1) ! vegetation temperature (Kelvin) + real(kind_lake) :: eflx_soil_grnd(1) ! soil heat flux (W/m**2) [+ = into soil] + real(kind_lake) :: eflx_lh_grnd(1) ! ground evaporation heat flux (W/m**2) [+ to atm] + real(kind_lake) :: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(kind_lake) :: eflx_lwrad_out(1) ! emitted infrared (longwave) radiation (W/m**2) + real(kind_lake) :: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + real(kind_lake) :: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) + real(kind_lake) :: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] + real(kind_lake) :: forc_snow(1) ! snow rate [mm/s] + real(kind_lake) :: forc_rain(1) ! rain rate [mm/s] + real(kind_lake) :: ws(1) ! surface friction velocity (m/s) + real(kind_lake) :: ks(1) ! coefficient passed to ShalLakeTemperature + real(kind_lake) :: qflx_snomelt(1) !snow melt (mm H2O /s) tem(out),snowwater(in) integer :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 (new) - real(kind_phys) :: endwb(1) ! water mass end of the time step - real(kind_phys) :: snowage(1) ! non dimensional snow age [-] - real(kind_phys) :: snowice(1) ! average snow ice lens - real(kind_phys) :: snowliq(1) ! average snow liquid water - real(kind_phys) :: t_snow(1) ! vertically averaged snow temperature - real(kind_phys) :: qflx_drain(1) ! sub-surface runoff (mm H2O /s) - real(kind_phys) :: qflx_surf(1) ! surface runoff (mm H2O /s) - real(kind_phys) :: qflx_infl(1) ! infiltration (mm H2O /s) - real(kind_phys) :: qflx_qrgwl(1) ! qflx_surf at glaciers, wetlands, lakes - real(kind_phys) :: qcharge(1) ! aquifer recharge rate (mm/s) - real(kind_phys) :: qflx_snowcap(1) ! excess precipitation due to snow capping (mm H2O /s) [+] - real(kind_phys) :: qflx_snowcap_col(1) ! excess precipitation due to snow capping (mm H2O /s) [+] - real(kind_phys) :: qflx_snow_grnd_pft(1) ! snow on ground after interception (mm H2O/s) [+] - real(kind_phys) :: qflx_snow_grnd_col(1) ! snow on ground after interception (mm H2O/s) [+] - real(kind_phys) :: qflx_rain_grnd(1) ! rain on ground after interception (mm H2O/s) [+] - real(kind_phys) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water - real(kind_phys) :: qflx_evap_tot_col(1) !pft quantity averaged to the column (assuming one pft) - real(kind_phys) :: soilalpha(1) !factor that reduces ground saturated specific humidity (-) - real(kind_phys) :: zwt(1) !water table depth - real(kind_phys) :: fcov(1) !fractional area with water table at surface - real(kind_phys) :: rootr_column(1,1:nlevsoil) !effective fraction of roots in each soil layer - real(kind_phys) :: qflx_evap_grnd(1) ! ground surface evaporation rate (mm H2O/s) [+] - real(kind_phys) :: qflx_sub_snow(1) ! sublimation rate from snow pack (mm H2O /s) [+] - real(kind_phys) :: qflx_dew_snow(1) ! surface dew added to snow pack (mm H2O /s) [+] - real(kind_phys) :: qflx_dew_grnd(1) ! ground surface dew formation (mm H2O /s) [+] - real(kind_phys) :: qflx_rain_grnd_col(1) !rain on ground after interception (mm H2O/s) [+] + real(kind_lake) :: endwb(1) ! water mass end of the time step + real(kind_lake) :: snowage(1) ! non dimensional snow age [-] + real(kind_lake) :: snowice(1) ! average snow ice lens + real(kind_lake) :: snowliq(1) ! average snow liquid water + real(kind_lake) :: t_snow(1) ! vertically averaged snow temperature + real(kind_lake) :: qflx_drain(1) ! sub-surface runoff (mm H2O /s) + real(kind_lake) :: qflx_surf(1) ! surface runoff (mm H2O /s) + real(kind_lake) :: qflx_infl(1) ! infiltration (mm H2O /s) + real(kind_lake) :: qflx_qrgwl(1) ! qflx_surf at glaciers, wetlands, lakes + real(kind_lake) :: qcharge(1) ! aquifer recharge rate (mm/s) + real(kind_lake) :: qflx_snowcap(1) ! excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_lake) :: qflx_snowcap_col(1) ! excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_lake) :: qflx_snow_grnd_pft(1) ! snow on ground after interception (mm H2O/s) [+] + real(kind_lake) :: qflx_snow_grnd_col(1) ! snow on ground after interception (mm H2O/s) [+] + real(kind_lake) :: qflx_rain_grnd(1) ! rain on ground after interception (mm H2O/s) [+] + real(kind_lake) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water + real(kind_lake) :: qflx_evap_tot_col(1) !pft quantity averaged to the column (assuming one pft) + real(kind_lake) :: soilalpha(1) !factor that reduces ground saturated specific humidity (-) + real(kind_lake) :: zwt(1) !water table depth + real(kind_lake) :: fcov(1) !fractional area with water table at surface + real(kind_lake) :: rootr_column(1,1:nlevsoil) !effective fraction of roots in each soil layer + real(kind_lake) :: qflx_evap_grnd(1) ! ground surface evaporation rate (mm H2O/s) [+] + real(kind_lake) :: qflx_sub_snow(1) ! sublimation rate from snow pack (mm H2O /s) [+] + real(kind_lake) :: qflx_dew_snow(1) ! surface dew added to snow pack (mm H2O /s) [+] + real(kind_lake) :: qflx_dew_grnd(1) ! ground surface dew formation (mm H2O /s) [+] + real(kind_lake) :: qflx_rain_grnd_col(1) !rain on ground after interception (mm H2O/s) [+] begwb = 0 ! lat = lat*pi/180 ! [radian] @@ -1214,60 +1220,60 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, integer, intent(inout) :: errflg logical :: unhappy character(len=*), intent(inout) :: errmsg - real(kind_phys),intent(in) :: xlat_d,xlon_d - real(kind_phys),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) - real(kind_phys),intent(in) :: forc_pbot(1) ! atmospheric pressure (Pa) - real(kind_phys),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) - real(kind_phys),intent(in) :: forc_hgt(1) ! atmospheric reference height (m) - real(kind_phys),intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] - real(kind_phys),intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] - real(kind_phys),intent(in) :: forc_hgt_u(1) ! observational height of wind [m] - real(kind_phys),intent(in) :: forc_q(1) ! atmospheric specific humidity (kg/kg) - real(kind_phys),intent(in) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) - real(kind_phys),intent(in) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) - real(kind_phys),intent(in) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) - ! real(kind_phys),intent(in) :: forc_rho(1) ! density (kg/m**3) - real(kind_phys),intent(in) :: forc_snow(1) ! snow rate [mm/s] - real(kind_phys),intent(in) :: forc_rain(1) ! rain rate [mm/s] - real(kind_phys),intent(in) :: h2osno(1) ! snow water (mm H2O) - real(kind_phys),intent(in) :: snowdp(1) ! snow height (m) - real(kind_phys),intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) - real(kind_phys),intent(in) :: lat(1) ! latitude (radians) - real(kind_phys),intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) - real(kind_phys),intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - real(kind_phys),intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) - real(kind_phys),intent(in) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + real(kind_lake),intent(in) :: xlat_d,xlon_d + real(kind_lake),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) + real(kind_lake),intent(in) :: forc_pbot(1) ! atmospheric pressure (Pa) + real(kind_lake),intent(in) :: forc_psrf(1) ! atmospheric surface pressure (Pa) + real(kind_lake),intent(in) :: forc_hgt(1) ! atmospheric reference height (m) + real(kind_lake),intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] + real(kind_lake),intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] + real(kind_lake),intent(in) :: forc_hgt_u(1) ! observational height of wind [m] + real(kind_lake),intent(in) :: forc_q(1) ! atmospheric specific humidity (kg/kg) + real(kind_lake),intent(in) :: forc_u(1) ! atmospheric wind speed in east direction (m/s) + real(kind_lake),intent(in) :: forc_v(1) ! atmospheric wind speed in north direction (m/s) + real(kind_lake),intent(in) :: forc_lwrad(1) ! downward infrared (longwave) radiation (W/m**2) + ! real(kind_lake),intent(in) :: forc_rho(1) ! density (kg/m**3) + real(kind_lake),intent(in) :: forc_snow(1) ! snow rate [mm/s] + real(kind_lake),intent(in) :: forc_rain(1) ! rain rate [mm/s] + real(kind_lake),intent(in) :: h2osno(1) ! snow water (mm H2O) + real(kind_lake),intent(in) :: snowdp(1) ! snow height (m) + real(kind_lake),intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) + real(kind_lake),intent(in) :: lat(1) ! latitude (radians) + real(kind_lake),intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness for soil or snow (m) + real(kind_lake),intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + real(kind_lake),intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) + real(kind_lake),intent(in) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) integer ,intent(in) :: snl(1) ! number of snow layers - real(kind_phys),intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_phys),intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) - real(kind_phys),intent(in) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) + real(kind_lake),intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_lake),intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + real(kind_lake),intent(in) :: savedtke1(1) ! top level eddy conductivity from previous timestep (W/m.K) !inout: - real(kind_phys),intent(inout) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_lake),intent(inout) :: t_grnd(1) ! ground temperature (Kelvin) !out: - real(kind_phys),intent(out):: ustar_out(1) ! friction velocity [m/s] - real(kind_phys),intent(out):: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] - real(kind_phys),intent(out):: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) - real(kind_phys),intent(out):: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg - real(kind_phys),intent(out):: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] - real(kind_phys),intent(out):: eflx_lwrad_out(1) ! emitted infrared (longwave) radiation (W/m**2) - real(kind_phys),intent(out):: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] - real(kind_phys),intent(out):: eflx_soil_grnd(1) ! soil heat flux (W/m**2) [+ = into soil] - real(kind_phys),intent(out):: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] - real(kind_phys),intent(out):: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] - real(kind_phys),intent(out):: eflx_lh_grnd(1) ! ground evaporation heat flux (W/m**2) [+ to atm] - real(kind_phys),intent(out):: t_veg(1) ! vegetation temperature (Kelvin) - real(kind_phys),intent(out):: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) - real(kind_phys),intent(out):: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) - real(kind_phys),intent(out):: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) - real(kind_phys),intent(out):: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) - real(kind_phys),intent(out):: ram1(1) ! aerodynamical resistance (s/m) - real(kind_phys),intent(out):: ws(1) ! surface friction velocity (m/s) - real(kind_phys),intent(out):: ks(1) ! coefficient passed to ShalLakeTemperature + real(kind_lake),intent(out):: ustar_out(1) ! friction velocity [m/s] + real(kind_lake),intent(out):: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] + real(kind_lake),intent(out):: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) + real(kind_lake),intent(out):: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + real(kind_lake),intent(out):: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(kind_lake),intent(out):: eflx_lwrad_out(1) ! emitted infrared (longwave) radiation (W/m**2) + real(kind_lake),intent(out):: eflx_lwrad_net(1) ! net infrared (longwave) rad (W/m**2) [+ = to atm] + real(kind_lake),intent(out):: eflx_soil_grnd(1) ! soil heat flux (W/m**2) [+ = into soil] + real(kind_lake),intent(out):: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] + real(kind_lake),intent(out):: eflx_lh_tot(1) ! total latent heat flux (W/m8*2) [+ to atm] + real(kind_lake),intent(out):: eflx_lh_grnd(1) ! ground evaporation heat flux (W/m**2) [+ to atm] + real(kind_lake),intent(out):: t_veg(1) ! vegetation temperature (Kelvin) + real(kind_lake),intent(out):: t_ref2m(1) ! 2 m height surface air temperature (Kelvin) + real(kind_lake),intent(out):: q_ref2m(1) ! 2 m height surface specific humidity (kg/kg) + real(kind_lake),intent(out):: taux(1) ! wind (shear) stress: e-w (kg/m/s**2) + real(kind_lake),intent(out):: tauy(1) ! wind (shear) stress: n-s (kg/m/s**2) + real(kind_lake),intent(out):: ram1(1) ! aerodynamical resistance (s/m) + real(kind_lake),intent(out):: ws(1) ! surface friction velocity (m/s) + real(kind_lake),intent(out):: ks(1) ! coefficient passed to ShalLakeTemperature ! for calculation of decay of eddy diffusivity with depth - real(kind_phys),intent(out):: eflx_gnet(1) !net heat flux into ground (W/m**2) + real(kind_lake),intent(out):: eflx_gnet(1) !net heat flux into ground (W/m**2) ! Change the type variable to pass back to WRF. - real(kind_phys),intent(out):: z0mg(1) ! roughness length over ground, momentum (m( + real(kind_lake),intent(out):: z0mg(1) ! roughness length over ground, momentum (m( @@ -1275,13 +1281,13 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, integer , parameter :: islak = 2 ! index of lake, 1 = deep lake, 2 = shallow lake integer , parameter :: niters = 3 ! maximum number of iterations for surface temperature - real(kind_phys), parameter :: beta1 = 1._kind_phys ! coefficient of convective velocity (in computing W_*) [-] - real(kind_phys), parameter :: emg = 0.97_kind_phys ! ground emissivity (0.97 for water) - real(kind_phys), parameter :: zii = 1000._kind_phys! convective boundary height [m] - real(kind_phys), parameter :: tdmax = 277._kind_phys ! temperature of maximum water density - real(kind_phys) :: forc_th(1) ! atmospheric potential temperature (Kelvin) - real(kind_phys) :: forc_vp(1) !atmospheric vapor pressure (Pa) - real(kind_phys) :: forc_rho(1) ! density (kg/m**3) + real(kind_lake), parameter :: beta1 = 1._kind_lake ! coefficient of convective velocity (in computing W_*) [-] + real(kind_lake), parameter :: emg = 0.97_kind_lake ! ground emissivity (0.97 for water) + real(kind_lake), parameter :: zii = 1000._kind_lake! convective boundary height [m] + real(kind_lake), parameter :: tdmax = 277._kind_lake ! temperature of maximum water density + real(kind_lake) :: forc_th(1) ! atmospheric potential temperature (Kelvin) + real(kind_lake) :: forc_vp(1) !atmospheric vapor pressure (Pa) + real(kind_lake) :: forc_rho(1) ! density (kg/m**3) integer :: i,fc,fp,g,c,p ! do loop or array index integer :: fncopy ! number of values in pft filter copy integer :: fnold ! previous number of pft filter values @@ -1289,67 +1295,67 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, integer :: iter ! iteration index integer :: nmozsgn(lbp:ubp) ! number of times moz changes sign integer :: jtop(lbc:ubc) ! top level for each column (no longer all 1) - real(kind_phys) :: ax ! used in iteration loop for calculating t_grnd (numerator of NR solution) - real(kind_phys) :: bx ! used in iteration loop for calculating t_grnd (denomin. of NR solution) - real(kind_phys) :: degdT ! d(eg)/dT - real(kind_phys) :: dqh(lbp:ubp) ! diff of humidity between ref. height and surface - real(kind_phys) :: dth(lbp:ubp) ! diff of virtual temp. between ref. height and surface - real(kind_phys) :: dthv ! diff of vir. poten. temp. between ref. height and surface - real(kind_phys) :: dzsur(lbc:ubc) ! 1/2 the top layer thickness (m) - real(kind_phys) :: eg ! water vapor pressure at temperature T [pa] - real(kind_phys) :: htvp(lbc:ubc) ! latent heat of vapor of water (or sublimation) [j/kg] - real(kind_phys) :: obu(lbp:ubp) ! monin-obukhov length (m) - real(kind_phys) :: obuold(lbp:ubp) ! monin-obukhov length of previous iteration - real(kind_phys) :: qsatg(lbc:ubc) ! saturated humidity [kg/kg] - real(kind_phys) :: qsatgdT(lbc:ubc) ! d(qsatg)/dT - real(kind_phys) :: qstar ! moisture scaling parameter - real(kind_phys) :: ram(lbp:ubp) ! aerodynamical resistance [s/m] - real(kind_phys) :: rah(lbp:ubp) ! thermal resistance [s/m] - real(kind_phys) :: raw(lbp:ubp) ! moisture resistance [s/m] - real(kind_phys) :: stftg3(lbp:ubp) ! derivative of fluxes w.r.t ground temperature - real(kind_phys) :: temp1(lbp:ubp) ! relation for potential temperature profile - real(kind_phys) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m - real(kind_phys) :: temp2(lbp:ubp) ! relation for specific humidity profile - real(kind_phys) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m - real(kind_phys) :: tgbef(lbc:ubc) ! initial ground temperature - real(kind_phys) :: thm(lbc:ubc) ! intermediate variable (forc_t+0.0098*forc_hgt_t) - real(kind_phys) :: thv(lbc:ubc) ! virtual potential temperature (kelvin) - real(kind_phys) :: thvstar ! virtual potential temperature scaling parameter - real(kind_phys) :: tksur ! thermal conductivity of snow/soil (w/m/kelvin) - real(kind_phys) :: tsur ! top layer temperature - real(kind_phys) :: tstar ! temperature scaling parameter - real(kind_phys) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] - real(kind_phys) :: ur(lbp:ubp) ! wind speed at reference height [m/s] - real(kind_phys) :: ustar(lbp:ubp) ! friction velocity [m/s] - real(kind_phys) :: wc ! convective velocity [m/s] - real(kind_phys) :: zeta ! dimensionless height used in Monin-Obukhov theory - real(kind_phys) :: zldis(lbp:ubp) ! reference height "minus" zero displacement height [m] - real(kind_phys) :: displa(lbp:ubp) ! displacement (always zero) [m] - ! real(kind_phys) :: z0mg(lbp:ubp) ! roughness length over ground, momentum [m] - real(kind_phys) :: z0hg(lbp:ubp) ! roughness length over ground, sensible heat [m] - real(kind_phys) :: z0qg(lbp:ubp) ! roughness length over ground, latent heat [m] - real(kind_phys) :: u2m ! 2 m wind speed (m/s) - real(kind_phys) :: u10(1) ! 10-m wind (m/s) (for dust model) - real(kind_phys) :: fv(1) ! friction velocity (m/s) (for dust model) - - real(kind_phys) :: fm(lbp:ubp) ! needed for BGC only to diagnose 10m wind speed - real(kind_phys) :: bw ! partial density of water (ice + liquid) - real(kind_phys) :: t_grnd_temp ! Used in surface flux correction over frozen ground - real(kind_phys) :: betaprime(lbc:ubc) ! Effective beta: 1 for snow layers, beta(islak) otherwise + real(kind_lake) :: ax ! used in iteration loop for calculating t_grnd (numerator of NR solution) + real(kind_lake) :: bx ! used in iteration loop for calculating t_grnd (denomin. of NR solution) + real(kind_lake) :: degdT ! d(eg)/dT + real(kind_lake) :: dqh(lbp:ubp) ! diff of humidity between ref. height and surface + real(kind_lake) :: dth(lbp:ubp) ! diff of virtual temp. between ref. height and surface + real(kind_lake) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(kind_lake) :: dzsur(lbc:ubc) ! 1/2 the top layer thickness (m) + real(kind_lake) :: eg ! water vapor pressure at temperature T [pa] + real(kind_lake) :: htvp(lbc:ubc) ! latent heat of vapor of water (or sublimation) [j/kg] + real(kind_lake) :: obu(lbp:ubp) ! monin-obukhov length (m) + real(kind_lake) :: obuold(lbp:ubp) ! monin-obukhov length of previous iteration + real(kind_lake) :: qsatg(lbc:ubc) ! saturated humidity [kg/kg] + real(kind_lake) :: qsatgdT(lbc:ubc) ! d(qsatg)/dT + real(kind_lake) :: qstar ! moisture scaling parameter + real(kind_lake) :: ram(lbp:ubp) ! aerodynamical resistance [s/m] + real(kind_lake) :: rah(lbp:ubp) ! thermal resistance [s/m] + real(kind_lake) :: raw(lbp:ubp) ! moisture resistance [s/m] + real(kind_lake) :: stftg3(lbp:ubp) ! derivative of fluxes w.r.t ground temperature + real(kind_lake) :: temp1(lbp:ubp) ! relation for potential temperature profile + real(kind_lake) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m + real(kind_lake) :: temp2(lbp:ubp) ! relation for specific humidity profile + real(kind_lake) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m + real(kind_lake) :: tgbef(lbc:ubc) ! initial ground temperature + real(kind_lake) :: thm(lbc:ubc) ! intermediate variable (forc_t+0.0098*forc_hgt_t) + real(kind_lake) :: thv(lbc:ubc) ! virtual potential temperature (kelvin) + real(kind_lake) :: thvstar ! virtual potential temperature scaling parameter + real(kind_lake) :: tksur ! thermal conductivity of snow/soil (w/m/kelvin) + real(kind_lake) :: tsur ! top layer temperature + real(kind_lake) :: tstar ! temperature scaling parameter + real(kind_lake) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] + real(kind_lake) :: ur(lbp:ubp) ! wind speed at reference height [m/s] + real(kind_lake) :: ustar(lbp:ubp) ! friction velocity [m/s] + real(kind_lake) :: wc ! convective velocity [m/s] + real(kind_lake) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(kind_lake) :: zldis(lbp:ubp) ! reference height "minus" zero displacement height [m] + real(kind_lake) :: displa(lbp:ubp) ! displacement (always zero) [m] + ! real(kind_lake) :: z0mg(lbp:ubp) ! roughness length over ground, momentum [m] + real(kind_lake) :: z0hg(lbp:ubp) ! roughness length over ground, sensible heat [m] + real(kind_lake) :: z0qg(lbp:ubp) ! roughness length over ground, latent heat [m] + real(kind_lake) :: u2m ! 2 m wind speed (m/s) + real(kind_lake) :: u10(1) ! 10-m wind (m/s) (for dust model) + real(kind_lake) :: fv(1) ! friction velocity (m/s) (for dust model) + + real(kind_lake) :: fm(lbp:ubp) ! needed for BGC only to diagnose 10m wind speed + real(kind_lake) :: bw ! partial density of water (ice + liquid) + real(kind_lake) :: t_grnd_temp ! Used in surface flux correction over frozen ground + real(kind_lake) :: betaprime(lbc:ubc) ! Effective beta: 1 for snow layers, beta(islak) otherwise character*256 :: message ! tgs COARE - real(kind_phys) :: tc, visc, ren + real(kind_lake) :: tc, visc, ren ! This assumes all radiation is absorbed in the top snow layer and will need ! to be changed for CLM 4. ! ! Constants for lake temperature model ! - real(kind_phys), parameter :: beta(2) = & ! fraction solar rad absorbed at surface: depends on lake type - (/0.4_kind_phys, 0.4_kind_phys/) ! (deep lake, shallow lake) + real(kind_lake), parameter :: beta(2) = & ! fraction solar rad absorbed at surface: depends on lake type + (/0.4_kind_lake, 0.4_kind_lake/) ! (deep lake, shallow lake) ! This is the energy absorbed at the lake surface if no snow. - ! data za /0.6_kind_phys, 0.5_kind_phys/ - ! data eta /0.1_kind_phys, 0.5_kind_phys/ + ! data za /0.6_kind_lake, 0.5_kind_lake/ + ! data eta /0.1_kind_lake, 0.5_kind_lake/ !----------------------------------------------------------------------- unhappy=.false. @@ -1383,11 +1389,11 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, if (snl(c) < 0) then - betaprime(c) = 1._kind_phys !Assume all solar rad. absorbed at the surface of the top snow layer. - dzsur(c) = dz(c,jtop(c))*0.5_kind_phys + betaprime(c) = 1._kind_lake !Assume all solar rad. absorbed at the surface of the top snow layer. + dzsur(c) = dz(c,jtop(c))*0.5_kind_lake else betaprime(c) = beta(islak) - dzsur(c) = dz_lake(c,1)*0.5_kind_phys + dzsur(c) = dz_lake(c,1)*0.5_kind_lake end if ! Originally this was 1*dz, but shouldn't it be 1/2? @@ -1399,8 +1405,8 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! Potential, virtual potential temperature, and wind speed at the ! reference height - thm(c) = forc_t(g) + 0.0098_kind_phys*forc_hgt_t(g) ! intermediate variable - thv(c) = forc_th(g)*(1._kind_phys+0.61_kind_phys*forc_q(g)) ! virtual potential T + thm(c) = forc_t(g) + 0.0098_kind_lake*forc_hgt_t(g) ! intermediate variable + thv(c) = forc_th(g)*(1._kind_lake+0.61_kind_lake*forc_q(g)) ! virtual potential T end do !dir$ concurrent @@ -1411,49 +1417,53 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, g = pgridcell(p) nmozsgn(p) = 0 - obuold(p) = 0._kind_phys - displa(p) = 0._kind_phys + obuold(p) = 0._kind_lake + displa(p) = 0._kind_lake ! Roughness lengths ! changed by Hongping Gu ! if (t_grnd(c) >= tfrz) then ! for unfrozen lake - ! z0mg(p) = 0.01_kind_phys + ! z0mg(p) = 0.01_kind_lake ! else ! for frozen lake ! ! Is this okay even if it is snow covered? What is the roughness over ! non-veg. snow? - ! z0mg(p) = 0.04_kind_phys + ! z0mg(p) = 0.04_kind_lake ! end if if (t_grnd(c) >= tfrz) then ! for unfrozen lake - z0mg(p) = 0.001_kind_phys !original 0.01 + z0mg(p) = 0.001_kind_lake !original 0.01 else if(snl(c) == 0 ) then ! for frozen lake ! Is this okay even if it is snow covered? What is the roughness over ! non-veg. snow? - z0mg(p) = 0.005_kind_phys !original 0.04, now for frozen lake without snow + z0mg(p) = 0.005_kind_lake !original 0.04, now for frozen lake without snow else ! for frozen lake with snow - z0mg(p) = 0.0024_kind_phys + z0mg(p) = 0.0024_kind_lake end if + if(.false.) then + ! This can't work since it uses ustar before ustar is initialized !- tgs - use COARE formulation for z0hg and z0qg. !-- suggestion from Ayumi Manome (GLERL), Aug. 2018 !-- Charusombat et al., 2018, https://doi.org/10.5194/hess-2017-725 - tc=forc_t(g)-273.15_kind_phys - visc=1.326e-5_kind_phys*(1._kind_phys + 6.542e-3_kind_phys*tc + 8.301e-6_kind_phys*tc*tc & - - 4.84e-9_kind_phys*tc*tc*tc) - - Ren = MAX(ustar(p)*z0mg(p)/visc, 0.1_kind_phys) - z0hg(p) = (5.5e-5_kind_phys)*(Ren**(-0.60_kind_phys)) + tc=forc_t(g)-273.15_kind_lake + visc=1.326e-5_kind_lake*(1._kind_lake + 6.542e-3_kind_lake*tc + 8.301e-6_kind_lake*tc*tc & + - 4.84e-9_kind_lake*tc*tc*tc) + visc=max(1e-7_kind_lake, visc) - z0hg(p) = MIN(z0hg(p),1.0e-4_kind_phys) - z0hg(p) = MAX(z0hg(p),2.0e-9_kind_phys) + Ren = MAX(ustar(p)*z0mg(p)/visc, 0.1_kind_lake) + z0hg(p) = (5.5e-5_kind_lake)*(Ren**(-0.60_kind_lake)) + + z0hg(p) = MIN(z0hg(p),1.0e-4_kind_lake) + z0hg(p) = MAX(z0hg(p),2.0e-9_kind_lake) z0qg(p) = z0hg(p) ! end COARE - !z0hg(p) = z0mg(p) - !z0qg(p) = z0mg(p) + endif + z0hg(p) = z0mg(p) + z0qg(p) = z0mg(p) ! Latent heat @@ -1472,11 +1482,11 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! Initialize stability variables - ur(p) = max(1.0_kind_phys,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) + ur(p) = max(1.0_kind_lake,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) dth(p) = thm(c)-t_grnd(c) dqh(p) = forc_q(g)-qsatg(c) - dthv = dth(p)*(1._kind_phys+0.61_kind_phys*forc_q(g))+0.61_kind_phys*forc_th(g)*dqh(p) - zldis(p) = forc_hgt_u(g) - 0._kind_phys + dthv = dth(p)*(1._kind_lake+0.61_kind_lake*forc_q(g))+0.61_kind_lake*forc_th(g)*dqh(p) + zldis(p) = forc_hgt_u(g) - 0._kind_lake ! Initialize Monin-Obukhov length and wind speed @@ -1524,15 +1534,15 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, else !Need to calculate thermal conductivity of the top snow layer bw = (h2osoi_ice(c,jtop(c))+h2osoi_liq(c,jtop(c)))/dz(c,jtop(c)) - tksur = tkairc + (7.75e-5_kind_phys *bw + 1.105e-6_kind_phys*bw*bw)*(tkice-tkairc) + tksur = tkairc + (7.75e-5_kind_lake *bw + 1.105e-6_kind_lake*bw*bw)*(tkice-tkairc) tsur = t_soisno(c,jtop(c)) end if ! Determine aerodynamic resistances - ram(p) = 1._kind_phys/(ustar(p)*ustar(p)/um(p)) - rah(p) = 1._kind_phys/(temp1(p)*ustar(p)) - raw(p) = 1._kind_phys/(temp2(p)*ustar(p)) + ram(p) = 1._kind_lake/(ustar(p)*ustar(p)/um(p)) + rah(p) = 1._kind_lake/(temp1(p)*ustar(p)) + raw(p) = 1._kind_lake/(temp2(p)*ustar(p)) ram1(p) = ram(p) !pass value to global variable ! Get derivative of fluxes with respect to ground temperature @@ -1541,12 +1551,12 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! Changed surface temperature from t_lake(c,1) to tsur. ! Also adjusted so that if there are snow layers present, all radiation is absorbed in the top layer. - ax = betaprime(c)*sabg(p) + emg*forc_lwrad(g) + 3._kind_phys*stftg3(p)*tgbef(c) & + ax = betaprime(c)*sabg(p) + emg*forc_lwrad(g) + 3._kind_lake*stftg3(p)*tgbef(c) & + forc_rho(g)*cpair/rah(p)*thm(c) & - htvp(c)*forc_rho(g)/raw(p)*(qsatg(c)-qsatgdT(c)*tgbef(c) - forc_q(g)) & + tksur*tsur/dzsur(c) !Changed sabg(p) and to betaprime(c)*sabg(p). - bx = 4._kind_phys*stftg3(p) + forc_rho(g)*cpair/rah(p) & + bx = 4._kind_lake*stftg3(p) + forc_rho(g)*cpair/rah(p) & + htvp(c)*forc_rho(g)/raw(p)*qsatgdT(c) + tksur/dzsur(c) t_grnd(c) = ax/bx @@ -1577,20 +1587,20 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, tstar = temp1(p)*dth(p) qstar = temp2(p)*dqh(p) - thvstar=tstar*(1._kind_phys+0.61_kind_phys*forc_q(g)) + 0.61_kind_phys*forc_th(g)*qstar + thvstar=tstar*(1._kind_lake+0.61_kind_lake*forc_q(g)) + 0.61_kind_lake*forc_th(g)*qstar zeta=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c)) - if (zeta >= 0._kind_phys) then !stable - zeta = min(2._kind_phys,max(zeta,0.01_kind_phys)) - um(p) = max(ur(p),0.1_kind_phys) + if (zeta >= 0._kind_lake) then !stable + zeta = min(2._kind_lake,max(zeta,0.01_kind_lake)) + um(p) = max(ur(p),0.1_kind_lake) else !unstable - zeta = max(-100._kind_phys,min(zeta,-0.01_kind_phys)) - wc = beta1*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_kind_phys + zeta = max(-100._kind_lake,min(zeta,-0.01_kind_lake)) + wc = beta1*(-grav*ustar(p)*thvstar*zii/thv(c))**0.333_kind_lake um(p) = sqrt(ur(p)*ur(p)+wc*wc) end if obu(p) = zldis(p)/zeta - if (obuold(p)*obu(p) < 0._kind_phys) nmozsgn(p) = nmozsgn(p)+1 + if (obuold(p)*obu(p) < 0._kind_lake) nmozsgn(p) = nmozsgn(p)+1 obuold(p) = obu(p) @@ -1630,7 +1640,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! Should this happen if the lake temperature is below freezing, too? I'll assume that for now. ! Also, allow convection if ground temp is colder than lake but warmer than 4C, or warmer than ! lake which is warmer than freezing but less than 4C. - if ( (h2osno(c) > 0.5_kind_phys .or. t_lake(c,1) <= tfrz) .and. t_grnd(c) > tfrz) then + if ( (h2osno(c) > 0.5_kind_lake .or. t_lake(c,1) <= tfrz) .and. t_grnd(c) > tfrz) then t_grnd_temp = t_grnd(c) t_grnd(c) = tfrz eflx_sh_grnd(p) = forc_rho(g)*cpair*(t_grnd(c)-thm(c))/rah(p) @@ -1655,9 +1665,9 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! Net longwave from ground to atmosphere - ! eflx_lwrad_out(p) = (1._kind_phys-emg)*forc_lwrad(g) + stftg3(p)*(-3._kind_phys*tgbef(c)+4._kind_phys*t_grnd(c)) + ! eflx_lwrad_out(p) = (1._kind_lake-emg)*forc_lwrad(g) + stftg3(p)*(-3._kind_lake*tgbef(c)+4._kind_lake*t_grnd(c)) ! What is tgbef doing in this equation? Can't it be exact now? --Zack Subin, 4/14/09 - eflx_lwrad_out(p) = (1._kind_phys-emg)*forc_lwrad(g) + emg*sb*t_grnd(c)**4 + eflx_lwrad_out(p) = (1._kind_lake-emg)*forc_lwrad(g) + emg*sb*t_grnd(c)**4 ! Ground heat flux @@ -1696,10 +1706,10 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, endif endif ! 2 m height air temperature - t_ref2m(p) = thm(c) + temp1(p)*dth(p)*(1._kind_phys/temp12m(p) - 1._kind_phys/temp1(p)) + t_ref2m(p) = thm(c) + temp1(p)*dth(p)*(1._kind_lake/temp12m(p) - 1._kind_lake/temp1(p)) ! 2 m height specific humidity - q_ref2m(p) = forc_q(g) + temp2(p)*dqh(p)*(1._kind_phys/temp22m(p) - 1._kind_phys/temp2(p)) + q_ref2m(p) = forc_q(g) + temp2(p)*dqh(p)*(1._kind_lake/temp22m(p) - 1._kind_lake/temp2(p)) ! Energy residual used for melting snow ! Effectively moved to ShalLakeTemp @@ -1714,14 +1724,14 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! This is the actual heat flux from the ground interface into the lake, not including ! the light that penetrates the surface. - ! u2m = max(1.0_kind_phys,ustar(p)/vkc*log(2._kind_phys/z0mg(p))) + ! u2m = max(1.0_kind_lake,ustar(p)/vkc*log(2._kind_lake/z0mg(p))) ! u2 often goes below 1 m/s; it seems like the only reason for this minimum is to ! keep it from being zero in the ks equation below; 0.1 m/s is a better limit for ! stable conditions --ZS - u2m = max(0.1_kind_phys,ustar(p)/vkc*log(2._kind_phys/z0mg(p))) + u2m = max(0.1_kind_lake,ustar(p)/vkc*log(2._kind_lake/z0mg(p))) - ws(c) = 1.2e-03_kind_phys * u2m - ks(c) = 6.6_kind_phys*sqrt(abs(sin(lat(g))))*(u2m**(-1.84_kind_phys)) + ws(c) = 1.2e-03_kind_lake * u2m + ks(c) = 6.6_kind_lake*sqrt(abs(sin(lat(g))))*(u2m**(-1.84_kind_lake)) end do @@ -1845,126 +1855,126 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !in: integer, intent(inout) :: errflg - real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_phys), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_phys), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_phys), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_phys), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + real(kind_lake), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_lake), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_lake), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_lake), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) character(*), intent(inout) :: errmsg - real(kind_phys), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) - real(kind_phys), intent(inout) :: h2osno(1) ! snow water (mm H2O) - real(kind_phys), intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) - real(kind_phys), intent(in) :: dz(1,-nlevsnow + 1:nlevsoil) ! layer thickness for snow & soil (m) - real(kind_phys), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - real(kind_phys), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) - real(kind_phys), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) + real(kind_lake), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osno(1) ! snow water (mm H2O) + real(kind_lake), intent(in) :: sabg(1) ! solar radiation absorbed by ground (W/m**2) + real(kind_lake), intent(in) :: dz(1,-nlevsnow + 1:nlevsoil) ! layer thickness for snow & soil (m) + real(kind_lake), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + real(kind_lake), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth for snow & soil (m) + real(kind_lake), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) ! the other z and dz variables - real(kind_phys), intent(in) :: z_lake(1,nlevlake) ! layer depth for lake (m) - real(kind_phys), intent(in) :: ws(1) ! surface friction velocity (m/s) - real(kind_phys), intent(in) :: ks(1) ! coefficient passed to ShalLakeTemperature + real(kind_lake), intent(in) :: z_lake(1,nlevlake) ! layer depth for lake (m) + real(kind_lake), intent(in) :: ws(1) ! surface friction velocity (m/s) + real(kind_lake), intent(in) :: ks(1) ! coefficient passed to ShalLakeTemperature ! for calculation of decay of eddy diffusivity with depth integer , intent(in) :: snl(1) ! negative of number of snow layers - real(kind_phys), intent(inout) :: eflx_gnet(1) ! net heat flux into ground (W/m**2) at the surface interface - real(kind_phys), intent(in) :: lakedepth(1) ! column lake depth (m) + real(kind_lake), intent(inout) :: eflx_gnet(1) ! net heat flux into ground (W/m**2) at the surface interface + real(kind_lake), intent(in) :: lakedepth(1) ! column lake depth (m) - ! real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_phys), intent(inout) :: snowdp(1) !snow height (m) - real(kind_phys), intent(in) :: dtime !timestep + ! real(kind_lake), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_lake), intent(inout) :: snowdp(1) !snow height (m) + real(kind_lake), intent(in) :: dtime !timestep !out: - real(kind_phys), intent(out) :: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] - real(kind_phys), intent(out) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] - real(kind_phys), intent(out) :: eflx_soil_grnd(1) ! heat flux into snow / lake (W/m**2) [+ = into soil] + real(kind_lake), intent(out) :: eflx_sh_grnd(1) ! sensible heat flux from ground (W/m**2) [+ to atm] + real(kind_lake), intent(out) :: eflx_sh_tot(1) ! total sensible heat flux (W/m**2) [+ to atm] + real(kind_lake), intent(out) :: eflx_soil_grnd(1) ! heat flux into snow / lake (W/m**2) [+ = into soil] ! Here this includes the whole lake radiation absorbed. - !real(kind_phys), intent(out) :: qmelt(1) ! snow melt [mm/s] [temporary] - - real(kind_phys), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) - real(kind_phys), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) - real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) [for snow & soil layers] - real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) [for snow & soil layers] - real(kind_phys), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen - real(kind_phys), intent(out) :: savedtke1(1) ! top level thermal conductivity (W/mK) - real(kind_phys), intent(out) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water - real(kind_phys), intent(out) :: qflx_snomelt(1) !snow melt (mm H2O /s) + !real(kind_lake), intent(out) :: qmelt(1) ! snow melt [mm/s] [temporary] + + real(kind_lake), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil (or snow) temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) [for snow & soil layers] + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) [for snow & soil layers] + real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_lake), intent(out) :: savedtke1(1) ! top level thermal conductivity (W/mK) + real(kind_lake), intent(out) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water + real(kind_lake), intent(out) :: qflx_snomelt(1) !snow melt (mm H2O /s) integer, intent(out) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 (new) ! OTHER LOCAL VARIABLES: integer , parameter :: islak = 2 ! index of lake, 1 = deep lake, 2 = shallow lake - real(kind_phys), parameter :: p0 = 1._kind_phys ! neutral value of turbulent prandtl number + real(kind_lake), parameter :: p0 = 1._kind_lake ! neutral value of turbulent prandtl number integer :: i,j,fc,fp,g,c,p ! do loop or array index - real(kind_phys) :: eta(2) ! light extinction coefficient (/m): depends on lake type - real(kind_phys) :: cwat ! specific heat capacity of water (j/m**3/kelvin) - real(kind_phys) :: cice_eff ! effective heat capacity of ice (using density of + real(kind_lake) :: eta(2) ! light extinction coefficient (/m): depends on lake type + real(kind_lake) :: cwat ! specific heat capacity of water (j/m**3/kelvin) + real(kind_lake) :: cice_eff ! effective heat capacity of ice (using density of ! water because layer depth is not adjusted when freezing - real(kind_phys) :: cfus ! effective heat of fusion per unit volume + real(kind_lake) :: cfus ! effective heat of fusion per unit volume ! using water density as above - real(kind_phys) :: km ! molecular diffusion coefficient (m**2/s) - real(kind_phys) :: tkice_eff ! effective conductivity since layer depth is constant - real(kind_phys) :: a(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "a" vector for tridiagonal matrix - real(kind_phys) :: b(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "b" vector for tridiagonal matrix - real(kind_phys) :: c1(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "c" vector for tridiagonal matrix - real(kind_phys) :: r(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "r" vector for tridiagonal solution - real(kind_phys) :: rhow(lbc:ubc,nlevlake) ! density of water (kg/m**3) - real(kind_phys) :: phi(lbc:ubc,nlevlake) ! solar radiation absorbed by layer (w/m**2) - real(kind_phys) :: kme(lbc:ubc,nlevlake) ! molecular + eddy diffusion coefficient (m**2/s) - real(kind_phys) :: rsfin ! relative flux of solar radiation into layer - real(kind_phys) :: rsfout ! relative flux of solar radiation out of layer - real(kind_phys) :: phi_soil(lbc:ubc) ! solar radiation into top soil layer (W/m**2) - real(kind_phys) :: ri ! richardson number - real(kind_phys) :: fin(lbc:ubc) ! net heat flux into lake at ground interface (w/m**2) - real(kind_phys) :: ocvts(lbc:ubc) ! (cwat*(t_lake[n ])*dz - real(kind_phys) :: ncvts(lbc:ubc) ! (cwat*(t_lake[n+1])*dz - real(kind_phys) :: ke ! eddy diffusion coefficient (m**2/s) - real(kind_phys) :: zin ! depth at top of layer (m) - real(kind_phys) :: zout ! depth at bottom of layer (m) - real(kind_phys) :: drhodz ! d [rhow] /dz (kg/m**4) - real(kind_phys) :: n2 ! brunt-vaisala frequency (/s**2) - real(kind_phys) :: num ! used in calculating ri - real(kind_phys) :: den ! used in calculating ri - real(kind_phys) :: tav_froz(lbc:ubc) ! used in aver temp for convectively mixed layers (C) - real(kind_phys) :: tav_unfr(lbc:ubc) ! " - real(kind_phys) :: nav(lbc:ubc) ! used in aver temp for convectively mixed layers - real(kind_phys) :: phidum ! temporary value of phi - real(kind_phys) :: iceav(lbc:ubc) ! used in calc aver ice for convectively mixed layers - real(kind_phys) :: qav(lbc:ubc) ! used in calc aver heat content for conv. mixed layers + real(kind_lake) :: km ! molecular diffusion coefficient (m**2/s) + real(kind_lake) :: tkice_eff ! effective conductivity since layer depth is constant + real(kind_lake) :: a(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "a" vector for tridiagonal matrix + real(kind_lake) :: b(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "b" vector for tridiagonal matrix + real(kind_lake) :: c1(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "c" vector for tridiagonal matrix + real(kind_lake) :: r(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! "r" vector for tridiagonal solution + real(kind_lake) :: rhow(lbc:ubc,nlevlake) ! density of water (kg/m**3) + real(kind_lake) :: phi(lbc:ubc,nlevlake) ! solar radiation absorbed by layer (w/m**2) + real(kind_lake) :: kme(lbc:ubc,nlevlake) ! molecular + eddy diffusion coefficient (m**2/s) + real(kind_lake) :: rsfin ! relative flux of solar radiation into layer + real(kind_lake) :: rsfout ! relative flux of solar radiation out of layer + real(kind_lake) :: phi_soil(lbc:ubc) ! solar radiation into top soil layer (W/m**2) + real(kind_lake) :: ri ! richardson number + real(kind_lake) :: fin(lbc:ubc) ! net heat flux into lake at ground interface (w/m**2) + real(kind_lake) :: ocvts(lbc:ubc) ! (cwat*(t_lake[n ])*dz + real(kind_lake) :: ncvts(lbc:ubc) ! (cwat*(t_lake[n+1])*dz + real(kind_lake) :: ke ! eddy diffusion coefficient (m**2/s) + real(kind_lake) :: zin ! depth at top of layer (m) + real(kind_lake) :: zout ! depth at bottom of layer (m) + real(kind_lake) :: drhodz ! d [rhow] /dz (kg/m**4) + real(kind_lake) :: n2 ! brunt-vaisala frequency (/s**2) + real(kind_lake) :: num ! used in calculating ri + real(kind_lake) :: den ! used in calculating ri + real(kind_lake) :: tav_froz(lbc:ubc) ! used in aver temp for convectively mixed layers (C) + real(kind_lake) :: tav_unfr(lbc:ubc) ! " + real(kind_lake) :: nav(lbc:ubc) ! used in aver temp for convectively mixed layers + real(kind_lake) :: phidum ! temporary value of phi + real(kind_lake) :: iceav(lbc:ubc) ! used in calc aver ice for convectively mixed layers + real(kind_lake) :: qav(lbc:ubc) ! used in calc aver heat content for conv. mixed layers integer :: jtop(lbc:ubc) ! top level for each column (no longer all 1) - real(kind_phys) :: cv (lbc:ubc,-nlevsnow+1:nlevsoil) !heat capacity of soil/snow [J/(m2 K)] - real(kind_phys) :: tk (lbc:ubc,-nlevsnow+1:nlevsoil) !thermal conductivity of soil/snow [W/(m K)] + real(kind_lake) :: cv (lbc:ubc,-nlevsnow+1:nlevsoil) !heat capacity of soil/snow [J/(m2 K)] + real(kind_lake) :: tk (lbc:ubc,-nlevsnow+1:nlevsoil) !thermal conductivity of soil/snow [W/(m K)] !(at interface below, except for j=0) - real(kind_phys) :: cv_lake (lbc:ubc,1:nlevlake) !heat capacity [J/(m2 K)] - real(kind_phys) :: tk_lake (lbc:ubc,1:nlevlake) !thermal conductivity at layer node [W/(m K)] - real(kind_phys) :: cvx (lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !heat capacity for whole column [J/(m2 K)] - real(kind_phys) :: tkix(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !thermal conductivity at layer interfaces + real(kind_lake) :: cv_lake (lbc:ubc,1:nlevlake) !heat capacity [J/(m2 K)] + real(kind_lake) :: tk_lake (lbc:ubc,1:nlevlake) !thermal conductivity at layer node [W/(m K)] + real(kind_lake) :: cvx (lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !heat capacity for whole column [J/(m2 K)] + real(kind_lake) :: tkix(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !thermal conductivity at layer interfaces !for whole column [W/(m K)] - real(kind_phys) :: tx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! temperature of whole column [K] - real(kind_phys) :: tktopsoillay(lbc:ubc) ! thermal conductivity [W/(m K)] - real(kind_phys) :: fnx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !heat diffusion through the layer interface below [W/m2] - real(kind_phys) :: phix(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !solar source term for whole column [W/m**2] - real(kind_phys) :: zx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !interface depth (+ below surface) for whole column [m] - real(kind_phys) :: dzm !used in computing tridiagonal matrix [m] - real(kind_phys) :: dzp !used in computing tridiagonal matrix [m] + real(kind_lake) :: tx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) ! temperature of whole column [K] + real(kind_lake) :: tktopsoillay(lbc:ubc) ! thermal conductivity [W/(m K)] + real(kind_lake) :: fnx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !heat diffusion through the layer interface below [W/m2] + real(kind_lake) :: phix(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !solar source term for whole column [W/m**2] + real(kind_lake) :: zx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !interface depth (+ below surface) for whole column [m] + real(kind_lake) :: dzm !used in computing tridiagonal matrix [m] + real(kind_lake) :: dzp !used in computing tridiagonal matrix [m] integer :: jprime ! j - nlevlake - real(kind_phys) :: factx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !coefficient used in computing tridiagonal matrix - real(kind_phys) :: t_lake_bef(lbc:ubc,1:nlevlake) !beginning lake temp for energy conservation check [K] - real(kind_phys) :: t_soisno_bef(lbc:ubc,-nlevsnow+1:nlevsoil) !beginning soil temp for E cons. check [K] - real(kind_phys) :: lhabs(lbc:ubc) ! total per-column latent heat abs. from phase change (J/m^2) - real(kind_phys) :: esum1(lbc:ubc) ! temp for checking energy (J/m^2) - real(kind_phys) :: esum2(lbc:ubc) ! "" - real(kind_phys) :: zsum(lbc:ubc) ! temp for putting ice at the top during convection (m) - real(kind_phys) :: wsum(lbc:ubc) ! temp for checking water (kg/m^2) - real(kind_phys) :: wsum_end(lbc:ubc) ! temp for checking water (kg/m^2) - real(kind_phys) :: errsoi(1) ! soil/lake energy conservation error (W/m**2) - real(kind_phys) :: eflx_snomelt(1) !snow melt heat flux (W/m**2) + real(kind_lake) :: factx(lbc:ubc,-nlevsnow+1:nlevlake+nlevsoil) !coefficient used in computing tridiagonal matrix + real(kind_lake) :: t_lake_bef(lbc:ubc,1:nlevlake) !beginning lake temp for energy conservation check [K] + real(kind_lake) :: t_soisno_bef(lbc:ubc,-nlevsnow+1:nlevsoil) !beginning soil temp for E cons. check [K] + real(kind_lake) :: lhabs(lbc:ubc) ! total per-column latent heat abs. from phase change (J/m^2) + real(kind_lake) :: esum1(lbc:ubc) ! temp for checking energy (J/m^2) + real(kind_lake) :: esum2(lbc:ubc) ! "" + real(kind_lake) :: zsum(lbc:ubc) ! temp for putting ice at the top during convection (m) + real(kind_lake) :: wsum(lbc:ubc) ! temp for checking water (kg/m^2) + real(kind_lake) :: wsum_end(lbc:ubc) ! temp for checking water (kg/m^2) + real(kind_lake) :: errsoi(1) ! soil/lake energy conservation error (W/m**2) + real(kind_lake) :: eflx_snomelt(1) !snow melt heat flux (W/m**2) CHARACTER*256 :: message ! ! Constants for lake temperature model ! - real(kind_phys), parameter :: beta(2) = & ! fraction solar rad absorbed at surface: depends on lake type - (/0.4_kind_phys, 0.4_kind_phys/) ! (deep lake, shallow lake) - real(kind_phys), parameter :: za(2) = & ! base of surface absorption layer (m): depends on lake type - (/0.6_kind_phys, 0.6_kind_phys/) + real(kind_lake), parameter :: beta(2) = & ! fraction solar rad absorbed at surface: depends on lake type + (/0.4_kind_lake, 0.4_kind_lake/) ! (deep lake, shallow lake) + real(kind_lake), parameter :: za(2) = & ! base of surface absorption layer (m): depends on lake type + (/0.6_kind_lake, 0.6_kind_lake/) ! For now, keep beta and za for shallow lake the same as deep lake, until better data is found. ! It looks like eta is key and that larger values give better results for shallow lakes. Use ! empirical expression from Hakanson (below). This is still a very unconstrained parameter @@ -1993,10 +2003,10 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! Initialize Ebal quantities computed below - ocvts(c) = 0._kind_phys - ncvts(c) = 0._kind_phys - esum1(c) = 0._kind_phys - esum2(c) = 0._kind_phys + ocvts(c) = 0._kind_lake + ncvts(c) = 0._kind_lake + esum1(c) = 0._kind_lake + esum2(c) = 0._kind_lake end do @@ -2022,7 +2032,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !cdir nodep do fc = 1, num_shlakec c = filter_shlakec(fc) - if (j == 1) wsum(c) = 0._kind_phys + if (j == 1) wsum(c) = 0._kind_lake wsum(c) = wsum(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) end do end do @@ -2050,8 +2060,8 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !cdir nodep do fc = 1, num_shlakec c = filter_shlakec(fc) - rhow(c,j) = (1._kind_phys - lake_icefrac(c,j)) * & - 1000._kind_phys*( 1.0_kind_phys - 1.9549e-05_kind_phys*(abs(t_lake(c,j)-277._kind_phys))**1.68_kind_phys ) & + rhow(c,j) = (1._kind_lake - lake_icefrac(c,j)) * & + 1000._kind_lake*( 1.0_kind_lake - 1.9549e-05_kind_lake*(abs(t_lake(c,j)-277._kind_lake))**1.68_kind_lake ) & + lake_icefrac(c,j)*denice ! Allow for ice fraction; assume constant ice density. ! Is this the right weighted average? @@ -2071,27 +2081,27 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! n2 = grav / rhow(c,j) * drhodz ! Fixed sign error here: our z goes up going down into the lake, so no negative ! sign is needed to make this positive unlike in Hostetler. --ZS - num = 40._kind_phys * n2 * (vkc*z_lake(c,j))**2 - den = max( (ws(c)**2) * exp(-2._kind_phys*ks(c)*z_lake(c,j)), 1.e-10_kind_phys ) - ri = ( -1._kind_phys + sqrt( max(1._kind_phys+num/den, 0._kind_phys) ) ) / 20._kind_phys + num = 40._kind_lake * n2 * (vkc*z_lake(c,j))**2 + den = max( (ws(c)**2) * exp(-2._kind_lake*ks(c)*z_lake(c,j)), 1.e-10_kind_lake ) + ri = ( -1._kind_lake + sqrt( max(1._kind_lake+num/den, 0._kind_lake) ) ) / 20._kind_lake if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then - ! ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + ! ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_lake+37._kind_lake*ri*ri) - if( t_lake(c,1) > 277.15_kind_phys ) then + if( t_lake(c,1) > 277.15_kind_lake ) then if (lakedepth(c) > 15.0 ) then - ke = 1.e+2_kind_phys*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + ke = 1.e+2_kind_lake*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_lake+37._kind_lake*ri*ri) else - ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_lake+37._kind_lake*ri*ri) endif else if (lakedepth(c) > 15.0 ) then if (lakedepth(c) > 150.0 ) then - ke = 1.e+5_kind_phys*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + ke = 1.e+5_kind_lake*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_lake+37._kind_lake*ri*ri) else - ke =1.e+4_kind_phys*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + ke =1.e+4_kind_lake*vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_lake+37._kind_lake*ri*ri) end if else - ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_phys+37._kind_phys*ri*ri) + ke = vkc*ws(c)*z_lake(c,j)/p0 * exp(-ks(c)*z_lake(c,j)) / (1._kind_lake+37._kind_lake*ri*ri) endif end if @@ -2102,7 +2112,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! diffusivity equation assumes water. else kme(c,j) = km - tk_lake(c,j) = tkwat*tkice_eff / ( (1._kind_phys-lake_icefrac(c,j))*tkice_eff & + tk_lake(c,j) = tkwat*tkice_eff / ( (1._kind_lake-lake_icefrac(c,j))*tkice_eff & + tkwat*lake_icefrac(c,j) ) ! Assume the resistances add as for the calculation of conductivities at layer interfaces. end if @@ -2120,7 +2130,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then tk_lake(c,j) = tk_lake(c,j-1) else - tk_lake(c,j) = tkwat*tkice_eff / ( (1._kind_phys-lake_icefrac(c,j))*tkice_eff & + tk_lake(c,j) = tkwat*tkice_eff / ( (1._kind_lake-lake_icefrac(c,j))*tkice_eff & + tkwat*lake_icefrac(c,j) ) end if @@ -2142,29 +2152,29 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! (regression of Secchi Depth with lake depth for small glacial basin lakes), and the ! Poole & Atkins expression for extinction coeffient of 1.7 / Secchi Depth (m). if(.not.USE_ETALAKE) then - eta(:) = 1.1925_kind_phys*lakedepth(c)**(-0.424) + eta(:) = 1.1925_kind_lake*lakedepth(c)**(-0.424) else eta(:) = ETALAKE endif - zin = z_lake(c,j) - 0.5_kind_phys*dz_lake(c,j) - zout = z_lake(c,j) + 0.5_kind_phys*dz_lake(c,j) - rsfin = exp( -eta(islak)*max( zin-za(islak),0._kind_phys ) ) - rsfout = exp( -eta(islak)*max( zout-za(islak),0._kind_phys ) ) + zin = z_lake(c,j) - 0.5_kind_lake*dz_lake(c,j) + zout = z_lake(c,j) + 0.5_kind_lake*dz_lake(c,j) + rsfin = exp( -eta(islak)*max( zin-za(islak),0._kind_lake ) ) + rsfout = exp( -eta(islak)*max( zout-za(islak),0._kind_lake ) ) ! Let rsfout for bottom layer go into soil. ! This looks like it should be robust even for pathological cases, ! like lakes thinner than za. if (t_grnd(c) > tfrz .and. t_lake(c,1) > tfrz .and. snl(c) == 0) then - phidum = (rsfin-rsfout) * sabg(p) * (1._kind_phys-beta(islak)) + phidum = (rsfin-rsfout) * sabg(p) * (1._kind_lake-beta(islak)) if (j == nlevlake) then - phi_soil(c) = rsfout * sabg(p) * (1._kind_phys-beta(islak)) + phi_soil(c) = rsfout * sabg(p) * (1._kind_lake-beta(islak)) end if else if (j == 1 .and. snl(c) == 0) then !if frozen but no snow layers - phidum = sabg(p) * (1._kind_phys-beta(islak)) + phidum = sabg(p) * (1._kind_lake-beta(islak)) else !radiation absorbed at surface - phidum = 0._kind_phys - if (j == nlevlake) phi_soil(c) = 0._kind_phys + phidum = 0._kind_lake + if (j == nlevlake) phi_soil(c) = 0._kind_lake end if phi(c,j) = phidum @@ -2180,7 +2190,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! do fc = 1, num_shlakec c = filter_shlakec(fc) - cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._kind_phys-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) + cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._kind_lake-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) end do end do @@ -2204,7 +2214,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! ocvts(c) = ocvts(c) + cv_lake(c,j)*t_lake(c,j) & ocvts(c) = ocvts(c) + cv_lake(c,j)*(t_lake(c,j)-tfrz) & - + cfus*dz_lake(c,j)*(1._kind_phys-lake_icefrac(c,j)) !& + + cfus*dz_lake(c,j)*(1._kind_lake-lake_icefrac(c,j)) !& ! + (cwat-cice_eff)*lake_icefrac(c)*tfrz*dz_lake(c,j) !enthalpy reconciliation term t_lake_bef(c,j) = t_lake(c,j) end do @@ -2222,7 +2232,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ocvts(c) = ocvts(c) + cv(c,j)*(t_soisno(c,j)-tfrz) & + hfus*h2osoi_liq(c,j) !& ! + (cpliq-cpice)*h2osoi_ice(c,j)*tfrz !enthalpy reconciliation term - if (j == 1 .and. h2osno(c) > 0._kind_phys .and. j == jtop(c)) then + if (j == 1 .and. h2osno(c) > 0._kind_lake .and. j == jtop(c)) then ocvts(c) = ocvts(c) - h2osno(c)*hfus end if t_soisno_bef(c,j) = t_soisno(c,j) @@ -2257,7 +2267,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! if (j < 1) then !snow layer zx(c,j) = z(c,j) cvx(c,j) = cv(c,j) - phix(c,j) = 0._kind_phys + phix(c,j) = 0._kind_lake tx(c,j) = t_soisno(c,j) else if (j <= nlevlake) then !lake layer zx(c,j) = z_lake(c,j) @@ -2265,12 +2275,12 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! phix(c,j) = phi(c,j) tx(c,j) = t_lake(c,j) else !soil layer - zx(c,j) = zx(c,nlevlake) + dz_lake(c,nlevlake)*0.5_kind_phys + z(c,jprime) + zx(c,j) = zx(c,nlevlake) + dz_lake(c,nlevlake)*0.5_kind_lake + z(c,jprime) cvx(c,j) = cv(c,jprime) if (j == nlevlake + 1) then !top soil layer phix(c,j) = phi_soil(c) else !middle or bottom soil layer - phix(c,j) = 0._kind_phys + phix(c,j) = 0._kind_lake end if tx(c,j) = t_soisno(c,jprime) end if @@ -2304,7 +2314,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! else if (j == nlevlake) then !bottom lake layer dzp = zx(c,j+1) - zx(c,j) tkix(c,j) = (tktopsoillay(c)*tk_lake(c,j)*dzp / & - (tktopsoillay(c)*dz_lake(c,j)*0.5_kind_phys + tk_lake(c,j)*z(c,1) ) ) + (tktopsoillay(c)*dz_lake(c,j)*0.5_kind_lake + tk_lake(c,j)*z(c,1) ) ) ! tktopsoillay is the conductivity at the middle of that layer, as defined in SoilThermProp_Lake else !soil layer tkix(c,j) = tk(c,jprime) @@ -2331,7 +2341,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! fnx(c,j) = tkix(c,j)*(tx(c,j+1)-tx(c,j))/(zx(c,j+1)-zx(c,j)) else !bottom soil layer factx(c,j) = dtime/cvx(c,j) - fnx(c,j) = 0._kind_phys !not used + fnx(c,j) = 0._kind_lake !not used end if end if enddo @@ -2346,22 +2356,22 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! if (j >= jtop(c)) then if (j == jtop(c)) then !top layer dzp = zx(c,j+1)-zx(c,j) - a(c,j) = 0._kind_phys - b(c,j) = 1+(1._kind_phys-cnfac)*factx(c,j)*tkix(c,j)/dzp - c1(c,j) = -(1._kind_phys-cnfac)*factx(c,j)*tkix(c,j)/dzp + a(c,j) = 0._kind_lake + b(c,j) = 1+(1._kind_lake-cnfac)*factx(c,j)*tkix(c,j)/dzp + c1(c,j) = -(1._kind_lake-cnfac)*factx(c,j)*tkix(c,j)/dzp r(c,j) = tx(c,j) + factx(c,j)*( fin(c) + phix(c,j) + cnfac*fnx(c,j) ) else if (j < nlevlake+nlevsoil) then !middle layer dzm = (zx(c,j)-zx(c,j-1)) dzp = (zx(c,j+1)-zx(c,j)) - a(c,j) = - (1._kind_phys-cnfac)*factx(c,j)* tkix(c,j-1)/dzm - b(c,j) = 1._kind_phys+ (1._kind_phys-cnfac)*factx(c,j)*(tkix(c,j)/dzp + tkix(c,j-1)/dzm) - c1(c,j) = - (1._kind_phys-cnfac)*factx(c,j)* tkix(c,j)/dzp + a(c,j) = - (1._kind_lake-cnfac)*factx(c,j)* tkix(c,j-1)/dzm + b(c,j) = 1._kind_lake+ (1._kind_lake-cnfac)*factx(c,j)*(tkix(c,j)/dzp + tkix(c,j-1)/dzm) + c1(c,j) = - (1._kind_lake-cnfac)*factx(c,j)* tkix(c,j)/dzp r(c,j) = tx(c,j) + cnfac*factx(c,j)*( fnx(c,j) - fnx(c,j-1) ) + factx(c,j)*phix(c,j) else !bottom soil layer dzm = (zx(c,j)-zx(c,j-1)) - a(c,j) = - (1._kind_phys-cnfac)*factx(c,j)*tkix(c,j-1)/dzm - b(c,j) = 1._kind_phys+ (1._kind_phys-cnfac)*factx(c,j)*tkix(c,j-1)/dzm - c1(c,j) = 0._kind_phys + a(c,j) = - (1._kind_lake-cnfac)*factx(c,j)*tkix(c,j-1)/dzm + b(c,j) = 1._kind_lake+ (1._kind_lake-cnfac)*factx(c,j)*tkix(c,j-1)/dzm + c1(c,j) = 0._kind_lake r(c,j) = tx(c,j) - cnfac*factx(c,j)*fnx(c,j-1) end if end if @@ -2437,7 +2447,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! errsoi(c) = esum1(c)/dtime - eflx_soil_grnd(p) ! eflx_soil_grnd includes all the solar radiation absorbed in the lake, ! unlike eflx_gnet - if(abs(errsoi(c)) > .001_kind_phys) then ! 1.e-5_kind_phys) then + if(abs(errsoi(c)) > .001_kind_lake) then ! 1.e-5_kind_lake) then WRITE( message,* )'Primary soil energy conservation error in shlake & column during Tridiagonal Solution,', 'error (W/m^2):', c, errsoi(c) errmsg=trim(message) @@ -2499,7 +2509,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! Again assuming only one pft per column esum2(c) = esum2(c) - lhabs(c) errsoi(c) = esum2(c)/dtime - if(abs(errsoi(c)) > 1.e-5_kind_phys) then + if(abs(errsoi(c)) > 1.e-5_kind_lake) then write(message,*)'Primary soil energy conservation error in shlake column during Phase Change, error (W/m^2):', & c, errsoi(c) errmsg=trim(message) @@ -2515,10 +2525,10 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !cdir nodep do fc = 1, num_shlakec c = filter_shlakec(fc) - if (j == 1) wsum_end(c) = 0._kind_phys + if (j == 1) wsum_end(c) = 0._kind_lake wsum_end(c) = wsum_end(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) if (j == nlevsoil) then - if (abs(wsum(c)-wsum_end(c))>1.e-7_kind_phys) then + if (abs(wsum(c)-wsum_end(c))>1.e-7_kind_lake) then write(message,*)'Soil water balance error during phase change in ShalLakeTemperature.', & 'column, error (kg/m^2):', c, wsum_end(c)-wsum(c) errmsg=trim(message) @@ -2542,8 +2552,8 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !cdir nodep do fc = 1, num_shlakec c = filter_shlakec(fc) - rhow(c,j) = (1._kind_phys - lake_icefrac(c,j)) * & - 1000._kind_phys*( 1.0_kind_phys - 1.9549e-05_kind_phys*(abs(t_lake(c,j)-277._kind_phys))**1.68_kind_phys ) & + rhow(c,j) = (1._kind_lake - lake_icefrac(c,j)) * & + 1000._kind_lake*( 1.0_kind_lake - 1.9549e-05_kind_lake*(abs(t_lake(c,j)-277._kind_lake))**1.68_kind_lake ) & + lake_icefrac(c,j)*denice end do end do @@ -2553,9 +2563,9 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !cdir nodep do fc = 1, num_shlakec c = filter_shlakec(fc) - qav(c) = 0._kind_phys - nav(c) = 0._kind_phys - iceav(c) = 0._kind_phys + qav(c) = 0._kind_lake + nav(c) = 0._kind_lake + iceav(c) = 0._kind_lake end do do i = 1, j+1 @@ -2564,14 +2574,14 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! do fc = 1, num_shlakec c = filter_shlakec(fc) if (rhow(c,j) > rhow(c,j+1) .or. & - (lake_icefrac(c,j) < 1._kind_phys .and. lake_icefrac(c,j+1) > 0._kind_phys) ) then + (lake_icefrac(c,j) < 1._kind_lake .and. lake_icefrac(c,j+1) > 0._kind_lake) ) then if(LAKEDEBUG) then if (i==1) then print *, 'Convective Mixing in column ', c, '.' endif endif qav(c) = qav(c) + dz_lake(c,i)*(t_lake(c,i)-tfrz) * & - ((1._kind_phys - lake_icefrac(c,i))*cwat + lake_icefrac(c,i)*cice_eff) + ((1._kind_lake - lake_icefrac(c,i))*cwat + lake_icefrac(c,i)*cice_eff) ! tav(c) = tav(c) + t_lake(c,i)*dz_lake(c,i) iceav(c) = iceav(c) + lake_icefrac(c,i)*dz_lake(c,i) nav(c) = nav(c) + dz_lake(c,i) @@ -2584,20 +2594,20 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! do fc = 1, num_shlakec c = filter_shlakec(fc) if (rhow(c,j) > rhow(c,j+1) .or. & - (lake_icefrac(c,j) < 1._kind_phys .and. lake_icefrac(c,j+1) > 0._kind_phys) ) then + (lake_icefrac(c,j) < 1._kind_lake .and. lake_icefrac(c,j+1) > 0._kind_lake) ) then qav(c) = qav(c)/nav(c) iceav(c) = iceav(c)/nav(c) !If the average temperature is above freezing, put the extra energy into the water. !If it is below freezing, take it away from the ice. - if (qav(c) > 0._kind_phys) then - tav_froz(c) = 0._kind_phys !Celsius - tav_unfr(c) = qav(c) / ((1._kind_phys - iceav(c))*cwat) - else if (qav(c) < 0._kind_phys) then + if (qav(c) > 0._kind_lake) then + tav_froz(c) = 0._kind_lake !Celsius + tav_unfr(c) = qav(c) / ((1._kind_lake - iceav(c))*cwat) + else if (qav(c) < 0._kind_lake) then tav_froz(c) = qav(c) / (iceav(c)*cice_eff) - tav_unfr(c) = 0._kind_phys !Celsius + tav_unfr(c) = 0._kind_lake !Celsius else - tav_froz(c) = 0._kind_phys - tav_unfr(c) = 0._kind_phys + tav_froz(c) = 0._kind_lake + tav_unfr(c) = 0._kind_lake end if end if end do @@ -2607,7 +2617,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !cdir nodep do fc = 1, num_shlakec c = filter_shlakec(fc) - if (nav(c) > 0._kind_phys) then + if (nav(c) > 0._kind_lake) then ! if(0==1) then !Put all the ice at the top.! @@ -2616,28 +2626,28 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! !For the layer with both ice & water, be careful to use the average temperature !that preserves the correct total heat content given what the heat capacity of that !layer will actually be. - if (i == 1) zsum(c) = 0._kind_phys + if (i == 1) zsum(c) = 0._kind_lake if ((zsum(c)+dz_lake(c,i))/nav(c) <= iceav(c)) then t_lake(c,i) = tav_froz(c) + tfrz !tgs - 30jul19 - the next line is a bug and should be commented !out. This bug prevents lake ice form completely melting. - ! lake_icefrac(c,i) = 1._kind_phys + ! lake_icefrac(c,i) = 1._kind_lake else if (zsum(c)/nav(c) < iceav(c)) then !tgs - change ice fraction lake_icefrac(c,i) = (iceav(c)*nav(c) - zsum(c)) / dz_lake(c,i) ! Find average value that preserves correct heat content. t_lake(c,i) = ( lake_icefrac(c,i)*tav_froz(c)*cice_eff & - + (1._kind_phys - lake_icefrac(c,i))*tav_unfr(c)*cwat ) & + + (1._kind_lake - lake_icefrac(c,i))*tav_unfr(c)*cwat ) & / ( lake_icefrac(c,i)*cice_eff + (1-lake_icefrac(c,i))*cwat ) + tfrz else !tgs - remove ice - lake_icefrac(c,i) = 0._kind_phys + lake_icefrac(c,i) = 0._kind_lake t_lake(c,i) = tav_unfr(c) + tfrz end if zsum(c) = zsum(c) + dz_lake(c,i) - rhow(c,i) = (1._kind_phys - lake_icefrac(c,i)) * & - 1000._kind_phys*( 1.0_kind_phys - 1.9549e-05_kind_phys*(abs(t_lake(c,i)-277._kind_phys))**1.68_kind_phys ) & + rhow(c,i) = (1._kind_lake - lake_icefrac(c,i)) * & + 1000._kind_lake*( 1.0_kind_lake - 1.9549e-05_kind_lake*(abs(t_lake(c,i)-277._kind_lake))**1.68_kind_lake ) & + lake_icefrac(c,i)*denice end if end do @@ -2653,7 +2663,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! do fc = 1, num_shlakec c = filter_shlakec(fc) - cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._kind_phys-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) + cv_lake(c,j) = dz_lake(c,j) * (cwat*(1._kind_lake-lake_icefrac(c,j)) + cice_eff*lake_icefrac(c,j)) if (LAKEDEBUG) then print *,'Lake Ice Fraction, c, level:', c, j, lake_icefrac(c,j) endif @@ -2674,7 +2684,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ! ncvts(c) = ncvts(c) + cv_lake(c,j)*t_lake(c,j) & ncvts(c) = ncvts(c) + cv_lake(c,j)*(t_lake(c,j)-tfrz) & - + cfus*dz_lake(c,j)*(1._kind_phys-lake_icefrac(c,j)) !& + + cfus*dz_lake(c,j)*(1._kind_lake-lake_icefrac(c,j)) !& ! + (cwat-cice_eff)*lake_icefrac(c)*tfrz*dz_lake(c,j) !enthalpy reconciliation term fin(c) = fin(c) + phi(c,j) end do @@ -2691,7 +2701,7 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! ncvts(c) = ncvts(c) + cv(c,j)*(t_soisno(c,j)-tfrz) & + hfus*h2osoi_liq(c,j) !& ! + (cpliq-cpice)*h2osoi_ice(c,j)*tfrz !enthalpy reconciliation term - if (j == 1 .and. h2osno(c) > 0._kind_phys .and. j == jtop(c)) then + if (j == 1 .and. h2osno(c) > 0._kind_lake .and. j == jtop(c)) then ncvts(c) = ncvts(c) - h2osno(c)*hfus end if end if @@ -2706,17 +2716,17 @@ SUBROUTINE ShalLakeTemperature(t_grnd,h2osno,sabg,dz,dz_lake,z,zi, & ! p = filter_shlakep(fp) c = pcolumn(p) errsoi(c) = (ncvts(c)-ocvts(c)) / dtime - fin(c) - if( (LAKEDEBUG .and. abs(errsoi(c)) < 1._kind_phys) ) then -! .or. (.not.LAKEDEBUG .and. abs(errsoi(c)) < 10._kind_phys)) then + if( (LAKEDEBUG .and. abs(errsoi(c)) < 1._kind_lake) ) then +! .or. (.not.LAKEDEBUG .and. abs(errsoi(c)) < 10._kind_lake)) then eflx_sh_tot(p) = eflx_sh_tot(p) - errsoi(c) eflx_sh_grnd(p) = eflx_sh_grnd(p) - errsoi(c) eflx_soil_grnd(p) = eflx_soil_grnd(p) + errsoi(c) eflx_gnet(p) = eflx_gnet(p) + errsoi(c) - ! if (abs(errsoi(c)) > 1.e-3_kind_phys) then - if (abs(errsoi(c)) > 1.e-1_kind_phys) then + ! if (abs(errsoi(c)) > 1.e-3_kind_lake) then + if (abs(errsoi(c)) > 1.e-1_kind_lake) then print *,'errsoi incorporated into sensible heat in ShalLakeTemperature: c, (W/m^2):', c, errsoi(c) end if - errsoi(c) = 0._kind_phys + errsoi(c) = 0._kind_lake else if(LAKEDEBUG) then print *,'Soil Energy Balance Error at column, ', c, 'G, fintotal, column E tendency = ', & eflx_gnet(p), fin(c), (ncvts(c)-ocvts(c)) / dtime @@ -2761,23 +2771,23 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & integer, intent(inout) :: errflg character(*), intent(inout) :: errmsg integer , intent(in) :: snl(1) ! number of snow layers - ! real(kind_phys), intent(in) :: h2osno(1) ! snow water (mm H2O) - real(kind_phys), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_phys), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_phys), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_phys), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_phys), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) - real(kind_phys), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness (m) - real(kind_phys), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) - real(kind_phys), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) - real(kind_phys), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil temperature (Kelvin) - real(kind_phys), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_phys), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + ! real(kind_lake), intent(in) :: h2osno(1) ! snow water (mm H2O) + real(kind_lake), intent(in) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_lake), intent(in) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_lake), intent(in) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_lake), intent(in) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake), intent(in) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness (m) + real(kind_lake), intent(in) :: zi(1,-nlevsnow+0:nlevsoil) ! interface level below a "z" level (m) + real(kind_lake), intent(in) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) + real(kind_lake), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! soil temperature (Kelvin) + real(kind_lake), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_lake), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) !out - real(kind_phys), intent(out) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) ! heat capacity [J/(m2 K)] - real(kind_phys), intent(out) :: tk(lbc:ubc,-nlevsnow+1:nlevsoil) ! thermal conductivity [W/(m K)] - real(kind_phys), intent(out) :: tktopsoillay(lbc:ubc) ! thermal conductivity [W/(m K)] + real(kind_lake), intent(out) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) ! heat capacity [J/(m2 K)] + real(kind_lake), intent(out) :: tk(lbc:ubc,-nlevsnow+1:nlevsoil) ! thermal conductivity [W/(m K)] + real(kind_lake), intent(out) :: tktopsoillay(lbc:ubc) ! thermal conductivity [W/(m K)] !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! !CALLED FROM: ! subroutine ShalLakeTemperature in this module. @@ -2804,15 +2814,15 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & integer :: l,c,j ! indices integer :: fc ! lake filtered column indices - real(kind_phys) :: bw ! partial density of water (ice + liquid) - real(kind_phys) :: dksat ! thermal conductivity for saturated soil (j/(k s m)) - real(kind_phys) :: dke ! kersten number - real(kind_phys) :: fl ! fraction of liquid or unfrozen water to total water - real(kind_phys) :: satw ! relative total water content of soil. - real(kind_phys) :: thk(lbc:ubc,-nlevsnow+1:nlevsoil) ! thermal conductivity of layer + real(kind_lake) :: bw ! partial density of water (ice + liquid) + real(kind_lake) :: dksat ! thermal conductivity for saturated soil (j/(k s m)) + real(kind_lake) :: dke ! kersten number + real(kind_lake) :: fl ! fraction of liquid or unfrozen water to total water + real(kind_lake) :: satw ! relative total water content of soil. + real(kind_lake) :: thk(lbc:ubc,-nlevsnow+1:nlevsoil) ! thermal conductivity of layer character*256 :: message - real(kind_phys) :: denom + real(kind_lake) :: denom ! Thermal conductivity of soil from Farouki (1981) @@ -2831,8 +2841,8 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & ! Soil should be saturated. if (LAKEDEBUG) then satw = (h2osoi_liq(c,j)/denh2o + h2osoi_ice(c,j)/denice)/(dz(c,j)*watsat(c,j)) - ! satw = min(1._kind_phys, satw) - if (satw < 0.999_kind_phys) then + ! satw = min(1._kind_lake, satw) + if (satw < 0.999_kind_lake) then write(message,*)'WARNING: soil layer unsaturated in SoilThermProp_Lake, satw, j = ', satw, j ! errmsg=trim(message) ! errflg=1 @@ -2842,7 +2852,7 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & ! since we're not yet doing excess ice. ! But take care of this in HydrologyLake. endif - satw = 1._kind_phys + satw = 1._kind_lake denom = (h2osoi_ice(c,j)+h2osoi_liq(c,j)) if(denom>zero_h2o) then fl = h2osoi_liq(c,j)/denom @@ -2854,13 +2864,13 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & write(0,'(A)') trim(message) endif if (t_soisno(c,j) >= tfrz) then ! Unfrozen soil - dke = max(0._kind_phys, log10(satw) + 1.0_kind_phys) + dke = max(0._kind_lake, log10(satw) + 1.0_kind_lake) dksat = tksatu(c,j) else ! Frozen soil dke = satw - dksat = tkmg(c,j)*0.249_kind_phys**(fl*watsat(c,j))*2.29_kind_phys**watsat(c,j) + dksat = tkmg(c,j)*0.249_kind_lake**(fl*watsat(c,j))*2.29_kind_lake**watsat(c,j) endif - thk(c,j) = dke*dksat + (1._kind_phys-dke)*tkdry(c,j) + thk(c,j) = dke*dksat + (1._kind_lake-dke)*tkdry(c,j) ! else ! thk(c,j) = tkwat ! if (t_soisno(c,j) < tfrz) thk(c,j) = tkice @@ -2871,7 +2881,7 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & ! Only examine levels from snl(c)+1 -> 0 where snl(c) < 1 if (snl(c)+1 < 1 .AND. (j >= snl(c)+1) .AND. (j <= 0)) then bw = (h2osoi_ice(c,j)+h2osoi_liq(c,j))/dz(c,j) - thk(c,j) = tkairc + (7.75e-5_kind_phys *bw + 1.105e-6_kind_phys*bw*bw)*(tkice-tkairc) + thk(c,j) = tkairc + (7.75e-5_kind_lake *bw + 1.105e-6_kind_lake*bw*bw)*(tkice-tkairc) end if end do @@ -2894,7 +2904,7 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & else if (j == 0) then tk(c,j) = thk(c,j) else if (j == nlevsoil) then - tk(c,j) = 0._kind_phys + tk(c,j) = 0._kind_lake end if ! For top soil layer. if (j == 1) tktopsoillay(c) = thk(c,j) @@ -2916,7 +2926,7 @@ subroutine SoilThermProp_Lake (snl,dz,zi,z,t_soisno,h2osoi_liq,h2osoi_ice, & ! cv(c,j) = (h2osoi_ice(c,j)*cpice + h2osoi_liq(c,j)*cpliq) ! endif ! if (j == 1) then - ! if (snl(c)+1 == 1 .AND. h2osno(c) > 0._kind_phys) then + ! if (snl(c)+1 == 1 .AND. h2osno(c) > 0._kind_lake) then ! cv(c,j) = cv(c,j) + cpice*h2osno(c) ! end if ! end if @@ -2983,38 +2993,38 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i !in: integer , intent(in) :: snl(1) !number of snow layers - real(kind_phys), intent(inout) :: h2osno(1) !snow water (mm H2O) - real(kind_phys), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !layer thickness (m) - real(kind_phys), intent(in) :: dz_lake(1,nlevlake) !lake layer thickness (m) + real(kind_lake), intent(inout) :: h2osno(1) !snow water (mm H2O) + real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !layer thickness (m) + real(kind_lake), intent(in) :: dz_lake(1,nlevlake) !lake layer thickness (m) ! Needed in case snow height is less than critical value. !inout: - real(kind_phys), intent(inout) :: snowdp(1) !snow height (m) - real(kind_phys), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) - real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) - real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_phys), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen - real(kind_phys), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + real(kind_lake), intent(inout) :: snowdp(1) !snow height (m) + real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_lake), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) !out: - real(kind_phys), intent(out) :: qflx_snomelt(1) !snow melt (mm H2O /s) - real(kind_phys), intent(out) :: eflx_snomelt(1) !snow melt heat flux (W/m**2) + real(kind_lake), intent(out) :: qflx_snomelt(1) !snow melt (mm H2O /s) + real(kind_lake), intent(out) :: eflx_snomelt(1) !snow melt heat flux (W/m**2) integer, intent(out) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 (new) !What's the sign of this? Is it just output? - real(kind_phys), intent(inout) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) ! heat capacity [J/(m2 K)] - real(kind_phys), intent(inout) :: cv_lake (lbc:ubc,1:nlevlake) ! heat capacity [J/(m2 K)] - real(kind_phys), intent(out):: lhabs(lbc:ubc) ! total per-column latent heat abs. (J/m^2) + real(kind_lake), intent(inout) :: cv(lbc:ubc,-nlevsnow+1:nlevsoil) ! heat capacity [J/(m2 K)] + real(kind_lake), intent(inout) :: cv_lake (lbc:ubc,1:nlevlake) ! heat capacity [J/(m2 K)] + real(kind_lake), intent(out):: lhabs(lbc:ubc) ! total per-column latent heat abs. (J/m^2) ! OTHER LOCAL VARIABLES: integer :: j,c,g !do loop index integer :: fc !lake filtered column indices - real(kind_phys) :: heatavail !available energy for melting or freezing (J/m^2) - real(kind_phys) :: heatrem !energy residual or loss after melting or freezing - real(kind_phys) :: melt !actual melting (+) or freezing (-) [kg/m2] - real(kind_phys), parameter :: smallnumber = 1.e-7_kind_phys !to prevent tiny residuals from rounding error + real(kind_lake) :: heatavail !available energy for melting or freezing (J/m^2) + real(kind_lake) :: heatrem !energy residual or loss after melting or freezing + real(kind_lake) :: melt !actual melting (+) or freezing (-) [kg/m2] + real(kind_lake), parameter :: smallnumber = 1.e-7_kind_lake !to prevent tiny residuals from rounding error logical :: dophasechangeflag !----------------------------------------------------------------------- @@ -3025,9 +3035,9 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i do fc = 1,num_shlakec c = filter_shlakec(fc) - qflx_snomelt(c) = 0._kind_phys - eflx_snomelt(c) = 0._kind_phys - lhabs(c) = 0._kind_phys + qflx_snomelt(c) = 0._kind_lake + eflx_snomelt(c) = 0._kind_lake + lhabs(c) = 0._kind_lake end do do j = -nlevsnow+1,0 @@ -3047,19 +3057,19 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i do fc = 1,num_shlakec c = filter_shlakec(fc) - if (snl(c) == 0 .and. h2osno(c) > 0._kind_phys .and. t_lake(c,1) > tfrz) then + if (snl(c) == 0 .and. h2osno(c) > 0._kind_lake .and. t_lake(c,1) > tfrz) then heatavail = (t_lake(c,1) - tfrz) * cv_lake(c,1) melt = min(h2osno(c), heatavail/hfus) - heatrem = max(heatavail - melt*hfus, 0._kind_phys) + heatrem = max(heatavail - melt*hfus, 0._kind_lake) !catch small negative value to keep t at tfrz t_lake(c,1) = tfrz + heatrem/(cv_lake(c,1)) - snowdp(c) = snowdp(c)*(1._kind_phys - melt/h2osno(c)) + snowdp(c) = snowdp(c)*(1._kind_lake - melt/h2osno(c)) h2osno(c) = h2osno(c) - melt lhabs(c) = lhabs(c) + melt*hfus qflx_snomelt(c) = qflx_snomelt(c) + melt ! Prevent tiny residuals - if (h2osno(c) < smallnumber) h2osno(c) = 0._kind_phys - if (snowdp(c) < smallnumber) snowdp(c) = 0._kind_phys + if (h2osno(c) < smallnumber) h2osno(c) = 0._kind_lake + if (snowdp(c) < smallnumber) snowdp(c) = 0._kind_lake end if end do @@ -3072,19 +3082,19 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i c = filter_shlakec(fc) dophasechangeflag = .false. - if (t_lake(c,j) > tfrz .and. lake_icefrac(c,j) > 0._kind_phys) then ! melting + if (t_lake(c,j) > tfrz .and. lake_icefrac(c,j) > 0._kind_lake) then ! melting dophasechangeflag = .true. heatavail = (t_lake(c,j) - tfrz) * cv_lake(c,j) melt = min(lake_icefrac(c,j)*denh2o*dz_lake(c,j), heatavail/hfus) !denh2o is used because layer thickness is not adjusted for freezing - heatrem = max(heatavail - melt*hfus, 0._kind_phys) + heatrem = max(heatavail - melt*hfus, 0._kind_lake) !catch small negative value to keep t at tfrz - else if (t_lake(c,j) < tfrz .and. lake_icefrac(c,j) < 1._kind_phys) then !freezing + else if (t_lake(c,j) < tfrz .and. lake_icefrac(c,j) < 1._kind_lake) then !freezing dophasechangeflag = .true. heatavail = (t_lake(c,j) - tfrz) * cv_lake(c,j) - melt = max(-(1._kind_phys-lake_icefrac(c,j))*denh2o*dz_lake(c,j), heatavail/hfus) + melt = max(-(1._kind_lake-lake_icefrac(c,j))*denh2o*dz_lake(c,j), heatavail/hfus) !denh2o is used because layer thickness is not adjusted for freezing - heatrem = min(heatavail - melt*hfus, 0._kind_phys) + heatrem = min(heatavail - melt*hfus, 0._kind_lake) !catch small positive value to keep t at tfrz end if ! Update temperature and ice fraction. @@ -3095,8 +3105,8 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i cv_lake(c,j) = cv_lake(c,j) + melt*(cpliq-cpice) t_lake(c,j) = tfrz + heatrem/cv_lake(c,j) ! Prevent tiny residuals - if (lake_icefrac(c,j) > 1._kind_phys - smallnumber) lake_icefrac(c,j) = 1._kind_phys - if (lake_icefrac(c,j) < smallnumber) lake_icefrac(c,j) = 0._kind_phys + if (lake_icefrac(c,j) > 1._kind_lake - smallnumber) lake_icefrac(c,j) = 1._kind_lake + if (lake_icefrac(c,j) < smallnumber) lake_icefrac(c,j) = 0._kind_lake end if end do end do @@ -3112,21 +3122,21 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i if (j >= snl(c) + 1) then - if (t_soisno(c,j) > tfrz .and. h2osoi_ice(c,j) > 0._kind_phys) then ! melting + if (t_soisno(c,j) > tfrz .and. h2osoi_ice(c,j) > 0._kind_lake) then ! melting dophasechangeflag = .true. heatavail = (t_soisno(c,j) - tfrz) * cv(c,j) melt = min(h2osoi_ice(c,j), heatavail/hfus) - heatrem = max(heatavail - melt*hfus, 0._kind_phys) + heatrem = max(heatavail - melt*hfus, 0._kind_lake) !catch small negative value to keep t at tfrz if (j <= 0) then !snow imelt(c,j) = 1 qflx_snomelt(c) = qflx_snomelt(c) + melt end if - else if (t_soisno(c,j) < tfrz .and. h2osoi_liq(c,j) > 0._kind_phys) then !freezing + else if (t_soisno(c,j) < tfrz .and. h2osoi_liq(c,j) > 0._kind_lake) then !freezing dophasechangeflag = .true. heatavail = (t_soisno(c,j) - tfrz) * cv(c,j) melt = max(-h2osoi_liq(c,j), heatavail/hfus) - heatrem = min(heatavail - melt*hfus, 0._kind_phys) + heatrem = min(heatavail - melt*hfus, 0._kind_lake) !catch small positive value to keep t at tfrz if (j <= 0) then !snow imelt(c,j) = 2 @@ -3145,8 +3155,8 @@ subroutine PhaseChange_Lake (snl,h2osno,dz,dz_lake, & !i cv(c,j) = cv(c,j) + melt*(cpliq-cpice) t_soisno(c,j) = tfrz + heatrem/cv(c,j) ! Prevent tiny residuals - if (h2osoi_ice(c,j) < smallnumber) h2osoi_ice(c,j) = 0._kind_phys - if (h2osoi_liq(c,j) < smallnumber) h2osoi_liq(c,j) = 0._kind_phys + if (h2osoi_ice(c,j) < smallnumber) h2osoi_ice(c,j) = 0._kind_lake + if (h2osoi_liq(c,j) < smallnumber) h2osoi_liq(c,j) = 0._kind_lake end if end if @@ -3226,88 +3236,88 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & integer, intent(inout) :: errflg character(*), intent(inout) :: errmsg - real(kind_phys) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) - real(kind_phys) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] - real(kind_phys) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] - real(kind_phys) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) - real(kind_phys) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) + real(kind_lake) :: watsat(1,nlevsoil) ! volumetric soil water at saturation (porosity) + real(kind_lake) :: tksatu(1,nlevsoil) ! thermal conductivity, saturated soil [W/m-K] + real(kind_lake) :: tkmg(1,nlevsoil) ! thermal conductivity, soil minerals [W/m-K] + real(kind_lake) :: tkdry(1,nlevsoil) ! thermal conductivity, dry soil (W/m/Kelvin) + real(kind_lake) :: csol(1,nlevsoil) ! heat capacity, soil solids (J/m**3/Kelvin) ! integer , intent(in) :: clandunit(1) ! column's landunit ! integer , intent(in) :: ityplun(1) ! landunit type - real(kind_phys), intent(in) :: dtime ! timestep - real(kind_phys), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) - real(kind_phys), intent(in) :: forc_rain(1) ! rain rate [mm/s] - real(kind_phys), intent(in) :: forc_snow(1) ! snow rate [mm/s] - real(kind_phys), intent(in) :: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg - real(kind_phys), intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) + real(kind_lake), intent(in) :: dtime ! timestep + real(kind_lake), intent(in) :: dz_lake(1,nlevlake) ! layer thickness for lake (m) + real(kind_lake), intent(in) :: forc_rain(1) ! rain rate [mm/s] + real(kind_lake), intent(in) :: forc_snow(1) ! snow rate [mm/s] + real(kind_lake), intent(in) :: qflx_evap_tot(1) ! qflx_evap_soi + qflx_evap_veg + qflx_tran_veg + real(kind_lake), intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) - !real(kind_phys), intent(in),optional :: flfall(1) ! fraction of liquid water within falling precipitation (unused) + !real(kind_lake), intent(in),optional :: flfall(1) ! fraction of liquid water within falling precipitation (unused) logical , intent(in) :: do_capsnow(1) ! true => do snow capping - real(kind_phys), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) - real(kind_phys), intent(in) :: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) - real(kind_phys), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) + real(kind_lake), intent(in) :: t_grnd(1) ! ground temperature (Kelvin) + real(kind_lake), intent(in) :: qflx_evap_soi(1) ! soil evaporation (mm H2O/s) (+ = to atm) + real(kind_lake), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 !inout: - real(kind_phys), intent(inout) :: begwb(1) ! water mass begining of the time step + real(kind_lake), intent(inout) :: begwb(1) ! water mass begining of the time step ! inout: - real(kind_phys), intent(inout) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) - real(kind_phys), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness depth (m) - real(kind_phys), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) ! interface depth (m) + real(kind_lake), intent(inout) :: z(1,-nlevsnow+1:nlevsoil) ! layer depth (m) + real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) ! layer thickness depth (m) + real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) ! interface depth (m) integer , intent(inout) :: snl(1) ! number of snow layers - real(kind_phys), intent(inout) :: h2osno(1) ! snow water (mm H2O) - real(kind_phys), intent(inout) :: snowdp(1) ! snow height (m) - real(kind_phys), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen - real(kind_phys), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osno(1) ! snow water (mm H2O) + real(kind_lake), intent(inout) :: snowdp(1) ! snow height (m) + real(kind_lake), intent(inout) :: lake_icefrac(1,nlevlake) ! mass fraction of lake layer that is frozen + real(kind_lake), intent(inout) :: t_lake(1,nlevlake) ! lake temperature (Kelvin) - real(kind_phys), intent(inout) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water + real(kind_lake), intent(inout) :: frac_iceold(1,-nlevsnow+1:nlevsoil) ! fraction of ice relative to the tot water ! out: - real(kind_phys), intent(out) :: endwb(1) ! water mass end of the time step - real(kind_phys), intent(out) :: snowage(1) ! non dimensional snow age [-] - real(kind_phys), intent(out) :: snowice(1) ! average snow ice lens - real(kind_phys), intent(out) :: snowliq(1) ! average snow liquid water - real(kind_phys), intent(out) :: t_snow(1) ! vertically averaged snow temperature - real(kind_phys), intent(out) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! snow temperature (Kelvin) - real(kind_phys), intent(out) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) - real(kind_phys), intent(out) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) - real(kind_phys), intent(out) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] - real(kind_phys), intent(out) :: qflx_drain(1) ! sub-surface runoff (mm H2O /s) - real(kind_phys), intent(out) :: qflx_surf(1) ! surface runoff (mm H2O /s) - real(kind_phys), intent(out) :: qflx_infl(1) ! infiltration (mm H2O /s) - real(kind_phys), intent(out) :: qflx_qrgwl(1) ! qflx_surf at glaciers, wetlands, lakes - real(kind_phys), intent(out) :: qcharge(1) ! aquifer recharge rate (mm/s) - real(kind_phys), intent(out) :: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] - real(kind_phys), intent(out) :: qflx_snowcap(1) ! excess precipitation due to snow capping (mm H2O /s) [+] - real(kind_phys), intent(out) :: qflx_snowcap_col(1) ! excess precipitation due to snow capping (mm H2O /s) [+] - real(kind_phys), intent(out) :: qflx_snow_grnd_pft(1) ! snow on ground after interception (mm H2O/s) [+] - real(kind_phys), intent(out) :: qflx_snow_grnd_col(1) ! snow on ground after interception (mm H2O/s) [+] - real(kind_phys), intent(out) :: qflx_rain_grnd(1) ! rain on ground after interception (mm H2O/s) [+] - real(kind_phys), intent(out) :: qflx_evap_tot_col(1) !pft quantity averaged to the column (assuming one pft) - real(kind_phys) ,intent(out) :: soilalpha(1) !factor that reduces ground saturated specific humidity (-) - real(kind_phys), intent(out) :: zwt(1) !water table depth - real(kind_phys), intent(out) :: fcov(1) !fractional area with water table at surface - real(kind_phys), intent(out) :: rootr_column(1,1:nlevsoil) !effective fraction of roots in each soil layer - real(kind_phys), intent(out) :: qflx_evap_grnd(1) ! ground surface evaporation rate (mm H2O/s) [+] - real(kind_phys), intent(out) :: qflx_sub_snow(1) ! sublimation rate from snow pack (mm H2O /s) [+] - real(kind_phys), intent(out) :: qflx_dew_snow(1) ! surface dew added to snow pack (mm H2O /s) [+] - real(kind_phys), intent(out) :: qflx_dew_grnd(1) ! ground surface dew formation (mm H2O /s) [+] - real(kind_phys), intent(out) :: qflx_rain_grnd_col(1) !rain on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(out) :: endwb(1) ! water mass end of the time step + real(kind_lake), intent(out) :: snowage(1) ! non dimensional snow age [-] + real(kind_lake), intent(out) :: snowice(1) ! average snow ice lens + real(kind_lake), intent(out) :: snowliq(1) ! average snow liquid water + real(kind_lake), intent(out) :: t_snow(1) ! vertically averaged snow temperature + real(kind_lake), intent(out) :: t_soisno(1,-nlevsnow+1:nlevsoil) ! snow temperature (Kelvin) + real(kind_lake), intent(out) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) ! ice lens (kg/m2) + real(kind_lake), intent(out) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) ! liquid water (kg/m2) + real(kind_lake), intent(out) :: h2osoi_vol(1,-nlevsnow+1:nlevsoil) ! volumetric soil water (0<=h2osoi_vol<=watsat)[m3/m3] + real(kind_lake), intent(out) :: qflx_drain(1) ! sub-surface runoff (mm H2O /s) + real(kind_lake), intent(out) :: qflx_surf(1) ! surface runoff (mm H2O /s) + real(kind_lake), intent(out) :: qflx_infl(1) ! infiltration (mm H2O /s) + real(kind_lake), intent(out) :: qflx_qrgwl(1) ! qflx_surf at glaciers, wetlands, lakes + real(kind_lake), intent(out) :: qcharge(1) ! aquifer recharge rate (mm/s) + real(kind_lake), intent(out) :: qflx_prec_grnd(1) ! water onto ground including canopy runoff [kg/(m2 s)] + real(kind_lake), intent(out) :: qflx_snowcap(1) ! excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_snowcap_col(1) ! excess precipitation due to snow capping (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_snow_grnd_pft(1) ! snow on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(out) :: qflx_snow_grnd_col(1) ! snow on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(out) :: qflx_rain_grnd(1) ! rain on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(out) :: qflx_evap_tot_col(1) !pft quantity averaged to the column (assuming one pft) + real(kind_lake) ,intent(out) :: soilalpha(1) !factor that reduces ground saturated specific humidity (-) + real(kind_lake), intent(out) :: zwt(1) !water table depth + real(kind_lake), intent(out) :: fcov(1) !fractional area with water table at surface + real(kind_lake), intent(out) :: rootr_column(1,1:nlevsoil) !effective fraction of roots in each soil layer + real(kind_lake), intent(out) :: qflx_evap_grnd(1) ! ground surface evaporation rate (mm H2O/s) [+] + real(kind_lake), intent(out) :: qflx_sub_snow(1) ! sublimation rate from snow pack (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_dew_snow(1) ! surface dew added to snow pack (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_dew_grnd(1) ! ground surface dew formation (mm H2O /s) [+] + real(kind_lake), intent(out) :: qflx_rain_grnd_col(1) !rain on ground after interception (mm H2O/s) [+] ! Block of biogeochem currently not used. - real(kind_phys), pointer :: sucsat(:,:) ! minimum soil suction (mm) - real(kind_phys), pointer :: bsw(:,:) ! Clapp and Hornberger "b" - real(kind_phys), pointer :: bsw2(:,:) ! Clapp and Hornberger "b" for CN code - real(kind_phys), pointer :: psisat(:,:) ! soil water potential at saturation for CN code (MPa) - real(kind_phys), pointer :: vwcsat(:,:) ! volumetric water content at saturation for CN code (m3/m3) - real(kind_phys), pointer :: wf(:) ! soil water as frac. of whc for top 0.5 m - real(kind_phys), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) + real(kind_lake), pointer :: sucsat(:,:) ! minimum soil suction (mm) + real(kind_lake), pointer :: bsw(:,:) ! Clapp and Hornberger "b" + real(kind_lake), pointer :: bsw2(:,:) ! Clapp and Hornberger "b" for CN code + real(kind_lake), pointer :: psisat(:,:) ! soil water potential at saturation for CN code (MPa) + real(kind_lake), pointer :: vwcsat(:,:) ! volumetric water content at saturation for CN code (m3/m3) + real(kind_lake), pointer :: wf(:) ! soil water as frac. of whc for top 0.5 m + real(kind_lake), pointer :: soilpsi(:,:) ! soil water potential in each soil layer (MPa) ! OTHER LOCAL VARIABLES: @@ -3317,22 +3327,22 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & integer :: num_shlakenosnowc ! number of column non-snow points integer :: filter_shlakenosnowc(ubc-lbc+1) ! column filter for non-snow points integer :: newnode ! flag when new snow node is set, (1=yes, 0=no) - real(kind_phys) :: dz_snowf ! layer thickness rate change due to precipitation [mm/s] - real(kind_phys) :: bifall ! bulk density of newly fallen dry snow [kg/m3] - real(kind_phys) :: fracsnow(lbp:ubp) ! frac of precipitation that is snow - real(kind_phys) :: fracrain(lbp:ubp) ! frac of precipitation that is rain - real(kind_phys) :: qflx_prec_grnd_snow(lbp:ubp) ! snow precipitation incident on ground [mm/s] - real(kind_phys) :: qflx_prec_grnd_rain(lbp:ubp) ! rain precipitation incident on ground [mm/s] - real(kind_phys) :: qflx_evap_soi_lim ! temporary evap_soi limited by top snow layer content [mm/s] - real(kind_phys) :: h2osno_temp ! temporary h2osno [kg/m^2] - real(kind_phys) :: sumsnowice(lbc:ubc) ! sum of snow ice if snow layers found above unfrozen lake [kg/m&2] + real(kind_lake) :: dz_snowf ! layer thickness rate change due to precipitation [mm/s] + real(kind_lake) :: bifall ! bulk density of newly fallen dry snow [kg/m3] + real(kind_lake) :: fracsnow(lbp:ubp) ! frac of precipitation that is snow + real(kind_lake) :: fracrain(lbp:ubp) ! frac of precipitation that is rain + real(kind_lake) :: qflx_prec_grnd_snow(lbp:ubp) ! snow precipitation incident on ground [mm/s] + real(kind_lake) :: qflx_prec_grnd_rain(lbp:ubp) ! rain precipitation incident on ground [mm/s] + real(kind_lake) :: qflx_evap_soi_lim ! temporary evap_soi limited by top snow layer content [mm/s] + real(kind_lake) :: h2osno_temp ! temporary h2osno [kg/m^2] + real(kind_lake) :: sumsnowice(lbc:ubc) ! sum of snow ice if snow layers found above unfrozen lake [kg/m&2] logical :: unfrozen(lbc:ubc) ! true if top lake layer is unfrozen with snow layers above - real(kind_phys) :: heatrem ! used in case above [J/m^2] - real(kind_phys) :: heatsum(lbc:ubc) ! used in case above [J/m^2] - real(kind_phys) :: qflx_top_soil(1) !net water input into soil from top (mm/s) + real(kind_lake) :: heatrem ! used in case above [J/m^2] + real(kind_lake) :: heatsum(lbc:ubc) ! used in case above [J/m^2] + real(kind_lake) :: qflx_top_soil(1) !net water input into soil from top (mm/s) character*256 :: message - real(kind_phys),allocatable :: snow_water(:) ! temporary sum of snow water for Bal Check [kg/m^2] + real(kind_lake),allocatable :: snow_water(:) ! temporary sum of snow water for Bal Check [kg/m^2] !----------------------------------------------------------------------- ! Determine step size @@ -3377,10 +3387,10 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & if (do_capsnow(c)) then qflx_snowcap(p) = qflx_prec_grnd_snow(p) + qflx_prec_grnd_rain(p) - qflx_snow_grnd_pft(p) = 0._kind_phys - qflx_rain_grnd(p) = 0._kind_phys + qflx_snow_grnd_pft(p) = 0._kind_lake + qflx_rain_grnd(p) = 0._kind_lake else - qflx_snowcap(p) = 0._kind_phys + qflx_snowcap(p) = 0._kind_lake qflx_snow_grnd_pft(p) = qflx_prec_grnd_snow(p) ! ice onto ground (mm/s) qflx_rain_grnd(p) = qflx_prec_grnd_rain(p) ! liquid water onto ground (mm/s) end if @@ -3404,14 +3414,14 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & ! Progress Rep. 1, Alta Avalanche Study Center:Snow Layer Densification. if (do_capsnow(c)) then - dz_snowf = 0._kind_phys + dz_snowf = 0._kind_lake else - if (forc_t(g) > tfrz + 2._kind_phys) then - bifall=50._kind_phys + 1.7_kind_phys*(17.0_kind_phys)**1.5_kind_phys - else if (forc_t(g) > tfrz - 15._kind_phys) then - bifall=50._kind_phys + 1.7_kind_phys*(forc_t(g) - tfrz + 15._kind_phys)**1.5_kind_phys + if (forc_t(g) > tfrz + 2._kind_lake) then + bifall=50._kind_lake + 1.7_kind_lake*(17.0_kind_lake)**1.5_kind_lake + else if (forc_t(g) > tfrz - 15._kind_lake) then + bifall=50._kind_lake + 1.7_kind_lake*(forc_t(g) - tfrz + 15._kind_lake)**1.5_kind_lake else - bifall=50._kind_phys + bifall=50._kind_lake end if dz_snowf = qflx_snow_grnd_col(c)/bifall snowdp(c) = snowdp(c) + dz_snowf*dtime @@ -3419,9 +3429,9 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & end if ! if (itype(l)==istwet .and. t_grnd(c)>tfrz) then - ! h2osno(c)=0._kind_phys - ! snowdp(c)=0._kind_phys - ! snowage(c)=0._kind_phys + ! h2osno(c)=0._kind_lake + ! snowdp(c)=0._kind_lake + ! snowage(c)=0._kind_lake ! end if ! Take care of this later in function. @@ -3430,17 +3440,17 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & ! as the surface air temperature newnode = 0 ! flag for when snow node will be initialized - if (snl(c) == 0 .and. qflx_snow_grnd_col(c) > 0.0_kind_phys .and. snowdp(c) >= 0.01_kind_phys) then + if (snl(c) == 0 .and. qflx_snow_grnd_col(c) > 0.0_kind_lake .and. snowdp(c) >= 0.01_kind_lake) then newnode = 1 snl(c) = -1 dz(c,0) = snowdp(c) ! meter - z(c,0) = -0.5_kind_phys*dz(c,0) + z(c,0) = -0.5_kind_lake*dz(c,0) zi(c,-1) = -dz(c,0) - snowage(c) = 0._kind_phys ! snow age + snowage(c) = 0._kind_lake ! snow age t_soisno(c,0) = min(tfrz, forc_t(g)) ! K h2osoi_ice(c,0) = h2osno(c) ! kg/m2 - h2osoi_liq(c,0) = 0._kind_phys ! kg/m2 - frac_iceold(c,0) = 1._kind_phys + h2osoi_liq(c,0) = 0._kind_lake ! kg/m2 + frac_iceold(c,0) = 1._kind_lake end if ! The change of ice partial density of surface node due to precipitation. @@ -3464,26 +3474,26 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & jtop = snl(c)+1 ! Use column variables here - qflx_evap_grnd(c) = 0._kind_phys - qflx_sub_snow(c) = 0._kind_phys - qflx_dew_snow(c) = 0._kind_phys - qflx_dew_grnd(c) = 0._kind_phys + qflx_evap_grnd(c) = 0._kind_lake + qflx_sub_snow(c) = 0._kind_lake + qflx_dew_snow(c) = 0._kind_lake + qflx_dew_grnd(c) = 0._kind_lake if (jtop <= 0) then ! snow layers j = jtop ! Assign ground evaporation to sublimation from soil ice or to dew ! on snow or ground - if (qflx_evap_soi(p) >= 0._kind_phys) then + if (qflx_evap_soi(p) >= 0._kind_lake) then ! for evaporation partitioning between liquid evap and ice sublimation, ! use the ratio of liquid to (liquid+ice) in the top layer to determine split ! Since we're not limiting evap over lakes, but still can't remove more from top ! snow layer than there is there, create temp. limited evap_soi. qflx_evap_soi_lim = min(qflx_evap_soi(p), (h2osoi_liq(c,j)+h2osoi_ice(c,j))/dtime) - if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0._kind_phys) then - qflx_evap_grnd(c) = max(qflx_evap_soi_lim*(h2osoi_liq(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._kind_phys) + if ((h2osoi_liq(c,j)+h2osoi_ice(c,j)) > 0._kind_lake) then + qflx_evap_grnd(c) = max(qflx_evap_soi_lim*(h2osoi_liq(c,j)/(h2osoi_liq(c,j)+h2osoi_ice(c,j))), 0._kind_lake) else - qflx_evap_grnd(c) = 0._kind_phys + qflx_evap_grnd(c) = 0._kind_lake end if qflx_sub_snow(c) = qflx_evap_soi_lim - qflx_evap_grnd(c) else @@ -3499,13 +3509,13 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & if (do_capsnow(c)) qflx_snowcap(p) = qflx_snowcap(p) + qflx_dew_snow(c) + qflx_dew_grnd(c) else ! No snow layers: do as in HydrologyLake but with actual clmtype variables - if (qflx_evap_soi(p) >= 0._kind_phys) then + if (qflx_evap_soi(p) >= 0._kind_lake) then ! Sublimation: do not allow for more sublimation than there is snow ! after melt. Remaining surface evaporation used for infiltration. qflx_sub_snow(c) = min(qflx_evap_soi(p), h2osno(c)/dtime) qflx_evap_grnd(c) = qflx_evap_soi(p) - qflx_sub_snow(c) else - if (t_grnd(c) < tfrz-0.1_kind_phys) then + if (t_grnd(c) < tfrz-0.1_kind_lake) then qflx_dew_snow(c) = abs(qflx_evap_soi(p)) else qflx_dew_grnd(c) = abs(qflx_evap_soi(p)) @@ -3520,16 +3530,16 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & else h2osno(c) = h2osno(c) + (-qflx_sub_snow(c)+qflx_dew_snow(c))*dtime end if - if (h2osno_temp > 0._kind_phys) then + if (h2osno_temp > 0._kind_lake) then snowdp(c) = snowdp(c) * h2osno(c) / h2osno_temp else snowdp(c) = h2osno(c)/snow_bd !Assume a constant snow bulk density = 250. end if if (PERGRO) then - if (abs(h2osno(c)) < 1.e-10_kind_phys) h2osno(c) = 0._kind_phys + if (abs(h2osno(c)) < 1.e-10_kind_lake) h2osno(c) = 0._kind_lake else - h2osno(c) = max(h2osno(c), 0._kind_phys) + h2osno(c) = max(h2osno(c), 0._kind_lake) endif end if @@ -3611,7 +3621,7 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & do fc = 1, num_shlakesnowc c = filter_shlakesnowc(fc) - h2osno(c) = 0._kind_phys + h2osno(c) = 0._kind_lake end do do j = -nlevsnow+1,0 do fc = 1, num_shlakesnowc @@ -3634,7 +3644,7 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & do fc = 1, num_shlakec c = filter_shlakec(fc) - if (t_lake(c,1) > tfrz .and. lake_icefrac(c,1) == 0._kind_phys .and. snl(c) < 0) then + if (t_lake(c,1) > tfrz .and. lake_icefrac(c,1) == 0._kind_lake .and. snl(c) < 0) then unfrozen(c) = .true. else unfrozen(c) = .false. @@ -3649,8 +3659,8 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & if (unfrozen(c)) then if (j == -nlevsnow+1) then - sumsnowice(c) = 0._kind_phys - heatsum(c) = 0._kind_phys + sumsnowice(c) = 0._kind_lake + heatsum(c) = 0._kind_lake end if if (j >= snl(c)+1) then sumsnowice(c) = sumsnowice(c) + h2osoi_ice(c,j) @@ -3670,16 +3680,16 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & heatsum(c) = heatsum(c) + sumsnowice(c)*hfus heatrem = (t_lake(c,1) - tfrz)*cpliq*denh2o*dz_lake(c,1) - heatsum(c) - if (heatrem + denh2o*dz_lake(c,1)*hfus > 0._kind_phys) then + if (heatrem + denh2o*dz_lake(c,1)*hfus > 0._kind_lake) then ! Remove snow and subtract the latent heat from the top layer. - h2osno(c) = 0._kind_phys + h2osno(c) = 0._kind_lake snl(c) = 0 ! The rest of the bookkeeping for the removed snow will be done below. if (LAKEDEBUG) then print *,'Snow layers removed above unfrozen lake for column, snowice:', & c, sumsnowice(c) endif - if (heatrem > 0._kind_phys) then ! simply subtract the heat from the layer + if (heatrem > 0._kind_lake) then ! simply subtract the heat from the layer t_lake(c,1) = t_lake(c,1) - heatrem/(cpliq*denh2o*dz_lake(c,1)) else !freeze part of the layer t_lake(c,1) = tfrz @@ -3697,7 +3707,7 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & do fc = 1, num_shlakesnowc c = filter_shlakesnowc(fc) if (snl(c) == 0) then - snowage(c) = 0._kind_phys + snowage(c) = 0._kind_lake end if end do @@ -3709,12 +3719,12 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & do fc = 1, num_shlakesnowc c = filter_shlakesnowc(fc) if (j <= snl(c) .and. snl(c) > -nlevsnow) then - h2osoi_ice(c,j) = 0._kind_phys - h2osoi_liq(c,j) = 0._kind_phys - t_soisno(c,j) = 0._kind_phys - dz(c,j) = 0._kind_phys - z(c,j) = 0._kind_phys - zi(c,j-1) = 0._kind_phys + h2osoi_ice(c,j) = 0._kind_lake + h2osoi_liq(c,j) = 0._kind_lake + t_soisno(c,j) = 0._kind_lake + dz(c,j) = 0._kind_lake + z(c,j) = 0._kind_lake + zi(c,j-1) = 0._kind_lake end if end do end do @@ -3731,9 +3741,9 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & !cdir nodep do fc = 1, num_shlakesnowc c = filter_shlakesnowc(fc) - t_snow(c) = 0._kind_phys - snowice(c) = 0._kind_phys - snowliq(c) = 0._kind_phys + t_snow(c) = 0._kind_lake + snowice(c) = 0._kind_lake + snowliq(c) = 0._kind_lake end do !dir$ concurrent !cdir nodep @@ -3788,10 +3798,10 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & c = filter_shlakec(fc) jtop = snl(c)+1 - if(j == jtop) snow_water(c) = 0._kind_phys + if(j == jtop) snow_water(c) = 0._kind_lake if(j >= jtop) then snow_water(c) = snow_water(c) + h2osoi_ice(c,j) + h2osoi_liq(c,j) - if(j == 0 .and. abs(snow_water(c)-h2osno(c))>1.e-7_kind_phys) then + if(j == 0 .and. abs(snow_water(c)-h2osno(c))>1.e-7_kind_lake) then write(message,*)'h2osno does not equal sum of snow layers in ShalLakeHydrology:', & 'column, h2osno, sum of snow layers =', c, h2osno(c), snow_water(c) ! errmsg=trim(message) @@ -3813,9 +3823,9 @@ subroutine ShalLakeHydrology(dz_lake,forc_rain,forc_snow, & c = pcolumn(p) g = pgridcell(p) - qflx_infl(c) = 0._kind_phys - qflx_surf(c) = 0._kind_phys - qflx_drain(c) = 0._kind_phys + qflx_infl(c) = 0._kind_lake + qflx_surf(c) = 0._kind_lake + qflx_drain(c) = 0._kind_lake rootr_column(c,:) = spval soilalpha(c) = spval zwt(c) = spval @@ -3849,12 +3859,12 @@ subroutine QSat (T, p, es, esdT, qs, qsdT) ! ! !ARGUMENTS: implicit none - real(kind_phys), intent(in) :: T ! temperature (K) - real(kind_phys), intent(in) :: p ! surface atmospheric pressure (pa) - real(kind_phys), intent(out) :: es ! vapor pressure (pa) - real(kind_phys), intent(out) :: esdT ! d(es)/d(T) - real(kind_phys), intent(out) :: qs ! humidity (kg/kg) - real(kind_phys), intent(out) :: qsdT ! d(qs)/d(T) + real(kind_lake), intent(in) :: T ! temperature (K) + real(kind_lake), intent(in) :: p ! surface atmospheric pressure (pa) + real(kind_lake), intent(out) :: es ! vapor pressure (pa) + real(kind_lake), intent(out) :: esdT ! d(es)/d(T) + real(kind_lake), intent(out) :: qs ! humidity (kg/kg) + real(kind_lake), intent(out) :: qsdT ! d(qs)/d(T) ! ! !CALLED FROM: ! subroutine Biogeophysics1 in module Biogeophysics1Mod @@ -3869,56 +3879,56 @@ subroutine QSat (T, p, es, esdT, qs, qsdT) ! ! !LOCAL VARIABLES: ! - real(kind_phys) :: T_limit - real(kind_phys) :: td,vp,vp1,vp2 + real(kind_lake) :: T_limit + real(kind_lake) :: td,vp,vp1,vp2 ! ! For water vapor (temperature range 0C-100C) ! - real(kind_phys), parameter :: a0 = 6.11213476 - real(kind_phys), parameter :: a1 = 0.444007856 - real(kind_phys), parameter :: a2 = 0.143064234e-01 - real(kind_phys), parameter :: a3 = 0.264461437e-03 - real(kind_phys), parameter :: a4 = 0.305903558e-05 - real(kind_phys), parameter :: a5 = 0.196237241e-07 - real(kind_phys), parameter :: a6 = 0.892344772e-10 - real(kind_phys), parameter :: a7 = -0.373208410e-12 - real(kind_phys), parameter :: a8 = 0.209339997e-15 + real(kind_lake), parameter :: a0 = 6.11213476 + real(kind_lake), parameter :: a1 = 0.444007856 + real(kind_lake), parameter :: a2 = 0.143064234e-01 + real(kind_lake), parameter :: a3 = 0.264461437e-03 + real(kind_lake), parameter :: a4 = 0.305903558e-05 + real(kind_lake), parameter :: a5 = 0.196237241e-07 + real(kind_lake), parameter :: a6 = 0.892344772e-10 + real(kind_lake), parameter :: a7 = -0.373208410e-12 + real(kind_lake), parameter :: a8 = 0.209339997e-15 ! ! For derivative:water vapor ! - real(kind_phys), parameter :: b0 = 0.444017302 - real(kind_phys), parameter :: b1 = 0.286064092e-01 - real(kind_phys), parameter :: b2 = 0.794683137e-03 - real(kind_phys), parameter :: b3 = 0.121211669e-04 - real(kind_phys), parameter :: b4 = 0.103354611e-06 - real(kind_phys), parameter :: b5 = 0.404125005e-09 - real(kind_phys), parameter :: b6 = -0.788037859e-12 - real(kind_phys), parameter :: b7 = -0.114596802e-13 - real(kind_phys), parameter :: b8 = 0.381294516e-16 + real(kind_lake), parameter :: b0 = 0.444017302 + real(kind_lake), parameter :: b1 = 0.286064092e-01 + real(kind_lake), parameter :: b2 = 0.794683137e-03 + real(kind_lake), parameter :: b3 = 0.121211669e-04 + real(kind_lake), parameter :: b4 = 0.103354611e-06 + real(kind_lake), parameter :: b5 = 0.404125005e-09 + real(kind_lake), parameter :: b6 = -0.788037859e-12 + real(kind_lake), parameter :: b7 = -0.114596802e-13 + real(kind_lake), parameter :: b8 = 0.381294516e-16 ! ! For ice (temperature range -75C-0C) ! - real(kind_phys), parameter :: c0 = 6.11123516 - real(kind_phys), parameter :: c1 = 0.503109514 - real(kind_phys), parameter :: c2 = 0.188369801e-01 - real(kind_phys), parameter :: c3 = 0.420547422e-03 - real(kind_phys), parameter :: c4 = 0.614396778e-05 - real(kind_phys), parameter :: c5 = 0.602780717e-07 - real(kind_phys), parameter :: c6 = 0.387940929e-09 - real(kind_phys), parameter :: c7 = 0.149436277e-11 - real(kind_phys), parameter :: c8 = 0.262655803e-14 + real(kind_lake), parameter :: c0 = 6.11123516 + real(kind_lake), parameter :: c1 = 0.503109514 + real(kind_lake), parameter :: c2 = 0.188369801e-01 + real(kind_lake), parameter :: c3 = 0.420547422e-03 + real(kind_lake), parameter :: c4 = 0.614396778e-05 + real(kind_lake), parameter :: c5 = 0.602780717e-07 + real(kind_lake), parameter :: c6 = 0.387940929e-09 + real(kind_lake), parameter :: c7 = 0.149436277e-11 + real(kind_lake), parameter :: c8 = 0.262655803e-14 ! ! For derivative:ice ! - real(kind_phys), parameter :: d0 = 0.503277922 - real(kind_phys), parameter :: d1 = 0.377289173e-01 - real(kind_phys), parameter :: d2 = 0.126801703e-02 - real(kind_phys), parameter :: d3 = 0.249468427e-04 - real(kind_phys), parameter :: d4 = 0.313703411e-06 - real(kind_phys), parameter :: d5 = 0.257180651e-08 - real(kind_phys), parameter :: d6 = 0.133268878e-10 - real(kind_phys), parameter :: d7 = 0.394116744e-13 - real(kind_phys), parameter :: d8 = 0.498070196e-16 + real(kind_lake), parameter :: d0 = 0.503277922 + real(kind_lake), parameter :: d1 = 0.377289173e-01 + real(kind_lake), parameter :: d2 = 0.126801703e-02 + real(kind_lake), parameter :: d3 = 0.249468427e-04 + real(kind_lake), parameter :: d4 = 0.313703411e-06 + real(kind_lake), parameter :: d5 = 0.257180651e-08 + real(kind_lake), parameter :: d6 = 0.133268878e-10 + real(kind_lake), parameter :: d7 = 0.394116744e-13 + real(kind_lake), parameter :: d8 = 0.498070196e-16 !----------------------------------------------------------------------- T_limit = T - tfrz @@ -3964,11 +3974,11 @@ subroutine Tridiagonal (lbc, ubc, lbj, ubj, jtop, numf, filter, & integer , intent(in) :: jtop(lbc:ubc) ! top level for each column integer , intent(in) :: numf ! filter dimension integer , intent(in) :: filter(1:numf) ! filter - real(kind_phys), intent(in) :: a(lbc:ubc, lbj:ubj) ! "a" left off diagonal of tridiagonal matrix - real(kind_phys), intent(in) :: b(lbc:ubc, lbj:ubj) ! "b" diagonal column for tridiagonal matrix - real(kind_phys), intent(in) :: c(lbc:ubc, lbj:ubj) ! "c" right off diagonal tridiagonal matrix - real(kind_phys), intent(in) :: r(lbc:ubc, lbj:ubj) ! "r" forcing term of tridiagonal matrix - real(kind_phys), intent(inout) :: u(lbc:ubc, lbj:ubj) ! solution + real(kind_lake), intent(in) :: a(lbc:ubc, lbj:ubj) ! "a" left off diagonal of tridiagonal matrix + real(kind_lake), intent(in) :: b(lbc:ubc, lbj:ubj) ! "b" diagonal column for tridiagonal matrix + real(kind_lake), intent(in) :: c(lbc:ubc, lbj:ubj) ! "c" right off diagonal tridiagonal matrix + real(kind_lake), intent(in) :: r(lbc:ubc, lbj:ubj) ! "r" forcing term of tridiagonal matrix + real(kind_lake), intent(inout) :: u(lbc:ubc, lbj:ubj) ! solution ! ! !CALLED FROM: ! subroutine BiogeophysicsLake in module BiogeophysicsLakeMod @@ -3985,8 +3995,8 @@ subroutine Tridiagonal (lbc, ubc, lbj, ubj, jtop, numf, filter, & ! !OTHER LOCAL VARIABLES: ! integer :: j,ci,fc !indices - real(kind_phys) :: gam(lbc:ubc,lbj:ubj) !temporary - real(kind_phys) :: bet(lbc:ubc) !temporary + real(kind_lake) :: gam(lbc:ubc,lbj:ubj) !temporary + real(kind_lake) :: bet(lbc:ubc) !temporary !----------------------------------------------------------------------- ! Solve the matrix @@ -4073,35 +4083,35 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i integer , intent(in) :: snl(1) !number of snow layers logical , intent(in) :: do_capsnow(1) !true => do snow capping - real(kind_phys), intent(in) :: dtime !timestep - real(kind_phys), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) - real(kind_phys), intent(in) :: qflx_rain_grnd(1) !rain on ground after interception (mm H2O/s) [+] - real(kind_phys), intent(in) :: qflx_sub_snow(1) !sublimation rate from snow pack (mm H2O /s) [+] - real(kind_phys), intent(in) :: qflx_evap_grnd(1) !ground surface evaporation rate (mm H2O/s) [+] - real(kind_phys), intent(in) :: qflx_dew_snow(1) !surface dew added to snow pack (mm H2O /s) [+] - real(kind_phys), intent(in) :: qflx_dew_grnd(1) !ground surface dew formation (mm H2O /s) [+] - real(kind_phys), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + real(kind_lake), intent(in) :: dtime !timestep + real(kind_lake), intent(in) :: qflx_snomelt(1) !snow melt (mm H2O /s) + real(kind_lake), intent(in) :: qflx_rain_grnd(1) !rain on ground after interception (mm H2O/s) [+] + real(kind_lake), intent(in) :: qflx_sub_snow(1) !sublimation rate from snow pack (mm H2O /s) [+] + real(kind_lake), intent(in) :: qflx_evap_grnd(1) !ground surface evaporation rate (mm H2O/s) [+] + real(kind_lake), intent(in) :: qflx_dew_snow(1) !surface dew added to snow pack (mm H2O /s) [+] + real(kind_lake), intent(in) :: qflx_dew_grnd(1) !ground surface dew formation (mm H2O /s) [+] + real(kind_lake), intent(in) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) !inout: - real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) !out: - real(kind_phys), intent(out) :: qflx_top_soil(1) !net water input into soil from top (mm/s) + real(kind_lake), intent(out) :: qflx_top_soil(1) !net water input into soil from top (mm/s) ! OTHER LOCAL VARIABLES: integer :: c, j, fc !do loop/array indices - real(kind_phys) :: qin(lbc:ubc) !water flow into the elmement (mm/s) - real(kind_phys) :: qout(lbc:ubc) !water flow out of the elmement (mm/s) - real(kind_phys) :: wgdif !ice mass after minus sublimation - real(kind_phys) :: vol_liq(lbc:ubc,-nlevsnow+1:0) !partial volume of liquid water in layer - real(kind_phys) :: vol_ice(lbc:ubc,-nlevsnow+1:0) !partial volume of ice lens in layer - real(kind_phys) :: eff_porosity(lbc:ubc,-nlevsnow+1:0) !effective porosity = porosity - vol_ice + real(kind_lake) :: qin(lbc:ubc) !water flow into the elmement (mm/s) + real(kind_lake) :: qout(lbc:ubc) !water flow out of the elmement (mm/s) + real(kind_lake) :: wgdif !ice mass after minus sublimation + real(kind_lake) :: vol_liq(lbc:ubc,-nlevsnow+1:0) !partial volume of liquid water in layer + real(kind_lake) :: vol_ice(lbc:ubc,-nlevsnow+1:0) !partial volume of ice lens in layer + real(kind_lake) :: eff_porosity(lbc:ubc,-nlevsnow+1:0) !effective porosity = porosity - vol_ice !----------------------------------------------------------------------- ! Renew the mass of ice lens (h2osoi_ice) and liquid (h2osoi_liq) in the ! surface snow layer resulting from sublimation (frost) / evaporation (condense) @@ -4128,7 +4138,7 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i h2osoi_liq(c,snl(c)+1) = h2osoi_liq(c,snl(c)+1) + & (qflx_rain_grnd(c) + qflx_dew_grnd(c) - qflx_evap_grnd(c)) * dtime end if - h2osoi_liq(c,snl(c)+1) = max(0._kind_phys, h2osoi_liq(c,snl(c)+1)) + h2osoi_liq(c,snl(c)+1) = max(0._kind_lake, h2osoi_liq(c,snl(c)+1)) end do ! Porosity and partial volume @@ -4139,7 +4149,7 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i do fc = 1, num_snowc c = filter_snowc(fc) if (j >= snl(c)+1) then - vol_ice(c,j) = min(1._kind_phys, h2osoi_ice(c,j)/(dz(c,j)*denice)) + vol_ice(c,j) = min(1._kind_lake, h2osoi_ice(c,j)/(dz(c,j)*denice)) eff_porosity(c,j) = 1. - vol_ice(c,j) vol_liq(c,j) = min(eff_porosity(c,j),h2osoi_liq(c,j)/(dz(c,j)*denh2o)) end if @@ -4154,7 +4164,7 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i ! when the liquid water of layer exceeds the layer's holding ! capacity, the excess meltwater adds to the underlying neighbor layer. - qin(:) = 0._kind_phys + qin(:) = 0._kind_lake do j = -nlevsnow+1, 0 !dir$ concurrent @@ -4166,13 +4176,13 @@ subroutine SnowWater(lbc, ubc, num_snowc, filter_snowc, & !i if (j <= -1) then ! No runoff over snow surface, just ponding on surface if (eff_porosity(c,j) < wimp .OR. eff_porosity(c,j+1) < wimp) then - qout(c) = 0._kind_phys + qout(c) = 0._kind_lake else - qout(c) = max(0._kind_phys,(vol_liq(c,j)-ssi*eff_porosity(c,j))*dz(c,j)) + qout(c) = max(0._kind_lake,(vol_liq(c,j)-ssi*eff_porosity(c,j))*dz(c,j)) qout(c) = min(qout(c),(1.-vol_ice(c,j+1)-vol_liq(c,j+1))*dz(c,j+1)) end if else - qout(c) = max(0._kind_phys,(vol_liq(c,j) - ssi*eff_porosity(c,j))*dz(c,j)) + qout(c) = max(0._kind_lake,(vol_liq(c,j) - ssi*eff_porosity(c,j))*dz(c,j)) end if qout(c) = qout(c)*1000. h2osoi_liq(c,j) = h2osoi_liq(c,j) - qout(c) @@ -4234,43 +4244,43 @@ subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i integer, intent(in) :: filter_snowc(ubc-lbc+1) ! column filter for snow points integer, intent(in) :: snl(1) !number of snow layers integer, intent(in) :: imelt(1,-nlevsnow+1:nlevsoil) !flag for melting (=1), freezing (=2), Not=0 - real(kind_phys), intent(in) :: dtime - real(kind_phys), intent(in) :: frac_iceold(1,-nlevsnow+1:nlevsoil) !fraction of ice relative to the tot water - real(kind_phys), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) - real(kind_phys), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_phys), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + real(kind_lake), intent(in) :: dtime + real(kind_lake), intent(in) :: frac_iceold(1,-nlevsnow+1:nlevsoil) !fraction of ice relative to the tot water + real(kind_lake), intent(in) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) + real(kind_lake), intent(in) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_lake), intent(in) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) !inout: - real(kind_phys), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) ! OTHER LOCAL VARIABLES: integer :: j, c, fc ! indices - real(kind_phys), parameter :: c2 = 23.e-3 ! [m3/kg] - real(kind_phys), parameter :: c3 = 2.777e-6 ! [1/s] - real(kind_phys), parameter :: c4 = 0.04 ! [1/K] - real(kind_phys), parameter :: c5 = 2.0 ! - real(kind_phys), parameter :: dm = 100.0 ! Upper Limit on Destructive Metamorphism Compaction [kg/m3] - real(kind_phys), parameter :: eta0 = 9.e+5 ! The Viscosity Coefficient Eta0 [kg-s/m2] - real(kind_phys) :: burden(lbc:ubc) ! pressure of overlying snow [kg/m2] - real(kind_phys) :: ddz1 ! Rate of settling of snowpack due to destructive metamorphism. - real(kind_phys) :: ddz2 ! Rate of compaction of snowpack due to overburden. - real(kind_phys) :: ddz3 ! Rate of compaction of snowpack due to melt [1/s] - real(kind_phys) :: dexpf ! expf=exp(-c4*(273.15-t_soisno)). - real(kind_phys) :: fi ! Fraction of ice relative to the total water content at current time step - real(kind_phys) :: td ! t_soisno - tfrz [K] - real(kind_phys) :: pdzdtc ! Nodal rate of change in fractional-thickness due to compaction [fraction/s] - real(kind_phys) :: void ! void (1 - vol_ice - vol_liq) - real(kind_phys) :: wx ! water mass (ice+liquid) [kg/m2] - real(kind_phys) :: bi ! partial density of ice [kg/m3] + real(kind_lake), parameter :: c2 = 23.e-3 ! [m3/kg] + real(kind_lake), parameter :: c3 = 2.777e-6 ! [1/s] + real(kind_lake), parameter :: c4 = 0.04 ! [1/K] + real(kind_lake), parameter :: c5 = 2.0 ! + real(kind_lake), parameter :: dm = 100.0 ! Upper Limit on Destructive Metamorphism Compaction [kg/m3] + real(kind_lake), parameter :: eta0 = 9.e+5 ! The Viscosity Coefficient Eta0 [kg-s/m2] + real(kind_lake) :: burden(lbc:ubc) ! pressure of overlying snow [kg/m2] + real(kind_lake) :: ddz1 ! Rate of settling of snowpack due to destructive metamorphism. + real(kind_lake) :: ddz2 ! Rate of compaction of snowpack due to overburden. + real(kind_lake) :: ddz3 ! Rate of compaction of snowpack due to melt [1/s] + real(kind_lake) :: dexpf ! expf=exp(-c4*(273.15-t_soisno)). + real(kind_lake) :: fi ! Fraction of ice relative to the total water content at current time step + real(kind_lake) :: td ! t_soisno - tfrz [K] + real(kind_lake) :: pdzdtc ! Nodal rate of change in fractional-thickness due to compaction [fraction/s] + real(kind_lake) :: void ! void (1 - vol_ice - vol_liq) + real(kind_lake) :: wx ! water mass (ice+liquid) [kg/m2] + real(kind_lake) :: bi ! partial density of ice [kg/m3] !----------------------------------------------------------------------- ! Begin calculation - note that the following column loops are only invoked if snl(c) < 0 - burden(:) = 0._kind_phys + burden(:) = 0._kind_lake do j = -nlevsnow+1, 0 !dir$ concurrent @@ -4305,9 +4315,9 @@ subroutine SnowCompaction(lbc, ubc, num_snowc, filter_snowc, &!i ! Compaction occurring during melt if (imelt(c,j) == 1) then - ddz3 = - 1./dtime * max(0._kind_phys,(frac_iceold(c,j) - fi)/frac_iceold(c,j)) + ddz3 = - 1./dtime * max(0._kind_lake,(frac_iceold(c,j) - fi)/frac_iceold(c,j)) else - ddz3 = 0._kind_phys + ddz3 = 0._kind_lake end if ! Time rate of fractional change in dz (units of s-1) @@ -4362,17 +4372,17 @@ subroutine CombineSnowLayers(lbc, ubc, & !i integer, intent(inout) :: num_snowc ! number of column snow points in column filter integer, intent(inout) :: filter_snowc(ubc-lbc+1) ! column filter for snow points integer , intent(inout) :: snl(1) !number of snow layers - real(kind_phys), intent(inout) :: h2osno(1) !snow water (mm H2O) - real(kind_phys), intent(inout) :: snowdp(1) !snow height (m) - real(kind_phys), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) - real(kind_phys), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !interface level below a "z" level (m) - real(kind_phys), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) - real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + real(kind_lake), intent(inout) :: h2osno(1) !snow water (mm H2O) + real(kind_lake), intent(inout) :: snowdp(1) !snow height (m) + real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !interface level below a "z" level (m) + real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) !out: - real(kind_phys), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !layer thickness (m) + real(kind_lake), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !layer thickness (m) ! !EOP ! @@ -4384,9 +4394,9 @@ subroutine CombineSnowLayers(lbc, ubc, & !i integer :: msn_old(lbc:ubc) ! number of top snow layer integer :: mssi(lbc:ubc) ! node index integer :: neibor ! adjacent node selected for combination - real(kind_phys):: zwice(lbc:ubc) ! total ice mass in snow - real(kind_phys):: zwliq (lbc:ubc) ! total liquid water in snow - real(kind_phys), parameter :: dzmin(5) = & ! minimum of top snow layer + real(kind_lake):: zwice(lbc:ubc) ! total ice mass in snow + real(kind_lake):: zwliq (lbc:ubc) ! total liquid water in snow + real(kind_lake), parameter :: dzmin(5) = & ! minimum of top snow layer (/0.010, 0.015, 0.025, 0.055, 0.115/) !----------------------------------------------------------------------- @@ -4433,10 +4443,10 @@ subroutine CombineSnowLayers(lbc, ubc, & !i !cdir nodep do fc = 1, num_snowc c = filter_snowc(fc) - h2osno(c) = 0._kind_phys - snowdp(c) = 0._kind_phys - zwice(c) = 0._kind_phys - zwliq(c) = 0._kind_phys + h2osno(c) = 0._kind_lake + snowdp(c) = 0._kind_lake + zwice(c) = 0._kind_lake + zwliq(c) = 0._kind_lake end do do j = -nlevsnow+1,0 @@ -4464,7 +4474,7 @@ subroutine CombineSnowLayers(lbc, ubc, & !i if (snowdp(c) < 0.01 .and. snowdp(c) > 0.) then snl(c) = 0 h2osno(c) = zwice(c) - if (h2osno(c) <= 0.) snowdp(c) = 0._kind_phys + if (h2osno(c) <= 0.) snowdp(c) = 0._kind_lake ! if (ityplun(l) == istsoil) h2osoi_liq(c,1) = h2osoi_liq(c,1) + zwliq(c) !change by guhp end if end do @@ -4583,30 +4593,30 @@ subroutine DivideSnowLayers(lbc, ubc, & !i integer, intent(inout) :: num_snowc ! number of column snow points in column filter integer, intent(inout) :: filter_snowc(ubc-lbc+1) ! column filter for snow points integer , intent(inout) :: snl(1) !number of snow layers - real(kind_phys), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) - real(kind_phys), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !interface level below a "z" level (m) - real(kind_phys), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) - real(kind_phys), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) - real(kind_phys), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) + real(kind_lake), intent(inout) :: dz(1,-nlevsnow+1:nlevsoil) !layer depth (m) + real(kind_lake), intent(inout) :: zi(1,-nlevsnow+0:nlevsoil) !interface level below a "z" level (m) + real(kind_lake), intent(inout) :: t_soisno(1,-nlevsnow+1:nlevsoil) !soil temperature (Kelvin) + real(kind_lake), intent(inout) :: h2osoi_ice(1,-nlevsnow+1:nlevsoil) !ice lens (kg/m2) + real(kind_lake), intent(inout) :: h2osoi_liq(1,-nlevsnow+1:nlevsoil) !liquid water (kg/m2) !out: - real(kind_phys), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !layer thickness (m) + real(kind_lake), intent(out) :: z(1,-nlevsnow+1:nlevsoil) !layer thickness (m) ! OTHER LOCAL VARIABLES: integer :: j, c, fc ! indices - real(kind_phys) :: drr ! thickness of the combined [m] + real(kind_lake) :: drr ! thickness of the combined [m] integer :: msno ! number of snow layer 1 (top) to msno (bottom) - real(kind_phys) :: dzsno(lbc:ubc,nlevsnow) ! Snow layer thickness [m] - real(kind_phys) :: swice(lbc:ubc,nlevsnow) ! Partial volume of ice [m3/m3] - real(kind_phys) :: swliq(lbc:ubc,nlevsnow) ! Partial volume of liquid water [m3/m3] - real(kind_phys) :: tsno(lbc:ubc ,nlevsnow) ! Nodel temperature [K] - real(kind_phys) :: zwice ! temporary - real(kind_phys) :: zwliq ! temporary - real(kind_phys) :: propor ! temporary + real(kind_lake) :: dzsno(lbc:ubc,nlevsnow) ! Snow layer thickness [m] + real(kind_lake) :: swice(lbc:ubc,nlevsnow) ! Partial volume of ice [m3/m3] + real(kind_lake) :: swliq(lbc:ubc,nlevsnow) ! Partial volume of liquid water [m3/m3] + real(kind_lake) :: tsno(lbc:ubc ,nlevsnow) ! Nodel temperature [K] + real(kind_lake) :: zwice ! temporary + real(kind_lake) :: zwliq ! temporary + real(kind_lake) :: propor ! temporary !----------------------------------------------------------------------- ! Begin calculation - note that the following column loops are only invoked @@ -4792,14 +4802,14 @@ subroutine Combo(dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! ! !ARGUMENTS: implicit none - real(kind_phys), intent(in) :: dz2 ! nodal thickness of 2 elements being combined [m] - real(kind_phys), intent(in) :: wliq2 ! liquid water of element 2 [kg/m2] - real(kind_phys), intent(in) :: wice2 ! ice of element 2 [kg/m2] - real(kind_phys), intent(in) :: t2 ! nodal temperature of element 2 [K] - real(kind_phys), intent(inout) :: dz ! nodal thickness of 1 elements being combined [m] - real(kind_phys), intent(inout) :: wliq ! liquid water of element 1 - real(kind_phys), intent(inout) :: wice ! ice of element 1 [kg/m2] - real(kind_phys), intent(inout) :: t ! nodel temperature of elment 1 [K] + real(kind_lake), intent(in) :: dz2 ! nodal thickness of 2 elements being combined [m] + real(kind_lake), intent(in) :: wliq2 ! liquid water of element 2 [kg/m2] + real(kind_lake), intent(in) :: wice2 ! ice of element 2 [kg/m2] + real(kind_lake), intent(in) :: t2 ! nodal temperature of element 2 [K] + real(kind_lake), intent(inout) :: dz ! nodal thickness of 1 elements being combined [m] + real(kind_lake), intent(inout) :: wliq ! liquid water of element 1 + real(kind_lake), intent(inout) :: wice ! ice of element 1 [kg/m2] + real(kind_lake), intent(inout) :: t ! nodel temperature of elment 1 [K] ! ! !CALLED FROM: ! subroutine CombineSnowLayers in this module @@ -4814,13 +4824,13 @@ subroutine Combo(dz, wliq, wice, t, dz2, wliq2, wice2, t2) ! ! !LOCAL VARIABLES: ! - real(kind_phys) :: dzc ! Total thickness of nodes 1 and 2 (dzc=dz+dz2). - real(kind_phys) :: wliqc ! Combined liquid water [kg/m2] - real(kind_phys) :: wicec ! Combined ice [kg/m2] - real(kind_phys) :: tc ! Combined node temperature [K] - real(kind_phys) :: h ! enthalpy of element 1 [J/m2] - real(kind_phys) :: h2 ! enthalpy of element 2 [J/m2] - real(kind_phys) :: hc ! temporary + real(kind_lake) :: dzc ! Total thickness of nodes 1 and 2 (dzc=dz+dz2). + real(kind_lake) :: wliqc ! Combined liquid water [kg/m2] + real(kind_lake) :: wicec ! Combined ice [kg/m2] + real(kind_lake) :: tc ! Combined node temperature [K] + real(kind_lake) :: h ! enthalpy of element 1 [J/m2] + real(kind_lake) :: h2 ! enthalpy of element 2 [J/m2] + real(kind_lake) :: hc ! temporary !----------------------------------------------------------------------- dzc = dz+dz2 @@ -4939,44 +4949,44 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i !in: integer , intent(in) :: pgridcell(1) ! pft's gridcell index - real(kind_phys), intent(in) :: forc_hgt(1) ! atmospheric reference height (m) - real(kind_phys), intent(in) :: forc_hgt_u(1) ! observational height of wind [m] - real(kind_phys), intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] - real(kind_phys), intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] + real(kind_lake), intent(in) :: forc_hgt(1) ! atmospheric reference height (m) + real(kind_lake), intent(in) :: forc_hgt_u(1) ! observational height of wind [m] + real(kind_lake), intent(in) :: forc_hgt_t(1) ! observational height of temperature [m] + real(kind_lake), intent(in) :: forc_hgt_q(1) ! observational height of humidity [m] integer , intent(in) :: lbp, ubp ! pft array bounds integer , intent(in) :: fn ! number of filtered pft elements integer , intent(in) :: filterp(fn) ! pft filter - real(kind_phys), intent(in) :: displa(lbp:ubp) ! displacement height (m) - real(kind_phys), intent(in) :: z0m(lbp:ubp) ! roughness length over vegetation, momentum [m] - real(kind_phys), intent(in) :: z0h(lbp:ubp) ! roughness length over vegetation, sensible heat [m] - real(kind_phys), intent(in) :: z0q(lbp:ubp) ! roughness length over vegetation, latent heat [m] - real(kind_phys), intent(in) :: obu(lbp:ubp) ! monin-obukhov length (m) + real(kind_lake), intent(in) :: displa(lbp:ubp) ! displacement height (m) + real(kind_lake), intent(in) :: z0m(lbp:ubp) ! roughness length over vegetation, momentum [m] + real(kind_lake), intent(in) :: z0h(lbp:ubp) ! roughness length over vegetation, sensible heat [m] + real(kind_lake), intent(in) :: z0q(lbp:ubp) ! roughness length over vegetation, latent heat [m] + real(kind_lake), intent(in) :: obu(lbp:ubp) ! monin-obukhov length (m) integer, intent(in) :: iter ! iteration number - real(kind_phys), intent(in) :: ur(lbp:ubp) ! wind speed at reference height [m/s] - real(kind_phys), intent(in) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] + real(kind_lake), intent(in) :: ur(lbp:ubp) ! wind speed at reference height [m/s] + real(kind_lake), intent(in) :: um(lbp:ubp) ! wind speed including the stablity effect [m/s] !out: - real(kind_phys), intent(out) :: ustar(lbp:ubp) ! friction velocity [m/s] - real(kind_phys), intent(out) :: temp1(lbp:ubp) ! relation for potential temperature profile - real(kind_phys), intent(out) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m - real(kind_phys), intent(out) :: temp2(lbp:ubp) ! relation for specific humidity profile - real(kind_phys), intent(out) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m - real(kind_phys), intent(out) :: u10(1) ! 10-m wind (m/s) (for dust model) - real(kind_phys), intent(out) :: fv(1) ! friction velocity (m/s) (for dust model) + real(kind_lake), intent(out) :: ustar(lbp:ubp) ! friction velocity [m/s] + real(kind_lake), intent(out) :: temp1(lbp:ubp) ! relation for potential temperature profile + real(kind_lake), intent(out) :: temp12m(lbp:ubp) ! relation for potential temperature profile applied at 2-m + real(kind_lake), intent(out) :: temp2(lbp:ubp) ! relation for specific humidity profile + real(kind_lake), intent(out) :: temp22m(lbp:ubp) ! relation for specific humidity profile applied at 2-m + real(kind_lake), intent(out) :: u10(1) ! 10-m wind (m/s) (for dust model) + real(kind_lake), intent(out) :: fv(1) ! friction velocity (m/s) (for dust model) !inout: - real(kind_phys), intent(inout) :: fm(lbp:ubp) ! needed for DGVM only to diagnose 10m wind + real(kind_lake), intent(inout) :: fm(lbp:ubp) ! needed for DGVM only to diagnose 10m wind ! OTHER LOCAL VARIABLES: - real(kind_phys), parameter :: zetam = 1.574_kind_phys ! transition point of flux-gradient relation (wind profile) - real(kind_phys), parameter :: zetat = 0.465_kind_phys ! transition point of flux-gradient relation (temp. profile) + real(kind_lake), parameter :: zetam = 1.574_kind_lake ! transition point of flux-gradient relation (wind profile) + real(kind_lake), parameter :: zetat = 0.465_kind_lake ! transition point of flux-gradient relation (temp. profile) integer :: f ! pft-filter index integer :: p ! pft index integer :: g ! gridcell index - real(kind_phys):: zldis(lbp:ubp) ! reference height "minus" zero displacement heght [m] - real(kind_phys):: zeta(lbp:ubp) ! dimensionless height used in Monin-Obukhov theory + real(kind_lake):: zldis(lbp:ubp) ! reference height "minus" zero displacement heght [m] + real(kind_lake):: zeta(lbp:ubp) ! dimensionless height used in Monin-Obukhov theory !------------------------------------------------------------------------------ @@ -4999,16 +5009,16 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i ustar(p) = vkc*um(p)/(log(-zetam*obu(p)/z0m(p))& - StabilityFunc1(-zetam) & + StabilityFunc1(z0m(p)/obu(p)) & - + 1.14_kind_phys*((-zeta(p))**0.333_kind_phys-(zetam)**0.333_kind_phys)) - else if (zeta(p) < 0._kind_phys) then + + 1.14_kind_lake*((-zeta(p))**0.333_kind_lake-(zetam)**0.333_kind_lake)) + else if (zeta(p) < 0._kind_lake) then ustar(p) = vkc*um(p)/(log(zldis(p)/z0m(p))& - StabilityFunc1(zeta(p))& + StabilityFunc1(z0m(p)/obu(p))) - else if (zeta(p) <= 1._kind_phys) then - ustar(p) = vkc*um(p)/(log(zldis(p)/z0m(p)) + 5._kind_phys*zeta(p) -5._kind_phys*z0m(p)/obu(p)) + else if (zeta(p) <= 1._kind_lake) then + ustar(p) = vkc*um(p)/(log(zldis(p)/z0m(p)) + 5._kind_lake*zeta(p) -5._kind_lake*z0m(p)/obu(p)) else - ustar(p) = vkc*um(p)/(log(obu(p)/z0m(p))+5._kind_phys-5._kind_phys*z0m(p)/obu(p) & - +(5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + ustar(p) = vkc*um(p)/(log(obu(p)/z0m(p))+5._kind_lake-5._kind_lake*z0m(p)/obu(p) & + +(5._kind_lake*log(zeta(p))+zeta(p)-1._kind_lake)) end if ! Temperature profile @@ -5019,16 +5029,16 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i temp1(p) = vkc/(log(-zetat*obu(p)/z0h(p))& - StabilityFunc2(-zetat) & + StabilityFunc2(z0h(p)/obu(p)) & - + 0.8_kind_phys*((zetat)**(-0.333_kind_phys)-(-zeta(p))**(-0.333_kind_phys))) - else if (zeta(p) < 0._kind_phys) then + + 0.8_kind_lake*((zetat)**(-0.333_kind_lake)-(-zeta(p))**(-0.333_kind_lake))) + else if (zeta(p) < 0._kind_lake) then temp1(p) = vkc/(log(zldis(p)/z0h(p)) & - StabilityFunc2(zeta(p)) & + StabilityFunc2(z0h(p)/obu(p))) - else if (zeta(p) <= 1._kind_phys) then - temp1(p) = vkc/(log(zldis(p)/z0h(p)) + 5._kind_phys*zeta(p) - 5._kind_phys*z0h(p)/obu(p)) + else if (zeta(p) <= 1._kind_lake) then + temp1(p) = vkc/(log(zldis(p)/z0h(p)) + 5._kind_lake*zeta(p) - 5._kind_lake*z0h(p)/obu(p)) else - temp1(p) = vkc/(log(obu(p)/z0h(p)) + 5._kind_phys - 5._kind_phys*z0h(p)/obu(p) & - + (5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + temp1(p) = vkc/(log(obu(p)/z0h(p)) + 5._kind_lake - 5._kind_lake*z0h(p)/obu(p) & + + (5._kind_lake*log(zeta(p))+zeta(p)-1._kind_lake)) end if ! Humidity profile @@ -5042,37 +5052,37 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i temp2(p) = vkc/(log(-zetat*obu(p)/z0q(p)) & - StabilityFunc2(-zetat) & + StabilityFunc2(z0q(p)/obu(p)) & - + 0.8_kind_phys*((zetat)**(-0.333_kind_phys)-(-zeta(p))**(-0.333_kind_phys))) - else if (zeta(p) < 0._kind_phys) then + + 0.8_kind_lake*((zetat)**(-0.333_kind_lake)-(-zeta(p))**(-0.333_kind_lake))) + else if (zeta(p) < 0._kind_lake) then temp2(p) = vkc/(log(zldis(p)/z0q(p)) & - StabilityFunc2(zeta(p)) & + StabilityFunc2(z0q(p)/obu(p))) - else if (zeta(p) <= 1._kind_phys) then - temp2(p) = vkc/(log(zldis(p)/z0q(p)) + 5._kind_phys*zeta(p)-5._kind_phys*z0q(p)/obu(p)) + else if (zeta(p) <= 1._kind_lake) then + temp2(p) = vkc/(log(zldis(p)/z0q(p)) + 5._kind_lake*zeta(p)-5._kind_lake*z0q(p)/obu(p)) else - temp2(p) = vkc/(log(obu(p)/z0q(p)) + 5._kind_phys - 5._kind_phys*z0q(p)/obu(p) & - + (5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + temp2(p) = vkc/(log(obu(p)/z0q(p)) + 5._kind_lake - 5._kind_lake*z0q(p)/obu(p) & + + (5._kind_lake*log(zeta(p))+zeta(p)-1._kind_lake)) end if endif ! Temperature profile applied at 2-m - zldis(p) = 2.0_kind_phys + z0h(p) + zldis(p) = 2.0_kind_lake + z0h(p) zeta(p) = zldis(p)/obu(p) if (zeta(p) < -zetat) then temp12m(p) = vkc/(log(-zetat*obu(p)/z0h(p))& - StabilityFunc2(-zetat) & + StabilityFunc2(z0h(p)/obu(p)) & - + 0.8_kind_phys*((zetat)**(-0.333_kind_phys)-(-zeta(p))**(-0.333_kind_phys))) - else if (zeta(p) < 0._kind_phys) then + + 0.8_kind_lake*((zetat)**(-0.333_kind_lake)-(-zeta(p))**(-0.333_kind_lake))) + else if (zeta(p) < 0._kind_lake) then temp12m(p) = vkc/(log(zldis(p)/z0h(p)) & - StabilityFunc2(zeta(p)) & + StabilityFunc2(z0h(p)/obu(p))) - else if (zeta(p) <= 1._kind_phys) then - temp12m(p) = vkc/(log(zldis(p)/z0h(p)) + 5._kind_phys*zeta(p) - 5._kind_phys*z0h(p)/obu(p)) + else if (zeta(p) <= 1._kind_lake) then + temp12m(p) = vkc/(log(zldis(p)/z0h(p)) + 5._kind_lake*zeta(p) - 5._kind_lake*z0h(p)/obu(p)) else - temp12m(p) = vkc/(log(obu(p)/z0h(p)) + 5._kind_phys - 5._kind_phys*z0h(p)/obu(p) & - + (5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + temp12m(p) = vkc/(log(obu(p)/z0h(p)) + 5._kind_lake - 5._kind_lake*z0h(p)/obu(p) & + + (5._kind_lake*log(zeta(p))+zeta(p)-1._kind_lake)) end if ! Humidity profile applied at 2-m @@ -5080,20 +5090,20 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i if (z0q(p) == z0h(p)) then temp22m(p) = temp12m(p) else - zldis(p) = 2.0_kind_phys + z0q(p) + zldis(p) = 2.0_kind_lake + z0q(p) zeta(p) = zldis(p)/obu(p) if (zeta(p) < -zetat) then temp22m(p) = vkc/(log(-zetat*obu(p)/z0q(p)) - & StabilityFunc2(-zetat) + StabilityFunc2(z0q(p)/obu(p)) & - + 0.8_kind_phys*((zetat)**(-0.333_kind_phys)-(-zeta(p))**(-0.333_kind_phys))) - else if (zeta(p) < 0._kind_phys) then + + 0.8_kind_lake*((zetat)**(-0.333_kind_lake)-(-zeta(p))**(-0.333_kind_lake))) + else if (zeta(p) < 0._kind_lake) then temp22m(p) = vkc/(log(zldis(p)/z0q(p)) - & StabilityFunc2(zeta(p))+StabilityFunc2(z0q(p)/obu(p))) - else if (zeta(p) <= 1._kind_phys) then - temp22m(p) = vkc/(log(zldis(p)/z0q(p)) + 5._kind_phys*zeta(p)-5._kind_phys*z0q(p)/obu(p)) + else if (zeta(p) <= 1._kind_lake) then + temp22m(p) = vkc/(log(zldis(p)/z0q(p)) + 5._kind_lake*zeta(p)-5._kind_lake*z0q(p)/obu(p)) else - temp22m(p) = vkc/(log(obu(p)/z0q(p)) + 5._kind_phys - 5._kind_phys*z0q(p)/obu(p) & - + (5._kind_phys*log(zeta(p))+zeta(p)-1._kind_phys)) + temp22m(p) = vkc/(log(obu(p)/z0q(p)) + 5._kind_lake - 5._kind_lake*z0q(p)/obu(p) & + + (5._kind_lake*log(zeta(p))+zeta(p)-1._kind_lake)) end if end if end do @@ -5116,9 +5126,9 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i zeta(p) = zldis(p)/obu(p) if (zeta(p) < -zetam) then ! zeta < -1 ustar(p) = vkc * um(p) / log(-zetam*obu(p)/z0m(p)) - else if (zeta(p) < 0._kind_phys) then ! -1 <= zeta < 0 + else if (zeta(p) < 0._kind_lake) then ! -1 <= zeta < 0 ustar(p) = vkc * um(p) / log(zldis(p)/z0m(p)) - else if (zeta(p) <= 1._kind_phys) then ! 0 <= ztea <= 1 + else if (zeta(p) <= 1._kind_lake) then ! 0 <= ztea <= 1 ustar(p)=vkc * um(p)/log(zldis(p)/z0m(p)) else ! 1 < zeta, phi=5+zeta ustar(p)=vkc * um(p)/log(obu(p)/z0m(p)) @@ -5128,9 +5138,9 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i zeta(p) = zldis(p)/obu(p) if (zeta(p) < -zetat) then temp1(p)=vkc/log(-zetat*obu(p)/z0h(p)) - else if (zeta(p) < 0._kind_phys) then + else if (zeta(p) < 0._kind_lake) then temp1(p)=vkc/log(zldis(p)/z0h(p)) - else if (zeta(p) <= 1._kind_phys) then + else if (zeta(p) <= 1._kind_lake) then temp1(p)=vkc/log(zldis(p)/z0h(p)) else temp1(p)=vkc/log(obu(p)/z0h(p)) @@ -5140,33 +5150,33 @@ subroutine FrictionVelocity(pgridcell,forc_hgt,forc_hgt_u, & !i zeta(p) = zldis(p)/obu(p) if (zeta(p) < -zetat) then temp2(p)=vkc/log(-zetat*obu(p)/z0q(p)) - else if (zeta(p) < 0._kind_phys) then + else if (zeta(p) < 0._kind_lake) then temp2(p)=vkc/log(zldis(p)/z0q(p)) - else if (zeta(p) <= 1._kind_phys) then + else if (zeta(p) <= 1._kind_lake) then temp2(p)=vkc/log(zldis(p)/z0q(p)) else temp2(p)=vkc/log(obu(p)/z0q(p)) end if - zldis(p) = 2.0_kind_phys + z0h(p) + zldis(p) = 2.0_kind_lake + z0h(p) zeta(p) = zldis(p)/obu(p) if (zeta(p) < -zetat) then temp12m(p)=vkc/log(-zetat*obu(p)/z0h(p)) - else if (zeta(p) < 0._kind_phys) then + else if (zeta(p) < 0._kind_lake) then temp12m(p)=vkc/log(zldis(p)/z0h(p)) - else if (zeta(p) <= 1._kind_phys) then + else if (zeta(p) <= 1._kind_lake) then temp12m(p)=vkc/log(zldis(p)/z0h(p)) else temp12m(p)=vkc/log(obu(p)/z0h(p)) end if - zldis(p) = 2.0_kind_phys + z0q(p) + zldis(p) = 2.0_kind_lake + z0q(p) zeta(p) = zldis(p)/obu(p) if (zeta(p) < -zetat) then temp22m(p)=vkc/log(-zetat*obu(p)/z0q(p)) - else if (zeta(p) < 0._kind_phys) then + else if (zeta(p) < 0._kind_lake) then temp22m(p)=vkc/log(zldis(p)/z0q(p)) - else if (zeta(p) <= 1._kind_phys) then + else if (zeta(p) <= 1._kind_lake) then temp22m(p)=vkc/log(zldis(p)/z0q(p)) else temp22m(p)=vkc/log(obu(p)/z0q(p)) @@ -5180,7 +5190,7 @@ end subroutine FrictionVelocity ! !IROUTINE: StabilityFunc ! ! !INTERFACE: - real(kind_phys) function StabilityFunc1(zeta) + real(kind_lake) function StabilityFunc1(zeta) ! ! !DESCRIPTION: ! Stability function for rib < 0. @@ -5191,7 +5201,7 @@ real(kind_phys) function StabilityFunc1(zeta) ! ! !ARGUMENTS: implicit none - real(kind_phys), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(kind_lake), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory ! ! !CALLED FROM: ! subroutine FrictionVelocity in this module @@ -5204,15 +5214,15 @@ real(kind_phys) function StabilityFunc1(zeta) !EOP ! ! !LOCAL VARIABLES: - real(kind_phys) :: chik, chik2 + real(kind_lake) :: chik, chik2 !------------------------------------------------------------------------------ - chik2 = sqrt(1._kind_phys-16._kind_phys*zeta) + chik2 = sqrt(1._kind_lake-16._kind_lake*zeta) chik = sqrt(chik2) - StabilityFunc1 = 2._kind_phys*log((1._kind_phys+chik)*0.5_kind_phys) & + StabilityFunc1 = 2._kind_lake*log((1._kind_lake+chik)*0.5_kind_lake) & !Changed to pie, Zack Subin, 7/9/08 !Spelling corrected, changed to pi, Sam Trahan the Killjoy, 6/2/22 - + log((1._kind_phys+chik2)*0.5_kind_phys)-2._kind_phys*atan(chik)+pi*0.5_kind_phys + + log((1._kind_lake+chik2)*0.5_kind_lake)-2._kind_lake*atan(chik)+pi*0.5_kind_lake end function StabilityFunc1 @@ -5222,7 +5232,7 @@ end function StabilityFunc1 ! !IROUTINE: StabilityFunc2 ! ! !INTERFACE: - real(kind_phys) function StabilityFunc2(zeta) + real(kind_lake) function StabilityFunc2(zeta) ! ! !DESCRIPTION: ! Stability function for rib < 0. @@ -5233,7 +5243,7 @@ real(kind_phys) function StabilityFunc2(zeta) ! ! !ARGUMENTS: implicit none - real(kind_phys), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(kind_lake), intent(in) :: zeta ! dimensionless height used in Monin-Obukhov theory ! ! !CALLED FROM: ! subroutine FrictionVelocity in this module @@ -5246,11 +5256,11 @@ real(kind_phys) function StabilityFunc2(zeta) !EOP ! ! !LOCAL VARIABLES: - real(kind_phys) :: chik2 + real(kind_lake) :: chik2 !------------------------------------------------------------------------------ - chik2 = sqrt(1._kind_phys-16._kind_phys*zeta) - StabilityFunc2 = 2._kind_phys*log((1._kind_phys+chik2)*0.5_kind_phys) + chik2 = sqrt(1._kind_lake-16._kind_lake*zeta) + StabilityFunc2 = 2._kind_lake*log((1._kind_lake+chik2)*0.5_kind_lake) end function StabilityFunc2 @@ -5273,13 +5283,13 @@ subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) ! ! !ARGUMENTS: implicit none - real(kind_phys), intent(in) :: ur ! wind speed at reference height [m/s] - real(kind_phys), intent(in) :: thv ! virtual potential temperature (kelvin) - real(kind_phys), intent(in) :: dthv ! diff of vir. poten. temp. between ref. height and surface - real(kind_phys), intent(in) :: zldis ! reference height "minus" zero displacement heght [m] - real(kind_phys), intent(in) :: z0m ! roughness length, momentum [m] - real(kind_phys), intent(out) :: um ! wind speed including the stability effect [m/s] - real(kind_phys), intent(out) :: obu ! monin-obukhov length (m) + real(kind_lake), intent(in) :: ur ! wind speed at reference height [m/s] + real(kind_lake), intent(in) :: thv ! virtual potential temperature (kelvin) + real(kind_lake), intent(in) :: dthv ! diff of vir. poten. temp. between ref. height and surface + real(kind_lake), intent(in) :: zldis ! reference height "minus" zero displacement heght [m] + real(kind_lake), intent(in) :: z0m ! roughness length, momentum [m] + real(kind_lake), intent(out) :: um ! wind speed including the stability effect [m/s] + real(kind_lake), intent(out) :: obu ! monin-obukhov length (m) ! ! !CALLED FROM: ! subroutine BareGroundFluxes in module BareGroundFluxesMod.F90 @@ -5295,33 +5305,33 @@ subroutine MoninObukIni (ur, thv, dthv, zldis, z0m, um, obu) ! ! !LOCAL VARIABLES: ! - real(kind_phys) :: wc ! convective velocity [m/s] - real(kind_phys) :: rib ! bulk Richardson number - real(kind_phys) :: zeta ! dimensionless height used in Monin-Obukhov theory - real(kind_phys) :: ustar ! friction velocity [m/s] + real(kind_lake) :: wc ! convective velocity [m/s] + real(kind_lake) :: rib ! bulk Richardson number + real(kind_lake) :: zeta ! dimensionless height used in Monin-Obukhov theory + real(kind_lake) :: ustar ! friction velocity [m/s] !----------------------------------------------------------------------- ! Initial values of u* and convective velocity - ustar=0.06_kind_phys - wc=0.5_kind_phys - if (dthv >= 0._kind_phys) then - um=max(ur,0.1_kind_phys) + ustar=0.06_kind_lake + wc=0.5_kind_lake + if (dthv >= 0._kind_lake) then + um=max(ur,0.1_kind_lake) else um=sqrt(ur*ur+wc*wc) endif rib=grav*zldis*dthv/(thv*um*um) if (PERGRO) then - rib = 0._kind_phys + rib = 0._kind_lake endif - if (rib >= 0._kind_phys) then ! neutral or stable - zeta = rib*log(zldis/z0m)/(1._kind_phys-5._kind_phys*min(rib,0.19_kind_phys)) - zeta = min(2._kind_phys,max(zeta,0.01_kind_phys )) + if (rib >= 0._kind_lake) then ! neutral or stable + zeta = rib*log(zldis/z0m)/(1._kind_lake-5._kind_lake*min(rib,0.19_kind_lake)) + zeta = min(2._kind_lake,max(zeta,0.01_kind_lake )) else ! unstable zeta=rib*log(zldis/z0m) - zeta = max(-100._kind_phys,min(zeta,-0.01_kind_phys )) + zeta = max(-100._kind_lake,min(zeta,-0.01_kind_lake )) endif obu=zldis/zeta @@ -5361,71 +5371,71 @@ subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,c hfus = con_hfus hvap = con_hvap hsub = con_hfus+con_hvap - invhvap = 1._kind_phys/hvap - invhsub = 1._kind_phys/hsub + invhvap = 1._kind_lake/hvap + invhsub = 1._kind_lake/hsub rair = con_rd cpair = con_cp - ! dzlak(1) = 0.1_kind_phys - ! dzlak(2) = 1._kind_phys - ! dzlak(3) = 2._kind_phys - ! dzlak(4) = 3._kind_phys - ! dzlak(5) = 4._kind_phys - ! dzlak(6) = 5._kind_phys - ! dzlak(7) = 7._kind_phys - ! dzlak(8) = 7._kind_phys - ! dzlak(9) = 10.45_kind_phys - ! dzlak(10)= 10.45_kind_phys + ! dzlak(1) = 0.1_kind_lake + ! dzlak(2) = 1._kind_lake + ! dzlak(3) = 2._kind_lake + ! dzlak(4) = 3._kind_lake + ! dzlak(5) = 4._kind_lake + ! dzlak(6) = 5._kind_lake + ! dzlak(7) = 7._kind_lake + ! dzlak(8) = 7._kind_lake + ! dzlak(9) = 10.45_kind_lake + ! dzlak(10)= 10.45_kind_lake ! - ! zlak(1) = 0.05_kind_phys - ! zlak(2) = 0.6_kind_phys - ! zlak(3) = 2.1_kind_phys - ! zlak(4) = 4.6_kind_phys - ! zlak(5) = 8.1_kind_phys - ! zlak(6) = 12.6_kind_phys - ! zlak(7) = 18.6_kind_phys - ! zlak(8) = 25.6_kind_phys - ! zlak(9) = 34.325_kind_phys - ! zlak(10)= 44.775_kind_phys - dzlak(1) = 0.1_kind_phys - dzlak(2) = 0.1_kind_phys - dzlak(3) = 0.1_kind_phys - dzlak(4) = 0.1_kind_phys - dzlak(5) = 0.1_kind_phys - dzlak(6) = 0.1_kind_phys - dzlak(7) = 0.1_kind_phys - dzlak(8) = 0.1_kind_phys - dzlak(9) = 0.1_kind_phys - dzlak(10)= 0.1_kind_phys + ! zlak(1) = 0.05_kind_lake + ! zlak(2) = 0.6_kind_lake + ! zlak(3) = 2.1_kind_lake + ! zlak(4) = 4.6_kind_lake + ! zlak(5) = 8.1_kind_lake + ! zlak(6) = 12.6_kind_lake + ! zlak(7) = 18.6_kind_lake + ! zlak(8) = 25.6_kind_lake + ! zlak(9) = 34.325_kind_lake + ! zlak(10)= 44.775_kind_lake + dzlak(1) = 0.1_kind_lake + dzlak(2) = 0.1_kind_lake + dzlak(3) = 0.1_kind_lake + dzlak(4) = 0.1_kind_lake + dzlak(5) = 0.1_kind_lake + dzlak(6) = 0.1_kind_lake + dzlak(7) = 0.1_kind_lake + dzlak(8) = 0.1_kind_lake + dzlak(9) = 0.1_kind_lake + dzlak(10)= 0.1_kind_lake - zlak(1) = 0.05_kind_phys - zlak(2) = 0.15_kind_phys - zlak(3) = 0.25_kind_phys - zlak(4) = 0.35_kind_phys - zlak(5) = 0.45_kind_phys - zlak(6) = 0.55_kind_phys - zlak(7) = 0.65_kind_phys - zlak(8) = 0.75_kind_phys - zlak(9) = 0.85_kind_phys - zlak(10)= 0.95_kind_phys + zlak(1) = 0.05_kind_lake + zlak(2) = 0.15_kind_lake + zlak(3) = 0.25_kind_lake + zlak(4) = 0.35_kind_lake + zlak(5) = 0.45_kind_lake + zlak(6) = 0.55_kind_lake + zlak(7) = 0.65_kind_lake + zlak(8) = 0.75_kind_lake + zlak(9) = 0.85_kind_lake + zlak(10)= 0.95_kind_lake ! "0" refers to soil surface and "nlevsoil" refers to the bottom of model soil do j = 1, nlevsoil - zsoi(j) = scalez*(exp(0.5_kind_phys*(j-0.5_kind_phys))-1._kind_phys) !node depths + zsoi(j) = scalez*(exp(0.5_kind_lake*(j-0.5_kind_lake))-1._kind_lake) !node depths enddo - dzsoi(1) = 0.5_kind_phys*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces + dzsoi(1) = 0.5_kind_lake*(zsoi(1)+zsoi(2)) !thickness b/n two interfaces do j = 2,nlevsoil-1 - dzsoi(j)= 0.5_kind_phys*(zsoi(j+1)-zsoi(j-1)) + dzsoi(j)= 0.5_kind_lake*(zsoi(j+1)-zsoi(j-1)) enddo dzsoi(nlevsoil) = zsoi(nlevsoil)-zsoi(nlevsoil-1) - zisoi(0) = 0._kind_phys + zisoi(0) = 0._kind_lake do j = 1, nlevsoil-1 - zisoi(j) = 0.5_kind_phys*(zsoi(j)+zsoi(j+1)) !interface depths + zisoi(j) = 0.5_kind_lake*(zsoi(j)+zsoi(j+1)) !interface depths enddo - zisoi(nlevsoil) = zsoi(nlevsoil) + 0.5_kind_phys*dzsoi(nlevsoil) + zisoi(nlevsoil) = zsoi(nlevsoil) + 0.5_kind_lake*dzsoi(nlevsoil) end subroutine clm_lake_init @@ -5508,7 +5518,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, !LOGICAL, DIMENSION( : ),intent(out) :: lake !REAL(KIND_PHYS), OPTIONAL, DIMENSION( : ), INTENT(IN) :: lake_depth ! no separate variable for this in CCPP - real(kind_phys), dimension( 1:im,1:nlevsoil ) :: bsw3d, & + real(kind_lake), dimension( 1:im,1:nlevsoil ) :: bsw3d, & bsw23d, & psisat3d, & vwcsat3d, & @@ -5517,19 +5527,19 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, hksat3d, & sucsat3d integer :: n,i,j,k,ib,lev,bottom ! indices - real(kind_phys),dimension(1:im ) :: bd2d ! bulk density of dry soil material [kg/m^3] - real(kind_phys),dimension(1:im ) :: tkm2d ! mineral conductivity - real(kind_phys),dimension(1:im ) :: xksat2d ! maximum hydraulic conductivity of soil [mm/s] - real(kind_phys),dimension(1:im ) :: depthratio2d ! ratio of lake depth to standard deep lake depth - real(kind_phys),dimension(1:im ) :: clay2d ! temporary - real(kind_phys),dimension(1:im ) :: sand2d ! temporary + real(kind_lake),dimension(1:im ) :: bd2d ! bulk density of dry soil material [kg/m^3] + real(kind_lake),dimension(1:im ) :: tkm2d ! mineral conductivity + real(kind_lake),dimension(1:im ) :: xksat2d ! maximum hydraulic conductivity of soil [mm/s] + real(kind_lake),dimension(1:im ) :: depthratio2d ! ratio of lake depth to standard deep lake depth + real(kind_lake),dimension(1:im ) :: clay2d ! temporary + real(kind_lake),dimension(1:im ) :: sand2d ! temporary logical,parameter :: arbinit = .false. - real(kind_phys),parameter :: defval = -999.0 + real(kind_lake),parameter :: defval = -999.0 integer :: isl integer :: numb_lak ! for debug character*256 :: message - real(kind_phys) :: ht + real(kind_lake) :: ht logical :: climatology_limits @@ -5538,7 +5548,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, integer :: used_lakedepth_default, init_points, month, julday integer :: mon, iday, num2, num1, juld, day2, day1, wght1, wght2 - real(kind_phys) :: Tclim + real(kind_lake) :: Tclim used_lakedepth_default=0 @@ -5639,35 +5649,35 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, do k = 1,nlevsoil clay2d(i) = clay3d(i,k) sand2d(i) = sand3d(i,k) - watsat3d(i,k) = 0.489_kind_phys - 0.00126_kind_phys*sand2d(i) - bd2d(i) = (1._kind_phys-watsat3d(i,k))*2.7e3_kind_phys - xksat2d(i) = 0.0070556_kind_phys *( 10._kind_phys**(-0.884_kind_phys+0.0153_kind_phys*sand2d(i)) ) ! mm/s - tkm2d(i) = (8.80_kind_phys*sand2d(i)+2.92_kind_phys*clay2d(i))/(sand2d(i)+clay2d(i)) ! W/(m K) - - bsw3d(i,k) = 2.91_kind_phys + 0.159_kind_phys*clay2d(i) - bsw23d(i,k) = -(3.10_kind_phys + 0.157_kind_phys*clay2d(i) - 0.003_kind_phys*sand2d(i)) - psisat3d(i,k) = -(exp((1.54_kind_phys - 0.0095_kind_phys*sand2d(i) + 0.0063_kind_phys*(100.0_kind_phys-sand2d(i) & - -clay2d(i)))*log(10.0_kind_phys))*9.8e-5_kind_phys) - vwcsat3d(i,k) = (50.5_kind_phys - 0.142_kind_phys*sand2d(i) - 0.037_kind_phys*clay2d(i))/100.0_kind_phys + watsat3d(i,k) = 0.489_kind_lake - 0.00126_kind_lake*sand2d(i) + bd2d(i) = (1._kind_lake-watsat3d(i,k))*2.7e3_kind_lake + xksat2d(i) = 0.0070556_kind_lake *( 10._kind_lake**(-0.884_kind_lake+0.0153_kind_lake*sand2d(i)) ) ! mm/s + tkm2d(i) = (8.80_kind_lake*sand2d(i)+2.92_kind_lake*clay2d(i))/(sand2d(i)+clay2d(i)) ! W/(m K) + + bsw3d(i,k) = 2.91_kind_lake + 0.159_kind_lake*clay2d(i) + bsw23d(i,k) = -(3.10_kind_lake + 0.157_kind_lake*clay2d(i) - 0.003_kind_lake*sand2d(i)) + psisat3d(i,k) = -(exp((1.54_kind_lake - 0.0095_kind_lake*sand2d(i) + 0.0063_kind_lake*(100.0_kind_lake-sand2d(i) & + -clay2d(i)))*log(10.0_kind_lake))*9.8e-5_kind_lake) + vwcsat3d(i,k) = (50.5_kind_lake - 0.142_kind_lake*sand2d(i) - 0.037_kind_lake*clay2d(i))/100.0_kind_lake hksat3d(i,k) = xksat2d(i) - sucsat3d(i,k) = 10._kind_phys * ( 10._kind_phys**(1.88_kind_phys-0.0131_kind_phys*sand2d(i)) ) - tkmg3d(i,k) = tkm2d(i) ** (1._kind_phys- watsat3d(i,k)) - tksatu3d(i,k) = tkmg3d(i,k)*0.57_kind_phys**watsat3d(i,k) - tkdry3d(i,k) = (0.135_kind_phys*bd2d(i) + 64.7_kind_phys) / (2.7e3_kind_phys - 0.947_kind_phys*bd2d(i)) - csol3d(i,k) = (2.128_kind_phys*sand2d(i)+2.385_kind_phys*clay2d(i)) / (sand2d(i)+clay2d(i))*1.e6_kind_phys ! J/(m3 K) - watdry3d(i,k) = watsat3d(i,k) * (316230._kind_phys/sucsat3d(i,k)) ** (-1._kind_phys/bsw3d(i,k)) - watopt3d(i,k) = watsat3d(i,k) * (158490._kind_phys/sucsat3d(i,k)) ** (-1._kind_phys/bsw3d(i,k)) + sucsat3d(i,k) = 10._kind_lake * ( 10._kind_lake**(1.88_kind_lake-0.0131_kind_lake*sand2d(i)) ) + tkmg3d(i,k) = tkm2d(i) ** (1._kind_lake- watsat3d(i,k)) + tksatu3d(i,k) = tkmg3d(i,k)*0.57_kind_lake**watsat3d(i,k) + tkdry3d(i,k) = (0.135_kind_lake*bd2d(i) + 64.7_kind_lake) / (2.7e3_kind_lake - 0.947_kind_lake*bd2d(i)) + csol3d(i,k) = (2.128_kind_lake*sand2d(i)+2.385_kind_lake*clay2d(i)) / (sand2d(i)+clay2d(i))*1.e6_kind_lake ! J/(m3 K) + watdry3d(i,k) = watsat3d(i,k) * (316230._kind_lake/sucsat3d(i,k)) ** (-1._kind_lake/bsw3d(i,k)) + watopt3d(i,k) = watsat3d(i,k) * (158490._kind_lake/sucsat3d(i,k)) ** (-1._kind_lake/bsw3d(i,k)) end do if (clm_lakedepth(i) == spval) then - clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake) + clm_lakedepth(i) = zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake) z_lake3d(i,1:nlevlake) = zlak(1:nlevlake) dz_lake3d(i,1:nlevlake) = dzlak(1:nlevlake) else - depthratio2d(i) = clm_lakedepth(i) / (zlak(nlevlake) + 0.5_kind_phys*dzlak(nlevlake)) + depthratio2d(i) = clm_lakedepth(i) / (zlak(nlevlake) + 0.5_kind_lake*dzlak(nlevlake)) z_lake3d(i,1) = zlak(1) dz_lake3d(i,1) = dzlak(1) dz_lake3d(i,2:nlevlake) = dzlak(2:nlevlake)*depthratio2d(i) - z_lake3d(i,2:nlevlake) = zlak(2:nlevlake)*depthratio2d(i) + dz_lake3d(i,1)*(1._kind_phys - depthratio2d(i)) + z_lake3d(i,2:nlevlake) = zlak(2:nlevlake)*depthratio2d(i) + dz_lake3d(i,1)*(1._kind_lake - depthratio2d(i)) end if z3d(i,1:nlevsoil) = zsoi(1:nlevsoil) zi3d(i,0:nlevsoil) = zisoi(0:nlevsoil) @@ -5675,64 +5685,64 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, savedtke12d(i) = tkwat ! Initialize for first timestep. - if (snowdp2d(i) < 0.01_kind_phys) then + if (snowdp2d(i) < 0.01_kind_lake) then snl2d(i) = 0 - dz3d(i,-nlevsnow+1:0) = 0._kind_phys - z3d (i,-nlevsnow+1:0) = 0._kind_phys - zi3d(i,-nlevsnow+0:0) = 0._kind_phys + dz3d(i,-nlevsnow+1:0) = 0._kind_lake + z3d (i,-nlevsnow+1:0) = 0._kind_lake + zi3d(i,-nlevsnow+0:0) = 0._kind_lake else - if ((snowdp2d(i) >= 0.01_kind_phys) .and. (snowdp2d(i) <= 0.03_kind_phys)) then + if ((snowdp2d(i) >= 0.01_kind_lake) .and. (snowdp2d(i) <= 0.03_kind_lake)) then snl2d(i) = -1 dz3d(i,0) = snowdp2d(i) - else if ((snowdp2d(i) > 0.03_kind_phys) .and. (snowdp2d(i) <= 0.04_kind_phys)) then + else if ((snowdp2d(i) > 0.03_kind_lake) .and. (snowdp2d(i) <= 0.04_kind_lake)) then snl2d(i) = -2 - dz3d(i,-1) = snowdp2d(i)*0.5_kind_phys + dz3d(i,-1) = snowdp2d(i)*0.5_kind_lake dz3d(i, 0) = dz3d(i,-1) - else if ((snowdp2d(i) > 0.04_kind_phys) .and. (snowdp2d(i) <= 0.07_kind_phys)) then + else if ((snowdp2d(i) > 0.04_kind_lake) .and. (snowdp2d(i) <= 0.07_kind_lake)) then snl2d(i) = -2 - dz3d(i,-1) = 0.02_kind_phys + dz3d(i,-1) = 0.02_kind_lake dz3d(i, 0) = snowdp2d(i) - dz3d(i,-1) - else if ((snowdp2d(i) > 0.07_kind_phys) .and. (snowdp2d(i) <= 0.12_kind_phys)) then + else if ((snowdp2d(i) > 0.07_kind_lake) .and. (snowdp2d(i) <= 0.12_kind_lake)) then snl2d(i) = -3 - dz3d(i,-2) = 0.02_kind_phys - dz3d(i,-1) = (snowdp2d(i) - 0.02_kind_phys)*0.5_kind_phys + dz3d(i,-2) = 0.02_kind_lake + dz3d(i,-1) = (snowdp2d(i) - 0.02_kind_lake)*0.5_kind_lake dz3d(i, 0) = dz3d(i,-1) - else if ((snowdp2d(i) > 0.12_kind_phys) .and. (snowdp2d(i) <= 0.18_kind_phys)) then + else if ((snowdp2d(i) > 0.12_kind_lake) .and. (snowdp2d(i) <= 0.18_kind_lake)) then snl2d(i) = -3 - dz3d(i,-2) = 0.02_kind_phys - dz3d(i,-1) = 0.05_kind_phys + dz3d(i,-2) = 0.02_kind_lake + dz3d(i,-1) = 0.05_kind_lake dz3d(i, 0) = snowdp2d(i) - dz3d(i,-2) - dz3d(i,-1) - else if ((snowdp2d(i) > 0.18_kind_phys) .and. (snowdp2d(i) <= 0.29_kind_phys)) then + else if ((snowdp2d(i) > 0.18_kind_lake) .and. (snowdp2d(i) <= 0.29_kind_lake)) then snl2d(i) = -4 - dz3d(i,-3) = 0.02_kind_phys - dz3d(i,-2) = 0.05_kind_phys - dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-3) - dz3d(i,-2))*0.5_kind_phys + dz3d(i,-3) = 0.02_kind_lake + dz3d(i,-2) = 0.05_kind_lake + dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-3) - dz3d(i,-2))*0.5_kind_lake dz3d(i, 0) = dz3d(i,-1) - else if ((snowdp2d(i) > 0.29_kind_phys) .and. (snowdp2d(i) <= 0.41_kind_phys)) then + else if ((snowdp2d(i) > 0.29_kind_lake) .and. (snowdp2d(i) <= 0.41_kind_lake)) then snl2d(i) = -4 - dz3d(i,-3) = 0.02_kind_phys - dz3d(i,-2) = 0.05_kind_phys - dz3d(i,-1) = 0.11_kind_phys + dz3d(i,-3) = 0.02_kind_lake + dz3d(i,-2) = 0.05_kind_lake + dz3d(i,-1) = 0.11_kind_lake dz3d(i, 0) = snowdp2d(i) - dz3d(i,-3) - dz3d(i,-2) - dz3d(i,-1) - else if ((snowdp2d(i) > 0.41_kind_phys) .and. (snowdp2d(i) <= 0.64_kind_phys)) then + else if ((snowdp2d(i) > 0.41_kind_lake) .and. (snowdp2d(i) <= 0.64_kind_lake)) then snl2d(i) = -5 - dz3d(i,-4) = 0.02_kind_phys - dz3d(i,-3) = 0.05_kind_phys - dz3d(i,-2) = 0.11_kind_phys - dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-4) - dz3d(i,-3) - dz3d(i,-2))*0.5_kind_phys + dz3d(i,-4) = 0.02_kind_lake + dz3d(i,-3) = 0.05_kind_lake + dz3d(i,-2) = 0.11_kind_lake + dz3d(i,-1) = (snowdp2d(i) - dz3d(i,-4) - dz3d(i,-3) - dz3d(i,-2))*0.5_kind_lake dz3d(i, 0) = dz3d(i,-1) - else if (snowdp2d(i) > 0.64_kind_phys) then + else if (snowdp2d(i) > 0.64_kind_lake) then snl2d(i) = -5 - dz3d(i,-4) = 0.02_kind_phys - dz3d(i,-3) = 0.05_kind_phys - dz3d(i,-2) = 0.11_kind_phys - dz3d(i,-1) = 0.23_kind_phys + dz3d(i,-4) = 0.02_kind_lake + dz3d(i,-3) = 0.05_kind_lake + dz3d(i,-2) = 0.11_kind_lake + dz3d(i,-1) = 0.23_kind_lake dz3d(i, 0)=snowdp2d(i)-dz3d(i,-4)-dz3d(i,-3)-dz3d(i,-2)-dz3d(i,-1) endif end if do k = 0, snl2d(i)+1, -1 - z3d(i,k) = zi3d(i,k) - 0.5_kind_phys*dz3d(i,k) + z3d(i,k) = zi3d(i,k) - 0.5_kind_lake*dz3d(i,k) zi3d(i,k-1) = zi3d(i,k) - dz3d(i,k) end do @@ -5773,15 +5783,15 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, end if do k = 1,nlevsoil - h2osoi_vol3d(i,k) = 1.0_kind_phys + h2osoi_vol3d(i,k) = 1.0_kind_lake h2osoi_vol3d(i,k) = min(h2osoi_vol3d(i,k),watsat3d(i,k)) ! soil layers if (t_soisno3d(i,k) <= tfrz) then h2osoi_ice3d(i,k) = dz3d(i,k)*denice*h2osoi_vol3d(i,k) - h2osoi_liq3d(i,k) = 0._kind_phys + h2osoi_liq3d(i,k) = 0._kind_lake else - h2osoi_ice3d(i,k) = 0._kind_phys + h2osoi_ice3d(i,k) = 0._kind_lake h2osoi_liq3d(i,k) = dz3d(i,k)*denh2o*h2osoi_vol3d(i,k) endif enddo @@ -5789,7 +5799,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, do k = -nlevsnow+1, 0 if (k > snl2d(i)) then h2osoi_ice3d(i,k) = dz3d(i,k)*snow_bd - h2osoi_liq3d(i,k) = 0._kind_phys + h2osoi_liq3d(i,k) = 0._kind_lake end if end do From 52f820a3de64e55560db7b298beb6f8f1619962c Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 9 Mar 2023 00:59:11 +0000 Subject: [PATCH 33/46] clm lake: loops use ints & return if there is nothing to do --- physics/clm_lake.f90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 75c7eab13..b5a39b557 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -236,7 +236,7 @@ SUBROUTINE clm_lake_run( & ! Configuration and initialization: iopt_lake, iopt_lake_clm, min_lakeice, lakedepth_default, use_lakedepth, & - dtp, use_lake_model, clm_lake_initialized, frac_grid, frac_ice, & + dtp, use_lake_model, clm_lake_initialized, frac_grid, frac_ice, lkm, & ! Atmospheric model state inputs: tg3, pgr, zlvl, gt0, prsi, phii, qvcurr, gu0, gv0, xlat_d, xlon_d, & @@ -276,6 +276,7 @@ SUBROUTINE clm_lake_run( & INTEGER , INTENT (IN) :: im,km,me,master INTEGER, INTENT(IN) :: IDATE(4), kdt REAL(KIND_PHYS), INTENT(IN) :: fhour + INTEGER, INTENT(IN) :: lkm ! ! Configuration and initialization: @@ -470,6 +471,11 @@ SUBROUTINE clm_lake_run( & errmsg = ' ' errflg = 0 + + if(iopt_lake/=iopt_lake_clm .or. lkm==0) then + return ! nothing to do + endif + dtime=dtp if(LAKEDEBUG) then @@ -5741,7 +5747,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, endif end if - do k = 0, snl2d(i)+1, -1 + do k = 0, nint(snl2d(i)+1), -1 z3d(i,k) = zi3d(i,k) - 0.5_kind_lake*dz3d(i,k) zi3d(i,k-1) = zi3d(i,k) - dz3d(i,k) end do @@ -5775,7 +5781,7 @@ SUBROUTINE lakeini(kdt, ISLTYP, gt0, snowd, enddo if (snl2d(i) < 0) then - do k = snl2d(i)+1, 0 + do k = nint(snl2d(i)+1), 0 ! Be careful because there may be new snow layers with bad temperatures like 0 even if ! coming from init. con. file. if(t_soisno3d(i,k) > 300 .or. t_soisno3d(i,k) < 200) t_soisno3d(i,k) = min(tfrz,tsfc(i)) From a97690a2563a96576a4cb9adfb44f1ef89fc1d8f Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 9 Mar 2023 00:59:32 +0000 Subject: [PATCH 34/46] clm lake meta: need lkm --- physics/clm_lake.meta | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 4149fd8ef..035787aff 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -131,6 +131,13 @@ dimensions = () type = logical intent = in +[lkm] + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst + units = flag + dimensions = () + type = integer + intent = in [tg3] standard_name = deep_soil_temperature long_name = deep soil temperature From 1036acfbf585499d74b02cc1645c300a9774496a Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 17 Mar 2023 17:21:39 +0000 Subject: [PATCH 35/46] do not set wet(i) in random locations --- physics/GFS_surface_composites_inter.F90 | 1 - physics/GFS_surface_composites_post.F90 | 5 ----- physics/sfc_diff.f | 4 ---- 3 files changed, 10 deletions(-) diff --git a/physics/GFS_surface_composites_inter.F90 b/physics/GFS_surface_composites_inter.F90 index a4004bb82..5ceeb6ac8 100644 --- a/physics/GFS_surface_composites_inter.F90 +++ b/physics/GFS_surface_composites_inter.F90 @@ -62,7 +62,6 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_wat, semis ! --- ... define the downward lw flux absorbed by ground do i=1,im - if(use_lake_model(i)>0.0) wet(i)=.true. if (dry(i)) gabsbdlw_lnd(i) = semis_lnd(i) * adjsfcdlw(i) if (icy(i)) gabsbdlw_ice(i) = semis_ice(i) * adjsfcdlw(i) if (wet(i)) gabsbdlw_wat(i) = semis_wat(i) * adjsfcdlw(i) diff --git a/physics/GFS_surface_composites_post.F90 b/physics/GFS_surface_composites_post.F90 index 9683eac83..ab7528a62 100644 --- a/physics/GFS_surface_composites_post.F90 +++ b/physics/GFS_surface_composites_post.F90 @@ -88,11 +88,6 @@ subroutine GFS_surface_composites_post_run ( errflg = 0 ! --- generate ocean/land/ice composites - do i=1, im - if(use_lake_model(i) > 0.0) then - wet(i) = .true. - endif - enddo fractional_grid: if (frac_grid) then diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 0c452c58f..4da342cd7 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -167,10 +167,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ps is in pascals, wind is wind speed, ! surface roughness length is converted to m from cm ! - do i=1,im - if(use_lake_model(i) > 0) wet(i) = .true. - enddo - ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im From 40e1e266557410c17e29409e1089d9aa93e73356 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 3 Apr 2023 21:13:02 +0000 Subject: [PATCH 36/46] con_tpp => con_ttp --- physics/GFS_radiation_surface.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 index 903566864..f6067a86c 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/GFS_radiation_surface.F90 @@ -68,7 +68,7 @@ subroutine GFS_radiation_surface_run ( & integer, intent(in) :: im, nf_albd, ialb logical, intent(in) :: frac_grid, lslwr, lsswr, use_cice_alb, cplice integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp - real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice, con_tpp + real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice, con_ttp integer, dimension(:), intent(in) :: use_lake_model real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, slmsk, & From fe1d5845d6a965f6b93e4214c6fa02300e02b4af Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 4 Apr 2023 01:50:30 +0000 Subject: [PATCH 37/46] fix syntax error --- physics/sfc_diag.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index f5ca4a283..60917553f 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -92,7 +92,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & u10m(i) = f10m(i) * u1(i) v10m(i) = f10m(i) * v1(i) have_2m = use_lake_model(i)>0 .and. use_lake2m .and. & - & iopt_lake==iopt_lake_clm) then + & iopt_lake==iopt_lake_clm if(have_2m) then t2m(i) = lake_t2m(i) q2m(i) = lake_q2m(i) From 1a2be70f9c7a940413dc38fa3a5f8755d9cf00a8 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 4 Apr 2023 04:42:50 +0000 Subject: [PATCH 38/46] use integer constant for integer comparison --- physics/GFS_surface_composites_pre.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/GFS_surface_composites_pre.F90 index 7152f3166..98b9fecd2 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/GFS_surface_composites_pre.F90 @@ -73,7 +73,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l errflg = 0 do i=1,im - if(use_lake_model(i) > 0.0) then + if(use_lake_model(i) > 0) then wet(i) = .true. endif enddo From b9f1087747d3f4b775605649691c405236ae723e Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 4 Apr 2023 04:43:12 +0000 Subject: [PATCH 39/46] skip clm_lake_run if there are no lake points in the thread --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index b5a39b557..170df035b 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -472,7 +472,7 @@ SUBROUTINE clm_lake_run( & errmsg = ' ' errflg = 0 - if(iopt_lake/=iopt_lake_clm .or. lkm==0) then + if(iopt_lake/=iopt_lake_clm .or. lkm==0 .or. all(.not.use_lake_model)) then return ! nothing to do endif From b7cb04a7d9b7ecc7c3b4fa74b5f1b58f6a3e14ee Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 4 Apr 2023 05:07:10 +0000 Subject: [PATCH 40/46] integer, not logical --- physics/clm_lake.f90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 170df035b..b720c6bda 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -472,7 +472,7 @@ SUBROUTINE clm_lake_run( & errmsg = ' ' errflg = 0 - if(iopt_lake/=iopt_lake_clm .or. lkm==0 .or. all(.not.use_lake_model)) then + if(iopt_lake/=iopt_lake_clm .or. lkm==0 .or. all(use_lake_model==0)) then return ! nothing to do endif From cf604b5d9b1206c2c2e9497bedd2e8fc881823f9 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 14 Apr 2023 21:53:29 +0000 Subject: [PATCH 41/46] remove test code from clm_lake.f90 --- physics/clm_lake.f90 | 223 +------------------------------------------ 1 file changed, 4 insertions(+), 219 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index b720c6bda..4e44c921a 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -325,22 +325,6 @@ SUBROUTINE clm_lake_run( & real(kind_phys), dimension( :,: ) ,INTENT(inout) :: t_lake3d, & lake_icefrac3d -! Quick education on CCPP and deferred shape arrays. - -! CCPP requires deferred shape arrays as a workaround for its design -! flaw: it needs an argument that can receive either a null pointer, -! or an automatic storage array (which is not guaranteed to exist in -! memory at all). Such a thing doesn't exist in Fortran, so the design -! of CCPP assumes a compiler will accept either as an argument to a -! deferred shape array. - -! Apparently there is a misunderstanding among developers of how a -! deferred shape array is declared. If the array dimensions do not -! have an UPPER bound, then it is deferred shape. A LOWER bound is -! acceptable; it does not cease to be a deferred shape array. - -! That is why these seven arrays fit the CCPP design. - real(kind_phys), dimension( :,-nlevsnow+1: ) ,INTENT(inout) :: t_soisno3d, & h2osoi_ice3d, & h2osoi_liq3d, & @@ -443,25 +427,6 @@ SUBROUTINE clm_lake_run( & character*255 :: message logical, parameter :: feedback_to_atmosphere = .true. ! FIXME: REMOVE - ! Functionality to print extra values at problematic points specified by user - logical :: was_unhappy,is_unhappy - - ! Points come from this file - character(*), parameter :: unhappy_txt = "unhappy.txt" - - ! Special values of the unhappy_count to indicate data is unavailable - integer, parameter :: HAVE_NOT_READ_UNHAPPY_POINTS_YET = -1 - integer, parameter :: FAILED_TO_READ_UNHAPPY_POINTS = -2 - - ! These "save" variables are protected by an OMP CRITICAL to - ! ensure they're only initialized once. - - ! Number of unhappy points - integer, save :: unhappy_count = HAVE_NOT_READ_UNHAPPY_POINTS_YET - - ! The latitude and longitude of unhappy points. - real(kind_lake), allocatable, save :: unhappy_lat(:),unhappy_lon(:) - real(kind_lake) :: to_radians, lat_d, lon_d, qss integer :: month,num1,num2,day_of_month @@ -478,34 +443,6 @@ SUBROUTINE clm_lake_run( & dtime=dtp - if(LAKEDEBUG) then - ! Have we read the unhappy points? - ! The first "if" ensures we don't initiate an OMP CRITICAL unless we have to. - if(unhappy_count==HAVE_NOT_READ_UNHAPPY_POINTS_YET) then - !$OMP CRITICAL - - ! Check unhappy_count again since it probably changed - ! during the setup of the omp critical, when another - ! thread read in the unhappy points. - if(unhappy_count==HAVE_NOT_READ_UNHAPPY_POINTS_YET) then - call read_unhappy_points - if(unhappy_count>0) then -1308 format("Read ",I0,' points from unhappy point list file "',A,'"!') - print 1308,unhappy_count,unhappy_txt -8031 format('Read unhappy xlat_d=',F20.12,' xlon_d=',F20.12) - do i=1,unhappy_count - print 8031,unhappy_lat(i),unhappy_lon(i) - enddo - endif - endif - !$OMP END CRITICAL - endif - ! At this point, at least one thread should have read in the unhappy points. - if(unhappy_count==FAILED_TO_READ_UNHAPPY_POINTS .and. kdt<2) then - write(0,'(A)') "Could not read unhappy points. Will not print unhappy point data." - endif - endif - ! Initialize any uninitialized lake points. call lakeini(kdt=kdt, ISLTYP=ISLTYP, gt0=gt0, snowd=snowd, weasd=weasd, & lakedepth_default=lakedepth_default, fhour=fhour, & @@ -656,13 +593,6 @@ SUBROUTINE clm_lake_run( & enddo enddo - if(LAKEDEBUG.and.kdt<3) then - was_unhappy = point_is_unhappy(xlat_d(i),xlon_d(i)) - if(was_unhappy) then - print *,'Unhappy point before LakeMain t_lake = ',t_lake(1,:) - print *,'Unhappy point before LakeMain t_soilsno = ',t_soisno(1,:) - endif - endif eflx_lwrad_net = -9999 eflx_gnet = -9999 @@ -678,7 +608,6 @@ SUBROUTINE clm_lake_run( & lat_d = xlat_d(i) lon_d = xlon_d(i) - is_unhappy=.false. CALL LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I forc_hgt_t,forc_hgt_u,forc_q, forc_u, & forc_v,forc_lwrad,prec, sabg,lat, & @@ -692,21 +621,7 @@ SUBROUTINE clm_lake_run( & t_ref2m,q_ref2m, dtime, & watsat, tksatu, tkmg, tkdry, csol, & taux,tauy,ram1,z0mg,ustar_out,errmsg,errflg, & - lat_d,lon_d,is_unhappy) - if(LAKEDEBUG) then - if((was_unhappy .or. is_unhappy) .and. kdt<3) then - print *,'Unhappy point after LakeMain t_lake = ',t_lake(1,:) - print *,'Unhappy point after LakeMain t_soilsno = ',t_soisno(1,:) - endif - if(is_unhappy .and. kdt<3) then -3081 format('UNHAPPY AT: lat=',F20.12,' lon=',F20.12) - print 3081,xlat_d(i),xlon_d(i) - endif - if(errflg/=0) then - errflg=0 ! Bad. Remove this - ! return ! should do this instead - endif - endif + lat_d,lon_d) ! Renew Lake State Variables:(14) do c = 1,column @@ -857,129 +772,6 @@ SUBROUTINE clm_lake_run( & print 3082,kdt,me,lake_points,snow_points,ice_points endif - CONTAINS - - logical function point_is_unhappy(xlat_d,xlon_d) - ! Is this point near one of the points read in from the unhappy_txt file? - ! If lakedebug is false, then it will return false immediately. - implicit none - integer :: j - real(kind_phys), intent(in) :: xlat_d,xlon_d - - if(lakedebug) then - do j=1,unhappy_count - if(abs(xlat_d-unhappy_lat(j))<.015 .and. abs(xlon_d-unhappy_lon(j))<.015) then - point_is_unhappy=.true. -1444 format('Now processing unhappy point ',I0,' location xlat_d=',F20.12,' xlon_d=',F20.12,' close to xlat_d=',F20.12,' xlon_d=',F20.12) - print 1444,j,xlat_d,xlon_d,unhappy_lat(j),unhappy_lon(j) - return - endif - enddo - endif - - ! No points matched or lakedebug is disabled. - point_is_unhappy=.false. - end function point_is_unhappy - - subroutine read_unhappy_points - ! Reads points from unhappy_txt file into unhappy_lat and unhappy lon. - ! Sets unhappy_count to the number of points read in. - ! On error, sets unhappy_count to FAILED_TO_READ_UNHAPPY_POINTS - ! - ! Also allocates unhappy_lat and unhappy_lon. Their size may - ! be larger than the number of unhappy points if the header - ! line with the point count has a higher count than the - ! number of data lines. - ! - ! File format is: - ! ------------------------------------------ - ! |5 | number of points to read in. - ! |12.34567890000000000 12.34567890000000000| Lat and lon, exactly 20 characters each, with one space between - ! | 18.70411 134.4567890000000000| Lat and lon, exactly 20 characters each, with one space between - ! |-19.8567890000000000 -134.05| Lat and lon, exactly 20 characters each, with one space between - ! |36.34567890000000000 28.34567890000000000| Lat and lon, exactly 20 characters each, with one space between - ! |-85.4567890000000000 -41.4567890000000000| Lat and lon, exactly 20 characters each, with one space between - ! ------------------------------------------- - ! - ! Longitudes must be between -180 and +180 degrees. - ! - ! If the lat and lon fields are not exactly 20 characters, - ! with one space between them, the code will not work. You - ! can space-pad them before the number or put lots of zeros - ! after the decimal point. - use ISO_FORTRAN_ENV, only: iostat_end, iostat_eor - implicit none - integer :: i,unhappy_iostat,unhappy_unit,expect_count,actual_count - - ! This uses GOTOs to mimics a try-catch construct. Do not - ! remove the GOTOs. They are the cleanest and most - ! maintainable way to implement error handlers in Fortran - ! when a long cleanup block is required in multiple places. - - ! Number of points actually read in is 0 since we haven't read yet. - actual_count=0 - - ! Open the unhappy points file - open(file=unhappy_txt,form='formatted',newunit=unhappy_unit,action='read',iostat=unhappy_iostat,status='old') - if(unhappy_iostat/=0) then - write(message,'(A,A,A)') 'Could not open "',unhappy_txt,'"!!' - goto 1001 ! Error handler without closing file - endif - - ! Determine how many points to read in. - expect_count=-1 - read(unit=unhappy_unit,fmt='(I12)',iostat=unhappy_iostat) expect_count - if(unhappy_iostat/=0 .or. expect_count<0) then - write(message,'(A,A,A)') 'Could not read unhappy point count from "',unhappy_txt,'"!!' - goto 1000 ! Error handler that also closes the file - endif - - ! Allocate enough data for the number of points we expect to read in - allocate(unhappy_lat(expect_count)) - allocate(unhappy_lon(expect_count)) - - unhappy_lat = -999 - unhappy_lon = -999 - - ! Read data, and determine the number of points actually in the file - do i=1,expect_count - read(unit=unhappy_unit,fmt='(F20.14,F20.14)',iostat=unhappy_iostat) & - unhappy_lat(actual_count+1),unhappy_lon(actual_count+1) - if(unhappy_iostat==iostat_end) then - exit - else if(unhappy_iostat==iostat_eor) then - continue ! Probably a blank line - else if(unhappy_iostat/=0) then - write(message,'(A,A,A)') 'Error reading from "',unhappy_txt,'"!!' - goto 1000 ! Error handler that also closes the file - else - actual_count=actual_count+1 - endif - enddo - - ! Indicate successful read by setting the unhappy_count to the number of points actually read in. - unhappy_count=actual_count - close(unhappy_iostat) - - return ! Success! - - ! Error handlers. - - ! Theses do not set errmsg or error flag because this is - ! just an error in setting up a diagnostic, not in the model - ! itself. - -1000 continue ! Error handler, after file is opened - close(unhappy_iostat) - -1001 continue ! Error handler, whether file was opened or not - write(0,'(A)') message - if(allocated(unhappy_lat)) deallocate(unhappy_lat) - if(allocated(unhappy_lon)) deallocate(unhappy_lon) - unhappy_count=FAILED_TO_READ_UNHAPPY_POINTS - - end subroutine read_unhappy_points - END SUBROUTINE clm_lake_run @@ -995,11 +787,10 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I eflx_sh_tot,eflx_lh_tot, & t_ref2m,q_ref2m, dtime, & watsat, tksatu, tkmg, tkdry, csol, & - taux,tauy,ram1,z0mg,ustar_out,errmsg,errflg, xlat_d,xlon_d,unhappy) + taux,tauy,ram1,z0mg,ustar_out,errmsg,errflg, xlat_d,xlon_d) implicit none !in: - logical :: unhappy integer, intent(inout) :: errflg character(*), intent(inout) :: errmsg real(kind_lake),intent(in) :: dtime ! timestep @@ -1146,7 +937,7 @@ SUBROUTINE LakeMain(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, & !I eflx_sh_grnd,eflx_lwrad_out,eflx_lwrad_net, & eflx_soil_grnd,eflx_sh_tot,eflx_lh_tot, & eflx_lh_grnd,t_veg,t_ref2m,q_ref2m,taux,tauy, & - ram1,ws,ks,eflx_gnet,z0mg,ustar_out,errmsg,errflg,xlat_d,xlon_d,unhappy) + ram1,ws,ks,eflx_gnet,z0mg,ustar_out,errmsg,errflg,xlat_d,xlon_d) if(errflg/=0) then return ! State is invalid now, so pass error to caller. endif @@ -1201,7 +992,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, eflx_sh_grnd,eflx_lwrad_out,eflx_lwrad_net, & eflx_soil_grnd,eflx_sh_tot,eflx_lh_tot, & eflx_lh_grnd,t_veg,t_ref2m,q_ref2m,taux,tauy, & - ram1,ws,ks,eflx_gnet,z0mg,ustar_out,errmsg,errflg,xlat_d,xlon_d,unhappy) + ram1,ws,ks,eflx_gnet,z0mg,ustar_out,errmsg,errflg,xlat_d,xlon_d) !============================================================================== ! DESCRIPTION: ! Calculates lake temperatures and surface fluxes for shallow lakes. @@ -1224,7 +1015,6 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, !in: integer, intent(inout) :: errflg - logical :: unhappy character(len=*), intent(inout) :: errmsg real(kind_lake),intent(in) :: xlat_d,xlon_d real(kind_lake),intent(in) :: forc_t(1) ! atmospheric temperature (Kelvin) @@ -1364,8 +1154,6 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! data eta /0.1_kind_lake, 0.5_kind_lake/ !----------------------------------------------------------------------- - unhappy=.false. - ! Begin calculations !dir$ concurrent @@ -1384,7 +1172,6 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, if (snl(c) > 0 .or. snl(c) < -5) then errmsg='snl is not defined in ShalLakeFluxesMod; snl: out of range value' errflg=1 - unhappy=.true. return ! Cannot continue end if ! if (snl(c) /= 0) then @@ -1699,7 +1486,6 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, if (abs(eflx_sh_tot(p)) > 1500 .or. abs(eflx_lh_tot(p)) > 1500) then 3018 format('CLM_Lake ShalLakeFluxes: WARNING: SH=',F12.4,' LH=',F12.4,' at xlat_d=',F10.3,' xlon_d=',F10.3) print 3018,eflx_sh_tot(p), eflx_lh_tot(p),xlat_d,xlon_d - unhappy = .true. end if if (abs(eflx_sh_tot(p)) > 10000 .or. abs(eflx_lh_tot(p)) > 10000 & .or. abs(t_grnd(c)-288)>200 ) then @@ -1708,7 +1494,6 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! errmsg=message ! errflg=1 write(0,'(A)') trim(message) - unhappy = .true. endif endif ! 2 m height air temperature From 6a15a0a6185f821e90448221c2cbc51b41f50ef4 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 19 Apr 2023 18:22:03 +0000 Subject: [PATCH 42/46] remove repeated constants --- physics/clm_lake.f90 | 24 ++++++++++++++++-------- physics/clm_lake.meta | 16 ++++++++++++++++ physics/sfc_diff.f | 2 -- physics/sfc_diff.meta | 7 ------- 4 files changed, 32 insertions(+), 17 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 4e44c921a..c206b9af0 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -99,6 +99,9 @@ MODULE clm_lake real(kind_lake) :: invhsub !1/hsub [kg/J] real(kind_lake) :: rair !gas constant for dry air [J/kg/K] real(kind_lake) :: cpair !specific heat of dry air [J/kg/K] + real(kind_lake) :: con_eps !ratio of gas constants of air and water vapor [unitless] + real(kind_lake) :: one_minus_con_eps !1 - con_eps [unitless] + real(kind_lake) :: con_fvirt !1/con_eps - 1 [unitless] real(kind_lake), public, parameter :: spval = 1.e36 !special value for missing data (ocean) real(kind_lake), parameter :: depth_c = 50. !below the level t_lake3d will be 277.0 !mchen @@ -1159,8 +1162,8 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, !dir$ concurrent !cdir nodep forc_th(1) = forc_t(1) * (forc_psrf(1)/ forc_pbot(1))**(rair/cpair) - forc_vp(1) = forc_q(1) * forc_pbot(1)/ (0.622 + 0.378 * forc_q(1)) - forc_rho(1) = (forc_pbot(1) - 0.378 * forc_vp(1)) / (rair * forc_t(1)) + forc_vp(1) = forc_q(1) * forc_pbot(1)/ (con_eps + one_minus_con_eps * forc_q(1)) + forc_rho(1) = (forc_pbot(1) - one_minus_con_eps * forc_vp(1)) / (rair * forc_t(1)) do fc = 1, num_shlakec c = filter_shlakec(fc) @@ -1199,7 +1202,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! reference height thm(c) = forc_t(g) + 0.0098_kind_lake*forc_hgt_t(g) ! intermediate variable - thv(c) = forc_th(g)*(1._kind_lake+0.61_kind_lake*forc_q(g)) ! virtual potential T + thv(c) = forc_th(g)*(1._kind_lake+con_fvirt*forc_q(g)) ! virtual potential T end do !dir$ concurrent @@ -1278,7 +1281,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ur(p) = max(1.0_kind_lake,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) dth(p) = thm(c)-t_grnd(c) dqh(p) = forc_q(g)-qsatg(c) - dthv = dth(p)*(1._kind_lake+0.61_kind_lake*forc_q(g))+0.61_kind_lake*forc_th(g)*dqh(p) + dthv = dth(p)*(1._kind_lake+con_fvirt*forc_q(g))+con_fvirt*forc_th(g)*dqh(p) zldis(p) = forc_hgt_u(g) - 0._kind_lake ! Initialize Monin-Obukhov length and wind speed @@ -1380,7 +1383,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, tstar = temp1(p)*dth(p) qstar = temp2(p)*dqh(p) - thvstar=tstar*(1._kind_lake+0.61_kind_lake*forc_q(g)) + 0.61_kind_lake*forc_th(g)*qstar + thvstar=tstar*(1._kind_lake+con_fvirt*forc_q(g)) + con_fvirt*forc_th(g)*qstar zeta=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c)) if (zeta >= 0._kind_lake) then !stable @@ -3742,7 +3745,7 @@ subroutine QSat (T, p, es, esdT, qs, qsdT) es = es * 100. ! pa esdT = esdT * 100. ! pa/K - vp = 1.0 / (p - 0.378*es) + vp = 1.0 / (p - one_minus_con_eps*es) vp1 = 0.622 * vp vp2 = vp1 * vp @@ -5133,10 +5136,12 @@ end subroutine MoninObukIni !! \htmlinclude clm_lake_init.html !! subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,con_cliq, & - con_hfus,con_hvap,con_rd,con_cp,rholakeice,clm_lake_debug,errmsg,errflg) + con_hfus,con_hvap,con_rd,con_cp,rholakeice,clm_lake_debug, & + con_eps_model,con_fvirt_model,errmsg,errflg) implicit none real(kind_phys), intent(in) :: con_pi,karman,con_g,con_sbc,con_t0c, & - rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp,rholakeice + rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp, & + rholakeice,con_eps_model,con_fvirt_model INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg logical, intent(in) :: clm_lake_debug @@ -5166,6 +5171,9 @@ subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,c invhsub = 1._kind_lake/hsub rair = con_rd cpair = con_cp + con_eps = con_eps_model + con_fvirt = con_fvirt_model + one_minus_con_eps = 1.0_kind_lake - con_eps ! dzlak(1) = 0.1_kind_lake ! dzlak(2) = 1._kind_lake diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 035787aff..bbaaded16 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -895,6 +895,22 @@ type = real kind = kind_phys intent = in +[con_eps_model] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_fvirt_model] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [con_cp] standard_name = specific_heat_of_dry_air_at_constant_pressure long_name = specific heat of dry air at constant pressure diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 0ca7ced16..6e834537a 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -78,7 +78,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & fh2_wat, fh2_lnd, fh2_ice, & !intent(inout) & ztmax_wat, ztmax_lnd, ztmax_ice, & !intent(inout) & zvfun, & !intent(out) - & use_lake_model, & !intent(in) & errmsg, errflg) !intent(out) ! implicit none @@ -88,7 +87,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean integer, dimension(:), intent(in) :: vegtype - integer, dimension(:), intent(in) :: use_lake_model logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index e0fedfa45..eb30b8c50 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -565,13 +565,6 @@ type = real kind = kind_phys intent = inout -[use_lake_model] - standard_name = flag_for_using_lake_model - long_name = flag indicating lake points using a lake model - units = flag - dimensions = (horizontal_loop_extent) - type = integer - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 783af0ef9ad228f0710d26d4a461f34731c7c280 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 19 Apr 2023 18:22:03 +0000 Subject: [PATCH 43/46] remove repeated constants and redundant variable --- physics/clm_lake.f90 | 24 ++++++++++++++++-------- physics/clm_lake.meta | 16 ++++++++++++++++ physics/sfc_diff.f | 2 -- physics/sfc_diff.meta | 7 ------- 4 files changed, 32 insertions(+), 17 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 4e44c921a..c206b9af0 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -99,6 +99,9 @@ MODULE clm_lake real(kind_lake) :: invhsub !1/hsub [kg/J] real(kind_lake) :: rair !gas constant for dry air [J/kg/K] real(kind_lake) :: cpair !specific heat of dry air [J/kg/K] + real(kind_lake) :: con_eps !ratio of gas constants of air and water vapor [unitless] + real(kind_lake) :: one_minus_con_eps !1 - con_eps [unitless] + real(kind_lake) :: con_fvirt !1/con_eps - 1 [unitless] real(kind_lake), public, parameter :: spval = 1.e36 !special value for missing data (ocean) real(kind_lake), parameter :: depth_c = 50. !below the level t_lake3d will be 277.0 !mchen @@ -1159,8 +1162,8 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, !dir$ concurrent !cdir nodep forc_th(1) = forc_t(1) * (forc_psrf(1)/ forc_pbot(1))**(rair/cpair) - forc_vp(1) = forc_q(1) * forc_pbot(1)/ (0.622 + 0.378 * forc_q(1)) - forc_rho(1) = (forc_pbot(1) - 0.378 * forc_vp(1)) / (rair * forc_t(1)) + forc_vp(1) = forc_q(1) * forc_pbot(1)/ (con_eps + one_minus_con_eps * forc_q(1)) + forc_rho(1) = (forc_pbot(1) - one_minus_con_eps * forc_vp(1)) / (rair * forc_t(1)) do fc = 1, num_shlakec c = filter_shlakec(fc) @@ -1199,7 +1202,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ! reference height thm(c) = forc_t(g) + 0.0098_kind_lake*forc_hgt_t(g) ! intermediate variable - thv(c) = forc_th(g)*(1._kind_lake+0.61_kind_lake*forc_q(g)) ! virtual potential T + thv(c) = forc_th(g)*(1._kind_lake+con_fvirt*forc_q(g)) ! virtual potential T end do !dir$ concurrent @@ -1278,7 +1281,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, ur(p) = max(1.0_kind_lake,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) dth(p) = thm(c)-t_grnd(c) dqh(p) = forc_q(g)-qsatg(c) - dthv = dth(p)*(1._kind_lake+0.61_kind_lake*forc_q(g))+0.61_kind_lake*forc_th(g)*dqh(p) + dthv = dth(p)*(1._kind_lake+con_fvirt*forc_q(g))+con_fvirt*forc_th(g)*dqh(p) zldis(p) = forc_hgt_u(g) - 0._kind_lake ! Initialize Monin-Obukhov length and wind speed @@ -1380,7 +1383,7 @@ SUBROUTINE ShalLakeFluxes(forc_t,forc_pbot,forc_psrf,forc_hgt,forc_hgt_q, tstar = temp1(p)*dth(p) qstar = temp2(p)*dqh(p) - thvstar=tstar*(1._kind_lake+0.61_kind_lake*forc_q(g)) + 0.61_kind_lake*forc_th(g)*qstar + thvstar=tstar*(1._kind_lake+con_fvirt*forc_q(g)) + con_fvirt*forc_th(g)*qstar zeta=zldis(p)*vkc * grav*thvstar/(ustar(p)**2*thv(c)) if (zeta >= 0._kind_lake) then !stable @@ -3742,7 +3745,7 @@ subroutine QSat (T, p, es, esdT, qs, qsdT) es = es * 100. ! pa esdT = esdT * 100. ! pa/K - vp = 1.0 / (p - 0.378*es) + vp = 1.0 / (p - one_minus_con_eps*es) vp1 = 0.622 * vp vp2 = vp1 * vp @@ -5133,10 +5136,12 @@ end subroutine MoninObukIni !! \htmlinclude clm_lake_init.html !! subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,con_cliq, & - con_hfus,con_hvap,con_rd,con_cp,rholakeice,clm_lake_debug,errmsg,errflg) + con_hfus,con_hvap,con_rd,con_cp,rholakeice,clm_lake_debug, & + con_eps_model,con_fvirt_model,errmsg,errflg) implicit none real(kind_phys), intent(in) :: con_pi,karman,con_g,con_sbc,con_t0c, & - rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp,rholakeice + rhowater,con_csol,con_cliq, con_hfus,con_hvap,con_rd,con_cp, & + rholakeice,con_eps_model,con_fvirt_model INTEGER, INTENT(OUT) :: errflg CHARACTER(*), INTENT(OUT) :: errmsg logical, intent(in) :: clm_lake_debug @@ -5166,6 +5171,9 @@ subroutine clm_lake_init(con_pi,karman,con_g,con_sbc,con_t0c,rhowater,con_csol,c invhsub = 1._kind_lake/hsub rair = con_rd cpair = con_cp + con_eps = con_eps_model + con_fvirt = con_fvirt_model + one_minus_con_eps = 1.0_kind_lake - con_eps ! dzlak(1) = 0.1_kind_lake ! dzlak(2) = 1._kind_lake diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 035787aff..bbaaded16 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -895,6 +895,22 @@ type = real kind = kind_phys intent = in +[con_eps_model] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in +[con_fvirt_model] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in [con_cp] standard_name = specific_heat_of_dry_air_at_constant_pressure long_name = specific heat of dry air at constant pressure diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 0ca7ced16..6e834537a 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -78,7 +78,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & fh2_wat, fh2_lnd, fh2_ice, & !intent(inout) & ztmax_wat, ztmax_lnd, ztmax_ice, & !intent(inout) & zvfun, & !intent(out) - & use_lake_model, & !intent(in) & errmsg, errflg) !intent(out) ! implicit none @@ -88,7 +87,6 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) integer, intent(in) :: sfc_z0_type ! option for calculating surface roughness length over ocean integer, dimension(:), intent(in) :: vegtype - integer, dimension(:), intent(in) :: use_lake_model logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index e0fedfa45..eb30b8c50 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -565,13 +565,6 @@ type = real kind = kind_phys intent = inout -[use_lake_model] - standard_name = flag_for_using_lake_model - long_name = flag indicating lake points using a lake model - units = flag - dimensions = (horizontal_loop_extent) - type = integer - intent = in [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP From 3929f9fe32d74e427a400041d1347466442177b5 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 19 Apr 2023 18:25:46 +0000 Subject: [PATCH 44/46] remove redundant .not.have_2m in sfc_diag.f --- physics/sfc_diag.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index 60917553f..768814e8c 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -149,7 +149,7 @@ subroutine sfc_diag_run (im,xlat_d,xlon_d, & q2m(i) = qsurf(i)*wrk + max(qmin,q1c)*fhi endif ! flux method - if(.not. have_2m .and. diag_log) then + if(diag_log) then !-- Alternative logarithmic diagnostics: dT = t1(i) - tskin(i) dQ = qv1 - qsfcmr From 37dd7a570178904dd0032a655ae20ec23dadb361 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 19 Apr 2023 18:29:19 +0000 Subject: [PATCH 45/46] explain why kind_lake exists --- physics/clm_lake.f90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index c206b9af0..4fc4112ce 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -35,6 +35,10 @@ MODULE clm_lake public :: clm_lake_run, clm_lake_init, LAKEDEBUG + ! In WRF, the CLM Lake Model was hard-coded to use double precision, regardless of + ! precision of physics. For that reason, we retain double precision here. However, + ! we're not yet certain that all of CLM Lake needs to be double precision, so we + ! maintain a "kind_lake" to allow future experimentation in datatypes. integer, parameter, public :: kind_lake = kind_dbl_prec logical :: LAKEDEBUG = .false. ! Enable lots of checks and debug prints and errors From 4d691081e46d17d5b77b6aa7714ba2a369088ae4 Mon Sep 17 00:00:00 2001 From: Grant Firl Date: Wed, 14 Jun 2023 14:25:38 -0400 Subject: [PATCH 46/46] fix bug in scm_sfc_flux_spec.F90 --- physics/scm_sfc_flux_spec.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/scm_sfc_flux_spec.F90 b/physics/scm_sfc_flux_spec.F90 index 835b468ff..e835b77ff 100644 --- a/physics/scm_sfc_flux_spec.F90 +++ b/physics/scm_sfc_flux_spec.F90 @@ -58,9 +58,9 @@ subroutine scm_sfc_flux_spec_run (im, u1, v1, z1, t1, q1, p1, roughness_length, use machine, only: kind_phys integer, intent(in) :: im, lkm - integer, intent(inout) :: islmsk(:) + integer, intent(inout) :: islmsk(:), use_lake_model(:) logical, intent(in) :: cplflx, cplice - logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:), use_lake_model(:) + logical, intent(inout) :: dry(:), icy(:), flag_cice(:), wet(:) real(kind=kind_phys), intent(in) :: cp, grav, hvap, rd, fvirt, vonKarman, min_seaice, tgice, min_lakeice real(kind=kind_phys), intent(in) :: u1(:), v1(:), z1(:), t1(:), q1(:), p1(:), roughness_length(:), & spec_sh_flux(:), spec_lh_flux(:), exner_inverse(:), T_surf(:), oceanfrac(:), lakefrac(:), lakedepth(:)