From b2560a5217de1eafcd6f4312499b7e0169a3d4ff Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Tue, 1 Jun 2021 21:00:46 -0400 Subject: [PATCH 1/9] updates to include snodi --- physics/GFS_surface_composites.F90 | 101 ++++++++++++---------------- physics/GFS_surface_composites.meta | 36 ---------- physics/flake_driver.meta | 8 +-- physics/module_MYNNSFC_wrapper.F90 | 7 +- physics/module_MYNNSFC_wrapper.meta | 9 --- physics/sfc_diff.f | 9 +-- physics/sfc_diff.meta | 9 --- 7 files changed, 55 insertions(+), 124 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index fd15fea9a..17766a2cd 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -30,9 +30,9 @@ end subroutine GFS_surface_composites_pre_finalize subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & flag_cice, cplflx, cplwav2atm, landfrac, lakefrac, lakedepth, oceanfrac, frland, & dry, icy, lake, use_flake, ocean, wet, hice, cice, zorlo, zorll, zorli, & - snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & + snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & tprcp_lnd, tprcp_ice, uustar, uustar_wat, uustar_lnd, uustar_ice, & - weasd, weasd_wat, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & + weasd, weasd_lnd, weasd_ice, ep1d_ice, tsfc, tsfco, tsfcl, tsfc_wat, & tsfc_lnd, tsfc_ice, tisfc, tice, tsurf_wat, tsurf_lnd, tsurf_ice, & gflx_ice, tgice, islmsk, islmsk_cice, slmsk, semis_rad, semis_wat, semis_lnd, semis_ice, & emis_lnd, emis_ice, qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & @@ -41,9 +41,9 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, implicit none ! Interface variables - integer, intent(in ) :: im, lkm - integer, intent(in ) :: lsm, lsm_noahmp, lsm_ruc - logical, intent(in ) :: flag_init, frac_grid, cplflx, cplwav2atm + integer, intent(in ) :: im, lkm + integer, intent(in ) :: lsm, lsm_noahmp, lsm_ruc + logical, intent(in ) :: flag_init, frac_grid, cplflx, cplwav2atm logical, dimension(:), intent(inout) :: flag_cice logical, dimension(:), intent(inout) :: dry, icy, lake, use_flake, ocean, wet real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac @@ -52,9 +52,9 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss, hflx real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl, tisfc - real(kind=kind_phys), dimension(:), intent(inout) :: snowd_wat, snowd_lnd, snowd_ice, tprcp_wat, & + real(kind=kind_phys), dimension(:), intent(inout) :: snowd_lnd, snowd_ice, tprcp_wat, & tprcp_lnd, tprcp_ice, tsfc_wat, tsfc_lnd, tsfc_ice, tsurf_wat,tsurf_lnd, tsurf_ice, & - uustar_wat, uustar_lnd, uustar_ice, weasd_wat, weasd_lnd, weasd_ice, & + uustar_wat, uustar_lnd, uustar_ice, weasd_lnd, weasd_ice, & qss_wat, qss_lnd, qss_ice, hflx_wat, hflx_lnd, hflx_ice, ep1d_ice, gflx_ice real(kind=kind_phys), dimension(:), intent( out) :: tice real(kind=kind_phys), intent(in ) :: tgice @@ -62,7 +62,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, real(kind=kind_phys), dimension(:), intent(in ) :: semis_rad real(kind=kind_phys), dimension(:), intent(inout) :: semis_wat, semis_lnd, semis_ice, slmsk real(kind=kind_phys), dimension(:), intent(inout) :: emis_lnd, emis_ice - real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice + real(kind=kind_phys), intent(in ) :: min_lakeice, min_seaice ! real(kind=kind_phys), dimension(:), intent(inout) :: zorlo, zorll, zorli ! @@ -102,6 +102,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, flag_cice(i) = .false. islmsk_cice(i) = 0 islmsk(i) = 0 + snowd_ice(i) = zero endif if (cice(i) < one) then wet(i) = .true. ! some open ocean @@ -116,6 +117,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, cice(i) = zero hice(i) = zero islmsk(i) = 0 + snowd_ice(i) = zero endif islmsk_cice(i) = islmsk(i) flag_cice(i) = .false. @@ -125,24 +127,37 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, endif endif else ! all land - cice(i) = zero - hice(i) = zero + cice(i) = zero + hice(i) = zero islmsk_cice(i) = 1 islmsk(i) = 1 + snowd_ice(i) = zero endif - enddo + enddo + + do i=1,im + if (dry(i)) then + snowd_lnd(i) = (snowd(i) - snowd_ice(i)*cice(i)*(one-frland(i))) / frland(i) + else + snowd_lnd(i) = zero + endif + enddo else do i = 1, IM if (islmsk(i) == 1) then -! tsfcl(i) = tsfc(i) - dry(i) = .true. - frland(i) = one - cice(i) = zero - hice(i) = zero +! tsfcl(i) = tsfc(i) + dry(i) = .true. + frland(i) = one + cice(i) = zero + hice(i) = zero + snowd_lnd(i) = snowd(i) + snowd_ice(i) = zero else - frland(i) = zero + frland(i) = zero + snowd_lnd(i) = zero + snowd_ice(i) = snowd(i) if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. @@ -161,6 +176,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, flag_cice(i) = .false. islmsk(i) = 0 islmsk_cice(i) = 0 + snowd_ice(i) = zero endif if (cice(i) < one) then wet(i) = .true. ! some open ocean @@ -172,9 +188,10 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, tisfc(i) = max(timin, min(tisfc(i), tgice)) islmsk(i) = 2 else - cice(i) = zero - hice(i) = zero - islmsk(i) = 0 + cice(i) = zero + hice(i) = zero + islmsk(i) = 0 + snowd_ice(i) = zero endif islmsk_cice(i) = islmsk(i) flag_cice(i) = .false. @@ -195,10 +212,6 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, ! uustar_wat(i) = uustar(i) tsfc_wat(i) = tsfco(i) tsurf_wat(i) = tsfco(i) -! weasd_wat(i) = weasd(i) -! snowd_wat(i) = snowd(i) - weasd_wat(i) = zero - snowd_wat(i) = zero !-- reference emiss value for surface emissivity in setemis ! 1-open water, 2-grass/shrub land, 3-bare soil, tundra, ! 4-sandy desert, 5-rocky desert, 6-forest, 7-ice, 8-snow @@ -214,7 +227,6 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, weasd_lnd(i) = weasd(i) tsfc_lnd(i) = tsfcl(i) tsurf_lnd(i) = tsfcl(i) - snowd_lnd(i) = snowd(i) if (iemsflg == 2 .and. .not. flag_init) then !-- use land emissivity from the LSM semis_lnd(i) = emis_lnd(i) @@ -263,33 +275,6 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, lkm, lsm, lsm_noahmp, endif enddo ! - if (frac_grid) then - do i=1,im - if (dry(i)) then - if (icy(i)) then - snowd_lnd(i) = snowd(i) / (frland(i) + cice(i)) - snowd_ice(i) = snowd_lnd(i) - else - snowd_lnd(i) = snowd(i) / frland(i) - snowd_ice(i) = zero - endif - elseif (icy(i)) then - snowd_lnd(i) = zero - snowd_ice(i) = snowd(i) / cice(i) - endif - enddo - else - do i=1,im - if (dry(i)) then - snowd_lnd(i) = snowd(i) - snowd_ice(i) = zero - elseif (icy(i)) then - snowd_lnd(i) = zero - snowd_ice(i) = snowd(i) / cice(i) - endif - enddo - endif - ! Assign sea ice temperature to interstitial variable do i = 1, im tice(i) = tisfc(i) @@ -410,7 +395,7 @@ subroutine GFS_surface_composites_post_run ( 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, & cmm, cmm_wat, cmm_lnd, cmm_ice, chh, chh_wat, chh_lnd, chh_ice, gflx, gflx_wat, gflx_lnd, gflx_ice, ep1d, ep1d_wat, & - ep1d_lnd, ep1d_ice, weasd, weasd_wat, weasd_lnd, weasd_ice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & + 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, tsfc_lnd, tsfc_ice, tisfc, tice, hice, cice, min_seaice, tiice, stc, & grav, prsik1, prslk1, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, errmsg, errflg) @@ -425,8 +410,8 @@ subroutine GFS_surface_composites_post_run ( 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, & fm10_wat, fm10_lnd, fm10_ice, fh2_wat, fh2_lnd, fh2_ice, tsurf_wat, tsurf_lnd, tsurf_ice, cmm_wat, cmm_lnd, cmm_ice, & - chh_wat, chh_lnd, chh_ice, gflx_wat, gflx_lnd, gflx_ice, ep1d_wat, ep1d_lnd, ep1d_ice, weasd_wat, weasd_lnd, weasd_ice, & - snowd_wat, snowd_lnd, snowd_ice,tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd, & + chh_wat, chh_lnd, chh_ice, gflx_wat, gflx_lnd, gflx_ice, ep1d_wat, ep1d_lnd, ep1d_ice, weasd_lnd, weasd_ice, & + snowd_lnd, snowd_ice, tprcp_wat, tprcp_lnd, tprcp_ice, evap_wat, evap_lnd, evap_ice, hflx_wat, hflx_lnd, & hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, tsfc_lnd, tsfc_ice, zorlo, zorll, zorli real(kind=kind_phys), dimension(:), intent(inout) :: zorl, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & @@ -473,8 +458,6 @@ subroutine GFS_surface_composites_post_run ( !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_wat(i) - !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_wat(i) - !snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + txo*snowd_wat(i) weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_wat(i) @@ -660,8 +643,8 @@ subroutine GFS_surface_composites_post_run ( chh(i) = chh_wat(i) gflx(i) = gflx_wat(i) ep1d(i) = ep1d_wat(i) - weasd(i) = weasd_wat(i) - snowd(i) = snowd_wat(i) + weasd(i) = zero + snowd(i) = zero evap(i) = evap_wat(i) hflx(i) = hflx_wat(i) qss(i) = qss_wat(i) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 9a97ed14d..88e5fc818 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -234,15 +234,6 @@ kind = kind_phys intent = in optional = F -[snowd_wat] - standard_name = surface_snow_thickness_water_equivalent_over_water - long_name = water equivalent snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [snowd_lnd] standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land @@ -342,15 +333,6 @@ kind = kind_phys intent = in optional = F -[weasd_wat] - standard_name = water_equivalent_accumulated_snow_depth_over_water - long_name = water equiv of acc snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [weasd_lnd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land @@ -1559,15 +1541,6 @@ kind = kind_phys intent = inout optional = F -[weasd_wat] - standard_name = water_equivalent_accumulated_snow_depth_over_water - long_name = water equiv of acc snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [weasd_lnd] standard_name = water_equivalent_accumulated_snow_depth_over_land long_name = water equiv of acc snow depth over land @@ -1595,15 +1568,6 @@ kind = kind_phys intent = inout optional = F -[snowd_wat] - standard_name = surface_snow_thickness_water_equivalent_over_water - long_name = water equivalent snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [snowd_lnd] standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land diff --git a/physics/flake_driver.meta b/physics/flake_driver.meta index b160dd7de..959b5b43f 100644 --- a/physics/flake_driver.meta +++ b/physics/flake_driver.meta @@ -114,8 +114,8 @@ intent = in optional = F [weasd] - standard_name = water_equivalent_accumulated_snow_depth_over_water - long_name = water equiv of acc snow depth over water + 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 @@ -217,8 +217,8 @@ intent = in optional = F [snwdph] - standard_name = surface_snow_thickness_water_equivalent_over_water - long_name = water equivalent snow depth over water + 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 diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index a27b02e0d..652184c4d 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -69,7 +69,7 @@ SUBROUTINE mynnsfc_wrapper_run( & & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) & tsurf_wat, tsurf_lnd, tsurf_ice, & !intent(in) & qsfc_wat, qsfc_lnd, qsfc_ice, & !intent(in) - & snowh_wat, snowh_lnd, snowh_ice, & !intent(in) + & snowh_lnd, snowh_ice, & !intent(in) & znt_wat, znt_lnd, znt_ice, & !intent(inout) & ust_wat, ust_lnd, ust_ice, & !intent(inout) & cm_wat, cm_lnd, cm_ice, & !intent(inout) @@ -163,7 +163,7 @@ SUBROUTINE mynnsfc_wrapper_run( & real(kind=kind_phys), dimension(:), intent(in) :: & & tskin_wat, tskin_lnd, tskin_ice, & & tsurf_wat, tsurf_lnd, tsurf_ice, & - & snowh_wat, snowh_lnd, snowh_ice + & snowh_lnd, snowh_ice real(kind=kind_phys), dimension(:), intent(inout) :: & & znt_wat, znt_lnd, znt_ice, & @@ -194,7 +194,7 @@ SUBROUTINE mynnsfc_wrapper_run( & real, dimension(im) :: & & hfx, znt, psim, psih, & & chs, ck, cd, mavail, xland, GZ1OZ0, & - & cpm, qgh, qfx, qsfc_ruc + & cpm, qgh, qfx, qsfc_ruc, snowh_wat real(kind=kind_phys), dimension(im,levs) :: & & pattern_spp_pbl, dz, th, qv @@ -240,6 +240,7 @@ SUBROUTINE mynnsfc_wrapper_run( & !znt_wat(i)=znt_wat(i)*0.01 !cm -> m !znt_ice(i)=znt_ice(i)*0.01 !cm -> m cpm(i)=cp + snowh_wat(i) = 0.0 enddo ! cm -> m diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index d082752c4..94393057b 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -391,15 +391,6 @@ kind = kind_phys intent = inout optional = F -[snowh_wat] - standard_name = surface_snow_thickness_water_equivalent_over_water - long_name = water equivalent snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [snowh_lnd] standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index bff171f4b..0f45a151d 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -72,7 +72,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & thsfc_loc, & !intent(in) & tskin_wat, tskin_lnd, tskin_ice, & !intent(in) & tsurf_wat, tsurf_lnd, tsurf_ice, & !intent(in) - & snwdph_wat,snwdph_lnd,snwdph_ice, & !intent(in) + & snwdph_lnd,snwdph_ice, & !intent(in) & z0rl_wat, z0rl_lnd, z0rl_ice, & !intent(inout) & z0rl_wav, & !intent(inout) & ustar_wat, ustar_lnd, ustar_ice, & !intent(inout) @@ -109,7 +109,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) real(kind=kind_phys), dimension(:), intent(in) :: & & tskin_wat, tskin_lnd, tskin_ice, & & tsurf_wat, tsurf_lnd, tsurf_ice, & - & snwdph_wat,snwdph_lnd,snwdph_ice + & snwdph_lnd,snwdph_ice real(kind=kind_phys), dimension(:), intent(in) :: z0rl_wav real(kind=kind_phys), dimension(:), intent(inout) :: & @@ -138,7 +138,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) real(kind=kind_phys) :: tv1 - real(kind=kind_phys) :: tvs, z0, z0max + real(kind=kind_phys) :: tvs, z0, z0max, snwdph_wat ! real(kind=kind_phys), parameter :: & one=1.0_kp, zero=0.0_kp, half=0.5_kp, qmin=1.0e-8_kp @@ -356,9 +356,10 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) stop endif ! + snwdph_wat = zero call stability ! --- inputs: - & (z1(i), snwdph_wat(i), thv1, wind(i), + & (z1(i), snwdph_wat, thv1, wind(i), & z0max, ztmax_wat(i), tvs, grav, tv1, thsfc_loc, ! --- outputs: & rb_wat(i), fm_wat(i), fh_wat(i), fm10_wat(i), fh2_wat(i), diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 7b639b6b0..e7551cf99 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -312,15 +312,6 @@ kind = kind_phys intent = in optional = F -[snwdph_wat] - standard_name = surface_snow_thickness_water_equivalent_over_water - long_name = water equivalent snow depth over water - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [snwdph_lnd] standard_name = surface_snow_thickness_water_equivalent_over_land long_name = water equivalent snow depth over land From a50a9dad106b50bdfc60b6e4c12ebf36857c0784 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 19 Jun 2021 00:36:49 +0000 Subject: [PATCH 2/9] a minor change in RAS --- physics/rascnv.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 index ee58baecd..e48dfccee 100644 --- a/physics/rascnv.F90 +++ b/physics/rascnv.F90 @@ -681,7 +681,8 @@ subroutine rascnv_run(IM, k, ntr, dt, dtf & if (advups) then ! For first order upstream for updraft alfint(:,:) = one elseif (advtvd) then ! TVD flux limiter scheme for updraft - alfint(:,:) = one +! alfint(:,:) = one + alfint(:,:) = half l = krmin lm1 = l - 1 dtvd(1,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) & From 11c3605ec47bbcbcc2cdae13147da7ea971f0617 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Mon, 5 Jul 2021 21:01:28 -0400 Subject: [PATCH 3/9] adding ice albedo from CICE --- physics/GFS_radiation_surface.F90 | 22 ++++++++++++---------- physics/GFS_radiation_surface.meta | 8 ++++++++ physics/radiation_surface.f | 20 ++++++++++++-------- 3 files changed, 32 insertions(+), 18 deletions(-) diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 index 2481af163..13190df38 100644 --- a/physics/GFS_radiation_surface.F90 +++ b/physics/GFS_radiation_surface.F90 @@ -62,7 +62,7 @@ subroutine GFS_radiation_surface_run ( & sncovr_ice, fice, zorl, hprime, tsfg, tsfa, tisfc, coszen, & min_seaice, min_lakeice, lakefrac, & alvsf, alnsf, alvwf, alnwf, facsf, facwf, & - semis_lnd, semis_ice, snoalb, & + semis_lnd, semis_ice, snoalb, use_cice_alb, & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & semisbase, semis, sfcalb, sfc_alb_dif, errmsg, errflg) @@ -74,7 +74,7 @@ subroutine GFS_radiation_surface_run ( & implicit none integer, intent(in) :: im - logical, intent(in) :: frac_grid, lslwr, lsswr + logical, intent(in) :: frac_grid, lslwr, lsswr, use_cice_alb integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice @@ -160,7 +160,8 @@ 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, vtype, & - frac_grid, min_seaice, xlon, xlat, slmsk, & + frac_grid, xlon, xlat, slmsk, & +! frac_grid, min_seaice, xlon, xlat, slmsk, & snowd, sncovr, sncovr_ice, zorl, tsfg, tsfa, & hprime, semis_lnd, semis_ice, im, & fracl, fraco, fraci, icy, & ! --- inputs @@ -181,13 +182,14 @@ subroutine GFS_radiation_surface_run ( & !> - Call module_radiation_surface::setalb(),to set up surface !! albedor for SW radiation. - call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, snowd, sncovr, sncovr_ice, snoalb, & - zorl, coszen, tsfg, tsfa, hprime, frac_grid, min_seaice, & - alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & - albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & - albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & - IM, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, & ! --- inputs - sfcalb ) ! --- outputs + call setalb (slmsk, lsm, lsm_noahmp, lsm_ruc, use_cice_alb, snowd, sncovr, sncovr_ice, & + snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, lakefrac, & +! snoalb, zorl, coszen, tsfg, tsfa, hprime, frac_grid, min_seaice, & + alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + IM, sfc_alb_pert, lndp_alb, fracl, fraco, fraci, icy, & ! --- inputs + sfcalb ) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/GFS_radiation_surface.meta b/physics/GFS_radiation_surface.meta index c38ffe2a3..721d343e9 100644 --- a/physics/GFS_radiation_surface.meta +++ b/physics/GFS_radiation_surface.meta @@ -404,6 +404,14 @@ kind = kind_phys intent = in optional = F +[use_cice_alb] + standard_name = flag_for_cice_albedo + long_name = flag for using ice albedos form CICE when coupled (default on) + units = flag + dimensions = () + type = logical + intent = in + optional = F [albdvis_lnd] standard_name = surface_albedo_direct_visible_over_land long_name = direct surface albedo visible band over land diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 3ec34513c..8ab6758f8 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -332,9 +332,10 @@ end subroutine sfc_init !! @{ !----------------------------------- subroutine setalb & - & ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf, & ! --- inputs: + & ( slmsk,lsm,lsm_noahmp,lsm_ruc,use_cice_alb,snowf, & ! --- inputs: & sncovr,sncovr_ice,snoalb,zorlf,coszf, & - & tsknf,tairf,hprif,frac_grid,min_seaice, & + & tsknf,tairf,hprif,frac_grid, lakefrac, & +! & tsknf,tairf,hprif,frac_grid,min_seaice, & & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & @@ -406,16 +407,17 @@ subroutine setalb & ! --- inputs integer, intent(in) :: IMAX integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc - logical, intent(in) :: frac_grid + logical, intent(in) :: use_cice_alb, frac_grid real (kind=kind_phys), dimension(:), intent(in) :: & + & lakefrac, & & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & & icealbdvis, icealbdnir, icealbivis, icealbinir, & & sncovr, sncovr_ice, snoalb, albPpert ! sfc-perts, mgehne real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne - real (kind=kind_phys), intent(in) :: min_seaice +! real (kind=kind_phys), intent(in) :: min_seaice real (kind=kind_phys), dimension(:), intent(in) :: & & fracl, fraco, fraci logical, dimension(:), intent(in) :: & @@ -581,8 +583,9 @@ subroutine setalb & ! model. Otherwise it uses the backup albedo computation ! from ialbflg = 1. if (icy(i)) then - if(lsm == lsm_ruc ) then - !-- use ice albedo from the RUC ice model + if (lsm == lsm_ruc .or. & + & (use_cice_alb .and. lakefrac(i) < 0.0)) then + !-- use ice albedo from the RUC ice model or asevd_ice = icealbivis(i) asend_ice = icealbinir(i) asevb_ice = icealbdvis(i) @@ -700,7 +703,8 @@ end subroutine setalb !----------------------------------- subroutine setemis & & ( lsm,lsm_noahmp,lsm_ruc,vtype,frac_grid, & ! --- inputs: - & min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & + & xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & +! & min_seaice,xlon,xlat,slmsk,snowf,sncovr,sncovr_ice, & & zorlf,tsknf,tairf,hprif, & & semis_lnd,semis_ice,IMAX,fracl,fraco,fraci,icy, & & semisbase, sfcemis & ! --- outputs: @@ -757,7 +761,7 @@ subroutine setemis & integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in) :: frac_grid real (kind=kind_phys), dimension(:), intent(in) :: vtype - real (kind=kind_phys), intent(in) :: min_seaice +! real (kind=kind_phys), intent(in) :: min_seaice real (kind=kind_phys), dimension(:), intent(in) :: & & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, & From be8f9c0161f8897fc6cadcf2b64b1267f208a845 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 16 Jul 2021 11:31:13 +0000 Subject: [PATCH 4/9] updating radiation_surface to use cice albedo --- physics/radiation_surface.f | 83 ++++++++++++++++++++----------------- 1 file changed, 44 insertions(+), 39 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 8ab6758f8..c6a8333f2 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -464,49 +464,54 @@ subroutine setalb & asenb_wat = asevb_wat endif - if (icy(i)) then - !-- Computation of ice albedo - asnow = 0.02*snowf(i) - argh = min(0.50, max(.025, 0.01*zorlf(i))) - hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) - fsno0 = asnow / (argh + asnow) * hrgh ! snow fraction on ice - ! diffused - if (tsknf(i) > 271.1 .and. tsknf(i) < 271.5) then - !tgs: looks like albedo reduction from puddles on ice - a1 = (tsknf(i) - 271.1)**2 - asevd_ice = 0.7 - 4.0*a1 - asend_ice = 0.65 - 3.6875*a1 + if (icy(i)) then !-- Computation of ice albedo + + if (use_cice_alb .and. lakefrac(i) < 0.0) then !-- use ice albedo from CICE for sea-ice + asevd_ice = icealbivis(i) + asend_ice = icealbinir(i) + asevb_ice = icealbdvis(i) + asenb_ice = icealbdnir(i) else - asevd_ice = 0.70 - asend_ice = 0.65 - endif - ! direct - asevb_ice = asevd_ice - asenb_ice = asend_ice - - if (fsno0 > f_zero) then - ! Snow on ice - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd - asnvd = (asevd_ice + b1) ! diffused snow albedo - asnnd = (asend_ice + b1) - if (coszf(i) > 0.0001 .and. coszf(i) < 0.5) then ! direct snow albedo - csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) - asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) - asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) + asnow = 0.02*snowf(i) + argh = min(0.50, max(.025, 0.01*zorlf(i))) + hrgh = min(f_one,max(0.20,1.0577-1.1538e-3*hprif(i))) + fsno0 = asnow / (argh + asnow) * hrgh ! snow fraction on ice + ! diffused + if (tsknf(i) > 271.1 .and. tsknf(i) < 271.5) then + !tgs: looks like albedo reduction from puddles on ice + a1 = (tsknf(i) - 271.1)**2 + asevd_ice = 0.7 - 4.0*a1 + asend_ice = 0.65 - 3.6875*a1 else - asnvb = asnvd - asnnb = asnnd + asevd_ice = 0.70 + asend_ice = 0.65 endif + ! direct + asevb_ice = asevd_ice + asenb_ice = asend_ice - ! composite ice and snow albedos - asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0 - asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0 - asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 - asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 - endif ! snow - else - ! icy = false, fill in values + if (fsno0 > f_zero) then ! Snow on ice + dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) + b1 = 0.03 * dtgd + asnvd = (asevd_ice + b1) ! diffused snow albedo + asnnd = (asend_ice + b1) + if (coszf(i) > 0.0001 .and. coszf(i) < 0.5) then ! direct snow albedo + csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) + asnvb = min( 0.98, asnvd+(f_one-asnvd)*csnow ) + asnnb = min( 0.98, asnnd+(f_one-asnnd)*csnow ) + else + asnvb = asnvd + asnnb = asnnd + endif + + ! composite ice and snow albedos + asevd_ice = asevd_ice * (1. - fsno0) + asnvd * fsno0 + asend_ice = asend_ice * (1. - fsno0) + asnnd * fsno0 + asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 + asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 + endif ! snow + endif ! if (use_cice_alb .and. lakefrac > 0) + else ! icy = false, fill in values asevd_ice = 0.70 asend_ice = 0.65 asevb_ice = 0.70 From f93631e5669eeed029e8de1a4cc0c951ffdb918b Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sat, 17 Jul 2021 00:28:30 +0000 Subject: [PATCH 5/9] updating radiation_surface --- physics/radiation_surface.f | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index c6a8333f2..373c6d819 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -439,6 +439,7 @@ subroutine setalb & real (kind=kind_phys) :: alndnb, alndnd, alndvb, alndvd real (kind=kind_phys) ffw, dtgd + real (kind=kind_phys), parameter :: epsln=1.0e-8_kind_phys integer :: i, k, kk, iflag @@ -466,7 +467,8 @@ subroutine setalb & if (icy(i)) then !-- Computation of ice albedo - if (use_cice_alb .and. lakefrac(i) < 0.0) then !-- use ice albedo from CICE for sea-ice + if (use_cice_alb .and. lakefrac(i) < epsln & + & .and. icealbivis(i) > epsln) then !-- use ice albedo from CICE for sea-ice asevd_ice = icealbivis(i) asend_ice = icealbinir(i) asevb_ice = icealbdvis(i) @@ -510,7 +512,7 @@ subroutine setalb & asevb_ice = asevb_ice * (1. - fsno0) + asnvb * fsno0 asenb_ice = asenb_ice * (1. - fsno0) + asnnb * fsno0 endif ! snow - endif ! if (use_cice_alb .and. lakefrac > 0) + endif ! if (use_cice_alb .and. lakefrac < epsln) else ! icy = false, fill in values asevd_ice = 0.70 asend_ice = 0.65 @@ -589,7 +591,7 @@ subroutine setalb & ! from ialbflg = 1. if (icy(i)) then if (lsm == lsm_ruc .or. & - & (use_cice_alb .and. lakefrac(i) < 0.0)) then + & (use_cice_alb .and. lakefrac(i) < epsln)) then !-- use ice albedo from CICE for sea-ice !-- use ice albedo from the RUC ice model or asevd_ice = icealbivis(i) asend_ice = icealbinir(i) From 43c767725d67ed0d5b0b9dae1ece44ee1983750d Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 29 Jul 2021 10:56:32 -0400 Subject: [PATCH 6/9] fixing based on Dom's observation --- physics/GFS_surface_composites.F90 | 2 +- physics/radiation_surface.f | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index a4adc7c4e..962b61812 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -150,7 +150,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm hice(i) = zero icy(i) = .false. else - frland(i) = zero + frland(i) = zero if (oceanfrac(i) > zero) then if (cice(i) >= min_seaice) then icy(i) = .true. diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index b0755947f..a0c0f12b8 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -597,8 +597,8 @@ subroutine setalb & ! from ialbflg = 1. if (icy(i)) then if (lsm == lsm_ruc .or. & - & (use_cice_alb .and. lakefrac(i) < epsln)) then !-- use ice albedo from CICE for sea-ice - !-- use ice albedo from the RUC ice model or + & (use_cice_alb .and. lakefrac(i) < epsln)) then !-- use ice albedo from the RUC ice model or + !-- use ice albedo from CICE for sea-ice asevd_ice = icealbivis(i) asend_ice = icealbinir(i) asevb_ice = icealbdvis(i) From dfacad08eda5d4aa2171faa1fd709a18d909cdd9 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Sun, 1 Aug 2021 21:42:35 -0400 Subject: [PATCH 7/9] fixing the crash in noahmp in debug mode --- physics/GFS_surface_composites.F90 | 4 +- physics/GFS_surface_composites.meta | 8 --- physics/GFS_surface_generic.F90 | 1 - physics/gcycle.F90 | 7 +- physics/sfcsub.F | 108 ++++++++++++++++++---------- 5 files changed, 78 insertions(+), 50 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 962b61812..2a7a87dcb 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -29,7 +29,7 @@ end subroutine GFS_surface_composites_pre_finalize !! subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm, lsm_noahmp, lsm_ruc, frac_grid, & flag_cice, cplflx, cplwav2atm, landfrac, lakefrac, lakedepth, oceanfrac, frland, & - dry, icy, lake, use_flake, ocean, wet, hice, cice, zorlo, zorll, zorli, & + dry, icy, lake, use_flake, 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, & @@ -45,7 +45,7 @@ subroutine GFS_surface_composites_pre_run (im, flag_init, flag_restart, lkm, lsm integer, intent(in ) :: lsm, lsm_noahmp, lsm_ruc logical, intent(in ) :: flag_init, flag_restart, frac_grid, cplflx, cplwav2atm logical, dimension(:), intent(inout) :: flag_cice - logical, dimension(:), intent(inout) :: dry, icy, lake, use_flake, ocean, wet + logical, dimension(:), intent(inout) :: dry, icy, lake, use_flake, wet 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 diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index ac7822bad..a59b012bf 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -172,14 +172,6 @@ type = logical intent = inout optional = F -[ocean] - standard_name = flag_nonzero_ocean_surface_fraction - long_name = flag indicating presence of some ocean surface area fraction - units = flag - dimensions = (horizontal_loop_extent) - type = logical - intent = inout - optional = F [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/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index b6dd30cfe..1ec7ff784 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -149,7 +149,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, soiltyp(i) = int( stype(i)+0.5_kind_phys ) vegtype(i) = int( vtype(i)+0.5_kind_phys ) slopetyp(i) = int( slope(i)+0.5_kind_phys ) !! clu: slope -> slopetyp - if (soiltyp(i) < 1) soiltyp(i) = 14 if (vegtype(i) < 1) vegtype(i) = 17 if (slopetyp(i) < 1) slopetyp(i) = 1 endif diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 718b375af..608147c4b 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -124,9 +124,10 @@ subroutine gcycle (me, nthrds, nx, ny, isc, jsc, nsst, tile_num, nlunit, ! if (frac_grid) then do ix=1,npts - if (landfrac(ix) > -1.0e-8_kind_phys) then - slmskl(ix) = ceiling(landfrac(ix)-1.0e-8_kind_phys) - slmskw(ix) = floor(landfrac(ix)+1.0e-8_kind_phys) +! if (landfrac(ix) > -1.0e-8_kind_phys) then + if (landfrac(ix) > 0.0_kind_phys) then + slmskl(ix) = ceiling(landfrac(ix)-1.0e-6_kind_phys) + slmskw(ix) = floor(landfrac(ix)+1.0e-6_kind_phys) else if (nint(slmsk(ix)) == 1) then slmskl(ix) = 1.0_kind_phys diff --git a/physics/sfcsub.F b/physics/sfcsub.F index 002103e10..e28af7b8a 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -1285,7 +1285,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getsmc(wetclm,len,lsoil,smcclm,me) endif do k=1,lsoil - call qcmxmn(message('stc',k),smcclm(1,k),sliclm,snoclm,icefl1, +! call qcmxmn(message('stc',k),smcclm(1,k),sliclm,snoclm,icefl1, + call qcmxmn(message('stc',k),smcclm(1,k),slmskl,snoclm,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1295,20 +1296,24 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getstc(tsfclm,tg3clm,sliclm,len,lsoil,stcclm,tsfimx) endif do k=1,lsoil - call qcmxmn(message('stc',k),stcclm(1,k),sliclm,snoclm,icefl1, +! call qcmxmn(message('stc',k),stcclm(1,k),sliclm,snoclm,icefl1, + call qcmxmn(message('stc',k),stcclm(1,k),slmskl,snoclm,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1, +! call qcmxmn('vegc ',vegclm,sliclm,snoclm,icefl1, + call qcmxmn('vegc ',vegclm,slmskl,snoclm,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetc ',vetclm,sliclm,snoclm,icefl1, +! call qcmxmn('vetc ',vetclm,sliclm,snoclm,icefl1, + call qcmxmn('vetc ',vetclm,slmskl,snoclm,icefl1, & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotc ',sotclm,sliclm,snoclm,icefl1, +! call qcmxmn('sotc ',sotclm,sliclm,snoclm,icefl1, + call qcmxmn('sotc ',sotclm,slmskl,snoclm,icefl1, & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, & sotjmx,sotjmn,sotsmx,sotsmn,epssot, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1322,15 +1327,18 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, ! & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] --------------------------------------------------------------- - call qcmxmn('vmnc ',vmnclm,sliclm,snoclm,icefl1, +! call qcmxmn('vmnc ',vmnclm,sliclm,snoclm,icefl1, + call qcmxmn('vmnc ',vmnclm,slmskl,snoclm,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxc ',vmxclm,sliclm,snoclm,icefl1, +! call qcmxmn('vmxc ',vmxclm,sliclm,snoclm,icefl1, + call qcmxmn('vmxc ',vmxclm,slmskl,snoclm,icefl1, & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpc ',slpclm,sliclm,snoclm,icefl1, +! call qcmxmn('slpc ',slpclm,sliclm,snoclm,icefl1, + call qcmxmn('slpc ',slpclm,slmskl,snoclm,icefl1, & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1651,7 +1659,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, ! & rla,rlo,len,kqcm,percrit,lgchek,me) ! endif - call qcmxmn('tg3a ',tg3anl,slianl,snoanl,icefl1, +! call qcmxmn('tg3a ',tg3anl,slianl,snoanl,icefl1, + call qcmxmn('tg3a ',tg3anl,slmskl,snoanl,icefl1, & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn, & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1663,7 +1672,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & endif !-- soil moisture do k=1,lsoil - call qcmxmn(message('smca',k),smcanl(1,1),slianl,snoanl,icefl1, +! call qcmxmn(message('smca',k),smcanl(1,1),slianl,snoanl,icefl1, + call qcmxmn(message('smca',k),smcanl(1,1),slmskl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1673,33 +1683,40 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & call getstc(tsfanl,tg3anl,slianl,len,lsoil,stcanl,tsfimx) endif do k=1,lsoil - call qcmxmn(message('stca',k),stcanl(1,1),slianl,snoanl,icefl1, +! call qcmxmn(message('stca',k),stcanl(1,1),slianl,snoanl,icefl1, + call qcmxmn(message('stca',k),stcanl(1,1),slmskl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - call qcmxmn('vega ',veganl,slianl,snoanl,icefl1, +! call qcmxmn('vega ',veganl,slianl,snoanl,icefl1, + call qcmxmn('vega ',veganl,slmskl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('veta ',vetanl,slianl,snoanl,icefl1, +! call qcmxmn('veta ',vetanl,slianl,snoanl,icefl1, + call qcmxmn('veta ',vetanl,slmskl,snoanl,icefl1, & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sota ',sotanl,slianl,snoanl,icefl1, +! call qcmxmn('sota ',sotanl,slianl,snoanl,icefl1, + call qcmxmn('sota ',sotanl,slmskl,snoanl,icefl1, & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, & sotjmx,sotjmn,sotsmx,sotsmn,epssot, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l]---------------------------------------------------------------------- - call qcmxmn('vmna ',vmnanl,slianl,snoanl,icefl1, +! call qcmxmn('vmna ',vmnanl,slianl,snoanl,icefl1, + call qcmxmn('vmna ',vmnanl,slmskl,snoanl,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxa ',vmxanl,slianl,snoanl,icefl1, +! call qcmxmn('vmxa ',vmxanl,slianl,snoanl,icefl1, + call qcmxmn('vmxa ',vmxanl,slmskl,snoanl,icefl1, & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpa ',slpanl,slianl,snoanl,icefl1, +! call qcmxmn('slpa ',slpanl,slianl,snoanl,icefl1, + call qcmxmn('slpa ',slpanl,slmskl,snoanl,icefl1, & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1796,11 +1813,13 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & & tsflmx,tsflmn,tsfomx,tsfomn,tsfimx,tsfimn, & tsfjmx,tsfjmn,tsfsmx,tsfsmn,epstsf, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, +! call qcmxmn('stc1f ',stcfcs(1,1),slifcs,snofcs,icefl1, + call qcmxmn('stc1f ',stcfcs(1,1),slmskl,snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1, +! call qcmxmn('stc2f ',stcfcs(1,2),slifcs,snofcs,icefl1, + call qcmxmn('stc2f ',stcfcs(1,2),slmskl,snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1882,7 +1901,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & plrjmx,plrjmn,plrsmx,plrsmn,epsplr, ! & rla,rlo,len,kqcm,percrit,lgchek,me) ! endif - call qcmxmn('tg3f ',tg3fcs,slifcs,snofcs,icefl1, +! call qcmxmn('tg3f ',tg3fcs,slifcs,snofcs,icefl1, + call qcmxmn('tg3f ',tg3fcs,slmskl,snofcs,icefl1, & tg3lmx,tg3lmn,tg3omx,tg3omn,tg3imx,tg3imn, & tg3jmx,tg3jmn,tg3smx,tg3smn,epstg3, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -1897,7 +1917,8 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & rla,rlo,len,kqcm,percrit,lgchek,me) !-- soil moisture forecast do k=1,lsoil - call qcmxmn(message('smcfcw',k),smcfcs(1,k),slifcs, +! call qcmxmn(message('smcfcw',k),smcfcs(1,k),slifcs, + call qcmxmn(message('smcfcw',k),smcfcs(1,k),slmskl, & snofcs,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, @@ -1905,35 +1926,42 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & enddo !-- soil temperature forecast do k=1,lsoil - call qcmxmn(message('stcf',k),stcfcs(1,k),slifcs, +! call qcmxmn(message('stcf',k),stcfcs(1,k),slifcs, + call qcmxmn(message('stcf',k),stcfcs(1,k),slmskl, & snofcs,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo - call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1, +! call qcmxmn('vegf ',vegfcs,slifcs,snofcs,icefl1, + call qcmxmn('vegf ',vegfcs,slmskl,snofcs,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetf ',vetfcs,slifcs,snofcs,icefl1, +! call qcmxmn('vetf ',vetfcs,slifcs,snofcs,icefl1, + call qcmxmn('vetf ',vetfcs,slmskl,snofcs,icefl1, & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotf ',sotfcs,slifcs,snofcs,icefl1, +! call qcmxmn('sotf ',sotfcs,slifcs,snofcs,icefl1, + call qcmxmn('sotf ',sotfcs,slmskl,snofcs,icefl1, & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, & sotjmx,sotjmn,sotsmx,sotsmn,epssot, & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] --------------------------------------------------------------- - call qcmxmn('vmnf ',vmnfcs,slifcs,snofcs,icefl1, +! call qcmxmn('vmnf ',vmnfcs,slifcs,snofcs,icefl1, + call qcmxmn('vmnf ',vmnfcs,slmskl,snofcs,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxf ',vmxfcs,slifcs,snofcs,icefl1, +! call qcmxmn('vmxf ',vmxfcs,slifcs,snofcs,icefl1, + call qcmxmn('vmxf ',vmxfcs,slmskl,snofcs,icefl1, & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpf ',slpfcs,slifcs,snofcs,icefl1, +! call qcmxmn('slpf ',slpfcs,slifcs,snofcs,icefl1, + call qcmxmn('slpf ',slpfcs,slmskl,snofcs,icefl1, & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -2117,27 +2145,32 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & rla,rlo,len,kqcm,percrit,lgchek,me) ! endif do k=1,lsoil - call qcmxmn(message('stcm',k),stcanl(1,k),slianl,snoanl,icefl1, +! call qcmxmn(message('stcm',k),stcanl(1,k),slianl,snoanl,icefl1, + call qcmxmn(message('stcm',k),stcanl(1,k),slmskl,snoanl,icefl1, & stclmx,stclmn,stcomx,stcomn,stcimx,stcimn, & stcjmx,stcjmn,stcsmx,stcsmn,eptsfc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo do k=1,lsoil - call qcmxmn(message('smcm',k),smcanl(1,k),slianl,snoanl,icefl1, +! call qcmxmn(message('smcm',k),smcanl(1,k),slianl,snoanl,icefl1, + call qcmxmn(message('smcm',k),smcanl(1,k),slmskl,snoanl,icefl1, & smclmx,smclmn,smcomx,smcomn,smcimx,smcimn, & smcjmx,smcjmn,smcsmx,smcsmn,epssmc, & rla,rlo,len,kqcm,percrit,lgchek,me) enddo kqcm = 1 - call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1, +! call qcmxmn('vegm ',veganl,slianl,snoanl,icefl1, + call qcmxmn('vegm ',veganl,slmskl,snoanl,icefl1, & veglmx,veglmn,vegomx,vegomn,vegimx,vegimn, & vegjmx,vegjmn,vegsmx,vegsmn,epsveg, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vetm ',vetanl,slianl,snoanl,icefl1, +! call qcmxmn('vetm ',vetanl,slianl,snoanl,icefl1, + call qcmxmn('vetm ',vetanl,slmskl,snoanl,icefl1, & vetlmx,vetlmn,vetomx,vetomn,vetimx,vetimn, & vetjmx,vetjmn,vetsmx,vetsmn,epsvet, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('sotm ',sotanl,slianl,snoanl,icefl1, +! call qcmxmn('sotm ',sotanl,slianl,snoanl,icefl1, + call qcmxmn('sotm ',sotanl,slmskl,snoanl,icefl1, & sotlmx,sotlmn,sotomx,sotomn,sotimx,sotimn, & sotjmx,sotjmn,sotsmx,sotsmn,epssot, & rla,rlo,len,kqcm,percrit,lgchek,me) @@ -2151,15 +2184,18 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! & sicjmx,sicjmn,sicsmx,sicsmn,epssic, ! & rla,rlo,len,kqcm,percrit,lgchek,me) !clu [+16l] add vmn, vmx, slp, abs - call qcmxmn('vmnm ',vmnanl,slianl,snoanl,icefl1, +! call qcmxmn('vmnm ',vmnanl,slianl,snoanl,icefl1, + call qcmxmn('vmnm ',vmnanl,slmskl,snoanl,icefl1, & vmnlmx,vmnlmn,vmnomx,vmnomn,vmnimx,vmnimn, & vmnjmx,vmnjmn,vmnsmx,vmnsmn,epsvmn, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('vmxm ',vmxanl,slianl,snoanl,icefl1, +! call qcmxmn('vmxm ',vmxanl,slianl,snoanl,icefl1, + call qcmxmn('vmxm ',vmxanl,slmskl,snoanl,icefl1, & vmxlmx,vmxlmn,vmxomx,vmxomn,vmximx,vmximn, & vmxjmx,vmxjmn,vmxsmx,vmxsmn,epsvmx, & rla,rlo,len,kqcm,percrit,lgchek,me) - call qcmxmn('slpm ',slpanl,slianl,snoanl,icefl1, +! call qcmxmn('slpm ',slpanl,slianl,snoanl,icefl1, + call qcmxmn('slpm ',slpanl,slmskl,snoanl,icefl1, & slplmx,slplmn,slpomx,slpomn,slpimx,slpimn, & slpjmx,slpjmn,slpsmx,slpsmn,epsslp, & rla,rlo,len,kqcm,percrit,lgchek,me) From 59fd4c8debdd075a361ef8ee9864f05354cfd8d6 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Thu, 5 Aug 2021 00:33:39 +0000 Subject: [PATCH 8/9] fixing sfcsub.F for fractional grid --- physics/sfcsub.F | 28 ++++++++++++++-------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/physics/sfcsub.F b/physics/sfcsub.F index e28af7b8a..b0aefb858 100644 --- a/physics/sfcsub.F +++ b/physics/sfcsub.F @@ -1197,7 +1197,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! set ocean/land/sea-ice mask ! - call setlsi(slmskw,aisclm,len,aicice,sliclm) + call setlsi(slmskl,aisclm,len,aicice,sliclm) ! if(lprnt) print *,' aisclm=',aisclm(iprnt),' sliclm=' ! &,sliclm(iprnt),' slmskw=',slmskw(iprnt) @@ -1530,9 +1530,10 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & slianl(i) = 0. ! print *,'cycle - ice free: fice=',sicanl(i) elseif (nint(slianl(i)) == 1 .and. sicanl(i) >= crit) then - if (nint(slmskw(i)) == 0) then ! can happen only for fractional grid - slianl(i) = 2.0_kind_io8 - else +! if (nint(slmskw(i)) == 0) then ! can happen only for fractional grid +! slianl(i) = 2.0_kind_io8 +! else + if (nint(slmskw(i)) /= 0) then ! can happen only for fractional grid ! print *,'cycle - land covered by sea-ice: fice=',sicanl(i) sicanl(i) = 0.0_kind_io8 endif @@ -1560,7 +1561,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! ! set ocean/land/sea-ice mask ! - call setlsi(slmskw,aisanl,len,aicice,slianl) + call setlsi(slmskl,aisanl,len,aicice,slianl) ! if(lprnt) print *,' aisanl=',aisanl(iprnt),' slianl=' & ! &,slianl(iprnt),' slmskwl=',slmskw(iprnt),slmskl(iprnt) @@ -1568,7 +1569,7 @@ subroutine sfccycle(lugb,len,lsoil,sig1t,deltsfc & ! do k=1,lsoil do i=1,len - if (slianl(i) .eq. 0) then + if (slianl(i) == 0 .and. nint(slmskl(i)) /= 1) then smcanl(i,k) = smcomx stcanl(i,k) = tsfanl(i) endif @@ -4477,13 +4478,12 @@ subroutine filfcs(tsffcs,wetfcs,snofcs,zorfcs,albfcs, & end !>\ingroup mod_sfcsub - subroutine bktges(smcfcs,slianl,stcfcs,len,lsoil) + subroutine bktges(smcfcs,stcfcs,len,lsoil) ! use machine , only : kind_io8,kind_io4 implicit none integer i,j,len,lsoil,k - real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil), & - & slianl(len) + real (kind=kind_io8) smcfcs(len,lsoil), stcfcs(len,lsoil) ! ! note that smfcs comes in with the original unit (cm?) (not grib file) ! @@ -5058,7 +5058,7 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & ! ! snow over sea ice is cycled ! - if(slianl(i).eq.2.) then + if (nint(slianl(i)) == 2) then snoanl(i) = snofcs(i) endif ! @@ -5089,7 +5089,7 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & ! do k = 1, 4 do i=i1_t,i2_t - if(slianl(i).eq.0.) then + if (nint(slianl(i)) == 0) then albanl(i,k) = albfcs(i,k)*ralbs + albanl(i,k)*qalbs else albanl(i,k) = albfcs(i,k)*ralbl + albanl(i,k)*qalbl @@ -5099,7 +5099,7 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & ! do k = 1, 2 do i=i1_t,i2_t - if(slianl(i).eq.0.) then + if (nint(slianl(i)) == 0) then alfanl(i,k) = alffcs(i,k)*ralfs + alfanl(i,k)*qalfs else alfanl(i,k) = alffcs(i,k)*ralfl + alfanl(i,k)*qalfl @@ -5109,7 +5109,7 @@ subroutine merge(len,lsoil,iy,im,id,ih,fh,deltsfc, & ! do k = 1, lsoil do i=i1_t,i2_t - if(slianl(i).eq.0.) then + if (nint(slianl(i)) == 0) then smcanl(i,k) = smcfcs(i,k)*rsmcs(k) + smcanl(i,k)*qsmcs(k) stcanl(i,k) = stcfcs(i,k)*rstcs(k) + stcanl(i,k)*qstcs(k) else @@ -7076,7 +7076,7 @@ subroutine clima(lugb,iy,im,id,ih,fh,len,lsoil,slmskl,slmskw, & cvbclm(i) = 0.0 cvtclm(i) = 0.0 cnpclm(i) = 0.0 - sliclm(i) = 0.0 + sliclm(i) = slmskl(i) scvclm(i) = 0.0 vmnclm(i) = 0.0 vmxclm(i) = 0.0 From 3ea7dcfbdf14a7876a93c3524d3f442b026e2347 Mon Sep 17 00:00:00 2001 From: "Shrinivas.Moorthi" Date: Fri, 6 Aug 2021 17:46:27 +0000 Subject: [PATCH 9/9] fixing potential segfault in radiation_surface.f --- physics/radiation_surface.f | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index a0c0f12b8..750c54dd6 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -440,7 +440,7 @@ subroutine setalb & real (kind=kind_phys) :: alndnb, alndnd, alndvb, alndvd - real (kind=kind_phys) ffw, dtgd + real (kind=kind_phys) ffw, dtgd, icealb real (kind=kind_phys), parameter :: epsln=1.0e-8_kind_phys integer :: i, k, kk, iflag @@ -469,8 +469,12 @@ subroutine setalb & if (icy(i)) then !-- Computation of ice albedo - if (use_cice_alb .and. lakefrac(i) < epsln & - & .and. icealbivis(i) > epsln) then !-- use ice albedo from CICE for sea-ice + if (use_cice_alb .and. lakefrac(i) < epsln) then + icealb = icealbivis(i) + else + icealb = f_zero + endif + if (icealb > epsln) then !-- use ice albedo from CICE for sea-ice asevd_ice = icealbivis(i) asend_ice = icealbinir(i) asevb_ice = icealbdvis(i) @@ -595,10 +599,17 @@ subroutine setalb & !tgs: this part of the code needs the input from the ice ! model. Otherwise it uses the backup albedo computation ! from ialbflg = 1. - if (icy(i)) then - if (lsm == lsm_ruc .or. & - & (use_cice_alb .and. lakefrac(i) < epsln)) then !-- use ice albedo from the RUC ice model or - !-- use ice albedo from CICE for sea-ice + + if (icy(i)) then !-- Computation of ice albedo + + if (use_cice_alb .and. lakefrac(i) < epsln) then + icealb = icealbivis(i) + else + icealb = f_zero + endif + + if (lsm == lsm_ruc .or. icealb > epsln) then !-- use ice albedo from the RUC ice model or + !-- use ice albedo from CICE for sea-ice asevd_ice = icealbivis(i) asend_ice = icealbinir(i) asevb_ice = icealbdvis(i)