From 8f54257bb79106320d6d366fe62f67b4f0640f01 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 15:48:05 +0000 Subject: [PATCH 1/6] add new flag to track new clm lake freezing grid and let gfs sfclay update stibility variables --- physics/GFS_surface_composites_pre.F90 | 4 +++- physics/clm_lake.f90 | 9 ++++++++- physics/clm_lake.meta | 7 +++++++ physics/sfc_diff.f | 4 +++- physics/sfc_diff.meta | 7 +++++++ 5 files changed, 28 insertions(+), 3 deletions(-) diff --git a/physics/GFS_surface_composites_pre.F90 b/physics/GFS_surface_composites_pre.F90 index 98b9fecd2..fd16dea59 100644 --- a/physics/GFS_surface_composites_pre.F90 +++ b/physics/GFS_surface_composites_pre.F90 @@ -241,8 +241,10 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, iopt_lake, iopt_l !mjz tsfcl(i) = huge endif + if (icy(i) .or. wet(i)) then ! init uustar_ice for all water/ice grids + uustar_ice(i) = uustar(i) + endif if (icy(i)) then ! Ice - uustar_ice(i) = uustar(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) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index 620f79a96..64c458a36 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,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, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, ISLTYP, rainncprv, raincprv, & + flag_iter, lake_freeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & @@ -325,6 +325,8 @@ SUBROUTINE clm_lake_run( & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter + LOGICAL, DIMENSION(:), INTENT(INOUT) :: lake_freeze + INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP ! @@ -754,6 +756,11 @@ SUBROUTINE clm_lake_run( & weasd(i) = weasdi(i) snowd(i) = snodi(c) ! surface_snow_thickness_water_equivalent_over_ice + + if (icy(i) .eq. .false.) then + lake_freeze(i)=.true. + end if + ! Ice points are icy: icy(i)=.true. ! flag_nonzero_sea_ice_surface_fraction ice_points = ice_points+1 diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 11a44286a..31d0bdb6e 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -328,6 +328,13 @@ dimensions = (horizontal_loop_extent) type = logical intent = in +[lake_freeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout [isltyp] standard_name = soil_type_classification long_name = soil type at each grid cell diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 6e834537a..0607748b6 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -60,6 +60,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) + & lake_freeze, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) @@ -90,6 +91,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy + logical, dimension(:), intent(in) :: lake_freeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation @@ -168,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i)) then + if(flag_iter(i) .or. lake_freeze(i) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index eb30b8c50..7abb703cd 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -194,6 +194,13 @@ dimensions = () type = logical intent = in +[lake_freeze] + standard_name = flag_for_lake_water_freeze + long_name = flag for lake water freeze + units = flag + dimensions = (horizontal_loop_extent) + type = logical + intent = inout [u10m] standard_name = x_wind_at_10m long_name = 10 meter u wind speed From 99997c677be9f60768a467996fb99ff993f51b0f Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 18:23:19 +0000 Subject: [PATCH 2/6] change lake_freeze intent to input only in sfc_diff meta --- physics/sfc_diff.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 7abb703cd..d10a29d29 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -200,7 +200,7 @@ units = flag dimensions = (horizontal_loop_extent) type = logical - intent = inout + intent = in [u10m] standard_name = x_wind_at_10m long_name = 10 meter u wind speed From 2ceb88bb7c32f37e80c63deba174c8ebb1240a85 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Mon, 18 Dec 2023 18:49:05 +0000 Subject: [PATCH 3/6] add missing parentheses --- physics/sfc_diff.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 0607748b6..bf2e8cde0 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -170,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i) .or. lake_freeze(i) then + if(flag_iter(i) .or. lake_freeze(i)) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 From 8941516ed69145557a90794a2fb1253e373c3661 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 00:31:25 +0000 Subject: [PATCH 4/6] fix compiling error for gnu --- 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 64c458a36..f58da2fa3 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -757,7 +757,7 @@ SUBROUTINE clm_lake_run( & snowd(i) = snodi(c) ! surface_snow_thickness_water_equivalent_over_ice - if (icy(i) .eq. .false.) then + if (.not. icy(i)) then lake_freeze(i)=.true. end if From 0fbcc9f62ad182ded98fcde2e4c2287ee3334738 Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 15:22:38 +0000 Subject: [PATCH 5/6] change name of lake_freeze to flag_lakefreeze --- physics/clm_lake.f90 | 6 +++--- physics/clm_lake.meta | 2 +- physics/sfc_diff.f | 6 +++--- physics/sfc_diff.meta | 2 +- 4 files changed, 8 insertions(+), 8 deletions(-) diff --git a/physics/clm_lake.f90 b/physics/clm_lake.f90 index f58da2fa3..77d647812 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,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, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, lake_freeze, ISLTYP, rainncprv, raincprv, & + flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, & @@ -325,7 +325,7 @@ SUBROUTINE clm_lake_run( & rainncprv, raincprv REAL(KIND_PHYS), DIMENSION(:,:), INTENT(in) :: gu0, gv0, prsi, gt0, phii LOGICAL, DIMENSION(:), INTENT(IN) :: flag_iter - LOGICAL, DIMENSION(:), INTENT(INOUT) :: lake_freeze + LOGICAL, DIMENSION(:), INTENT(INOUT) :: flag_lakefreeze INTEGER, DIMENSION(:), INTENT(IN) :: ISLTYP @@ -758,7 +758,7 @@ SUBROUTINE clm_lake_run( & if (.not. icy(i)) then - lake_freeze(i)=.true. + flag_lakefreeze(i)=.true. end if ! Ice points are icy: diff --git a/physics/clm_lake.meta b/physics/clm_lake.meta index 31d0bdb6e..5c454dd11 100644 --- a/physics/clm_lake.meta +++ b/physics/clm_lake.meta @@ -328,7 +328,7 @@ dimensions = (horizontal_loop_extent) type = logical intent = in -[lake_freeze] +[flag_lakefreeze] standard_name = flag_for_lake_water_freeze long_name = flag for lake water freeze units = flag diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index bf2e8cde0..c5ed8bfa6 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -60,7 +60,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & sigmaf,vegtype,shdmax,ivegsrc, & !intent(in) & z0pert,ztpert, & ! mg, sfc-perts !intent(in) & flag_iter,redrag, & !intent(in) - & lake_freeze, & !intent(in) + & flag_lakefreeze, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !intent(in) & thsfc_loc, & !intent(in) @@ -91,7 +91,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) logical, intent(in) :: redrag ! reduced drag coeff. flag for high wind over sea (j.han) logical, dimension(:), intent(in) :: flag_iter, dry, icy - logical, dimension(:), intent(in) :: lake_freeze + logical, dimension(:), intent(in) :: flag_lakefreeze logical, dimension(:), intent(inout) :: wet logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation @@ -170,7 +170,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! write(0,*)'in sfc_diff, sfc_z0_type=',sfc_z0_type do i=1,im - if(flag_iter(i) .or. lake_freeze(i)) then + if(flag_iter(i) .or. flag_lakefreeze(i)) then ! Need to initialize ztmax arrays ztmax_lnd(i) = 1. ! log(1) = 0 diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index d10a29d29..1aaad7239 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -194,7 +194,7 @@ dimensions = () type = logical intent = in -[lake_freeze] +[flag_lakefreeze] standard_name = flag_for_lake_water_freeze long_name = flag for lake water freeze units = flag From a9208405adffd6b1b6389ac3f1331097b05069ad Mon Sep 17 00:00:00 2001 From: Jili Dong Date: Tue, 19 Dec 2023 16:45:32 +0000 Subject: [PATCH 6/6] remove excess whitespace --- 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 77d647812..607c0b2df 100644 --- a/physics/clm_lake.f90 +++ b/physics/clm_lake.f90 @@ -268,7 +268,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, oro_lakedepth, wind, rho0, tsfc, & - flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & + flag_iter, flag_lakefreeze, ISLTYP, rainncprv, raincprv, & ! Feedback to atmosphere: evap_wat, evap_ice, hflx_wat, hflx_ice, gflx_wat, gflx_ice, &