diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 99f36f077..00e7865ef 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -307,7 +307,7 @@ module GFS_diagtoscreen private - public GFS_diagtoscreen_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize + public GFS_diagtoscreen_init, GFS_diagtoscreen_timestep_init, GFS_diagtoscreen_run, GFS_diagtoscreen_finalize contains @@ -344,6 +344,39 @@ subroutine GFS_diagtoscreen_init (Model, Data, Interstitial, errmsg, errflg) end subroutine GFS_diagtoscreen_init +!> \section arg_table_GFS_diagtoscreen_timestep_init Argument Table +!! \htmlinclude GFS_diagtoscreen_timestep_init.html +!! + subroutine GFS_diagtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) + + use GFS_typedefs, only: GFS_control_type, GFS_data_type, & + GFS_interstitial_type + + implicit none + + !--- interface variables + type(GFS_control_type), intent(in) :: Model + type(GFS_data_type), intent(in) :: Data(:) + type(GFS_interstitial_type), intent(in) :: Interstitial(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !--- local variables + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do i=1,size(Data) + call GFS_diagtoscreen_run (Model, Data(i)%Statein, Data(i)%Stateout, Data(i)%Sfcprop, & + Data(i)%Coupling, Data(i)%Grid, Data(i)%Tbd, Data(i)%Cldprop, & + Data(i)%Radtend, Data(i)%Intdiag, Interstitial(1), & + size(Interstitial), i, errmsg, errflg) + end do + + end subroutine GFS_diagtoscreen_timestep_init + subroutine GFS_diagtoscreen_finalize () end subroutine GFS_diagtoscreen_finalize @@ -507,6 +540,26 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowfallac_land', Sfcprop%snowfallac_land) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%snowfallac_ice', Sfcprop%snowfallac_ice) end if + ! Revised surface albedo and emissivity calculation + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%emis_lnd', Sfcprop%emis_lnd) + ! NoahMP and RUC + if (Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noahmp) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdvis_lnd', Sfcprop%albdvis_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdnir_lnd', Sfcprop%albdnir_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albivis_lnd', Sfcprop%albivis_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albinir_lnd', Sfcprop%albinir_lnd) + end if + ! RUC only + if (Model%lsm == Model%lsm_ruc) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%emis_ice', Sfcprop%emis_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdvis_ice', Sfcprop%albdvis_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albdnir_ice', Sfcprop%albdnir_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albivis_ice', Sfcprop%albivis_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%albinir_ice', Sfcprop%albinir_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sfalb_lnd', Sfcprop%sfalb_lnd) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sfalb_ice', Sfcprop%sfalb_ice) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Sfcprop%sfalb_lnd_bck', Sfcprop%sfalb_lnd_bck) + end if ! Radtend call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%upfxc', Radtend%sfcfsw(:)%upfxc) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Radtend%sfcfsw%dnfxc', Radtend%sfcfsw(:)%dnfxc) @@ -835,6 +888,13 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nwfa2d', Coupling%nwfa2d) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%nifa2d', Coupling%nifa2d) end if + if (Model%do_RRTMGP) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwUP_jac', Coupling%fluxlwUP_jac) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwUP_allsky', Coupling%fluxlwUP_allsky) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%fluxlwDOWN_allsky', Coupling%fluxlwDOWN_allsky) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Coupling%htrlw', Coupling%htrlw) + end if + ! ! Grid call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%xlon ', Grid%xlon ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%xlat ', Grid%xlat ) @@ -843,17 +903,17 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%coslat', Grid%coslat) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%area ', Grid%area ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%dx ', Grid%dx ) - if (Model%ntoz > 0) then + if (Model%kdt>0 .and. Model%ntoz>0) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_o3 ', Grid%ddy_o3 ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_o3', Grid%jindx1_o3) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx2_o3', Grid%jindx2_o3) endif - if (Model%h2o_phys) then + if (Model%kdt>0 .and. Model%h2o_phys) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_h ', Grid%ddy_h ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_h', Grid%jindx1_h) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx2_h', Grid%jindx2_h) endif - if (Model%do_ugwp_v1) then + if (Model%kdt>0 .and. Model%do_ugwp_v1) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_j1tau ', Grid%ddy_j1tau ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%ddy_j2tau ', Grid%ddy_j2tau ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Grid%jindx1_tau', Grid%jindx1_tau ) @@ -889,10 +949,13 @@ module GFS_interstitialtoscreen private - public GFS_interstitialtoscreen_init, GFS_interstitialtoscreen_run, GFS_interstitialtoscreen_finalize + public GFS_interstitialtoscreen_init, GFS_interstitialtoscreen_timestep_init, GFS_interstitialtoscreen_run, GFS_interstitialtoscreen_finalize contains +!> \section arg_table_GFS_interstitialtoscreen_init Argument Table +!! \htmlinclude GFS_interstitialtoscreen_init.html +!! subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, errflg) use GFS_typedefs, only: GFS_control_type, GFS_data_type, & @@ -924,6 +987,40 @@ subroutine GFS_interstitialtoscreen_init (Model, Data, Interstitial, errmsg, err end subroutine GFS_interstitialtoscreen_init +!> \section arg_table_GFS_interstitialtoscreen_timestep_init Argument Table +!! \htmlinclude GFS_interstitialtoscreen_timestep_init.html +!! + subroutine GFS_interstitialtoscreen_timestep_init (Model, Data, Interstitial, errmsg, errflg) + + use GFS_typedefs, only: GFS_control_type, GFS_data_type, & + GFS_interstitial_type + + implicit none + + !--- interface variables + type(GFS_control_type), intent(in) :: Model + type(GFS_data_type), intent(in) :: Data(:) + type(GFS_interstitial_type), intent(in) :: Interstitial(:) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + !--- local variables + integer :: i + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + + do i=1,size(Interstitial) + call GFS_interstitialtoscreen_run (Model, Data(1)%Statein, Data(1)%Stateout, Data(1)%Sfcprop, & + Data(1)%Coupling, Data(1)%Grid, Data(1)%Tbd, Data(1)%Cldprop, & + Data(1)%Radtend, Data(1)%Intdiag, Interstitial(i), & + size(Interstitial), -999, errmsg, errflg) + end do + + end subroutine GFS_interstitialtoscreen_timestep_init + subroutine GFS_interstitialtoscreen_finalize () end subroutine GFS_interstitialtoscreen_finalize @@ -1233,7 +1330,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_land ', Interstitial%tsfc_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfc_water ', Interstitial%tsfc_water ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsfg ', Interstitial%tsfg ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf ', Interstitial%tsurf ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_ice ', Interstitial%tsurf_ice ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_land ', Interstitial%tsurf_land ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tsurf_water ', Interstitial%tsurf_water ) @@ -1257,6 +1353,9 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%xmu ', Interstitial%xmu ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%z01d ', Interstitial%z01d ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%zt1d ', Interstitial%zt1d ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ztmax_ice ', Interstitial%ztmax_ice ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ztmax_land ', Interstitial%ztmax_land ) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%ztmax_water ', Interstitial%ztmax_water ) ! UGWP call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_mtb ', Interstitial%tau_mtb ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%tau_ogw ', Interstitial%tau_ogw ) @@ -1345,8 +1444,6 @@ subroutine GFS_interstitialtoscreen_run (Model, Statein, Stateout, Sfcprop, Coup call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%precip_frac ', Interstitial%precip_frac ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icseed_lw ', Interstitial%icseed_lw ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%icseed_sw ', Interstitial%icseed_sw ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwUP_allsky ', Interstitial%fluxlwUP_allsky ) - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwDOWN_allsky ', Interstitial%fluxlwDOWN_allsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwUP_clrsky ', Interstitial%fluxlwUP_clrsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxlwDOWN_clrsky ', Interstitial%fluxlwDOWN_clrsky ) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Interstitial%fluxswUP_allsky ', Interstitial%fluxswUP_allsky ) diff --git a/physics/GFS_debug.meta b/physics/GFS_debug.meta index f2a991426..a2d3db0bf 100644 --- a/physics/GFS_debug.meta +++ b/physics/GFS_debug.meta @@ -49,6 +49,52 @@ intent = out optional = F +######################################################################## +[ccpp-arg-table] + name = GFS_diagtoscreen_timestep_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type in FV3 + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = instance of derived type GFS_data_type + units = DDT + dimensions = (ccpp_block_count) + type = GFS_data_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance_all_threads + long_name = instance of derived type GFS_interstitial_type + units = DDT + dimensions = (omp_threads) + type = GFS_interstitial_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = GFS_diagtoscreen_run @@ -227,6 +273,52 @@ intent = out optional = F +######################################################################## +[ccpp-arg-table] + name = GFS_interstitialtoscreen_timestep_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type in FV3 + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Data] + standard_name = GFS_data_type_instance_all_blocks + long_name = instance of derived type GFS_data_type + units = DDT + dimensions = (ccpp_block_count) + type = GFS_data_type + intent = in + optional = F +[Interstitial] + standard_name = GFS_interstitial_type_instance_all_threads + long_name = instance of derived type GFS_interstitial_type + units = DDT + dimensions = (omp_threads) + type = GFS_interstitial_type + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + ######################################################################## [ccpp-arg-table] name = GFS_interstitialtoscreen_run diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 0f53edc35..b68900d09 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -75,16 +75,18 @@ subroutine GFS_phys_time_vary_init ( isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& - qsnowxy, wslakexy, albdvis, albdnir, albivis, albinir, emiss, taussxy, waxy, wtxy, & + qsnowxy, wslakexy, albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, albdvis_ice, & + albdnir_ice, albivis_ice, albinir_ice, emiss_lnd, emiss_ice, taussxy, waxy, wtxy, & 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, nthrds, errmsg, errflg) + slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, flag_restart, nthrds, & + errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny - logical, intent(in) :: h2o_phys, iaerclm + logical, intent(in) :: h2o_phys, iaerclm, flag_restart integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) @@ -125,11 +127,16 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(inout) :: alboldxy(:) real(kind_phys), intent(inout) :: qsnowxy(:) real(kind_phys), intent(inout) :: wslakexy(:) - real(kind_phys), intent(inout) :: albdvis(:) - real(kind_phys), intent(inout) :: albdnir(:) - real(kind_phys), intent(inout) :: albivis(:) - real(kind_phys), intent(inout) :: albinir(:) - real(kind_phys), intent(inout) :: emiss(:) + real(kind_phys), intent(inout) :: albdvis_lnd(:) + real(kind_phys), intent(inout) :: albdnir_lnd(:) + real(kind_phys), intent(inout) :: albivis_lnd(:) + real(kind_phys), intent(inout) :: albinir_lnd(:) + real(kind_phys), intent(inout) :: albdvis_ice(:) + real(kind_phys), intent(inout) :: albdnir_ice(:) + real(kind_phys), intent(inout) :: albivis_ice(:) + real(kind_phys), intent(inout) :: albinir_ice(:) + real(kind_phys), intent(inout) :: emiss_lnd(:) + real(kind_phys), intent(inout) :: emiss_ice(:) real(kind_phys), intent(inout) :: taussxy(:) real(kind_phys), intent(inout) :: waxy(:) real(kind_phys), intent(inout) :: wtxy(:) @@ -385,9 +392,30 @@ subroutine GFS_phys_time_vary_init ( if (errflg/=0) return end if - if (lsm == lsm_noahmp) then - if (all(tvxy < zero)) then + !--- For Noah MP or RUC LSMs: initialize four components of albedo for + !--- land and ice - not for restart runs + lsm_init: if (.not.flag_restart) then + if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' + do ix=1,im + albdvis_lnd(ix) = 0.2_kind_phys + albdnir_lnd(ix) = 0.2_kind_phys + albivis_lnd(ix) = 0.2_kind_phys + albinir_lnd(ix) = 0.2_kind_phys + emiss_lnd(ix) = 0.95_kind_phys + enddo + endif + if (lsm == lsm_ruc) then + do ix=1,im + albdvis_ice(ix) = 0.6_kind_phys + albdnir_ice(ix) = 0.6_kind_phys + albivis_ice(ix) = 0.6_kind_phys + albinir_ice(ix) = 0.6_kind_phys + emiss_ice(ix) = 0.97_kind_phys + enddo + endif + noahmp_init: if (lsm == lsm_noahmp) then allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) dzsno(:) = missing_value @@ -406,11 +434,6 @@ subroutine GFS_phys_time_vary_init ( alboldxy(:) = missing_value qsnowxy(:) = missing_value wslakexy(:) = missing_value - albdvis(:) = missing_value - albdnir(:) = missing_value - albivis(:) = missing_value - albinir(:) = missing_value - emiss(:) = missing_value taussxy(:) = missing_value waxy(:) = missing_value wtxy(:) = missing_value @@ -441,7 +464,7 @@ subroutine GFS_phys_time_vary_init ( !$OMP shared(im,lsoil,con_t0c,landfrac,tsfcl,tvxy,tgxy,tahxy) & !$OMP shared(snowd,canicexy,canliqxy,canopy,eahxy,cmxy,chxy) & !$OMP shared(fwetxy,sneqvoxy,weasd,alboldxy,qsnowxy,wslakexy) & -!$OMP shared(taussxy,albdvis,albdnir,albivis,albinir,emiss) & +!$OMP shared(taussxy) & !$OMP shared(waxy,wtxy,zwtxy,imn,vtype,xlaixy,xsaixy,lfmassxy) & !$OMP shared(stmassxy,rtmassxy,woodxy,stblcpxy,fastcpxy) & !$OMP shared(isbarren_table,isice_table,isurban_table) & @@ -480,11 +503,6 @@ subroutine GFS_phys_time_vary_init ( ! already set to 0.0 wslakexy(ix) = zero taussxy(ix) = zero - albdvis(ix) = 0.2_kind_phys - albdnir(ix) = 0.2_kind_phys - albivis(ix) = 0.2_kind_phys - albinir(ix) = 0.2_kind_phys - emiss(ix) = 0.95_kind_phys waxy(ix) = 4900.0_kind_phys wtxy(ix) = waxy(ix) @@ -655,8 +673,8 @@ subroutine GFS_phys_time_vary_init ( deallocate(dzsno) deallocate(dzsnso) - endif - endif !if Noah MP cold start ends + endif noahmp_init + endif lsm_init is_initialized = .true. diff --git a/physics/GFS_phys_time_vary.fv3.meta b/physics/GFS_phys_time_vary.fv3.meta index f9ce50fa0..6289fb6a7 100644 --- a/physics/GFS_phys_time_vary.fv3.meta +++ b/physics/GFS_phys_time_vary.fv3.meta @@ -755,45 +755,90 @@ kind = kind_phys intent = inout optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice units = frac dimensions = (horizontal_dimension) type = real @@ -935,6 +980,14 @@ kind = kind_phys intent = in optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [nthrds] standard_name = omp_threads long_name = number of OpenMP threads available for physics schemes diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 9fa4e2de3..e1b5c3d9b 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -69,16 +69,18 @@ subroutine GFS_phys_time_vary_init ( isot, ivegsrc, nlunit, sncovr, sncovr_ice, lsm, lsm_noahmp, lsm_ruc, min_seaice, & fice, landfrac, vtype, weasd, lsoil, zs, dzs, lsnow_lsm_lbound, lsnow_lsm_ubound, & tvxy, tgxy, tahxy, canicexy, canliqxy, eahxy, cmxy, chxy, fwetxy, sneqvoxy, alboldxy,& - qsnowxy, wslakexy, albdvis, albdnir, albivis, albinir, emiss, taussxy, waxy, wtxy, & + qsnowxy, wslakexy, albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, albdvis_ice, & + albdnir_ice, albivis_ice, albinir_ice, emiss_lnd, emiss_ice, taussxy, waxy, wtxy, & 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, nthrds, errmsg, errflg) + slc, smc, stc, tsfcl, snowd, canopy, tg3, stype, con_t0c, flag_restart, nthrds, & + errmsg, errflg) implicit none ! Interface variables integer, intent(in) :: me, master, ntoz, iccn, iflip, im, nx, ny - logical, intent(in) :: h2o_phys, iaerclm + logical, intent(in) :: h2o_phys, iaerclm, flag_restart integer, intent(in) :: idate(:) real(kind_phys), intent(in) :: xlat_d(:), xlon_d(:) @@ -119,11 +121,16 @@ subroutine GFS_phys_time_vary_init ( real(kind_phys), intent(inout) :: alboldxy(:) real(kind_phys), intent(inout) :: qsnowxy(:) real(kind_phys), intent(inout) :: wslakexy(:) - real(kind_phys), intent(inout) :: albdvis(:) - real(kind_phys), intent(inout) :: albdnir(:) - real(kind_phys), intent(inout) :: albivis(:) - real(kind_phys), intent(inout) :: albinir(:) - real(kind_phys), intent(inout) :: emiss(:) + real(kind_phys), intent(inout) :: albdvis_lnd(:) + real(kind_phys), intent(inout) :: albdnir_lnd(:) + real(kind_phys), intent(inout) :: albivis_lnd(:) + real(kind_phys), intent(inout) :: albinir_lnd(:) + real(kind_phys), intent(inout) :: albdvis_ice(:) + real(kind_phys), intent(inout) :: albdnir_ice(:) + real(kind_phys), intent(inout) :: albivis_ice(:) + real(kind_phys), intent(inout) :: albinir_ice(:) + real(kind_phys), intent(inout) :: emiss_lnd(:) + real(kind_phys), intent(inout) :: emiss_ice(:) real(kind_phys), intent(inout) :: taussxy(:) real(kind_phys), intent(inout) :: waxy(:) real(kind_phys), intent(inout) :: wtxy(:) @@ -339,8 +346,30 @@ subroutine GFS_phys_time_vary_init ( if (errflg/=0) return end if - if (lsm == lsm_noahmp) then - if (all(tvxy <= zero)) then + !--- For Noah MP or RUC LSMs: initialize four components of albedo for + !--- land and ice - not for restart runs + lsm_init: if (.not.flag_restart) then + if (lsm == lsm_noahmp .or. lsm == lsm_ruc) then + if (me == master ) write(0,'(a)') 'GFS_phys_time_vary_init: initialize albedo for land and ice' + do ix=1,im + albdvis_lnd(ix) = 0.2_kind_phys + albdnir_lnd(ix) = 0.2_kind_phys + albivis_lnd(ix) = 0.2_kind_phys + albinir_lnd(ix) = 0.2_kind_phys + emiss_lnd(ix) = 0.95_kind_phys + enddo + endif + if (lsm == lsm_ruc) then + do ix=1,im + albdvis_ice(ix) = 0.6_kind_phys + albdnir_ice(ix) = 0.6_kind_phys + albivis_ice(ix) = 0.6_kind_phys + albinir_ice(ix) = 0.6_kind_phys + emiss_ice(ix) = 0.97_kind_phys + enddo + endif + + noahmp_init: if (lsm == lsm_noahmp) then allocate(dzsno (lsnow_lsm_lbound:lsnow_lsm_ubound)) allocate(dzsnso(lsnow_lsm_lbound:lsoil) ) dzsno(:) = missing_value @@ -359,11 +388,6 @@ subroutine GFS_phys_time_vary_init ( alboldxy(:) = missing_value qsnowxy(:) = missing_value wslakexy(:) = missing_value - albdvis(:) = missing_value - albdnir(:) = missing_value - albivis(:) = missing_value - albinir(:) = missing_value - emiss(:) = missing_value taussxy(:) = missing_value waxy(:) = missing_value wtxy(:) = missing_value @@ -418,11 +442,6 @@ subroutine GFS_phys_time_vary_init ( ! already set to 0.0 wslakexy(ix) = zero taussxy(ix) = zero - albdvis(ix) = 0.2_kind_phys - albdnir(ix) = 0.2_kind_phys - albivis(ix) = 0.2_kind_phys - albinir(ix) = 0.2_kind_phys - emiss(ix) = 0.95_kind_phys waxy(ix) = 4900.0_kind_phys wtxy(ix) = waxy(ix) @@ -592,8 +611,8 @@ subroutine GFS_phys_time_vary_init ( deallocate(dzsno) deallocate(dzsnso) - endif - endif !if Noah MP cold start ends + endif noahmp_init + endif lsm_init is_initialized = .true. diff --git a/physics/GFS_phys_time_vary.scm.meta b/physics/GFS_phys_time_vary.scm.meta index 74408d533..23df2cfb2 100644 --- a/physics/GFS_phys_time_vary.scm.meta +++ b/physics/GFS_phys_time_vary.scm.meta @@ -755,45 +755,90 @@ kind = kind_phys intent = inout optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[emiss_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice units = frac dimensions = (horizontal_dimension) type = real @@ -935,6 +980,14 @@ kind = kind_phys intent = in optional = F +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + units = flag + dimensions = () + type = logical + intent = in + optional = F [nthrds] standard_name = omp_threads long_name = number of OpenMP threads available for physics schemes diff --git a/physics/GFS_radiation_surface.F90 b/physics/GFS_radiation_surface.F90 new file mode 100644 index 000000000..dd0c56d43 --- /dev/null +++ b/physics/GFS_radiation_surface.F90 @@ -0,0 +1,201 @@ +!>\file GFS_radiation_surface.f90 +!! This file contains calls to module_radiation_surface::setemis() to set up +!! surface emissivity for LW radiation and to module_radiation_surface::setalb() +!! to set up surface albedo for SW radiation. + module GFS_radiation_surface + + use machine, only: kind_phys + + contains + +!>\defgroup GFS_radiation_surface GFS radiation surface +!! @{ +!> \section arg_table_GFS_radiation_surface_init Argument Table +!! \htmlinclude GFS_radiation_surface_init.html +!! + subroutine GFS_radiation_surface_init (me, sfcalb, ialb, iems, errmsg, errflg) + + use physparam, only: ialbflg, iemsflg + use module_radiation_surface, only: NF_ALBD, sfc_init + + implicit none + + integer, intent(in) :: me, ialb, iems + real(kind=kind_phys), dimension(:,:), intent(in) :: sfcalb + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency check that the number of albedo components in array + ! sfcalb matches the parameter NF_ALBD from radiation_surface.f + if (size(sfcalb,dim=2)/=NF_ALBD) then + errmsg = 'Error in GFS_radiation_surface_init: second' // & + ' dimension of array sfcalb does not match' // & + ' parameter NF_ALBD in radiation_surface.f' + errflg = 1 + end if + + ialbflg= ialb ! surface albedo control flag + iemsflg= iems ! surface emissivity control flag + + if ( me == 0 ) then + print *,'In GFS_radiation_surface_init, before calling sfc_init' + print *,'ialb=',ialb,' iems=',iems + end if + + ! Call surface initialization routine + call sfc_init ( me, errmsg, errflg ) + + end subroutine GFS_radiation_surface_init + + +!> \section arg_table_GFS_radiation_surface_run Argument Table +!! \htmlinclude GFS_radiation_surface_run.html +!! + subroutine GFS_radiation_surface_run ( & + im, frac_grid, lslwr, lsswr, lsm, lsm_noahmp, lsm_ruc, & + vtype, xlat, xlon, slmsk, lndp_type, n_var_lndp, sfc_alb_pert, & + lndp_var_list, lndp_prt_list, landfrac, snowd, sncovr, & + 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, & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + semisbase, semis, sfcalb, sfc_alb_dif, errmsg, errflg) + + use module_radiation_surface, only: f_zero, f_one, & + epsln, NF_ALBD, & + setemis, setalb + + implicit none + + integer, intent(in) :: im + logical, intent(in) :: frac_grid, lslwr, lsswr + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc, lndp_type, n_var_lndp + real(kind=kind_phys), intent(in) :: min_seaice, min_lakeice + + real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, vtype, slmsk, & + sfc_alb_pert, lndp_prt_list, & + landfrac, lakefrac, & + snowd, sncovr, & + sncovr_ice, fice, zorl, & + hprime, tsfg, tsfa, tisfc, & + coszen, alvsf, alnsf, alvwf, & + alnwf, facsf, facwf, & + semis_lnd, semis_ice, snoalb + character(len=3) , dimension(:), intent(in) :: lndp_var_list + real(kind=kind_phys), dimension(:), intent(in) :: albdvis_lnd, albdnir_lnd, & + albivis_lnd, albinir_lnd + real(kind=kind_phys), dimension(:), intent(in) :: albdvis_ice, albdnir_ice, & + albivis_ice, albinir_ice + real(kind=kind_phys), dimension(:), intent(inout) :: semisbase, semis + real(kind=kind_phys), dimension(:,:), intent(inout) :: sfcalb + real(kind=kind_phys), dimension(:), intent(inout) :: sfc_alb_dif + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Local variables + integer :: i + real(kind=kind_phys) :: lndp_alb + real(kind=kind_phys) :: cimin + real(kind=kind_phys), dimension(im) :: fracl, fraci, fraco + logical, dimension(im) :: icy + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Return immediately if neither shortwave nor longwave radiation are called + if (.not. lsswr .and. .not. lslwr) return + + do i=1,im + if (lakefrac(i) > f_zero) then + cimin = min_lakeice + else + cimin = min_seaice + endif + enddo + + ! Set up land/ice/ocean fractions for emissivity and albedo calculations + if (.not. frac_grid) then + do i=1,im + if (slmsk(i) == 1) then + fracl(i) = f_one + fraci(i) = f_zero + fraco(i) = f_zero + icy(i) = .false. + else + fracl(i) = f_zero + fraco(i) = f_one + if(fice(i) < cimin) then + fraci(i) = f_zero + icy(i) = .false. + else + fraci(i) = fraco(i) * fice(i) + icy(i) = .true. + endif + fraco(i) = max(f_zero, fraco(i)-fraci(i)) + endif + enddo + else + do i=1,im + fracl(i) = landfrac(i) + fraco(i) = max(f_zero, f_one - fracl(i)) + if(fice(i) < cimin) then + fraci(i) = f_zero + icy(i) = .false. + else + fraci(i) = fraco(i) * fice(i) + icy(i) = .true. + endif + fraco(i) = max(f_zero, fraco(i)-fraci(i)) + enddo + endif + + if (lslwr) then +!> - Call module_radiation_surface::setemis(),to set up surface +!! emissivity for LW radiation. + call setemis (lsm, lsm_noahmp, lsm_ruc, vtype, landfrac, & + 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 + semisbase, semis) ! --- outputs + endif + + if (lsswr) then +!> - Set surface albedo perturbation, if requested + lndp_alb = -999. + if (lndp_type==1) then + do i =1,n_var_lndp + if (lndp_var_list(i) == 'alb') then + lndp_alb = lndp_prt_list(i) + endif + enddo + endif + +!> - 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, landfrac, 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))) + endif + + end subroutine GFS_radiation_surface_run + + subroutine GFS_radiation_surface_finalize () + end subroutine GFS_radiation_surface_finalize +!! @} + end module GFS_radiation_surface diff --git a/physics/GFS_radiation_surface.meta b/physics/GFS_radiation_surface.meta new file mode 100644 index 000000000..c38ffe2a3 --- /dev/null +++ b/physics/GFS_radiation_surface.meta @@ -0,0 +1,531 @@ +[ccpp-table-properties] + name = GFS_radiation_surface + type = scheme + dependencies = iounitdef.f,machine.F,physparam.f,radiation_surface.f,set_soilveg_ruc.F90,namelist_soilveg_ruc.F90 + +######################################################################## +[ccpp-arg-table] + name = GFS_radiation_surface_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[sfcalb] + standard_name = surface_albedo_components + long_name = surface albedo IR/UV/VIS components + units = frac + dimensions = (horizontal_dimension,number_of_components_for_surface_albedo) + type = real + kind = kind_phys + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iems] + standard_name = flag_for_surface_emissivity_control + long_name = surface emissivity control flag, use fixed value of 1 + units = flag + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_radiation_surface_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[frac_grid] + standard_name = flag_for_fractional_grid + long_name = flag for fractional grid + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lslwr] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[vtype] + standard_name = vegetation_type_classification_real + long_name = vegetation type for lsm + units = index + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radian + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[lndp_type] + standard_name = index_for_stochastic_land_surface_perturbation_type + long_name = index for stochastic land surface perturbations type + units = index + dimensions = () + type = integer + intent = in + optional = F +[n_var_lndp] + standard_name = number_of_land_surface_variables_perturbed + long_name = number of land surface variables perturbed + units = count + dimensions = () + type = integer + intent = in + optional = F +[sfc_alb_pert] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[lndp_var_list] + standard_name = variables_to_be_perturbed_for_landperts + long_name = variables to be perturbed for landperts + units = none + dimensions = (number_of_land_surface_variables_perturbed) + type = character + kind = len=3 + intent = in + optional = F +[lndp_prt_list] + standard_name = magnitude_of_perturbations_for_landperts + long_name = magnitude of perturbations for landperts + units = variable + dimensions = (number_of_land_surface_variables_perturbed) + type = real + kind = kind_phys + intent = in + optional = F +[landfrac] + standard_name = land_area_fraction + long_name = fraction of horizontal grid area occupied by land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[tisfc] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[min_lakeice] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[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 + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[facsf] + standard_name =fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[semis_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[semisbase] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcalb] + standard_name = surface_albedo_components + long_name = surface albedo IR/UV/VIS components + units = frac + dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) + type = real + kind = kind_phys + intent = inout + optional = F +[sfc_alb_dif] + standard_name = surface_diffused_shortwave_albedo + long_name = mean surface diffused sw albedo + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rrtmg_setup.F90 b/physics/GFS_rrtmg_setup.F90 index aa5f3f4ca..1af386370 100644 --- a/physics/GFS_rrtmg_setup.F90 +++ b/physics/GFS_rrtmg_setup.F90 @@ -4,11 +4,10 @@ !> \defgroup GFS_rrtmg_setup_mod GFS RRTMG Scheme Setup module GFS_rrtmg_setup - use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg,& -! & iaermdl, laswflg, lalwflg, lavoflg, icldflg, & + use physparam, only : isolar , ictmflg, ico2flg, ioznflg, iaerflg, & & iaermdl, icldflg, & & iovrRad=>iovr, lcrick , lcnorm , lnoprec, & - & ialbflg, iemsflg, isubcsw, isubclw, ivflip , ipsd0, & + & isubcsw, isubclw, ivflip , ipsd0, & & iswcliq, & & kind_phys @@ -44,7 +43,7 @@ module GFS_rrtmg_setup !! \htmlinclude GFS_rrtmg_setup_init.html !! subroutine GFS_rrtmg_setup_init ( & - si, levr, ictm, isol, ico2, iaer, ialb, iems, ntcw, & + si, levr, ictm, isol, ico2, iaer, ntcw, & num_p3d, npdf3d, ntoz, iovr, isubc_sw, isubc_lw, & icliq_sw, crick_proof, ccnorm, & imp_physics, & @@ -106,15 +105,6 @@ subroutine GFS_rrtmg_setup_init ( & ! =1 include tropspheric aerosols for lw ! ! c: =0 no topospheric aerosol in sw radiation ! ! =1 include tropspheric aerosols for sw ! -! ialb : control flag for surface albedo schemes ! -! =0: climatology, based on surface veg types ! -! =1: modis retrieval based surface albedo scheme ! -! iems : ab 2-digit control flag ! -! a: =0 set sfc air/ground t same for lw radiation ! -! =1 set sfc air/ground t diff for lw radiation ! -! b: =0 use fixed sfc emissivity=1.0 (black-body) ! -! =1 use varying climtology sfc emiss (veg based)! -! =2 future development (not yet) ! ! ntcw :=0 no cloud condensate calculated ! ! >0 array index location for cloud condensate ! ! num_p3d :=3: ferrier's microphysics cloud scheme ! @@ -158,9 +148,6 @@ subroutine GFS_rrtmg_setup_init ( & use module_radsw_parameters, only: NBDSW use module_radlw_parameters, only: NBDLW use module_radiation_aerosols,only: NF_AELW, NF_AESW, NSPC1 - use module_radiation_clouds, only: NF_CLDS - use module_radiation_gases, only: NF_VGAS - use module_radiation_surface, only: NF_ALBD implicit none @@ -171,8 +158,6 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: isol integer, intent(in) :: ico2 integer, intent(in) :: iaer - integer, intent(in) :: ialb - integer, intent(in) :: iems integer, intent(in) :: ntcw integer, intent(in) :: num_p3d integer, intent(in) :: npdf3d @@ -285,9 +270,6 @@ subroutine GFS_rrtmg_setup_init ( & isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation - ialbflg= ialb ! surface albedo control flag - iemsflg= iems ! surface emissivity control flag - ivflip = iflip ! vertical index direction control flag ! --- assign initial permutation seed for mcica cloud-radiation @@ -300,7 +282,7 @@ subroutine GFS_rrtmg_setup_init ( & print *,' In rad_initialize (GFS_rrtmg_setup_init), before calling radinit' print *,' si =',si print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& - & ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw + & ' iaer=',iaer,' ntcw=',ntcw print *,' np3d=',num_p3d,' ntoz=',ntoz, & & ' iovr=',iovr,' isubc_sw=',isubc_sw, & & ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & @@ -456,15 +438,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! ioznflg : ozone data source control flag ! ! =0: use climatological ozone profile ! ! =1: use interactive ozone profile ! -! ialbflg : albedo scheme control flag ! -! =0: climatology, based on surface veg types ! -! =1: modis retrieval based surface albedo scheme ! -! iemsflg : emissivity scheme cntrl flag (ab 2-digit integer) ! -! a:=0 set sfc air/ground t same for lw radiation ! -! =1 set sfc air/ground t diff for lw radiation ! -! b:=0 use fixed sfc emissivity=1.0 (black-body) ! -! =1 use varying climtology sfc emiss (veg based) ! -! =2 future development (not yet) ! ! icldflg : cloud optical property scheme control flag ! ! =0: use diagnostic cloud scheme ! ! =1: use prognostic cloud scheme (default) ! @@ -497,7 +470,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! =1: index from surface to toa ! ! ! ! subroutines called: sol_init, aer_init, gas_init, cld_init, ! -! sfc_init, rlwinit, rswinit ! +! rlwinit, rswinit ! ! ! ! usage: call radinit ! ! ! @@ -507,9 +480,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) use module_radiation_astronomy, only : sol_init use module_radiation_aerosols, only : aer_init use module_radiation_gases, only : gas_init - use module_radiation_surface, only : sfc_init use module_radiation_clouds, only : cld_init - ! DH* these should be called by rrtmg_lw_init and rrtmg_sw_init! use rrtmg_lw, only : rlwinit use rrtmg_sw, only : rswinit @@ -529,16 +500,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) ! !> -# Set up control variables and external module variables in !! module physparam -#if 0 - ! DH* WHAT IS THIS? - ! GFS_radiation_driver.F90 may in the future initialize air/ground - ! temperature differently; however, this is not used at the moment - ! and as such we avoid the difficulty of dealing with exchanging - ! itsfc between GFS_rrtmg_setup and a yet-to-be-created/-used - ! interstitial routine (or GFS_radiation_driver.F90) - itsfc = iemsflg / 10 ! sfc air/ground temp control - ! *DH -#endif loz1st = (ioznflg == 0) ! first-time clim ozone data read flag month0 = 0 iyear0 = 0 @@ -551,7 +512,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) print *, VTAGRAD !print out version tag print *,' - Selected Control Flag settings: ICTMflg=',ictmflg, & & ' ISOLar =',isolar, ' ICO2flg=',ico2flg,' IAERflg=',iaerflg, & - & ' IALBflg=',ialbflg,' IEMSflg=',iemsflg,' ICLDflg=',icldflg, & + & ' ICLDflg=',icldflg, & & ' IMP_PHYSICS=',imp_physics,' IOZNflg=',ioznflg print *,' IVFLIP=',ivflip,' IOVR=',iovrRad, & & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw @@ -606,8 +567,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) !! call module_radiation_aerosols::aer_init() !! - CO2 and other gases intialization routine: !! call module_radiation_gases::gas_init() -!! - surface intialization routine: -!! call module_radiation_surface::sfc_init() !! - cloud initialization routine: !! call module_radiation_clouds::cld_init() !! - LW radiation initialization routine: @@ -622,8 +581,6 @@ subroutine radinit( si, NLAY, imp_physics, me ) call gas_init ( me ) ! --- ... co2 and other gases initialization routine - call sfc_init ( me ) ! --- ... surface initialization routine - call cld_init ( si, NLAY, imp_physics, me) ! --- ... cloud initialization routine call rlwinit ( me ) ! --- ... lw radiation initialization routine @@ -631,7 +588,7 @@ subroutine radinit( si, NLAY, imp_physics, me ) call rswinit ( me ) ! --- ... sw radiation initialization routine ! return -!................................... +! end subroutine radinit !----------------------------------- diff --git a/physics/GFS_rrtmg_setup.meta b/physics/GFS_rrtmg_setup.meta index b75c8b044..ab95b8ccd 100644 --- a/physics/GFS_rrtmg_setup.meta +++ b/physics/GFS_rrtmg_setup.meta @@ -1,8 +1,8 @@ [ccpp-table-properties] name = GFS_rrtmg_setup type = scheme - dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f, - dependencies = module_mp_thompson.F90,radiation_gases.f,radiation_surface.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f, + dependencies = iounitdef.f,module_bfmicrophysics.f,physparam.f,radcons.f90,radiation_aerosols.f,radiation_astronomy.f,radiation_clouds.f + dependencies = module_mp_thompson.F90,radiation_gases.f,radlw_main.F90,radlw_param.f,radsw_main.F90,radsw_param.f ######################################################################## [ccpp-arg-table] @@ -57,22 +57,6 @@ type = integer intent = in optional = F -[ialb] - standard_name = flag_for_using_climatology_albedo - long_name = flag for using climatology alb, based on sfc type - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iems] - standard_name = flag_for_surface_emissivity_control - long_name = surface emissivity control flag, use fixed value of 1 - units = flag - dimensions = () - type = integer - intent = in - optional = F [ntcw] standard_name = index_for_liquid_cloud_condensate long_name = tracer index for cloud condensate (or liquid water) diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 8096aef2a..919cb33fb 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -86,7 +86,7 @@ dimensions = () type = logical intent = in - optional = F + optional = F [i_o3] standard_name = index_for_ozone long_name = tracer index for ozone mixing ratio @@ -324,7 +324,7 @@ standard_name = saturation_vapor_pressure long_name = saturation vapor pressure units = Pa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout @@ -333,7 +333,7 @@ standard_name = water_vapor_mixing_ratio long_name = water vaport mixing ratio units = kg/kg - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = inout diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index ff82ba779..d518cb6e3 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -5,12 +5,11 @@ module GFS_rrtmgp_setup use module_radiation_astronomy, only : sol_init, sol_update use module_radiation_aerosols, only : aer_init, aer_update use module_radiation_gases, only : gas_init, gas_update - use module_radiation_surface, only : sfc_init use GFS_cloud_diagnostics, only : hml_cloud_diagnostics_initialize ! *NOTE* These parameters below are required radiation_****** modules. They are not ! directly used by the RRTMGP routines. use physparam, only : isolar, ictmflg, ico2flg, ioznflg, iaerflg, & - iaermdl, ialbflg, iemsflg, ivflip + iaermdl, ivflip implicit none public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_timestep_init, GFS_rrtmgp_setup_finalize @@ -40,10 +39,10 @@ module GFS_rrtmgp_setup !! \section arg_table_GFS_rrtmgp_setup_init !! \htmlinclude GFS_rrtmgp_setup_init.html !! - subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, ialb, & - iems, ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, & + subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, & + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, & + imp_physics_zhao_carr_pdf, imp_physics_mg, si, levr, ictm, isol, ico2, iaer, & + ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, & norad_precip, idate, iflip, me, errmsg, errflg) ! Inputs @@ -59,8 +58,8 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, imp_physics_mg ! Flag for MG scheme real(kind_phys), dimension(:), intent(in) :: & si - integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & - ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & + integer, intent(in) :: levr, ictm, isol, ico2, iaer, & + ntcw, num_p3d, ntoz, iovr, isubc_sw, isubc_lw, & icliq_sw, iflip, me logical, intent(in) :: & crick_proof, ccnorm, norad_precip @@ -89,8 +88,6 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ictmflg = ictm ! data ic time/date control flag ico2flg = ico2 ! co2 data source control flag ioznflg = ntoz ! ozone data source control flag - ialbflg = ialb ! surface albedo control flag - iemsflg = iems ! surface emissivity control flag ivflip = iflip ! vertical index direction control flag if ( ictm==0 .or. ictm==-2 ) then @@ -113,8 +110,6 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ' isol = ',isol, & ' ico2 = ',ico2, & ' iaer = ',iaer, & - ' ialb = ',ialb, & - ' iems = ',iems, & ' ntcw = ',ntcw print *,' np3d = ',num_p3d, & ' ntoz = ',ntoz, & @@ -126,14 +121,6 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, ' me = ',me endif -#if 0 - ! GFS_radiation_driver.F90 may in the future initialize air/ground - ! temperature differently; however, this is not used at the moment - ! and as such we avoid the difficulty of dealing with exchanging - ! itsfc between GFS_rrtmgp_setup and a yet-to-be-created/-used - ! interstitial routine (or GFS_radiation_driver.F90) - itsfc = iemsflg / 10 ! sfc air/ground temp control -#endif loz1st = (ioznflg == 0) ! first-time clim ozone data read flag month0 = 0 iyear0 = 0 @@ -143,7 +130,6 @@ subroutine GFS_rrtmgp_setup_init(do_RRTMGP, imp_physics, imp_physics_fer_hires, call sol_init ( me ) call aer_init ( levr, me ) call gas_init ( me ) - call sfc_init ( me ) call hml_cloud_diagnostics_initialize(imp_physics, imp_physics_fer_hires, & imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, imp_physics_mg, levr, me, si,& diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index 8c436fe62..3d58d7fb0 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -2,7 +2,7 @@ name = GFS_rrtmgp_setup type = scheme dependencies = iounitdef.f,machine.F,module_bfmicrophysics.f,physparam.f,radiation_aerosols.f,radiation_astronomy.f - dependencies = module_mp_thompson.F90,radiation_clouds.f,radiation_gases.f,radiation_surface.f + dependencies = module_mp_thompson.F90,radiation_clouds.f,radiation_gases.f ######################################################################## [ccpp-arg-table] @@ -131,22 +131,6 @@ type = integer intent = in optional = F -[ialb] - standard_name = flag_for_using_climatology_albedo - long_name = flag for using climatology alb, based on sfc type - units = flag - dimensions = () - type = integer - intent = in - optional = F -[iems] - standard_name = flag_for_surface_emissivity_control - long_name = surface emissivity control flag, use fixed value of 1 - units = flag - dimensions = () - type = integer - intent = in - optional = F [ntcw] standard_name = index_for_liquid_cloud_condensate long_name = tracer index for cloud condensate (or liquid water) diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 68f2a07c1..19f211d7f 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -1,18 +1,13 @@ module GFS_rrtmgp_sw_pre use machine, only: & kind_phys ! Working type - use module_radiation_astronomy,only: & + use module_radiation_astronomy, only: & coszmn ! Function to compute cos(SZA) - use module_radiation_surface, only: & - NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) - setalb ! Routine to compute surface albedo - use surface_perturbation, only: & - cdfnor ! Routine to compute CDF (used to compute percentiles) use mo_gas_optics_rrtmgp, only: & ty_gas_optics_rrtmgp use rrtmgp_sw_gas_optics, only: sw_gas_props - public GFS_rrtmgp_sw_pre_run,GFS_rrtmgp_sw_pre_init,GFS_rrtmgp_sw_pre_finalize - + public GFS_rrtmgp_sw_pre_run, GFS_rrtmgp_sw_pre_init, GFS_rrtmgp_sw_pre_finalize + contains ! ######################################################################################### @@ -27,62 +22,25 @@ end subroutine GFS_rrtmgp_sw_pre_init !> \section arg_table_GFS_rrtmgp_sw_pre_run !! \htmlinclude GFS_rrtmgp_sw_pre.html !! - subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, n_var_lndp, lndp_type, lndp_var_list, & - lndp_prt_list, doSWrad, solhr, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, & - tsfg, tsfa, hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, & - albdnir, albivis, albinir, lsmask, sfc_wts, p_lay, tv_lay, relhum, p_lev, & - nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_dif, errmsg, errflg) - - ! Inputs + subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, & + nday, idxday, coszen, coszdg, sfcalb, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, errmsg, errflg) + + ! Input integer, intent(in) :: & me, & ! Current MPI rank - nCol, & ! Number of horizontal grid points - nLev, & ! Number of vertical layers - n_var_lndp, & ! Number of surface variables perturbed - lndp_type ! Type of land perturbations scheme used - character(len=3), dimension(:), intent(in) :: & - lndp_var_list - real(kind_phys), dimension(:), intent(in) :: & - lndp_prt_list + nCol ! Number of horizontal grid points + logical,intent(in) :: & - doSWrad ! Call RRTMGP SW radiation? + doSWrad ! Call RRTMGP SW radiation? real(kind_phys), intent(in) :: & - solhr ! Time in hours after 00z at the current timestep + solhr ! Time in hours after 00z at the current timestep real(kind_phys), dimension(:), intent(in) :: & - lsmask, & ! Landmask: sea/land/ice=0/1/2 lon, & ! Longitude coslat, & ! Cosine(latitude) - sinlat, & ! Sine(latitude) - snowd, & ! Water equivalent snow depth (mm) - sncovr, & ! Surface snow area fraction (frac) - snoalb, & ! Maximum snow albedo (frac) - zorl, & ! Surface roughness length (cm) - tsfg, & ! Surface ground temperature for radiation (K) - tsfa, & ! Lowest model layer air temperature for radiation (K) - hprime, & ! Standard deviation of subgrid orography (m) - alvsf, & ! Mean vis albedo with strong cosz dependency (frac) - alnsf, & ! Mean nir albedo with strong cosz dependency (frac) - alvwf, & ! Mean vis albedo with weak cosz dependency (frac) - alnwf, & ! Mean nir albedo with weak cosz dependency (frac) - facsf, & ! Fractional coverage with strong cosz dependency (frac) - facwf, & ! Fractional coverage with weak cosz dependency (frac) - fice, & ! Ice fraction over open water (frac) - tisfc ! Sea ice surface skin temperature (K) - real(kind_phys), dimension(:), intent(in) :: & - albdvis, & ! surface albedo from lsm (direct,vis) (frac) - albdnir, & ! surface albedo from lsm (direct,nir) (frac) - albivis, & ! surface albedo from lsm (diffuse,vis) (frac) - albinir ! surface albedo from lsm (diffuse,nir) (frac) - - real(kind_phys), dimension(:,:), intent(in) :: & - sfc_wts ! Weights for stochastic surface physics perturbation () - real(kind_phys), dimension(:,:),intent(in) :: & - p_lay, & ! Layer pressure - tv_lay, & ! Layer virtual-temperature - relhum ! Layer relative-humidity - real(kind_phys), dimension(:,:),intent(in) :: & - p_lev ! Pressure @ layer interfaces (Pa) + sinlat ! Sine(latitude) + + real(kind_phys), dimension(:,:), intent(in) :: sfcalb ! Outputs integer, intent(out) :: & @@ -91,23 +49,19 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, n_var_lndp, lndp_type, lndp_var idxday ! Indices for daylit points real(kind_phys), dimension(:), intent(inout) :: & coszen, & ! Cosine of SZA - coszdg, & ! Cosine of SZA, daytime - sfc_alb_dif ! Mean surface diffused (nIR+uvvis) sw albedo + coszdg ! Cosine of SZA, daytime real(kind_phys), dimension(:,:), intent(out) :: & - sfc_alb_nir_dir, & ! Surface albedo (direct) + sfc_alb_nir_dir, & ! Surface albedo (direct) sfc_alb_nir_dif, & ! Surface albedo (diffuse) sfc_alb_uvvis_dir, & ! Surface albedo (direct) sfc_alb_uvvis_dif ! Surface albedo (diffuse) character(len=*), intent(out) :: & errmsg ! Error message - integer, intent(out) :: & + integer, intent(out) :: & errflg ! Error flag ! Local variables - integer :: i, j, iCol, iBand, iLay - real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb - real(kind_phys), dimension(ncol) :: alb1d - real(kind_phys) :: lndp_alb + integer :: i, iBand ! Initialize CCPP error handling variables errmsg = '' @@ -125,31 +79,19 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, n_var_lndp, lndp_type, lndp_var ! #################################################################################### nday = 0 idxday = 0 - do i = 1, NCOL + do i = 1, nCol if (coszen(i) >= 0.0001) then nday = nday + 1 idxday(nday) = i endif enddo - - ! #################################################################################### - ! Call module_radiation_surface::setalb() to setup surface albedo. - ! #################################################################################### - alb1d(:) = 0. - lndp_alb = -999. - call setalb (lsmask, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, hprime, alvsf, & - alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, & - albinir, NCOL, alb1d, lndp_alb, sfcalb) - - ! Approximate mean surface albedo from vis- and nir- diffuse values. - sfc_alb_dif(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) - + ! Spread across all SW bands do iBand=1,sw_gas_props%get_nband() - sfc_alb_nir_dir(iBand,1:NCOL) = sfcalb(1:NCOL,1) - sfc_alb_nir_dif(iBand,1:NCOL) = sfcalb(1:NCOL,2) - sfc_alb_uvvis_dir(iBand,1:NCOL) = sfcalb(1:NCOL,3) - sfc_alb_uvvis_dif(iBand,1:NCOL) = sfcalb(1:NCOL,4) + sfc_alb_nir_dir(iBand,1:nCol) = sfcalb(1:nCol,1) + sfc_alb_nir_dif(iBand,1:nCol) = sfcalb(1:nCol,2) + sfc_alb_uvvis_dir(iBand,1:nCol) = sfcalb(1:nCol,3) + sfc_alb_uvvis_dif(iBand,1:nCol) = sfcalb(1:nCol,4) enddo else nday = 0 @@ -158,12 +100,10 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, n_var_lndp, lndp_type, lndp_var sfc_alb_nir_dif(:,1:nCol) = 0. sfc_alb_uvvis_dir(:,1:nCol) = 0. sfc_alb_uvvis_dif(:,1:nCol) = 0. - sfc_alb_dif(1:nCol) = 0. endif - end subroutine GFS_rrtmgp_sw_pre_run - + ! ######################################################################################### ! SUBROUTINE GFS_rrtmgp_sw_pre_finalize ! ######################################################################################### diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 349750879..c65e61cb5 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_sw_pre type = scheme - dependencies = iounitdef.f,machine.F,physparam.f,radiation_astronomy.f,radiation_surface.f + dependencies = machine.F,radiation_astronomy.f,rrtmgp_sw_gas_optics.F90,rte-rrtmgp/rrtmgp/mo_gas_optics_rrtmgp.F90, ######################################################################## [ccpp-arg-table] @@ -12,7 +12,7 @@ long_name = current MPI-rank units = index dimensions = () - type = integer + type = integer intent = in optional = F [ncol] @@ -23,48 +23,6 @@ type = integer intent = in optional = F -[nLev] - standard_name = vertical_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in - optional = F -[n_var_lndp] - standard_name = number_of_land_surface_variables_perturbed - long_name = number of land surface variables perturbed - units = count - dimensions = () - type = integer - intent = in - optional = F -[lndp_type] - standard_name = index_for_stochastic_land_surface_perturbation_type - long_name = index for stochastic land surface perturbations type - units = index - dimensions = () - type = integer - intent = in - optional = F -[lndp_var_list] - standard_name = variables_to_be_perturbed_for_landperts - long_name = variables to be perturbed for landperts - units = none - dimensions = (number_of_land_surface_variables_perturbed) - type = character - kind = len=3 - intent = in - optional = F -[lndp_prt_list] - standard_name =magnitude_of_perturbations_for_landperts - long_name = magnitude of perturbations for landperts - units = variable - dimensions = (number_of_land_surface_variables_perturbed) - type = real - kind = kind_phys - intent = in - optional = F [doSWrad] standard_name = flag_to_calc_sw long_name = logical flags for sw radiation calls @@ -108,231 +66,6 @@ type = real kind = kind_phys intent = in - optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snoalb] - standard_name = upper_bound_on_max_albedo_over_deep_snow - long_name = maximum snow albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alvsf] - standard_name = mean_vis_albedo_with_strong_cosz_dependency - long_name = mean vis albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alnsf] - standard_name = mean_nir_albedo_with_strong_cosz_dependency - long_name = mean nir albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alvwf] - standard_name = mean_vis_albedo_with_weak_cosz_dependency - long_name = mean vis albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alnwf] - standard_name = mean_nir_albedo_with_weak_cosz_dependency - long_name = mean nir albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[facsf] - standard_name =fractional_coverage_with_strong_cosz_dependency - long_name = fractional coverage with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[facwf] - standard_name = fractional_coverage_with_weak_cosz_dependency - long_name = fractional coverage with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tisfc] - standard_name = sea_ice_temperature - long_name = sea ice surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[lsmask] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sfc_wts] - standard_name = weights_for_stochastic_surface_physics_perturbation - long_name = weights for stochastic surface physics perturbation - units = none - dimensions = (horizontal_loop_extent,number_of_surface_perturbations) - type = real - kind = kind_phys - intent = in - optional = F -[p_lay] - standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa - long_name = air pressure at vertical layer for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[tv_lay] - standard_name = virtual_temperature - long_name = layer virtual temperature - units = K - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[relhum] - standard_name = relative_humidity - long_name = layer relative humidity - units = frac - dimensions = (horizontal_loop_extent,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa - long_name = air pressure at vertical interface for radiation calculation - units = hPa - dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) - type = real - kind = kind_phys - intent = in optional = F [nday] standard_name = daytime_points_dimension @@ -368,6 +101,15 @@ kind = kind_phys intent = inout optional = F +[sfcalb] + standard_name = surface_albedo_components + long_name = surface albedo IR/UV/VIS components + units = frac + dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) + type = real + kind = kind_phys + intent = in + optional = F [sfc_alb_nir_dir] standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) @@ -379,7 +121,7 @@ optional = F [sfc_alb_nir_dif] standard_name = surface_albedo_nearIR_diffuse - long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) units = none dimensions = (number_of_sw_bands_rrtmgp,horizontal_loop_extent) type = real @@ -404,15 +146,6 @@ kind = kind_phys intent = out optional = F -[sfc_alb_dif] - standard_name = surface_diffused_shortwave_albedo - long_name = mean surface diffused sw albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_thompsonmp_pre.meta b/physics/GFS_rrtmgp_thompsonmp_pre.meta index c17abde74..bb60df092 100644 --- a/physics/GFS_rrtmgp_thompsonmp_pre.meta +++ b/physics/GFS_rrtmgp_thompsonmp_pre.meta @@ -139,7 +139,7 @@ standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa long_name = air pressure at vertical interface for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension_plus_one) + dimensions = (horizontal_loop_extent,vertical_dimension_plus_one) type = real kind = kind_phys intent = in @@ -148,7 +148,7 @@ standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa long_name = air pressure at vertical layer for radiation calculation units = hPa - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in @@ -157,7 +157,7 @@ standard_name = virtual_temperature long_name = layer virtual temperature units = K - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_loop_extent,vertical_dimension) type = real kind = kind_phys intent = in diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index c06c7100e..ee99e0f85 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -4,6 +4,7 @@ module GFS_surface_composites_pre use machine, only: kind_phys + use physparam, only : iemsflg implicit none @@ -26,21 +27,23 @@ end subroutine GFS_surface_composites_pre_finalize !> \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, flag_cice, cplflx, cplwav2atm, & - landfrac, lakefrac, lakedepth, oceanfrac, frland, dry, icy, use_flake, ocean, wet, & - hice, cice, snowd, snowd_wat, snowd_lnd, snowd_ice, tprcp, tprcp_wat, & + 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, use_flake, ocean, wet, hice, cice, zorlo, zorll, zorli, & + snowd, snowd_wat, 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, & - tsfc_lnd, tsfc_ice, tisfc, tice, tsurf, tsurf_wat, tsurf_lnd, tsurf_ice, & + 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, & - qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & - min_lakeice, min_seaice, zorlo, zorll, zorli, errmsg, errflg) + emis_lnd, emis_ice, qss, qss_wat, qss_lnd, qss_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, & + min_lakeice, min_seaice, errmsg, errflg) implicit none ! Interface variables integer, intent(in ) :: im, lkm - logical, intent(in ) :: frac_grid, cplflx, cplwav2atm + 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, use_flake, ocean, wet real(kind=kind_phys), dimension(:), intent(in ) :: landfrac, lakefrac, lakedepth, oceanfrac @@ -48,7 +51,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx real(kind=kind_phys), dimension(:), intent( out) :: frland real(kind=kind_phys), dimension(:), intent(in ) :: snowd, tprcp, uustar, weasd, qss, hflx - real(kind=kind_phys), dimension(:), intent(inout) :: tsfc, tsfco, tsfcl, tisfc, tsurf + 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, & 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, & @@ -58,6 +61,7 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx integer, dimension(:), intent(inout) :: islmsk, islmsk_cice 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), dimension(:), intent(inout) :: zorlo, zorll, zorli @@ -184,7 +188,15 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx ! 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 + !data emsref / 0.97, 0.95, 0.94, 0.90, 0.93, 0.96, 0.96, 0.99 / + if(iemsflg == 2) then + semis_wat(i) = 0.97_kind_phys ! consistent with setemis + else semis_wat(i) = 0.984_kind_phys + endif qss_wat(i) = qss(i) hflx_wat(i) = hflx(i) ! DH* @@ -198,7 +210,12 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx 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) + else semis_lnd(i) = semis_rad(i) + endif qss_lnd(i) = qss(i) hflx_lnd(i) = hflx(i) ! DH* @@ -214,7 +231,12 @@ subroutine GFS_surface_composites_pre_run (im, lkm, frac_grid, flag_cice, cplflx snowd_ice(i) = snowd(i) ep1d_ice(i) = zero gflx_ice(i) = zero + if (iemsflg == 2 .and. .not. flag_init .and. lsm == lsm_ruc) then + !-- use emis_ice from RUC LSM with snow effect + semis_ice(i) = emis_ice(i) + else semis_ice(i) = 0.95_kind_phys + endif qss_ice(i) = qss(i) hflx_ice(i) = hflx(i) ! DH* @@ -328,13 +350,17 @@ module GFS_surface_composites_post use machine, only: kind_phys + ! For consistent calculations of composite surface properties + use sfc_diff, only: stability + implicit none private public GFS_surface_composites_post_init, GFS_surface_composites_post_finalize, GFS_surface_composites_post_run - real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, & + half = 0.5_kind_phys, qmin = 1.0e-8_kind_phys contains @@ -348,15 +374,16 @@ end subroutine GFS_surface_composites_post_finalize !! \htmlinclude GFS_surface_composites_post_run.html !! subroutine GFS_surface_composites_post_run ( & - im, kice, km, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & - zorl, zorlo, zorll, zorli, & + 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, & 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, tsurf_wat, tsurf_lnd, tsurf_ice, & + 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, & 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, errmsg, errflg) + 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) implicit none @@ -364,30 +391,39 @@ subroutine GFS_surface_composites_post_run ( logical, intent(in) :: cplflx, frac_grid, cplwav2atm logical, dimension(:), intent(in) :: flag_cice, dry, wet, icy integer, dimension(:), intent(in) :: islmsk - real(kind=kind_phys), dimension(:), intent(in) :: landfrac, lakefrac, oceanfrac, & + 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, & 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, & - hflx_ice, qss_wat, qss_lnd, qss_ice, tsfc_wat, tsfc_lnd, tsfc_ice + 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, zorlo, zorll, zorli, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & - fh2, tsurf, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc + real(kind=kind_phys), dimension(:), intent(inout) :: zorl, cd, cdq, rb, stress, ffmm, ffhh, uustar, fm10, & + fh2, cmm, chh, gflx, ep1d, weasd, snowd, tprcp, evap, hflx, qss, tsfc, tsfco, tsfcl, tisfc real(kind=kind_phys), dimension(:), intent(in ) :: tice ! interstitial sea ice temperature real(kind=kind_phys), dimension(:), intent(inout) :: hice, cice real(kind=kind_phys), intent(in ) :: min_seaice + real(kind=kind_phys), intent(in ) :: rd, rvrdm1 real(kind=kind_phys), dimension(:,:), intent(in ) :: tiice real(kind=kind_phys), dimension(:,:), intent(inout) :: stc + ! Additional data needed for calling "stability" + logical, intent(in ) :: thsfc_loc + real(kind=kind_phys), intent(in ) :: grav + real(kind=kind_phys), dimension(:), intent(in ) :: prsik1, prslk1, prslki, z1 + real(kind=kind_phys), dimension(:), intent(in ) :: ztmax_wat, ztmax_lnd, ztmax_ice + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Local variables integer :: i, k - real(kind=kind_phys) :: txl, txi, txo, wfrac + real(kind=kind_phys) :: txl, txi, txo, wfrac, q0, rho + ! For calling "stability" + real(kind=kind_phys) :: tsurf, virtfac, tv1, thv1, tvs, z0max, ztmax ! Initialize CCPP error handling variables errmsg = '' @@ -405,20 +441,6 @@ subroutine GFS_surface_composites_post_run ( txi = cice(i) * wfrac ! txi = ice fraction wrt whole cell txo = max(zero, wfrac-txi) ! txo = open water fraction - zorl(i) = txl*zorll(i) + txi*zorli(i) + txo*zorlo(i) - cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_wat(i) - cdq(i) = txl*cdq_lnd(i) + txi*cdq_ice(i) + txo*cdq_wat(i) - rb(i) = txl*rb_lnd(i) + txi*rb_ice(i) + txo*rb_wat(i) - stress(i) = txl*stress_lnd(i) + txi*stress_ice(i) + txo*stress_wat(i) - ffmm(i) = txl*ffmm_lnd(i) + txi*ffmm_ice(i) + txo*ffmm_wat(i) - ffhh(i) = txl*ffhh_lnd(i) + txi*ffhh_ice(i) + txo*ffhh_wat(i) - uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_wat(i) - fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_wat(i) - fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_wat(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_wat(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_wat(i) ! not used again! Moorthi - cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) - chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) !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) @@ -438,7 +460,82 @@ subroutine GFS_surface_composites_post_run ( qss(i) = txl*qss_lnd(i) + txi*qss_ice(i) + txo*qss_wat(i) gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_wat(i) endif - tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_wat(i) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Call stability for consistent surface properties. Currently this comes from ! +! the GFS surface layere scheme (sfc_diff), regardless of the actual surface ! +! layer parameterization being used - to be extended in the future ! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + tsfc(i) = ( txl * cdq_lnd(i) * tsfc_lnd(i) & + + txi * cdq_ice(i) * tice(i) & ! DH* Ben had tsurf_ice(i), but GFS_surface_composites_post_run uses tice instead + + txo * cdq_wat(i) * tsfc_wat(i)) & + / (txl * cdq_lnd(i) + txi * cdq_ice(i) + txo * cdq_wat(i) ) + tsurf = ( txl * cdq_lnd(i) * tsurf_lnd(i) & + + txi * cdq_ice(i) * tsurf_ice(i) & + + txo * cdq_wat(i) * tsurf_wat(i)) & + / (txl * cdq_lnd(i) + txi * cdq_ice(i) + txo * cdq_wat(i) ) + + q0 = max( q1(i), qmin ) + virtfac = one + rvrdm1 * q0 + + tv1 = t1(i) * virtfac ! Virtual temperature in middle of lowest layer + if(thsfc_loc) then ! Use local potential temperature + thv1 = t1(i) * prslki(i) * virtfac ! Theta-v at lowest level + tvs = half * (tsfc(i)+tsurf) * virtfac + else ! Use potential temperature referenced to 1000 hPa + thv1 = t1(i) / prslk1(i) * virtfac ! Theta-v at lowest level + tvs = half * (tsfc(i)+tsurf)/prsik1(i) * virtfac + endif + + zorl(i) = exp(txl*log(zorll(i)) + txi*log(zorli(i)) + txo*log(zorlo(i))) + z0max = 0.01_kind_phys * zorl(i) + ztmax = exp(txl*log(ztmax_lnd(i)) + txi*log(ztmax_ice(i)) + txo*log(ztmax_wat(i))) + + ! Only actually need to call "stability" if multiple surface types exist... + if(txl .eq. one) then ! 100% land + rb(i) = rb_lnd(i) + ffmm(i) = ffmm_lnd(i) + ffhh(i) = ffhh_lnd(i) + fm10(i) = fm10_lnd(i) + fh2(i) = fh2_lnd(i) + cd(i) = cd_lnd(i) + cdq(i) = cdq_lnd(i) + stress(i) = stress_lnd(i) + uustar(i) = uustar_lnd(i) + elseif(txo .eq. one) then ! 100% open water + rb(i) = rb_wat(i) + ffmm(i) = ffmm_wat(i) + ffhh(i) = ffhh_wat(i) + fm10(i) = fm10_wat(i) + fh2(i) = fh2_wat(i) + cd(i) = cd_wat(i) + cdq(i) = cdq_wat(i) + stress(i) = stress_wat(i) + uustar(i) = uustar_wat(i) + elseif(txi .eq. one) then ! 100% ice + rb(i) = rb_ice(i) + ffmm(i) = ffmm_ice(i) + ffhh(i) = ffhh_ice(i) + fm10(i) = fm10_ice(i) + fh2(i) = fh2_ice(i) + cd(i) = cd_ice(i) + cdq(i) = cdq_ice(i) + stress(i) = stress_ice(i) + uustar(i) = uustar_ice(i) + else ! Mix of multiple surface types (land, water, and/or ice) + call stability(z1(i), snowd(i), thv1, wind(i), z0max, ztmax, tvs, grav, & ! inputs + tv1, thsfc_loc, & ! inputs + rb(i), ffmm(i), ffhh(i), fm10(i), fh2(i), cd(i), cdq(i), & ! outputs + stress(i), uustar(i)) + endif ! Checking to see if point is one or multiple surface types + + ! BWG, 2021/02/25: cmm=cd*wind, chh=cdq*wind, so use composite cd, cdq + rho = prsl1(i) / (rd*tv1) + cmm(i) = cd(i)*wind(i) !txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_wat(i) + chh(i) = rho*cdq(i)*wind(i) !txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_wat(i) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! if (dry(i)) then tsfcl(i) = tsfc_lnd(i) ! over land @@ -499,7 +596,6 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_lnd(i) fm10(i) = fm10_lnd(i) fh2(i) = fh2_lnd(i) - !tsurf(i) = tsurf_lnd(i) tsfcl(i) = tsfc_lnd(i) ! over land tsfc(i) = tsfcl(i) tsfco(i) = tsfc(i) @@ -527,7 +623,6 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_wat(i) fm10(i) = fm10_wat(i) fh2(i) = fh2_wat(i) - !tsurf(i) = tsurf_wat(i) tsfco(i) = tsfc_wat(i) ! over lake (and ocean when uncoupled) tsfc(i) = tsfco(i) tsfcl(i) = tsfc(i) @@ -555,7 +650,6 @@ subroutine GFS_surface_composites_post_run ( fm10(i) = fm10_ice(i) fh2(i) = fh2_ice(i) stress(i) = stress_ice(i) - !tsurf(i) = tsurf_ice(i) cmm(i) = cmm_ice(i) chh(i) = chh_ice(i) gflx(i) = gflx_ice(i) diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index 996fb54aa..95f2c6e4e 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_surface_composites_pre type = scheme - dependencies = machine.F + dependencies = machine.F,sfc_diff.f ######################################################################## [ccpp-arg-table] @@ -15,6 +15,14 @@ type = integer intent = in optional = F +[flag_init] + standard_name = flag_for_first_time_step + long_name = flag signaling first time step for time integration loop + units = flag + dimensions = () + type = logical + intent = in + optional = F [lkm] standard_name = flag_for_lake_surface_scheme long_name = flag for lake surface model @@ -23,6 +31,30 @@ type = integer intent = in optional = F +[lsm] + standard_name = flag_for_land_surface_scheme + long_name = flag for land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_noahmp] + standard_name = flag_for_noahmp_land_surface_scheme + long_name = flag for NOAH MP land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F +[lsm_ruc] + standard_name = flag_for_ruc_land_surface_scheme + long_name = flag for RUC land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [frac_grid] standard_name = flag_for_fractional_grid long_name = flag for fractional grid @@ -158,6 +190,33 @@ kind = kind_phys intent = inout optional = F +[zorlo] + 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 + optional = F +[zorll] + standard_name = surface_roughness_length_over_land + long_name = surface roughness length over land + units = cm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[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 + optional = F [snowd] standard_name = surface_snow_thickness_water_equivalent long_name = water equivalent snow depth @@ -383,15 +442,6 @@ kind = kind_phys intent = out optional = F -[tsurf] - standard_name = surface_skin_temperature_after_iteration - long_name = surface skin temperature after iteration - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_water long_name = surface skin temperature after iteration over water @@ -498,6 +548,24 @@ kind = kind_phys intent = inout optional = F +[emis_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[emis_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [qss] standard_name = surface_specific_humidity long_name = surface air saturation specific humidity @@ -588,33 +656,6 @@ kind = kind_phys intent = in optional = F -[zorlo] - 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 - optional = F -[zorll] - standard_name = surface_roughness_length_over_land - long_name = surface roughness length over land - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F -[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 - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -817,6 +858,24 @@ type = integer intent = in optional = F +[rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rvrdm1] + 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 + optional = F [cplflx] standard_name = flag_for_flux_coupling long_name = flag controlling cplflx collection (default off) @@ -849,6 +908,14 @@ type = logical intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [islmsk] standard_name = sea_land_ice_mask long_name = sea/land/ice mask (=0/1/2) @@ -881,6 +948,42 @@ type = logical intent = in optional = F +[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 + optional = F +[t1] + standard_name = air_temperature_at_lowest_model_layer + long_name = surface layer mean temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = surface layer mean specific humidity + units = kg kg-1 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = surface layer mean pressure + units = Pa + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [landfrac] standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land @@ -924,7 +1027,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in optional = F [zorll] standard_name = surface_roughness_length_over_land @@ -933,7 +1036,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in optional = F [zorli] standard_name = surface_roughness_length_over_ice @@ -942,7 +1045,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout + intent = in optional = F [cd] standard_name = surface_drag_coefficient_for_momentum_in_air @@ -1268,15 +1371,6 @@ kind = kind_phys intent = in optional = F -[tsurf] - standard_name = surface_skin_temperature_after_iteration - long_name = surface skin temperature after iteration - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [tsurf_wat] standard_name = surface_skin_temperature_after_iteration_over_water long_name = surface skin temperature after iteration over water @@ -1780,6 +1874,78 @@ kind = kind_phys intent = inout optional = F +[grav] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[prsik1] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the ground surface + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prslk1] + standard_name = dimensionless_exner_function_at_lowest_model_layer + long_name = dimensionless Exner function at the lowest model layer + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[prslki] + standard_name = ratio_of_exner_function_between_midlayer_and_interface_at_lowest_model_layer + long_name = Exner function ratio bt midlayer and interface at 1st layer + units = ratio + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[z1] + standard_name = height_above_ground_at_lowest_model_layer + long_name = height above ground at 1st model layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ztmax_wat] + standard_name = bounded_surface_roughness_length_for_heat_over_water + long_name = bounded surface roughness length for heat over water + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ztmax_lnd] + standard_name = bounded_surface_roughness_length_for_heat_over_land + long_name = bounded surface roughness length for heat over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[ztmax_ice] + standard_name = bounded_surface_roughness_length_for_heat_over_ice + long_name = bounded surface roughness length for heat over ice + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 70a5b3541..d405b3821 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -27,7 +27,7 @@ end subroutine GFS_surface_generic_pre_finalize !! subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, & - sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, & + sigmaf, soiltyp, vegtype, slopetyp, work3, zlvl, & drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, lndp_type, n_var_lndp, sfc_wts, & lndp_var_list, lndp_prt_list, & z01d, zt1d, bexp1d, xlai1d, vegf1d, lndp_vgf, sfc_wts_inv, & @@ -49,7 +49,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(:), intent(inout) :: tsfc real(kind=kind_phys), dimension(:,:), intent(in) :: phil - real(kind=kind_phys), dimension(:), intent(inout) :: sigmaf, work3, tsurf, zlvl + real(kind=kind_phys), dimension(:), intent(inout) :: sigmaf, work3, zlvl ! Stochastic physics / surface perturbations real(kind=kind_phys), dimension(:), intent(out) :: drain_cpl @@ -161,7 +161,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, work3(i) = prsik_1(i) / prslk_1(i) - !tsurf(i) = tsfc(i) zlvl(i) = phil(i,1) * onebg smcwlt2(i) = zero smcref2(i) = zero diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index e174de153..2cdb1dbbe 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -170,15 +170,6 @@ kind = kind_phys intent = inout optional = F -[tsurf] - standard_name = surface_skin_temperature_after_iteration - long_name = surface skin temperature after iteration - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [zlvl] standard_name = height_above_ground_at_lowest_model_layer long_name = layer 1 height above ground (not MSL) diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 0bb56a07b..d082752c4 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -764,7 +764,7 @@ standard_name = water_vapor_mixing_ratio_at_surface_over_ice long_name = water vapor mixing ratio at surface over ice units = kg kg-1 - dimensions = (horizontal_dimension) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in diff --git a/physics/module_sf_ruclsm.F90 b/physics/module_sf_ruclsm.F90 index 1eceaf183..1e0ec2fe2 100644 --- a/physics/module_sf_ruclsm.F90 +++ b/physics/module_sf_ruclsm.F90 @@ -64,8 +64,8 @@ SUBROUTINE LSMRUC( & graupelncv,snowncv,rainncv,raincv, & ZS,RAINBL,SNOW,SNOWH,SNOWC,FRZFRAC,frpcpn, & rhosnf,precipfr, & - Z3D,P8W,T3D,QV3D,QC3D,RHO3D, & - GLW,GSW,EMISS,CHKLOWQ, CHS, & + Z3D,P8W,T3D,QV3D,QC3D,RHO3D,EMISBCK, & + GLW,GSWdn,GSW,EMISS,CHKLOWQ, CHS, & FLQC,FLHC,MAVAIL,CANWAT,VEGFRA,ALB,ZNT, & Z0,SNOALB,ALBBCK,LAI, & landusef, nlcat, & ! mosaic_lu, mosaic_soil, & @@ -185,6 +185,7 @@ SUBROUTINE LSMRUC( & REAL, DIMENSION( ims:ime , jms:jme ), & INTENT(IN ) :: RAINBL, & GLW, & + GSWdn, & GSW, & ALBBCK, & FLHC, & @@ -220,6 +221,7 @@ SUBROUTINE LSMRUC( & ALB, & LAI, & EMISS, & + EMISBCK, & MAVAIL, & SFCEXC, & Z0 , & @@ -706,11 +708,17 @@ SUBROUTINE LSMRUC( & ENDIF !> - Call soilvegin() to initialize soil and surface properties - CALL SOILVEGIN ( debug_print, & + IF((XLAND(I,J)-1.5).LT.0..and. xice(i,j).lt.xice_threshold)THEN + !-- land + CALL SOILVEGIN ( debug_print, & soilfrac,nscat,shdmin(i,j),shdmax(i,j),mosaic_lu, mosaic_soil,& NLCAT,ILAND,ISOIL,iswater,MYJ,IFOREST,lufrac,VEGFRA(I,J), & EMISSL(I,J),PC(I,J),ZNT(I,J),LAI(I,J),RDLAI2D, & QWRTZ,RHOCS,BCLH,DQM,KSAT,PSIS,QMIN,REF,WILT,i,j ) + + !-- update background emissivity for land points, can have vegetation mosaic effect + EMISBCK(I,J) = EMISSL(I,J) + IF (debug_print ) THEN if(init) & print *,'after SOILVEGIN - z0,znt(1,26),lai(1,26)',z0(i,j),znt(i,j),lai(i,j) @@ -776,6 +784,7 @@ SUBROUTINE LSMRUC( & print *,'NROOT, meltfactor, iforest, ivgtyp, i,j ', nroot,meltfactor,iforest,ivgtyp(I,J),I,J ENDIF + ENDIF ! land !!*** SET ZERO-VALUE FOR SOME OUTPUT DIAGNOSTIC ARRAYS ! if(i.eq.397.and.j.eq.562) then ! print *,'RUC LSM - xland(i,j),xice(i,j),snow(i,j)',i,j,xland(i,j),xice(i,j),snow(i,j) @@ -839,12 +848,13 @@ SUBROUTINE LSMRUC( & ISOIL = 16 ! STATSGO endif ZNT(I,J) = 0.011 - snoalb(i,j) = 0.75 + ! in FV3 albedo and emiss are defined for ice + !snoalb(i,j) = snoalb(i,j) + emissl(i,j) = emisbck(i,j) ! no snow impact, old 0.98 used in WRF dqm = 1. ref = 1. qmin = 0. wilt = 0. - emissl(i,j) = 0.98 patmb=P8w(i,1,j)*1.e-2 qvg (i,j) = QSN(SOILT(i,j),TBQ)/PATMB @@ -900,12 +910,13 @@ SUBROUTINE LSMRUC( & CALL SFCTMP (debug_print, dt,ktau,conflx,i,j, & !--- input variables nzs,nddzs,nroot,meltfactor, & !added meltfactor - iland,isoil,ivgtyp(i,j),isltyp(i,j), & + iland,isoil,ivgtyp(i,j),isltyp(i,j), & PRCPMS, NEWSNMS,SNWE,SNHEI,SNOWFRAC, & RHOSN,RHONEWSN,RHOSNFALL, & snowrat,grauprat,icerat,curat, & PATM,TABS,QVATM,QCATM,RHO, & - GLW(I,J),GSW(I,J),EMISSL(I,J), & + GLW(I,J),GSWdn(i,j),GSW(I,J), & + EMISSL(I,J),EMISBCK(I,J), & QKMS,TKMS,PC(I,J),LMAVAIL(I,J), & canwatr,vegfra(I,J),alb(I,J),znt(I,J), & snoalb(i,j),albbck(i,j),lai(i,j), & !new @@ -1046,7 +1057,7 @@ SUBROUTINE LSMRUC( & endif ENDIF - if(snow(i,j)==0.) EMISSL(i,j) = LEMITBL(IVGTYP(i,j)) + if(snow(i,j)==0.) EMISSL(i,j) = EMISBCK(i,j) EMISS (I,J) = EMISSL(I,J) ! SNOW is in [mm], SNWE is in [m]; CANWAT is in mm, CANWATR is in m SNOW (i,j) = SNWE*1000. @@ -1172,7 +1183,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia RHOSN,RHONEWSN,RHOSNFALL, & snowrat,grauprat,icerat,curat, & PATM,TABS,QVATM,QCATM,rho, & - GLW,GSW,EMISS,QKMS,TKMS,PC, & + GLW,GSWdn,GSW,EMISS,EMISBCK,QKMS,TKMS,PC, & MAVAIL,CST,VEGFRA,ALB,ZNT, & ALB_SNOW,ALB_SNOW_FREE,lai, & MYJ,SEAICE,ISICE, & @@ -1208,6 +1219,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia REAL , & INTENT(IN ) :: GLW, & GSW, & + GSWdn, & PC, & VEGFRA, & ALB_SNOW_FREE, & @@ -1221,6 +1233,7 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia !--- 2-D variables REAL , & INTENT(INOUT) :: EMISS, & + EMISBCK, & MAVAIL, & SNOWFRAC, & ALB_SNOW, & @@ -1420,11 +1433,11 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia enddo GSWnew=GSW - GSWin=GSW/(1.-alb) + GSWin=GSWdn !/(1.-alb) ALBice=ALB_SNOW_FREE ALBsn=alb_snow - EMISSN = 0.98 - EMISS_snowfree = LEMITBL(IVGTYP) + EMISSN = 0.99 ! from setemis, from WRF - 0.98 + EMISS_snowfree = EMISBCK ! LEMITBL(IVGTYP) !--- sea ice properties !--- N.N Zubov "Arctic Ice" @@ -1725,8 +1738,9 @@ SUBROUTINE SFCTMP (debug_print, delt,ktau,conflx,i,j, & !--- input varia ALBsn = MAX(keep_snow_albedo*alb_snow, & MIN((albice + (alb_snow - albice) * snowfrac), alb_snow)) Emiss = MAX(keep_snow_albedo*emissn, & + !-- emiss_snowfree=0.96 in setemis MIN((emiss_snowfree + & - (emissn - emiss_snowfree) * snowfrac), emissn)) + (emissn - emiss_snowfree) * snowfrac), emissn)) endif IF (debug_print ) THEN @@ -2576,7 +2590,7 @@ SUBROUTINE SOIL (debug_print, & ! endif alfa=1. ! field capacity -! 20jun18 - beta in Eq. (4) is called soilres here - it limits soil evaporation +! 20jun18 - beta in Eq. (5) is called soilres in the code - it limits soil evaporation ! when soil moisture is below field capacity. [Lee and Pielke, 1992] ! This formulation agrees with obsevations when top layer is < 2 cm thick. ! Soilres = 1 for snow, glaciers and wetland. @@ -2586,7 +2600,9 @@ SUBROUTINE SOIL (debug_print, & ! evaporation, effects sparsely vegetated areas--> cooler during the day ! fc=max(qmin,ref*0.25) ! ! For now we'll go back to ref*0.5 -! Replace 0.5 with 0.7 2021/03/15 +! 3feb21 - in RRFS testing (fv3-based), ref*0.5 gives too much direct +! evaporation. Therefore , it is replaced with ref*0.7. + !fc=max(qmin,ref*0.5) fc=max(qmin,ref*0.7) fex_fc=1. if((soilmois(1)+qmin) > fc .or. (qvatm-qvg) > 0.) then diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index 11b9741c5..ab7d33e44 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -87,13 +87,12 @@ !! - setemis(): set up surface emissivity for lw radiation !! !! SW surface albedo (namelist control parameter - \b IALB=1) -!!\n IALB=0: surface vegetation type based climatology scheme (monthly -!! data in \f$1^o\f$ horizontal resolution) !!\n IALB=1: MODIS retrievals based monthly mean climatology +!!\n IALB=2: use surface albedo from land model !! !! LW surface emissivity (namelist control parameter - \b IEMS=1) -!!\n IEMS=0: black-body emissivity (=1.0) !!\n IEMS=1: surface type based climatology in \f$1^o\f$ horizontal resolution +!!\n IEMS=2: use surface emissivity from land model !! !!\version NCEP-Radiation_surface v5.1 Nov 2012 @@ -101,6 +100,9 @@ !! emissivity for LW radiation. module module_radiation_surface ! +!! \section arg_table_module_radiation_surface +!! \htmlinclude module_radiation_surface.html +!! use physparam, only : ialbflg, iemsflg, semis_file, & & kind_phys use physcons, only : con_t0c, con_ttp, con_pi, con_tice @@ -122,11 +124,13 @@ module module_radiation_surface integer, parameter, public :: JMXEMS = 180 !< number of latitude points in global emis-type map real (kind=kind_phys), parameter :: f_zero = 0.0 real (kind=kind_phys), parameter :: f_one = 1.0 + real (kind=kind_phys), parameter :: epsln = 1.0e-6 real (kind=kind_phys), parameter :: rad2dg= 180.0 / con_pi integer, allocatable :: idxems(:,:) !< global surface emissivity index array - integer :: iemslw = 0 !< global surface emissivity control flag set up in 'sfc_init' + integer :: iemslw = 1 !< global surface emissivity control flag set up in 'sfc_init' ! public sfc_init, setalb, setemis + public f_zero, f_one, epsln ! ================= contains @@ -140,9 +144,8 @@ module module_radiation_surface !! @{ !----------------------------------- subroutine sfc_init & - & ( me )! --- inputs: -! --- outputs: ( none ) - + & ( me, errmsg, errflg )! --- inputs/outputs: +! ! =================================================================== ! ! ! ! this program is the initialization program for surface radiation ! @@ -161,13 +164,13 @@ subroutine sfc_init & ! ! ! external module variables: ! ! ialbflg - control flag for surface albedo schemes ! -! =0: climatology, based on surface veg types ! -! =1: ! +! =1: use modis based surface albedo ! +! =2: use surface albedo from land model ! ! iemsflg - control flag for sfc emissivity schemes (ab:2-dig)! ! a:=0 set sfc air/ground t same for lw radiation ! ! =1 set sfc air/ground t diff for lw radiation ! -! b:=0 use fixed sfc emissivity=1.0 (black-body) ! -! =1 use varying climtology sfc emiss (veg based) ! +! b:=1 use varying climtology sfc emiss (veg based) ! +! =2 use surface emissivity from land model ! ! ! ! ==================== end of description ===================== ! ! @@ -177,6 +180,8 @@ subroutine sfc_init & integer, intent(in) :: me ! --- outputs: ( none ) + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg ! --- locals: integer :: i, k @@ -185,21 +190,18 @@ subroutine sfc_init & character :: cline*80 ! !===> ... begin here +! + errmsg = '' + errflg = 0 ! if ( me == 0 ) print *, VTAGSFC ! print out version tag !> - Initialization of surface albedo section !! \n physparam::ialbflg -!! - = 0: using climatology surface albedo scheme for SW !! - = 1: using MODIS based land surface albedo for SW +!! - = 2: using albedo from land model - if ( ialbflg == 0 ) then - - if ( me == 0 ) then - print *,' - Using climatology surface albedo scheme for sw' - endif - - else if ( ialbflg == 1 ) then + if ( ialbflg == 1 ) then if ( me == 0 ) then print *,' - Using MODIS based land surface albedo for sw' @@ -212,27 +214,25 @@ subroutine sfc_init & endif else - print *,' !! ERROR in Albedo Scheme Setting, IALB=',ialbflg - stop + + errmsg = 'module_radiation_surface: invalid ialbflg option' + errflg = 1 + return + endif ! end if_ialbflg_block !> - Initialization of surface emissivity section !! \n physparam::iemsflg -!! - = 0: fixed SFC emissivity at 1.0 !! - = 1: input SFC emissivity type map from "semis_file" +!! - = 2: input SFC emissivity from land model iemslw = mod(iemsflg, 10) ! emissivity control - if ( iemslw == 0 ) then ! fixed sfc emis at 1.0 - - if ( me == 0 ) then - print *,' - Using Fixed Surface Emissivity = 1.0 for lw' - endif - elseif ( iemslw == 1 ) then ! input sfc emiss type map + if ( iemslw == 1 ) then ! input sfc emiss type map ! --- allocate data space if ( .not. allocated(idxems) ) then - allocate ( idxems(IMXEMS,JMXEMS) ) + allocate ( idxems(IMXEMS,JMXEMS) ) endif ! --- check to see if requested emissivity data file existed @@ -278,8 +278,11 @@ subroutine sfc_init & endif else - print *,' !! ERROR in Emissivity Scheme Setting, IEMS=',iemsflg - stop + + errmsg = 'module_radiation_surface: invalid iemslw option' + errflg = 1 + return + endif ! end if_iemslw_block ! @@ -329,10 +332,13 @@ end subroutine sfc_init !! @{ !----------------------------------- subroutine setalb & - & ( slmsk,snowf,sncovr,snoalb,zorlf,coszf,tsknf,tairf,hprif, & ! --- inputs: + & ( slmsk,lsm,lsm_noahmp,lsm_ruc,snowf, & ! --- inputs: + & sncovr,sncovr_ice,snoalb,zorlf,coszf, & + & tsknf,tairf,hprif,landfrac,frac_grid,min_seaice, & & alvsf,alnsf,alvwf,alnwf,facsf,facwf,fice,tisfc, & - & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir,IMAX, & - & albPpert, pertalb, & ! sfc-perts, mgehne + & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & + & icealbdvis, icealbdnir, icealbivis, icealbinir, & + & IMAX, albPpert, pertalb, fracl, fraco, fraci, icy, & & sfcalb & ! --- outputs: & ) @@ -355,6 +361,8 @@ subroutine setalb & ! snowf (IMAX) - snow depth water equivalent in mm ! ! sncovr(IMAX) - ialgflg=0: not used ! ! ialgflg=1: snow cover over land in fraction ! +! sncovr_ice(IMAX) - ialgflg=0: not used ! +! ialgflg=1: snow cover over ice in fraction ! ! snoalb(IMAX) - ialbflg=0: not used ! ! ialgflg=1: max snow albedo over land in fraction ! ! zorlf (IMAX) - surface roughness in cm ! @@ -397,18 +405,25 @@ subroutine setalb & ! --- inputs integer, intent(in) :: IMAX + integer, intent(in) :: lsm, lsm_noahmp, lsm_ruc + logical, intent(in) :: frac_grid real (kind=kind_phys), dimension(:), intent(in) :: & - & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & + & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, landfrac, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & & lsmalbdvis, lsmalbdnir, lsmalbivis, lsmalbinir, & - & sncovr, snoalb, albPpert ! sfc-perts, mgehne - real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne + & 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), dimension(:), intent(in) :: & + & fracl, fraco, fraci + logical, dimension(:), intent(in) :: & + & icy ! --- outputs real (kind=kind_phys), dimension(IMAX,NF_ALBD), intent(out) :: & & sfcalb -! real (kind=kind_phys), dimension(:,:), intent(out) :: sfcalb ! --- locals: real (kind=kind_phys) :: asnvb, asnnb, asnvd, asnnd, asevb & @@ -416,6 +431,11 @@ subroutine setalb & &, asnow, argh, hrgh, fsno0, fsno1, flnd0, fsea0, csnow & &, a1, a2, b1, b2, b3, ab1bm, ab2bm, m, s, alpha, beta, albtmp + real (kind=kind_phys) :: asevb_wat,asenb_wat,asevd_wat,asend_wat, & + & asevb_ice,asenb_ice,asevd_ice,asend_ice + + real (kind=kind_phys) :: alndnb, alndnd, alndvb, alndvd + real (kind=kind_phys) ffw, dtgd integer :: i, k, kk, iflag @@ -423,327 +443,211 @@ subroutine setalb & ! !===> ... begin here ! - -!> - If use climatological albedo scheme: - if ( ialbflg == 0 ) then ! use climatological albedo scheme +!> - Use modis based albedo for land area: + if ( ialbflg == 1 ) then do i = 1, IMAX -!> - Modified snow albedo scheme - units convert to m (originally -!! snowf in mm; zorlf in cm) - - 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 - if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero - fsno1 = f_one - fsno0 - flnd0 = min(f_one, facsf(i)+facwf(i)) - fsea0 = max(f_zero, f_one-flnd0) - fsno = fsno0 - fsea = fsea0 * fsno1 - flnd = flnd0 * fsno1 - -!> - Calculate diffused sea surface albedo - - if (tsknf(i) >= 271.5) then - asevd = 0.06 - asend = 0.06 - elseif (tsknf(i) < 271.1) then - asevd = 0.70 - asend = 0.65 - else - a1 = (tsknf(i) - 271.1)**2 - asevd = 0.7 - 4.0*a1 - asend = 0.65 - 3.6875*a1 - endif - -!> - Calculate diffused snow albedo. - - if (nint(slmsk(i)) == 2) then - ffw = f_one - fice(i) - if (ffw < f_one) then - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd - else - b1 = f_zero - endif + !-- water albedo + asevd_wat = 0.06 + asend_wat = 0.06 + asevb_wat = asevd_wat + asenb_wat = asevd_wat + + ! direct albedo CZA dependence over water + if (fraco(i) > f_zero .and. coszf(i) > 0.0001) then + asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb_wat = asevb_wat + endif - b3 = 0.06 * ffw - asnvd = (0.70 + b1) * fice(i) + b3 - asnnd = (0.60 + b1) * fice(i) + b3 - asevd = 0.70 * fice(i) + b3 - asend = 0.60 * fice(i) + b3 - else - asnvd = 0.90 - asnnd = 0.75 - endif - -!> - Calculate direct snow albedo. - - if (coszf(i) < 0.5) then - csnow = 0.5 * (3.0 / (f_one+4.0*coszf(i)) - f_one) - asnvb = min( 0.98, asnvd+(1.0-asnvd)*csnow ) - asnnb = min( 0.98, asnnd+(1.0-asnnd)*csnow ) - else - asnvb = asnvd - asnnb = asnnd - endif - -!> - Calculate direct sea surface albedo. - - if (coszf(i) > 0.0001) then - rfcs = 1.4 / (f_one + 0.8*coszf(i)) - rfcw = 1.1 / (f_one + 0.2*coszf(i)) - - if (tsknf(i) >= con_t0c) then - asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb = asevb + 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 else - asevb = asevd - asenb = asend + asevd_ice = 0.70 + asend_ice = 0.65 endif - else - rfcs = f_one - rfcw = f_one - asevb = asevd - asenb = asend - endif - - a1 = alvsf(i) * facsf(i) - b1 = alvwf(i) * facwf(i) - a2 = alnsf(i) * facsf(i) - b2 = alnwf(i) * facwf(i) - ab1bm = a1*rfcs + b1*rfcw - ab2bm = a2*rfcs + b2*rfcw - sfcalb(i,1) = min(0.99, ab2bm) *flnd + asenb*fsea + asnnb*fsno - sfcalb(i,2) = (a2 + b2) * 0.96 *flnd + asend*fsea + asnnd*fsno - sfcalb(i,3) = min(0.99, ab1bm) *flnd + asevb*fsea + asnvb*fsno - sfcalb(i,4) = (a1 + b1) * 0.96 *flnd + asevd*fsea + asnvd*fsno - - enddo ! end_do_i_loop - -!> - If use modis based albedo for land area: - elseif ( ialbflg == 1 ) then - - do i = 1, IMAX + ! 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 ) + else + asnvb = asnvd + asnnb = asnnd + endif -!> - Calculate snow cover input directly for land model, no + ! 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 + asevd_ice = 0.70 + asend_ice = 0.65 + asevb_ice = 0.70 + asenb_ice = 0.65 + endif ! end icy + + if (fracl(i) > f_zero) then +!> - Use snow cover input directly for land model, no !! conversion needed. - fsno0 = sncovr(i) - - if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero - - if (nint(slmsk(i)) == 2) then - 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 - endif - - fsno1 = f_one - fsno0 - flnd0 = min(f_one, facsf(i)+facwf(i)) - fsea0 = max(f_zero, f_one-flnd0) - fsno = fsno0 - fsea = fsea0 * fsno1 - flnd = flnd0 * fsno1 - -!> - Calculate diffused sea surface albedo. - - if (tsknf(i) >= 271.5) then - asevd = 0.06 - asend = 0.06 - elseif (tsknf(i) < 271.1) then - asevd = 0.70 - asend = 0.65 - else - a1 = (tsknf(i) - 271.1)**2 - asevd = 0.7 - 4.0*a1 - asend = 0.65 - 3.6875*a1 - endif - -!> - Calculate diffused snow albedo, land area use input max snow -!! albedo. - - if (nint(slmsk(i)) == 2) then - ffw = f_one - fice(i) - if (ffw < f_one) then - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd - else - b1 = f_zero - endif + fsno0 = sncovr(i) ! snow fraction on land - b3 = 0.06 * ffw - asnvd = (0.70 + b1) * fice(i) + b3 - asnnd = (0.60 + b1) * fice(i) + b3 - asevd = 0.70 * fice(i) + b3 - asend = 0.60 * fice(i) + b3 - else - asnvd = snoalb(i) - asnnd = snoalb(i) - endif - -!> - Calculate direct snow albedo. - - if (nint(slmsk(i)) == 2) then - if (coszf(i) < 0.5) then - 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 - else - asnvb = snoalb(i) - asnnb = snoalb(i) - endif - -!> - Calculate direct sea surface albedo, use fanglin's zenith angle -!! treatment. - - if (coszf(i) > 0.0001) then - -! rfcs = 1.89 - 3.34*coszf(i) + 4.13*coszf(i)*coszf(i) & -! & - 2.02*coszf(i)*coszf(i)*coszf(i) - rfcs = 1.775/(1.0+1.55*coszf(i)) - - if (tsknf(i) >= con_t0c) then - asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb = asevb + fsno1 = f_one - fsno0 + flnd0 = min(f_one, facsf(i)+facwf(i)) + flnd = flnd0 * fsno1 ! snow-free fraction + fsno = f_one - flnd ! snow-covered fraction + + !> - use Fanglin's zenith angle treatment. + if (coszf(i) > 0.0001) then + rfcs = 1.775/(1.0+1.55*coszf(i)) else - asevb = asevd - asenb = asend + !- no sun + rfcs = f_one endif - else - rfcs = f_one - asevb = asevd - asenb = asend - endif - - ab1bm = min(0.99, alnsf(i)*rfcs) - ab2bm = min(0.99, alvsf(i)*rfcs) - sfcalb(i,1) = ab1bm *flnd + asenb*fsea + asnnb*fsno - sfcalb(i,2) = alnwf(i) *flnd + asend*fsea + asnnd*fsno - sfcalb(i,3) = ab2bm *flnd + asevb*fsea + asnvb*fsno - sfcalb(i,4) = alvwf(i) *flnd + asevd*fsea + asnvd*fsno + !- zenith dependence is applied only to direct beam albedo + ab1bm = min(0.99, alnsf(i)*rfcs) + ab2bm = min(0.99, alvsf(i)*rfcs) + + alndnb = ab1bm *flnd + snoalb(i) * fsno + alndnd = alnwf(i)*flnd + snoalb(i) * fsno + alndvb = ab2bm *flnd + snoalb(i) * fsno + alndvd = alvwf(i)*flnd + snoalb(i) * fsno + else + !-- fill in values for land albedo + alndnb = 0. + alndnd = 0. + alndvb = 0. + alndvd = 0. + endif ! end land + + !-- Composite mean surface albedo from land, open water and + !-- ice fractions + sfcalb(i,1) = min(0.99,max(0.01,alndnb))*fracl(i) & ! direct beam NIR + & + asenb_wat*fraco(i) + asenb_ice*fraci(i) + sfcalb(i,2) = min(0.99,max(0.01,alndnd))*fracl(i) & ! diffuse NIR + & + asend_wat*fraco(i) + asend_ice*fraci(i) + sfcalb(i,3) = min(0.99,max(0.01,alndvb))*fracl(i) & ! direct beam visible + & + asevb_wat*fraco(i) + asevb_ice*fraci(i) + sfcalb(i,4) = min(0.99,max(0.01,alndvd))*fracl(i) & ! diffuse visible + & + asevd_wat*fraco(i) + asevd_ice*fraci(i) enddo ! end_do_i_loop -!> -# use land model output for land area: +!> -# use land model output for land area: Noah MP, RUC (land and ice). elseif ( ialbflg == 2 ) then do i = 1, IMAX -!> - albedo from noah mp already includes the snow portion - - fsno0 = f_zero - - if (nint(slmsk(i))==0 .and. tsknf(i)>con_tice) fsno0 = f_zero - - if (nint(slmsk(i)) == 2) then - 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 - endif - - fsno1 = f_one - fsno0 - flnd0 = min(f_one, facsf(i)+facwf(i)) - fsea0 = max(f_zero, f_one-flnd0) - fsno = fsno0 - fsea = fsea0 * fsno1 - flnd = flnd0 * fsno1 - -!> - Calculate diffused sea surface albedo. - - if (tsknf(i) >= 271.5) then - asevd = 0.06 - asend = 0.06 - elseif (tsknf(i) < 271.1) then - asevd = 0.70 - asend = 0.65 - else - a1 = (tsknf(i) - 271.1)**2 - asevd = 0.7 - 4.0*a1 - asend = 0.65 - 3.6875*a1 - endif - -!> - Calculate diffused snow albedo, land area use input max snow -!! albedo. - - if (nint(slmsk(i)) == 2) then - ffw = f_one - fice(i) - if (ffw < f_one) then - dtgd = max(f_zero, min(5.0, (con_ttp-tisfc(i)) )) - b1 = 0.03 * dtgd - else - b1 = f_zero - endif + !-- water albedo + asevd_wat = 0.06 + asend_wat = 0.06 + asevb_wat = asevd_wat + asenb_wat = asevd_wat + + ! direct albedo CZA dependence over water + if (fraco(i) > f_zero .and. coszf(i) > 0.0001) then + asevb_wat = max (asevd_wat, 0.026/(coszf(i)**1.7 + 0.065) & + & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & + & * (coszf(i)-f_one)) + asenb_wat = asevb_wat + endif - b3 = 0.06 * ffw - asnvd = (0.70 + b1) * fice(i) + b3 - asnnd = (0.60 + b1) * fice(i) + b3 - asevd = 0.70 * fice(i) + b3 - asend = 0.60 * fice(i) + b3 - else - asnvd = snoalb(i) - asnnd = snoalb(i) - endif - -!> - Calculate direct snow albedo. - - if (nint(slmsk(i)) == 2) then - if (coszf(i) < 0.5) then - 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 - else - asnvb = asnvd - asnnb = asnnd - endif - -!> - Calculate direct sea surface albedo, use fanglin's zenith angle -!! treatment. - - if (coszf(i) > 0.0001) then - -! rfcs = 1.89 - 3.34*coszf(i) + 4.13*coszf(i)*coszf(i) & -! & - 2.02*coszf(i)*coszf(i)*coszf(i) - rfcs = 1.775/(1.0+1.55*coszf(i)) - - if (tsknf(i) >= con_t0c) then - asevb = max(asevd, 0.026/(coszf(i)**1.7+0.065) & - & + 0.15 * (coszf(i)-0.1) * (coszf(i)-0.5) & - & * (coszf(i)-f_one)) - asenb = asevb + !-- ice albedo + !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 ) then + !-- use ice albedo from the RUC ice model + asevd_ice = icealbivis(i) + asend_ice = icealbinir(i) + asevb_ice = icealbdvis(i) + asenb_ice = icealbdnir(i) else - asevb = asevd - asenb = asend - endif - else - rfcs = f_one - asevb = asevd - asenb = asend - endif - - sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*flnd & - & + asenb*fsea + asnnb*fsno - sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*flnd & - & + asend*fsea + asnnd*fsno - sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*flnd & - & + asevb*fsea + asnvb*fsno - sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*flnd & - & + asevd*fsea + asnvd*fsno + !-- 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 + ! 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 + 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 ) + 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 ! ice option from LSM or otherwise + else + ! icy = false, fill in values + asevd_ice = 0.70 + asend_ice = 0.65 + asevb_ice = 0.70 + asenb_ice = 0.65 + endif ! end icy + + !-- Composite mean surface albedo from land, open water and + !-- ice fractions + sfcalb(i,1) = min(0.99,max(0.01,lsmalbdnir(i)))*fracl(i) & ! direct beam NIR + & + asenb_wat*fraco(i) + asenb_ice*fraci(i) + sfcalb(i,2) = min(0.99,max(0.01,lsmalbinir(i)))*fracl(i) & ! diffuse NIR + & + asend_wat*fraco(i) + asend_ice*fraci(i) + sfcalb(i,3) = min(0.99,max(0.01,lsmalbdvis(i)))*fracl(i) & ! direct beam visible + & + asevb_wat*fraco(i) + asevb_ice*fraci(i) + sfcalb(i,4) = min(0.99,max(0.01,lsmalbivis(i)))*fracl(i) & ! diffuse visible + & + asevd_wat*fraco(i) + asevd_ice*fraci(i) enddo ! end_do_i_loop @@ -783,7 +687,7 @@ end subroutine setalb !! or -pi -> +pi ranges !!\param xlat (IMAX), latitude in radiance, default to pi/2 -> !! -pi/2 range, otherwise see in-line comment -!!\param slmsk (IMAX), sea(0),land(1),ice(2) mask on fcst model grid +!!\param landfrac (IMAX), fraction of grid that is land !!\param snowf (IMAX), snow depth water equivalent in mm !!\param sncovr (IMAX), snow cover over land !!\param zorlf (IMAX), surface roughness in cm @@ -796,9 +700,11 @@ end subroutine setalb !! @{ !----------------------------------- subroutine setemis & - & ( xlon,xlat,slmsk,snowf,sncovr,zorlf,tsknf,tairf,hprif, & ! --- inputs: - & lsmemiss,IMAX, & - & sfcemis & ! --- outputs: + & ( lsm,lsm_noahmp,lsm_ruc,vtype,landfrac,frac_grid, & ! --- inputs: + & 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: & ) ! =================================================================== ! @@ -817,17 +723,19 @@ subroutine setemis & ! xlat (IMAX) - latitude in radiance, default to pi/2 -> -pi/2 ! ! range, otherwise see in-line comment ! ! slmsk (IMAX) - sea(0),land(1),ice(2) mask on fcst model grid ! +! landfrac (IMAX) - fraction of land on on fcst model grid ! ! snowf (IMAX) - snow depth water equivalent in mm ! ! sncovr(IMAX) - ialbflg=1: snow cover over land in fraction ! +! sncovr_ice(IMAX) - snow cover over ice in fraction ! ! zorlf (IMAX) - surface roughness in cm ! ! tsknf (IMAX) - ground surface temperature in k ! ! tairf (IMAX) - lowest model layer air temperature in k ! ! hprif (IMAX) - topographic sdv in m ! -! lsmemiss(IMAX)- emissivity from lsm ! +! semis_lnd (IMAX) - emissivity from lsm ! ! IMAX - array horizontal dimension ! ! ! ! outputs: ! -! sfcemis(IMAX) - surface emissivity ! +! sfcemis(IMAX) - surface emissivity ! ! ! ! ------------------------------------------------------------------- ! ! ! @@ -841,23 +749,38 @@ subroutine setemis & ! ! ! ==================== end of description ===================== ! ! + use set_soilveg_ruc_mod, only: set_soilveg_ruc + use namelist_soilveg_ruc + implicit none ! --- inputs integer, intent(in) :: IMAX + 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), dimension(:), intent(in) :: landfrac + real (kind=kind_phys), intent(in) :: min_seaice real (kind=kind_phys), dimension(:), intent(in) :: & - & xlon,xlat, slmsk, snowf,sncovr, zorlf, tsknf, tairf, hprif,& - & lsmemiss + & xlon,xlat, slmsk, snowf,sncovr, sncovr_ice, & + & zorlf, tsknf, tairf, hprif, semis_lnd, semis_ice + real (kind=kind_phys), dimension(:), intent(in) :: & + & fracl, fraco, fraci + logical, dimension(:), intent(in) :: & + & icy ! --- outputs + real (kind=kind_phys), dimension(:), intent(out) :: semisbase real (kind=kind_phys), dimension(:), intent(out) :: sfcemis ! --- locals: integer :: i, i1, i2, j1, j2, idx + integer :: ivgtyp real (kind=kind_phys) :: dltg, hdlt, tmp1, tmp2, & - & asnow, argh, hrgh, fsno, fsno0, fsno1 + & asnow, argh, hrgh, fsno + real (kind=kind_phys) :: sfcemis_land, sfcemis_ice ! --- reference emiss value for diff surface emiss index ! 1-open water, 2-grass/shrub land, 3-bare soil, tundra, @@ -869,32 +792,29 @@ subroutine setemis & ! !===> ... begin here ! -!> -# Set sfcemis default to 1.0 or by surface type and condition. - if ( iemslw == 0 ) then ! sfc emiss default to 1.0 - - sfcemis(:) = f_one - return - - elseif ( iemslw == 1 ) then ! emiss set by sfc type and condition +!> -# Set emissivity by surface type and conditions + if ( iemslw == 1 ) then dltg = 360.0 / float(IMXEMS) hdlt = 0.5 * dltg ! --- ... mapping input data onto model grid ! note: this is a simple mapping method, an upgrade is needed if -! the model grid is much corcer than the 1-deg data resolution +! the model grid is much coarser than the 1-deg data resolution lab_do_IMAX : do i = 1, IMAX - if ( nint(slmsk(i)) == 0 ) then ! sea point - - sfcemis(i) = emsref(1) - - else if ( nint(slmsk(i)) == 2 ) then ! sea-ice - - sfcemis(i) = emsref(7) + if (fracl(i) < epsln) then ! no land + if ( abs(fraco(i)-f_one) < epsln ) then ! open water point + sfcemis(i) = emsref(1) + elseif ( abs(fraci(i)-f_one) > epsln ) then ! complete sea/lake ice + sfcemis(i) = emsref(7) + else + !-- fractional sea ice + sfcemis(i) = fraco(i)*emsref(1) + fraci(i)*emsref(7) + endif - else ! land + else ! land or fractional grid ! --- map grid in longitude direction i2 = 1 @@ -925,56 +845,70 @@ subroutine setemis & endif enddo lab_do_JMXEMS - idx = max( 2, idxems(i2,j2) ) if ( idx >= 7 ) idx = 2 - sfcemis(i) = emsref(idx) + if (abs(fracl(i)-f_one) < epsln) then + sfcemis(i) = emsref(idx) + else + sfcemis(i) = fracl(i)*emsref(idx) + fraco(i)*emsref(1) & + & + fraci(i)*emsref(7) + endif + semisbase(i) = sfcemis(i) endif ! end if_slmsk_block -!> -# Check for snow covered area. +!> - Check for snow covered area. + if ( sncovr(i) > f_zero ) then ! input land/ice area snow cover - if ( ialbflg==1 .and. nint(slmsk(i))==1 ) then ! input land area snow cover - - fsno0 = sncovr(i) - fsno1 = f_one - fsno0 - sfcemis(i) = sfcemis(i)*fsno1 + emsref(8)*fsno0 + fsno = sncovr(i) + sfcemis(i) = sfcemis(i)*(f_one - fsno) + emsref(8)*fsno else ! compute snow cover from snow depth if ( snowf(i) > f_zero ) then 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 - if (nint(slmsk(i)) == 0 .and. tsknf(i) > 271.2) & - & fsno0=f_zero - fsno1 = f_one - fsno0 - sfcemis(i) = sfcemis(i)*fsno1 + emsref(8)*fsno0 + fsno = asnow / (argh + asnow) * hrgh + + if (abs(fraco(i)-f_one) < epsln) fsno = f_zero ! no snow over open water + sfcemis(i) = sfcemis(i)*(f_one - fsno) + emsref(8)*fsno endif endif ! end if_ialbflg enddo lab_do_IMAX - elseif ( iemslw == 2 ) then ! sfc emiss updated in land model - - do i = 1, IMAX - - if ( nint(slmsk(i)) == 0 ) then ! sea point - - sfcemis(i) = emsref(1) + elseif ( iemslw == 2 ) then ! sfc emiss updated in land model: Noah MP or RUC - else if ( nint(slmsk(i)) == 2 ) then ! sea-ice - - sfcemis(i) = emsref(7) + do i = 1, IMAX - else ! land + !-- ice emissivity + sfcemis_ice = emsref(7) + + if ( icy(i) ) then + !-- complete or fractional ice + if (lsm == lsm_noahmp) then + if ( snowf(i) > f_zero ) then + 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))) + fsno = asnow / (argh + asnow) * hrgh + sfcemis_ice = sfcemis_ice*(f_one-fsno)+emsref(8)*fsno + endif + elseif (lsm == lsm_ruc) then + sfcemis_ice = semis_ice(i) ! output from lsm (with snow effect) + endif ! lsm check + endif ! icy - sfcemis(i) = lsmemiss(i) + !-- land emissivity + !-- from Noah MP or RUC lsms + sfcemis_land = semis_lnd(i) ! albedo with snow effect from LSM - endif ! end if_slmsk_block - enddo + !-- Composite emissivity from land, water and ice fractions. + sfcemis(i) = fracl(i)*sfcemis_land + fraco(i)*emsref(1) & + & + fraci(i)*sfcemis_ice + enddo ! i endif ! end if_iemslw_block diff --git a/physics/radiation_surface.meta b/physics/radiation_surface.meta new file mode 100644 index 000000000..beab83ce9 --- /dev/null +++ b/physics/radiation_surface.meta @@ -0,0 +1,15 @@ +[ccpp-table-properties] + name = module_radiation_surface + type = module + dependencies = + +######################################################################## +[ccpp-arg-table] + name = module_radiation_surface + type = module +[nf_albd] + standard_name = number_of_components_for_surface_albedo + long_name = number of IR/VIS/UV compinents for surface albedo + units = none + dimensions = () + type = integer diff --git a/physics/rrtmg_lw_pre.F90 b/physics/rrtmg_lw_pre.F90 index 0494e283f..3ace48c0b 100644 --- a/physics/rrtmg_lw_pre.F90 +++ b/physics/rrtmg_lw_pre.F90 @@ -7,43 +7,25 @@ module rrtmg_lw_pre !>\defgroup rrtmg_lw_pre GFS RRTMG scheme pre !! @{ subroutine rrtmg_lw_pre_init () - end subroutine rrtmg_lw_pre_init + end subroutine rrtmg_lw_pre_init !> \section arg_table_rrtmg_lw_pre_run Argument Table !! \htmlinclude rrtmg_lw_pre_run.html !! - subroutine rrtmg_lw_pre_run (im, lslwr, xlat, xlon, slmsk, snowd, sncovr,& - zorl, hprime, tsfg, tsfa, semis, emiss, errmsg, errflg) - - use machine, only: kind_phys - use module_radiation_surface, only: setemis + subroutine rrtmg_lw_pre_run (errmsg, errflg) implicit none - - integer, intent(in) :: im - logical, intent(in) :: lslwr - real(kind=kind_phys), dimension(:), intent(in) :: xlat, xlon, slmsk, & - snowd, sncovr, zorl, hprime, tsfg, tsfa - real(kind=kind_phys), dimension(:), intent(in) :: emiss - real(kind=kind_phys), dimension(:), intent(out) :: semis - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (lslwr) then -!> - Call module_radiation_surface::setemis(),to setup surface -!! emissivity for LW radiation. - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, & - hprime, emiss, im, & ! --- inputs - semis) ! --- outputs - endif - end subroutine rrtmg_lw_pre_run - subroutine rrtmg_lw_pre_finalize () - end subroutine rrtmg_lw_pre_finalize + subroutine rrtmg_lw_pre_finalize () + end subroutine rrtmg_lw_pre_finalize !! @} - end module rrtmg_lw_pre + end module rrtmg_lw_pre diff --git a/physics/rrtmg_lw_pre.meta b/physics/rrtmg_lw_pre.meta index d62d9881c..fb84cb4c9 100644 --- a/physics/rrtmg_lw_pre.meta +++ b/physics/rrtmg_lw_pre.meta @@ -1,127 +1,12 @@ [ccpp-table-properties] name = rrtmg_lw_pre type = scheme - dependencies = iounitdef.f,machine.F,radiation_surface.f + dependencies = ######################################################################## [ccpp-arg-table] name = rrtmg_lw_pre_run type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[lslwr] - standard_name = flag_to_calc_lw - long_name = logical flags for lw radiation calls - units = flag - dimensions = () - type = logical - intent = in - optional = F -[xlat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[xlon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[semis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -139,4 +24,3 @@ type = integer intent = out optional = F - diff --git a/physics/rrtmg_sw_post.F90 b/physics/rrtmg_sw_post.F90 index a5906fb75..72e149fe1 100644 --- a/physics/rrtmg_sw_post.F90 +++ b/physics/rrtmg_sw_post.F90 @@ -24,7 +24,7 @@ subroutine rrtmg_sw_post_run (im, levr, levs, ltp, nday, lm, kd, lsswr, & implicit none integer, intent(in) :: im, levr, levs, & - ltp, nday, lm, kd + ltp, nday, lm, kd logical, intent(in) :: lsswr, swhtr real(kind=kind_phys), dimension(:), intent(in) :: sfcalb1, sfcalb2, & sfcalb3, sfcalb4 diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 2ea7de3d6..cc329f180 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -12,44 +12,22 @@ end subroutine rrtmg_sw_pre_init !> \section arg_table_rrtmg_sw_pre_run Argument Table !! \htmlinclude rrtmg_sw_pre_run.html !! - subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, lndp_prt_list, tsfg, tsfa, coszen, & - alb1d, slmsk, snowd, sncovr, snoalb, zorl, hprime, alvsf, alnsf, alvwf, & - alnwf, facsf, facwf, fice, tisfc, albdvis, albdnir, albivis, albinir, & - sfalb, nday, idxday, sfcalb1, sfcalb2, sfcalb3, sfcalb4, errmsg, errflg) + subroutine rrtmg_sw_pre_run (im, lsswr, coszen, nday, idxday, errmsg, errflg) use machine, only: kind_phys - use module_radiation_surface, only: NF_ALBD, setalb - implicit none - integer, intent(in) :: im, lndp_type, n_var_lndp - character(len=3) , dimension(:), intent(in) :: lndp_var_list + integer, intent(in) :: im logical, intent(in) :: lsswr - real(kind=kind_phys), dimension(:), intent(in) :: lndp_prt_list - real(kind=kind_phys), dimension(:), intent(in) :: tsfg, tsfa, coszen - real(kind=kind_phys), dimension(:), intent(in) :: alb1d - real(kind=kind_phys), dimension(:), intent(in) :: slmsk, snowd, & - sncovr, snoalb, & - zorl, hprime, & - alvsf, alnsf, & - alvwf, alnwf, & - facsf, facwf, & - fice, tisfc - real(kind=kind_phys), dimension(:), intent(in) :: albdvis, albdnir, & - albivis, albinir - real(kind=kind_phys), dimension(:), intent(inout) :: sfalb + real(kind=kind_phys), dimension(:), intent(in) :: coszen integer, intent(out) :: nday - integer, dimension(:), intent(out) :: idxday - real(kind=kind_phys), dimension(:), intent(out) :: sfcalb1, sfcalb2, & - sfcalb3, sfcalb4 + integer, dimension(:), intent(out) :: idxday character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Local variables integer :: i - real(kind=kind_phys), dimension(im,NF_ALBD) :: sfcalb - - real(kind=kind_phys) :: lndp_alb ! Initialize CCPP error handling variables errmsg = '' @@ -57,9 +35,9 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln ! --- ... start radiation calculations ! remember to set heating rate unit to k/sec! + !> -# Start SW radiation calculations if (lsswr) then - !> - Check for daytime points for SW radiation. nday = 0 idxday = 0 @@ -69,41 +47,11 @@ subroutine rrtmg_sw_pre_run (im, lndp_type, n_var_lndp, lsswr, lndp_var_list, ln idxday(nday) = i endif enddo - -! set albedo pert, if requested. - lndp_alb = -999. - if (lndp_type==1) then - do i =1,n_var_lndp - if (lndp_var_list(i) == 'alb') then - lndp_alb = lndp_prt_list(i) - endif - enddo - endif - -!> - Call module_radiation_surface::setalb() to setup surface albedo. -!! for SW radiation. - - call setalb (slmsk, snowd, sncovr, snoalb, zorl, coszen, tsfg, tsfa, & ! --- inputs - hprime, alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, & - tisfc, albdvis, albdnir, albivis, albinir,IM, alb1d, & ! mg, sfc-perts - lndp_alb, sfcalb) ! --- outputs - - -!> -# Approximate mean surface albedo from vis- and nir- diffuse values. - sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) else nday = 0 idxday = 0 - sfcalb = 0.0 endif - do i = 1, im - sfcalb1(i) = sfcalb(i,1) - sfcalb2(i) = sfcalb(i,2) - sfcalb3(i) = sfcalb(i,3) - sfcalb4(i) = sfcalb(i,4) - enddo - end subroutine rrtmg_sw_pre_run subroutine rrtmg_sw_pre_finalize () diff --git a/physics/rrtmg_sw_pre.meta b/physics/rrtmg_sw_pre.meta index 49d83ff89..c24cecfbd 100644 --- a/physics/rrtmg_sw_pre.meta +++ b/physics/rrtmg_sw_pre.meta @@ -15,22 +15,6 @@ type = integer intent = in optional = F -[lndp_type] - standard_name = index_for_stochastic_land_surface_perturbation_type - long_name = index for stochastic land surface perturbations type - units = index - dimensions = () - type = integer - intent = in - optional = F -[n_var_lndp] - standard_name = number_of_land_surface_variables_perturbed - long_name = number of land surface variables perturbed - units = count - dimensions = () - type = integer - intent = in - optional = F [lsswr] standard_name = flag_to_calc_sw long_name = logical flags for sw radiation calls @@ -39,42 +23,6 @@ type = logical intent = in optional = F -[lndp_var_list] - standard_name = variables_to_be_perturbed_for_landperts - long_name = variables to be perturbed for landperts - units = none - dimensions = (number_of_land_surface_variables_perturbed) - type = character - kind = len=3 - intent = in - optional = F -[lndp_prt_list] - standard_name = magnitude_of_perturbations_for_landperts - long_name = magnitude of perturbations for landperts - units = variable - dimensions = (number_of_land_surface_variables_perturbed) - type = real - kind = kind_phys - intent = in - optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [coszen] standard_name = cosine_of_zenith_angle long_name = mean cos of zenith angle over rad call period @@ -84,186 +32,6 @@ kind = kind_phys intent = in optional = F -[alb1d] - standard_name = surface_albedo_perturbation - long_name = surface albedo perturbation - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snoalb] - standard_name = upper_bound_on_max_albedo_over_deep_snow - long_name = maximum snow albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alvsf] - standard_name = mean_vis_albedo_with_strong_cosz_dependency - long_name = mean vis albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alnsf] - standard_name = mean_nir_albedo_with_strong_cosz_dependency - long_name = mean nir albedo with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alvwf] - standard_name = mean_vis_albedo_with_weak_cosz_dependency - long_name = mean vis albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[alnwf] - standard_name = mean_nir_albedo_with_weak_cosz_dependency - long_name = mean nir albedo with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[facsf] - standard_name = fractional_coverage_with_strong_cosz_dependency - long_name = fractional coverage with strong cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[facwf] - standard_name = fractional_coverage_with_weak_cosz_dependency - long_name = fractional coverage with weak cosz dependency - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[fice] - standard_name = sea_ice_concentration - long_name = ice fraction over open water - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tisfc] - standard_name = sea_ice_temperature - long_name = sea ice surface skin temperature - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sfalb] - standard_name = surface_diffused_shortwave_albedo - long_name = mean surface diffused sw albedo - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout - optional = F [nday] standard_name = daytime_points_dimension long_name = daytime points dimension @@ -280,42 +48,6 @@ type = integer intent = out optional = F -[sfcalb1] - standard_name = surface_albedo_due_to_near_IR_direct - long_name = surface albedo due to near IR direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[sfcalb2] - standard_name = surface_albedo_due_to_near_IR_diffused - long_name = surface albedo due to near IR diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[sfcalb3] - standard_name = surface_albedo_due_to_UV_and_VIS_direct - long_name = surface albedo due to UV+VIS direct beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F -[sfcalb4] - standard_name = surface_albedo_due_to_UV_and_VIS_diffused - long_name = surface albedo due to UV+VIS diffused beam - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index d5808f199..99318c1b8 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -25,36 +25,21 @@ end subroutine rrtmgp_lw_pre_init !> \section arg_table_rrtmgp_lw_pre_run !! \htmlinclude rrtmgp_lw_pre_run.html !! - subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, & - tsfg, tsfa, hprime, sfc_emiss_byband, emiss, semis, errmsg, errflg) + subroutine rrtmgp_lw_pre_run (doLWrad, semis, sfc_emiss_byband, errmsg, errflg) ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for longwave radiation call - integer, intent(in) :: & - nCol ! Number of horizontal grid points + doLWrad real(kind_phys), dimension(:), intent(in) :: & - xlon, & ! Longitude - xlat, & ! Latitude - slmsk, & ! Land/sea/sea-ice mask - zorl, & ! Surface roughness length (cm) - snowd, & ! water equivalent snow depth (mm) - sncovr, & ! Surface snow are fraction (1) - tsfg, & ! Surface ground temperature for radiation (K) - tsfa, & ! Lowest model layer air temperature for radiation (K) - hprime ! Standard deviation of subgrid orography - real(kind_phys), dimension(:), intent(in) :: & - emiss ! Surface emissivity from Noah MP + semis - ! Outputs - real(kind_phys), dimension(:,:), intent(out) :: & + ! Outputs + real(kind_phys), dimension(:,:), intent(inout) :: & sfc_emiss_byband ! Surface emissivity in each band character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & errflg ! Error flag - real(kind_phys), dimension(:), intent(out) :: & - semis ! Local variables integer :: iBand @@ -62,13 +47,8 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - - if (.not. doLWrad) return - ! ####################################################################################### - ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. - ! ####################################################################################### - call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfg, tsfa, hprime, emiss, nCol, semis) + if (.not. doLWrad) return ! Assign same emissivity to all bands do iBand=1,lw_gas_props%get_nband() diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index f2773fdda..914c1dafc 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -15,95 +15,15 @@ type = logical intent = in optional = F -[nCol] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[xlon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[xlat] - standard_name = latitude - long_name = latitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[slmsk] - standard_name = sea_land_ice_mask_real - long_name = landmask: sea/land/ice=0/1/2 - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[zorl] - standard_name = surface_roughness_length - long_name = surface roughness length - units = cm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[snowd] - standard_name = surface_snow_thickness_water_equivalent - long_name = water equivalent snow depth - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[sncovr] - standard_name = surface_snow_area_fraction_over_land - long_name = surface snow area fraction +[semis] + 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 optional = F -[tsfg] - standard_name = surface_ground_temperature_for_radiation - long_name = surface ground temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[tsfa] - standard_name = surface_air_temperature_for_radiation - long_name = lowest model layer air temperature for radiation - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[hprime] - standard_name = standard_deviation_of_subgrid_orography - long_name = standard deviation of subgrid orography - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [sfc_emiss_byband] standard_name = surface_emissivity_in_each_RRTMGP_LW_band long_name = surface emissivity in each RRTMGP LW band @@ -111,25 +31,7 @@ dimensions = (number_of_lw_bands_rrtmgp,horizontal_loop_extent) type = real kind = kind_phys - intent = out - optional = F -[emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F -[semis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction - units = frac - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = out + intent = inout optional = F [errmsg] standard_name = ccpp_error_message diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index 32eeee4a9..f6a163ec1 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -8,7 +8,7 @@ name = rrtmgp_sw_gas_optics_init type = scheme [ncol] - standard_name = horizontal_loop_extent + standard_name = horizontal_dimension long_name = horizontal dimension units = count dimensions = () diff --git a/physics/sfc_diag.f b/physics/sfc_diag.f index e91bd0e14..c21d3a989 100644 --- a/physics/sfc_diag.f +++ b/physics/sfc_diag.f @@ -23,7 +23,7 @@ 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, & + & evap,fm,fh,fm10,fh2,tskin,qsurf,thsfc_loc, & & f10m,u10m,v10m,t2m,q2m,errmsg,errflg & & ) ! @@ -32,6 +32,7 @@ subroutine sfc_diag_run & implicit none ! 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) :: & & ps, u1, v1, t1, q1, tskin, & @@ -74,11 +75,12 @@ subroutine sfc_diag_run & ! t2m(i) = t2m(i) * sig2k wrk = 1.0 - fhi -#ifdef GSD_SURFACE_FLUXES_BUGFIX - t2m(i) = tskin(i)*wrk + t1(i)*fhi - (grav+grav)/cp -#else - t2m(i) = tskin(i)*wrk + t1(i)*prslki(i)*fhi - (grav+grav)/cp -#endif + + 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 diff --git a/physics/sfc_diag.meta b/physics/sfc_diag.meta index deebf23df..9c1e72433 100644 --- a/physics/sfc_diag.meta +++ b/physics/sfc_diag.meta @@ -168,6 +168,14 @@ kind = kind_phys intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [f10m] standard_name = ratio_of_wind_at_lowest_model_layer_and_wind_at_10m long_name = ratio of fm10 and fm diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 93102e467..bff171f4b 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -11,6 +11,7 @@ module sfc_diff implicit none public :: sfc_diff_init, sfc_diff_run, sfc_diff_finalize + public :: stability private @@ -68,11 +69,12 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & flag_iter,redrag, & !intent(in) & u10m,v10m,sfc_z0_type, & !hafs,z0 type !intent(in) & wet,dry,icy, & !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) - & z0rl_wat, z0rl_lnd, z0rl_ice, & !intent(inout) - & z0rl_wav, & !intent(inout) + & snwdph_wat,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) & cm_wat, cm_lnd, cm_ice, & !intent(inout) & ch_wat, ch_lnd, ch_ice, & !intent(inout) @@ -82,6 +84,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & fh_wat, fh_lnd, fh_ice, & !intent(inout) & fm10_wat, fm10_lnd, fm10_ice, & !intent(inout) & fh2_wat, fh2_lnd, fh2_ice, & !intent(inout) + & ztmax_wat, ztmax_lnd, ztmax_ice, & !intent(inout) & errmsg, errflg) !intent(out) ! implicit none @@ -95,6 +98,8 @@ 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, wet, dry, icy + logical, intent(in) :: thsfc_loc ! Flag for reference pressure in theta calculation + real(kind=kind_phys), dimension(:), intent(in) :: u10m,v10m real(kind=kind_phys), intent(in) :: rvrdm1, eps, epsm1, grav real(kind=kind_phys), dimension(:), intent(in) :: & @@ -117,7 +122,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) & fm_wat, fm_lnd, fm_ice, & & fh_wat, fh_lnd, fh_ice, & & fm10_wat, fm10_lnd, fm10_ice, & - & fh2_wat, fh2_lnd, fh2_ice + & fh2_wat, fh2_lnd, fh2_ice, & + & ztmax_wat, ztmax_lnd, ztmax_ice +! character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! @@ -127,8 +134,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! real(kind=kind_phys) :: rat, thv1, restar, wind10m, & czilc, tem1, tem2, virtfac +! - real(kind=kind_phys) :: tvs, z0, z0max, ztmax + real(kind=kind_phys) :: tv1 + + real(kind=kind_phys) :: tvs, z0, z0max ! real(kind=kind_phys), parameter :: & one=1.0_kp, zero=0.0_kp, half=0.5_kp, qmin=1.0e-8_kp @@ -166,19 +176,33 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) do i=1,im if(flag_iter(i)) then + + ! Need to initialize ztmax arrays + ztmax_lnd(i) = 1. ! log(1) = 0 + ztmax_ice(i) = 1. ! log(1) = 0 + ztmax_wat(i) = 1. ! log(1) = 0 + virtfac = one + rvrdm1 * max(q1(i),qmin) - thv1 = t1(i) * prslki(i) * virtfac + + tv1 = t1(i) * virtfac ! Virtual temperature in middle of lowest layer + if(thsfc_loc) then ! Use local potential temperature + thv1 = t1(i) * prslki(i) * virtfac + else ! Use potential temperature reference to 1000 hPa + thv1 = t1(i) / prslk1(i) * virtfac + endif ! compute stability dependent exchange coefficients ! this portion of the code is presently suppressed ! if (dry(i)) then ! Some land -#ifdef GSD_SURFACE_FLUXES_BUGFIX - tvs = half * (tsurf_lnd(i)+tskin_lnd(i))/prsik1(i) - & * virtfac -#else - tvs = half * (tsurf_lnd(i)+tskin_lnd(i)) * virtfac -#endif + + if(thsfc_loc) then ! Use local potential temperature + tvs = half * (tsurf_lnd(i)+tskin_lnd(i)) * virtfac + else ! Use potential temperature referenced to 1000 hPa + tvs = half * (tsurf_lnd(i)+tskin_lnd(i))/prsik1(i) + & * virtfac + endif + z0max = max(zmin, min(0.01_kp * z0rl_lnd(i), z1(i))) !** xubin's new z0 over land tem1 = one - shdmax(i) @@ -229,27 +253,34 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) czilc = 0.8_kp tem1 = 1.0_kp - sigmaf(i) - ztmax = z0max*exp( - tem1*tem1 + ztmax_lnd(i) = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land if (ztpert(i) /= zero) then - ztmax = ztmax * (10.0_kp**ztpert(i)) + ztmax_lnd(i) = ztmax_lnd(i) * (10.0_kp**ztpert(i)) endif - ztmax = max(ztmax, zmin) + ztmax_lnd(i) = max(ztmax_lnd(i), zmin) ! call stability ! --- inputs: & (z1(i), snwdph_lnd(i), thv1, wind(i), - & z0max, ztmax, tvs, grav, + & z0max, ztmax_lnd(i), tvs, grav, tv1, thsfc_loc, ! --- outputs: & rb_lnd(i), fm_lnd(i), fh_lnd(i), fm10_lnd(i), fh2_lnd(i), & cm_lnd(i), ch_lnd(i), stress_lnd(i), ustar_lnd(i)) endif ! Dry points if (icy(i)) then ! Some ice - tvs = half * (tsurf_ice(i)+tskin_ice(i)) * virtfac + + if(thsfc_loc) then ! Use local potential temperature + tvs = half * (tsurf_ice(i)+tskin_ice(i)) * virtfac + else ! Use potential temperature referenced to 1000 hPa + tvs = half * (tsurf_ice(i)+tskin_ice(i))/prsik1(i) + & * virtfac + endif + z0max = max(zmin, min(0.01_kp * z0rl_ice(i), z1(i))) !** xubin's new z0 over land and sea ice tem1 = one - shdmax(i) @@ -270,14 +301,14 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) czilc = 0.8_kp tem1 = 1.0_kp - sigmaf(i) - ztmax = z0max*exp( - tem1*tem1 + ztmax_ice(i) = z0max*exp( - tem1*tem1 & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) - ztmax = max(ztmax, 1.0e-6) + ztmax_ice(i) = max(ztmax_ice(i), 1.0e-6) ! call stability ! --- inputs: & (z1(i), snwdph_ice(i), thv1, wind(i), - & z0max, ztmax, tvs, grav, + & z0max, ztmax_ice(i), tvs, grav, tv1, thsfc_loc, ! --- outputs: & rb_ice(i), fm_ice(i), fh_ice(i), fm10_ice(i), fh2_ice(i), & cm_ice(i), ch_ice(i), stress_ice(i), ustar_ice(i)) @@ -287,7 +318,14 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! the stuff now put into "stability" if (wet(i)) then ! Some open ocean - tvs = half * (tsurf_wat(i)+tskin_wat(i)) * virtfac + + if(thsfc_loc) then ! Use local potential temperature + tvs = half * (tsurf_wat(i)+tskin_wat(i)) * virtfac + else + tvs = half * (tsurf_wat(i)+tskin_wat(i))/prsik1(i) + & * virtfac + endif + z0 = 0.01_kp * z0rl_wat(i) z0max = max(zmin, min(z0,z1(i))) ustar_wat(i) = sqrt(grav * z0 / charnock) @@ -307,12 +345,12 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! rat taken from zeng, zhao and dickinson 1997 rat = min(7.0_kp, 2.67_kp * sqrt(sqrt(restar)) - 2.57_kp) - ztmax = max(z0max * exp(-rat), zmin) + ztmax_wat(i) = max(z0max * exp(-rat), zmin) ! if (sfc_z0_type == 6) then - call znot_t_v6(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) + call znot_t_v6(wind10m, ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type == 7) then - call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) + call znot_t_v7(wind10m, ztmax_wat(i)) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type > 0) then write(0,*)'no option for sfc_z0_type=',sfc_z0_type stop @@ -321,7 +359,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) call stability ! --- inputs: & (z1(i), snwdph_wat(i), thv1, wind(i), - & z0max, ztmax, tvs, grav, + & 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), & cm_wat(i), ch_wat(i), stress_wat(i), ustar_wat(i)) @@ -381,6 +419,7 @@ end subroutine sfc_diff_run subroutine stability & ! --- inputs: & ( z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav, & + & tv1, thsfc_loc, & ! --- outputs: & rb, fm, fh, fm10, fh2, cm, ch, stress, ustar) !----- @@ -389,6 +428,8 @@ subroutine stability & ! --- inputs: real(kind=kind_phys), intent(in) :: & & z1, snwdph, thv1, wind, z0max, ztmax, tvs, grav + real(kind=kind_phys), intent(in) :: tv1 + logical, intent(in) :: thsfc_loc ! --- outputs: real(kind=kind_phys), intent(out) :: & @@ -424,13 +465,15 @@ subroutine stability & dtv = thv1 - tvs adtv = max(abs(dtv),0.001_kp) dtv = sign(1.,dtv) * adtv -#ifdef GSD_SURFACE_FLUXES_BUGFIX - rb = max(-5000.0_kp, grav * dtv * z1 - & / (thv1 * wind * wind)) -#else - rb = max(-5000.0_kp, (grav+grav) * dtv * z1 - & / ((thv1 + tvs) * wind * wind)) -#endif + + if(thsfc_loc) then ! Use local potential temperature + rb = max(-5000.0_kp, (grav+grav) * dtv * z1 + & / ((thv1 + tvs) * wind * wind)) + else ! Use potential temperature referenced to 1000 hPa + rb = max(-5000.0_kp, grav * dtv * z1 + & / (tv1 * wind * wind)) + endif + tem1 = one / z0max tem2 = one / ztmax fm = log((z0max+z1) * tem1) diff --git a/physics/sfc_diff.meta b/physics/sfc_diff.meta index 342eaeea5..7b639b6b0 100644 --- a/physics/sfc_diff.meta +++ b/physics/sfc_diff.meta @@ -250,6 +250,14 @@ type = logical intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [tskin_wat] standard_name = surface_skin_temperature_over_water_interstitial long_name = surface skin temperature over water (temporary use as interstitial) @@ -610,6 +618,33 @@ kind = kind_phys intent = inout optional = F +[ztmax_wat] + standard_name = bounded_surface_roughness_length_for_heat_over_water + long_name = bounded surface roughness length for heat over water + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ztmax_lnd] + standard_name = bounded_surface_roughness_length_for_heat_over_land + long_name = bounded surface roughness length for heat over land + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[ztmax_ice] + standard_name = bounded_surface_roughness_length_for_heat_over_ice + long_name = bounded surface roughness length for heat over ice + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index f2f0369c2..f313f2fba 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -16,7 +16,12 @@ module lsm_ruc public :: lsm_ruc_init, lsm_ruc_run, lsm_ruc_finalize - real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 + real(kind=kind_phys), parameter :: zero = 0.0_kind_phys, one = 1.0_kind_phys, epsln = 1.0e-10_kind_phys + real(kind=kind_phys), dimension (2), parameter, private :: d = (/0.1,0.25/) + integer, dimension(20), parameter, private:: & + istwe = (/1,1,1,1,1,2,2,1,1,2,2,2,2,2,1,2,2,1,2,2/) ! IGBP 20 classes + + contains @@ -25,13 +30,20 @@ module lsm_ruc !! \section arg_table_lsm_ruc_init Argument Table !! \htmlinclude lsm_ruc_init.html !! - subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & - flag_restart, flag_init, & - im, lsoil_ruc, lsoil, kice, nlev, & ! in - lsm_ruc, lsm, slmsk, stype, vtype, & ! in - tsfc_lnd, tsfc_wat, & ! in - tg3, smc, slc, stc, & ! in - zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out + subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & + flag_restart, flag_init, con_fvirt, con_rd, & + im, lsoil_ruc, lsoil, kice, nlev, & ! in + lsm_ruc, lsm, slmsk, stype, vtype, & ! in + q1, prsl1, tsfc_lnd, tsfc_ice, tsfc_wat, & ! in + tg3, smc, slc, stc, fice, min_seaice, & ! in + sncovr_lnd, sncovr_ice, snoalb, & ! in + facsf, facwf, alvsf, alvwf, alnsf, alnwf, & ! in + sfcqv_lnd, sfcqv_ice, & ! out + sfalb_lnd_bck, & ! out + semisbase, semis_lnd, semis_ice, & ! out + albdvis_lnd,albdnir_lnd,albivis_lnd,albinir_lnd, & ! out + albdvis_ice,albdnir_ice,albivis_ice,albinir_ice, & ! out + zs, sh2o, smfrkeep, tslb, smois, wetness, & ! out tsice, pores, resid, errmsg, errflg) implicit none @@ -45,33 +57,59 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & integer, intent(in) :: kice integer, intent(in) :: nlev integer, intent(in) :: lsm_ruc, lsm + real (kind=kind_phys),intent(in) :: con_fvirt + real (kind=kind_phys),intent(in) :: con_rd real (kind=kind_phys), dimension(:), intent(in) :: slmsk real (kind=kind_phys), dimension(:), intent(in) :: stype real (kind=kind_phys), dimension(:), intent(in) :: vtype + real (kind=kind_phys), dimension(:), intent(in) :: q1 + real (kind=kind_phys), dimension(:), intent(in) :: prsl1 real (kind=kind_phys), dimension(:), intent(in) :: tsfc_lnd + real (kind=kind_phys), dimension(:), intent(in) :: tsfc_ice real (kind=kind_phys), dimension(:), intent(in) :: tsfc_wat real (kind=kind_phys), dimension(:), intent(in) :: tg3 + real (kind=kind_phys), dimension(:), intent(in) :: sncovr_lnd + real (kind=kind_phys), dimension(:), intent(in) :: sncovr_ice + real (kind=kind_phys), dimension(:), intent(in) :: snoalb + real (kind=kind_phys), dimension(:), intent(in) :: fice + real (kind=kind_phys), dimension(:), intent(in) :: facsf + real (kind=kind_phys), dimension(:), intent(in) :: facwf + real (kind=kind_phys), dimension(:), intent(in) :: alvsf + real (kind=kind_phys), dimension(:), intent(in) :: alvwf + real (kind=kind_phys), dimension(:), intent(in) :: alnsf + real (kind=kind_phys), dimension(:), intent(in) :: alnwf real (kind=kind_phys), dimension(:,:), intent(in) :: smc,slc,stc - + real (kind=kind_phys), intent(in) :: min_seaice ! --- in/out: real (kind=kind_phys), dimension(:), intent(inout) :: wetness -! --- out - real (kind=kind_phys), dimension(:), intent(out) :: zs +! --- inout real (kind=kind_phys), dimension(:,:), intent(inout) :: sh2o, smfrkeep real (kind=kind_phys), dimension(:,:), intent(inout) :: tslb, smois - real (kind=kind_phys), dimension(:,:), intent(out) :: tsice + real (kind=kind_phys), dimension(:), intent(inout) :: semis_lnd + real (kind=kind_phys), dimension(:), intent(inout) :: semis_ice + real (kind=kind_phys), dimension(:), intent(inout) :: & + albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & + sfcqv_lnd, sfcqv_ice - real (kind=kind_phys), dimension(:), intent(out) :: pores, resid +! --- out + real (kind=kind_phys), dimension(:), intent(out) :: zs + real (kind=kind_phys), dimension(:), intent(inout) :: sfalb_lnd_bck + real (kind=kind_phys), dimension(:,:), intent(out) :: tsice + real (kind=kind_phys), dimension(:), intent(out) :: semisbase + real (kind=kind_phys), dimension(:), intent(out) :: pores, resid character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- local real (kind=kind_phys), dimension(lsoil_ruc) :: dzs + real (kind=kind_phys) :: alb_lnd, alb_ice + real (kind=kind_phys) :: q0, qs1 integer :: ipr, i, k logical :: debug_print integer, dimension(im) :: soiltyp, vegtype @@ -149,7 +187,39 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & if (soiltyp(i) < 1) soiltyp(i) = 14 if (vegtype(i) < 1) vegtype(i) = 17 endif - enddo + !-- initialize background emissivity + semisbase(i) = lemitbl(vegtype(i)) ! no snow effect + + if (.not.flag_restart) then + !-- land + semis_lnd(i) = semisbase(i) * (1.-sncovr_lnd(i)) & + + 0.99 * sncovr_lnd(i) + sfalb_lnd_bck(i) = 0.25*(alnsf(i) + alnwf(i) + alvsf(i) + alvwf(i)) & + * min(1., facsf(i)+facwf(i)) + alb_lnd = sfalb_lnd_bck(i) * (1. - sncovr_lnd(i)) & + + snoalb(i) * sncovr_lnd(i) + albdvis_lnd(i) = alb_lnd + albdnir_lnd(i) = alb_lnd + albivis_lnd(i) = alb_lnd + albinir_lnd(i) = alb_lnd + !-- ice + semis_ice(i) = 0.97 * (1. - sncovr_ice(i)) + 0.99 * sncovr_ice(i) + alb_ice = 0.55 * (1. - sncovr_ice(i)) + 0.75 * sncovr_ice(i) + albdvis_ice(i) = alb_ice + albdnir_ice(i) = alb_ice + albivis_ice(i) = alb_ice + albinir_ice(i) = alb_ice + + !-- initialize QV mixing ratio at the surface from atm. 1st level + q0 = max(q1(i)/(1.-q1(i)), 1.e-8) ! q1=specific humidity at level 1 (kg/kg) + qs1 = rslf(prsl1(i),tsfc_lnd(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg) + q0 = min(qs1, q0) + sfcqv_lnd(i) = q0 + qs1 = rslf(prsl1(i),tsfc_ice(i)) + sfcqv_ice(i) = qs1 + endif ! .not. restart + + enddo ! i call init_soil_depth_3 ( zs , dzs , lsoil_ruc ) @@ -215,7 +285,6 @@ end subroutine lsm_ruc_finalize ! sigmaf - real, areal fractional cover of green vegetation im ! ! dlwflx - real, total sky sfc downward lw flux ( w/m**2 ) im ! ! dswflx - real, total sky sfc downward sw flux ( w/m**2 ) im ! -! snet - real, total sky sfc netsw flx into ground(w/m**2) im ! ! delt - real, time interval (second) 1 ! ! tg3 - real, deep soil temperature (k) im ! ! cm - real, surface exchange coeff for momentum (m/s) im ! @@ -275,18 +344,19 @@ subroutine lsm_ruc_run & ! inputs & imp_physics, imp_physics_gfdl, imp_physics_thompson, & & do_mynnsfclay, lsoil_ruc, lsoil, rdlai, zs, & & t1, q1, qc, soiltyp, vegtype, sigmaf, laixy, & - & dlwflx, dswsfc, snet, tg3, & - & land, icy, lake, & + & dlwflx, dswsfc, tg3, coszen, land, icy, lake, & & rainnc, rainc, ice, snow, graupel, & - & prsl1, zf, wind, shdmin, shdmax, alvwf, alnwf, & - & srflag, snoalb, isot, ivegsrc, fice, smcwlt2, smcref2, & + & prsl1, zf, wind, shdmin, shdmax, & + & srflag, sfalb_lnd_bck, snoalb, & + & isot, ivegsrc, fice, smcwlt2, smcref2, & + & min_lakeice, min_seaice, oceanfrac, & ! --- constants & con_cp, con_rd, con_rv, con_g, con_pi, con_hvap, & & con_fvirt, & ! for water & ch_wat, tskin_wat, & ! --- in/outs for ice and land - & semis_lnd, semis_ice, & + & semisbase, semis_lnd, semis_ice, sfalb_lnd, sfalb_ice, & & sncovr1_lnd, weasd_lnd, snwdph_lnd, tskin_lnd, & & sncovr1_ice, weasd_ice, snwdph_ice, tskin_ice, & ! for land @@ -297,11 +367,13 @@ subroutine lsm_ruc_run & ! inputs & runof, runoff, srunoff, drain, & & cm_lnd, ch_lnd, evbs, evcw, stm, wetness, & & snowfallac_lnd, & + & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & ! for ice & sfcqc_ice, sfcqv_ice, & & tice, tsurf_ice, tsnow_ice, z0rl_ice, & & qsurf_ice, gflux_ice, evap_ice, ep1d_ice, hflx_ice, & & cm_ice, ch_ice, snowfallac_ice, & + & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice, & ! --- out & rhosnf, sbsno, & & cmm_lnd, chh_lnd, cmm_ice, chh_ice, & @@ -315,8 +387,6 @@ subroutine lsm_ruc_run & ! inputs ! --- constant parameters: real(kind=kind_phys), parameter :: rhoh2o = 1000.0 real(kind=kind_phys), parameter :: stbolt = 5.670400e-8 - real(kind=kind_phys), parameter :: cimin = 0.15 !--- in GFS - !real(kind=kind_phys), parameter :: cimin = 0.02 !--- minimum ice concentration, 0.15 in GFS real(kind=kind_phys), parameter :: con_tice = 271.2 ! --- input: @@ -326,17 +396,17 @@ subroutine lsm_ruc_run & ! inputs integer, intent(in) :: imp_physics, imp_physics_gfdl, imp_physics_thompson real (kind=kind_phys), dimension(:), intent(in) :: & - & t1, sigmaf, laixy, dlwflx, dswsfc, snet, tg3, & - & prsl1, wind, shdmin, shdmax, & - & snoalb, alvwf, alnwf, zf, qc, q1, & + & t1, sigmaf, laixy, dlwflx, dswsfc, tg3, & + & coszen, prsl1, wind, shdmin, shdmax, & + & sfalb_lnd_bck, snoalb, zf, qc, q1, & ! for land & cm_lnd, ch_lnd, & ! for water - & ch_wat, tskin_wat, & + & ch_wat, tskin_wat, oceanfrac, & ! for ice & cm_ice, ch_ice - real (kind=kind_phys), intent(in) :: delt + real (kind=kind_phys), intent(in) :: delt, min_seaice, min_lakeice real (kind=kind_phys), intent(in) :: con_cp, con_rv, con_g, & con_pi, con_rd, & con_hvap, con_fvirt @@ -375,7 +445,8 @@ subroutine lsm_ruc_run & ! inputs ! --- output: real (kind=kind_phys), dimension(:), intent(inout) :: & & rhosnf, runof, drain, runoff, srunoff, evbs, evcw, & - & stm, wetness, semis_lnd, semis_ice, & + & stm, wetness, semisbase, semis_lnd, semis_ice, & + & sfalb_lnd, sfalb_ice, & ! for land & sncovr1_lnd, qsurf_lnd, gflux_lnd, evap_lnd, & & cmm_lnd, chh_lnd, hflx_lnd, sbsno, & @@ -384,13 +455,17 @@ subroutine lsm_ruc_run & ! inputs & sncovr1_ice, qsurf_ice, gflux_ice, evap_ice, ep1d_ice, & & cmm_ice, chh_ice, hflx_ice, snowfallac_ice + real (kind=kind_phys), dimension(:), intent( out) :: & + & albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, & + & albdvis_ice, albdnir_ice, albivis_ice, albinir_ice + logical, intent(in) :: flag_init, flag_restart character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! --- locals: real (kind=kind_phys), dimension(im) :: rho, & - & q0, qs1, & + & q0, qs1, albbcksol, & & tprcp_old, srflag_old, sr_old, canopy_old, wetness_old, & ! for land & weasd_lnd_old, snwdph_lnd_old, tskin_lnd_old, & @@ -408,6 +483,8 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(im,lsoil_ruc,1) :: smsoil, & slsoil, stsoil, smfrsoil, keepfrsoil, stsice + real (kind=kind_phys), dimension(im,lsoil_ruc,1) :: smice, & + slice, stice, smfrice, keepfrice real (kind=kind_phys), dimension(im,lsoil_ruc) :: smois_old, & & tsice_old, tslb_old, sh2o_old, & @@ -422,7 +499,7 @@ subroutine lsm_ruc_run & ! inputs & ffrozp, lwdn, prcp, xland, xland_wat, xice, xice_lnd, & & graupelncv, snowncv, rainncv, raincv, & & solnet_lnd, sfcexc, & - & runoff1, runoff2, acrunoff, & + & runoff1, runoff2, acrunoff, semis_bck, & & sfcems_lnd, hfx_lnd, shdfac, shdmin1d, shdmax1d, & & sneqv_lnd, snoalb1d_lnd, snowh_lnd, snoh_lnd, tsnav_lnd, & & snomlt_lnd, sncovr_lnd, soilw, soilm, ssoil_lnd, & @@ -460,9 +537,9 @@ subroutine lsm_ruc_run & ! inputs ! local integer :: ims,ime, its,ite, jms,jme, jts,jte, kms,kme, kts,kte - integer :: l, k, i, j, fractional_seaice - - logical :: flag(im), flag_ice_uncoupled(im) + integer :: l, k, i, j, fractional_seaice, ilst + real (kind=kind_phys) :: dm, cimin + logical :: flag(im), flag_ice(im), flag_ice_uncoupled(im) logical :: rdlai2d, myj, frpcpn logical :: debug_print ! @@ -477,9 +554,22 @@ subroutine lsm_ruc_run & ! inputs chklowq = 1. do i = 1, im ! i - horizontal loop + flag_ice(i) = .false. + if (icy(i) .and. .not. flag_cice(i)) then + ! - uncoupled ice model + if (oceanfrac(i) > zero) then + cimin = min_seaice + else + cimin = min_lakeice + endif + if (fice(i) >= cimin) then + ! - ice fraction is above the threshold for ice + flag_ice(i) = .true. + endif + 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) = (icy(i) .and. .not. flag_cice(i) .and. .not. lake(i)) + flag_ice_uncoupled(i) = (flag_ice(i) .and. .not. lake(i)) !> - Set flag for land and ice points. !- 10may19 - ice points are turned off. flag(i) = land(i) .or. flag_ice_uncoupled(i) @@ -770,9 +860,9 @@ subroutine lsm_ruc_run & ! inputs !> - 3. canopy/soil characteristics (s): !!\n \a vegtyp - vegetation type (integer index) -> vtype !!\n \a soiltyp - soil type (integer index) -> stype -!!\n \a sfcems - surface emmisivity -> sfcemis -!!\n \a 0.5*(alvwf + alnwf) - backround snow-free surface albedo (fraction) -> albbck -!!\n \a snoalb - upper bound on maximum albedo over deep snow -> snoalb1d +!!\n \a sfcems - surface emmisivity -> sfcemis +!!\n \a sfalb_lnd_bck - backround snow-free surface albedo (fraction) -> albbck_lnd +!!\n \a snoalb - upper bound on maximum albedo over deep snow -> snoalb1d_lnd if(ivegsrc == 1) then ! IGBP - MODIS vtype_wat(i,j) = 17 ! 17 - water (oceans and lakes) in MODIS @@ -808,6 +898,8 @@ subroutine lsm_ruc_run & ! inputs xlai(i,j) = 0. endif + semis_bck(i,j) = semisbase(i) + if (land(i)) then ! at least some land in the grid cell !> - 4. history (state) variables (h): @@ -835,18 +927,26 @@ subroutine lsm_ruc_run & ! inputs qsfc_lnd(i,j) = sfcqv_lnd(i)/(1.+sfcqv_lnd(i)) qsg_lnd(i,j) = rslf(prsl1(i),tsurf_lnd(i)) qcg_lnd(i,j) = sfcqc_lnd(i) - sfcems_lnd(i,j) = semis_lnd(i) sncovr_lnd(i,j) = sncovr1_lnd(i) - snoalb1d_lnd(i,j) = snoalb(i) - albbck_lnd(i,j) = max(0.01, 0.5 * (alvwf(i) + alnwf(i))) - ! alb_lnd takes into account snow on the ground - if (sncovr_lnd(i,j) > 0.) then - !- averaged of snow-free and snow-covered - alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) + if (kdt == 1) then + sfcems_lnd(i,j) = semisbase(i) * (1.-sncovr_lnd(i,j)) + 0.99 * sncovr_lnd(i,j) else - alb_lnd(i,j) = albbck_lnd(i,j) + sfcems_lnd(i,j) = semis_lnd(i) endif - solnet_lnd(i,j) = dswsfc(i)*(1.-alb_lnd(i,j)) !snet(i) !..net sw rad flx (dn-up) at sfc in w/m2 + + if(coszen(i) > 0. .and. weasd_lnd(i) < 1.e-4) then + !-- solar zenith angle dependence when no snow + ilst=istwe(vegtype(i)) ! 1 or 2 + dm = (1.+2.*d(ilst))/(1.+2.*d(ilst)*coszen(i)) + albbcksol(i) = sfalb_lnd_bck(i)*dm + else + albbcksol(i) = sfalb_lnd_bck(i) + endif ! coszen > 0. + + snoalb1d_lnd(i,j) = snoalb(i) + albbck_lnd(i,j) = albbcksol(i) !sfalb_lnd_bck(i) + alb_lnd(i,j) = albbck_lnd(i,j) * (1.-sncovr_lnd(i,j)) + snoalb(i) * sncovr_lnd(i,j) ! sfalb_lnd(i) + solnet_lnd(i,j) = dswsfc(i)*(1.-alb_lnd(i,j)) !..net sw rad flx (dn-up) at sfc in w/m2 cmc(i,j) = canopy(i) ! [mm] soilt_lnd(i,j) = tsurf_lnd(i) ! clu_q2m_iter @@ -895,7 +995,8 @@ subroutine lsm_ruc_run & ! inputs sneqv_lnd(i,j) = 300. * snowh_lnd(i,j) endif endif - ! ---- ... outside sflx, roughness uses cm as unit + + !-- z0rl is in [cm] z0_lnd(i,j) = z0rl_lnd(i)/100. znt_lnd(i,j) = z0rl_lnd(i)/100. @@ -965,8 +1066,8 @@ subroutine lsm_ruc_run & ! inputs & rhosnfr(i,j), precipfr(i,j), & ! --- inputs: & conflx2(i,1,j), sfcprs(i,1,j), sfctmp(i,1,j), q2(i,1,j), & - & qcatm(i,1,j), rho2(i,1,j), & - & lwdn(i,j), solnet_lnd(i,j), sfcems_lnd(i,j), chklowq(i,j), & + & qcatm(i,1,j), rho2(i,1,j), semis_bck(i,j), lwdn(i,j), & + & swdn(i,j), solnet_lnd(i,j), sfcems_lnd(i,j), chklowq(i,j), & & chs_lnd(i,j), flqc_lnd(i,j), flhc_lnd(i,j), & ! --- input/outputs: & wet(i,j), cmc(i,j), shdfac(i,j), alb_lnd(i,j), znt_lnd(i,j), & @@ -1103,6 +1204,17 @@ subroutine lsm_ruc_run & ! inputs ! ---- ... outside RUC LSM, roughness uses cm as unit ! (update after snow's effect) z0rl_lnd(i) = znt_lnd(i,j)*100. + !-- semis_lnd is with snow effect + semis_lnd(i) = sfcems_lnd(i,j) + !-- semisbas is without snow effect, but can have vegetation mosaic effect + semisbase(i) = semis_bck(i,j) + !-- sfalb_lnd has snow effect + sfalb_lnd(i) = alb_lnd(i,j) + !-- fill in albdvis_lnd, albdnir_lnd, albivis_lnd, albinir_lnd, + albdvis_lnd(i) = sfalb_lnd(i) + albdnir_lnd(i) = sfalb_lnd(i) + albinir_lnd(i) = sfalb_lnd(i) + albinir_lnd(i) = sfalb_lnd(i) do k = 1, lsoil_ruc smois(i,k) = smsoil(i,k,j) @@ -1122,23 +1234,21 @@ subroutine lsm_ruc_run & ! inputs !-- ice point sncovr_ice(i,j) = sncovr1_ice(i) - snoalb1d_ice(i,j) = 0.75 ! RAP value for max snow alb on ice - albbck_ice(i,j) = 0.55 ! RAP value for ice alb - if (sncovr_ice(i,j) > 0.) then - !- averaged of snow-free and snow-covered ice - alb_ice(i,j) = albbck_ice(i,j) * (1.-sncovr_ice(i,j)) + snoalb1d_ice(i,j) * sncovr_ice(i,j) - else - ! snow-free ice - alb_ice(i,j) = albbck_ice(i,j) - endif - + !-- alb_ice* is computed in setalb called from rrtmg_sw_pre. + snoalb1d_ice(i,j) = 0.75 !alb_ice_snow(i) !0.75 is RAP value for max snow alb on ice + albbck_ice(i,j) = 0.55 !alb_ice_snowfree(i) !0.55 is RAP value for ice alb + alb_ice(i,j) = sfalb_ice(i) solnet_ice(i,j) = dswsfc(i)*(1.-alb_ice(i,j)) qvg_ice(i,j) = sfcqv_ice(i) qsfc_ice(i,j) = sfcqv_ice(i)/(1.+sfcqv_ice(i)) qsg_ice(i,j) = rslf(prsl1(i),tsurf_ice(i)) qcg_ice(i,j) = sfcqc_ice(i) - sfcems_ice(i,j) = semis_ice(i) - + semis_bck(i,j) = 0.99 + if (kdt == 1) then + sfcems_ice(i,j) = semisbase(i) * (1.-sncovr_ice(i,j)) + 0.99 * sncovr_ice(i,j) + else + sfcems_ice(i,j) = semis_ice(i) + endif cmc(i,j) = canopy(i) ! [mm] soilt_ice(i,j) = tsurf_ice(i) ! clu_q2m_iter if (tsnow_ice(i) > 0. .and. tsnow_ice(i) < 273.15) then @@ -1149,10 +1259,10 @@ subroutine lsm_ruc_run & ! inputs tsnav_ice(i,j) = 0.5*(soilt_ice(i,j) + soilt1_ice(i,j)) - 273.15 do k = 1, lsoil_ruc stsice (i,k,j) = tsice(i,k) - smsoil (i,k,j) = 1. - slsoil (i,k,j) = 0. - smfrsoil(i,k,j) = 1. - keepfrsoil(i,k,j) = 1. + smice (i,k,j) = 1. + slice (i,k,j) = 0. + smfrice (i,k,j) = 1. + keepfrice(i,k,j) = 1. enddo wet_ice(i,j) = 1. @@ -1197,8 +1307,8 @@ subroutine lsm_ruc_run & ! inputs & rhosnfr(i,j), precipfr(i,j), & ! --- inputs: & conflx2(i,1,j), sfcprs(i,1,j), sfctmp(i,1,j), q2(i,1,j), & - & qcatm(i,1,j), rho2(i,1,j), & - & lwdn(i,j), solnet_ice(i,j), sfcems_ice(i,j), chklowq(i,j), & + & qcatm(i,1,j), rho2(i,1,j), semis_bck(i,j), lwdn(i,j), & + & swdn(i,j), solnet_ice(i,j), sfcems_ice(i,j), chklowq(i,j), & & chs_ice(i,j), flqc_ice(i,j), flhc_ice(i,j), & ! --- input/outputs: & wet_ice(i,j), cmc(i,j), shdfac(i,j), alb_ice(i,j), & @@ -1214,13 +1324,13 @@ subroutine lsm_ruc_run & ! inputs ! --- constants & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, stbolt, & ! --- input/outputs: - & smsoil(i,:,j), slsoil(i,:,j), soilm(i,j), smmax(i,j), & + & smice(i,:,j), slice(i,:,j), soilm(i,j), smmax(i,j), & & stsice(i,:,j), soilt_ice(i,j), & & hfx_ice(i,j), qfx_ice(i,j), lh_ice(i,j), & & infiltr(i,j), runoff1(i,j), runoff2(i,j), acrunoff(i,j), & & sfcexc(i,j), acceta(i,j), ssoil_ice(i,j), & - & snfallac_ice(i,j), acsn(i,j), snomlt_ice(i,j), & - & smfrsoil(i,:,j),keepfrsoil(i,:,j), .false., & + & snfallac_ice(i,j), acsn(i,j), snomlt_ice(i,j), & + & smfrice(i,:,j),keepfrice(i,:,j), .false., & & shdmin1d(i,j), shdmax1d(i,j), rdlai2d, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte ) @@ -1243,10 +1353,19 @@ subroutine lsm_ruc_run & ! inputs weasd_ice(i) = sneqv_ice(i,j) ! mm sncovr1_ice(i) = sncovr_ice(i,j) z0rl_ice(i) = znt_ice(i,j)*100. + !-- semis_ice is with snow effect + semis_ice(i) = sfcems_ice(i,j) + !-- sfalb_ice is with snow effect + sfalb_ice(i) = alb_ice(i,j) + albdvis_ice(i) = sfalb_ice(i) + albdnir_ice(i) = sfalb_ice(i) + albinir_ice(i) = sfalb_ice(i) + albinir_ice(i) = sfalb_ice(i) + do k = 1, lsoil_ruc tsice(i,k) = stsice(i,k,j) - if(.not. frac_grid) then + if(.not. frac_grid .or. .not. land(i)) then smois(i,k) = 1. sh2o(i,k) = 0. tslb(i,k) = stsice(i,k,j) @@ -1481,7 +1600,7 @@ subroutine rucinit (restart, im, lsoil_ruc, lsoil, nlev, & ! in !! Check if RUC soil data (tslb, ...) is provided or not !if (minval(tslb)==maxval(tslb)) then - ! For restart runs, can assume that RUC soul data is provided + ! For restart runs, can assume that RUC soil data is provided if (.not.restart) then flag_sst = 0 diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index e504c0700..7a7fc5075 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -63,9 +63,27 @@ type = logical intent = in optional = F +[con_fvirt] + 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 + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent + standard_name = horizontal_dimension + long_name = horizontal dimension units = count dimensions = () type = integer @@ -146,6 +164,24 @@ kind = kind_phys intent = in optional = F +[q1] + standard_name = water_vapor_specific_humidity_at_lowest_model_layer + long_name = water vapor specific humidity at lowest model layer + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl1] + standard_name = air_pressure_at_lowest_model_layer + long_name = mean pressure at lowest model layer + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [tsfc_lnd] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -155,6 +191,15 @@ kind = kind_phys intent = in optional = F +[tsfc_ice] + standard_name = sea_ice_temperature + long_name = sea ice surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [tsfc_wat] standard_name = sea_surface_temperature long_name = sea surface temperature @@ -200,6 +245,231 @@ kind = kind_phys intent = in optional = F +[fice] + standard_name = sea_ice_concentration + long_name = ice fraction over open water + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[sncovr_lnd] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr_ice] + standard_name = surface_snow_area_fraction_over_ice + long_name = surface snow area fraction over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snoalb] + standard_name = upper_bound_on_max_albedo_over_deep_snow + long_name = maximum snow albedo + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facsf] + standard_name = fractional_coverage_with_strong_cosz_dependency + long_name = fractional coverage with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[facwf] + standard_name = fractional_coverage_with_weak_cosz_dependency + long_name = fractional coverage with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvsf] + standard_name = mean_vis_albedo_with_strong_cosz_dependency + long_name = mean vis albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alvwf] + standard_name = mean_vis_albedo_with_weak_cosz_dependency + long_name = mean vis albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnsf] + standard_name = mean_nir_albedo_with_strong_cosz_dependency + long_name = mean nir albedo with strong cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[alnwf] + standard_name = mean_nir_albedo_with_weak_cosz_dependency + long_name = mean nir albedo with weak cosz dependency + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfcqv_lnd] + standard_name = water_vapor_mixing_ratio_at_surface_over_land + long_name = water vapor mixing ratio at surface over land + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfcqv_ice] + standard_name = water_vapor_mixing_ratio_at_surface_over_ice + long_name = water vapor mixing ratio at surface over ice + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[sfalb_lnd_bck] + standard_name =surface_snow_free_albedo_over_land + long_name = surface snow-free albedo over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[semisbase] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[semis_lnd] + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[semis_ice] + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [zs] standard_name = depth_of_soil_levels_for_land_surface_model long_name = depth of soil levels for land surface model @@ -540,19 +810,19 @@ kind = kind_phys intent = in optional = F -[snet] - standard_name = surface_net_downwelling_shortwave_flux - long_name = surface net downwelling shortwave flux at current time - units = W m-2 +[tg3] + standard_name = deep_soil_temperature + long_name = deep soil temperature + units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[tg3] - standard_name = deep_soil_temperature - long_name = deep soil temperature - units = K +[coszen] + standard_name = instantaneous_cosine_of_zenith_angle + long_name = cosine of zenith angle at current time + units = none dimensions = (horizontal_loop_extent) type = real kind = kind_phys @@ -672,33 +942,24 @@ kind = kind_phys intent = in optional = F -[alvwf] - standard_name = mean_vis_albedo_with_weak_cosz_dependency - long_name = mean vis albedo with weak cosz dependency - units = frac +[srflag] + standard_name = flag_for_precipitation_type + long_name = snow/rain flag for precipitation + units = flag dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[alnwf] - standard_name = mean_nir_albedo_with_weak_cosz_dependency - long_name = mean nir albedo with weak cosz dependency +[sfalb_lnd_bck] + standard_name =surface_snow_free_albedo_over_land + long_name = surface snow-free albedo over ice units = frac dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[srflag] - standard_name = flag_for_precipitation_type - long_name = snow/rain flag for precipitation - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in - optional = F [snoalb] standard_name = upper_bound_on_max_albedo_over_deep_snow long_name = maximum snow albedo @@ -751,6 +1012,33 @@ kind = kind_phys intent = inout optional = F +[min_lakeice] + standard_name = lake_ice_minimum + long_name = minimum lake ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[min_seaice] + standard_name = sea_ice_minimum + long_name = minimum sea ice value + units = frac + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F [con_cp] standard_name = specific_heat_of_dry_air_at_constant_pressure long_name = specific heat !of dry air at constant pressure @@ -832,9 +1120,18 @@ kind = kind_phys intent = in optional = F +[semisbase] + standard_name = baseline_surface_longwave_emissivity + long_name = baseline surface lw emissivity in fraction + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F [semis_lnd] - standard_name = surface_longwave_emissivity_over_land_interstitial - long_name = surface lw emissivity in fraction over land (temporary use as interstitial) + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -842,8 +1139,26 @@ intent = inout optional = F [semis_ice] - standard_name = surface_longwave_emissivity_over_ice_interstitial - long_name = surface lw emissivity in fraction over ice (temporary use as interstitial) + standard_name = surface_longwave_emissivity_over_ice + long_name = surface lw emissivity in fraction over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sfalb_lnd] + standard_name = surface_diffused_shortwave_albedo_over_land + long_name = mean surface diffused sw albedo over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout + optional = F +[sfalb_ice] + standard_name = surface_diffused_shortwave_albedo_over_ice + long_name = mean surface diffused sw albedo over ice units = frac dimensions = (horizontal_loop_extent) type = real @@ -1174,6 +1489,42 @@ kind = kind_phys intent = inout optional = F +[albdvis_lnd] + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albdnir_lnd] + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albivis_lnd] + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albinir_lnd] + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [sfcqc_ice] standard_name = cloud_condensed_water_mixing_ratio_at_surface_over_ice long_name = moist cloud water mixing ratio at surface over ice @@ -1300,6 +1651,42 @@ kind = kind_phys intent = inout optional = F +[albdvis_ice] + standard_name = surface_albedo_direct_visible_over_ice + long_name = direct surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albdnir_ice] + standard_name = surface_albedo_direct_NIR_over_ice + long_name = direct surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albivis_ice] + standard_name = surface_albedo_diffuse_visible_over_ice + long_name = diffuse surface albedo visible band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F +[albinir_ice] + standard_name = surface_albedo_diffuse_NIR_over_ice + long_name = diffuse surface albedo NIR band over ice + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = out + optional = F [rhosnf] standard_name = density_of_frozen_precipitation long_name = density of frozen precipitation diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 1e225ddf2..949f0d6a6 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -1034,8 +1034,8 @@ intent = inout optional = F [albdvis] - standard_name = surface_albedo_direct_visible - long_name = direct surface albedo visible band + standard_name = surface_albedo_direct_visible_over_land + long_name = direct surface albedo visible band over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -1043,8 +1043,8 @@ intent = out optional = F [albdnir] - standard_name = surface_albedo_direct_NIR - long_name = direct surface albedo NIR band + standard_name = surface_albedo_direct_NIR_over_land + long_name = direct surface albedo NIR band over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -1052,8 +1052,8 @@ intent = out optional = F [albivis] - standard_name = surface_albedo_diffuse_visible - long_name = diffuse surface albedo visible band + standard_name = surface_albedo_diffuse_visible_over_land + long_name = diffuse surface albedo visible band over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -1061,8 +1061,8 @@ intent = out optional = F [albinir] - standard_name = surface_albedo_diffuse_NIR - long_name = diffuse surface albedo NIR band + standard_name = surface_albedo_diffuse_NIR_over_land + long_name = diffuse surface albedo NIR band over land units = frac dimensions = (horizontal_loop_extent) type = real @@ -1070,8 +1070,8 @@ intent = out optional = F [emiss] - standard_name = surface_emissivity_lsm - long_name = surface emissivity from lsm + standard_name = surface_longwave_emissivity_over_land + long_name = surface lw emissivity in fraction over land units = frac dimensions = (horizontal_loop_extent) type = real diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index f03e725f3..967fd1c0a 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -32,7 +32,7 @@ subroutine sfc_nst_run & & sinlat, stress, & & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & - & nstf_name5, lprnt, ipr, & + & nstf_name5, lprnt, ipr, thsfc_loc, & & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: @@ -50,7 +50,7 @@ subroutine sfc_nst_run & ! prsl1, prslki, wet, use_flake, xlon, sinlat, stress, ! ! sfcemis, dlwflx, sfcnsw, rain, timestep, kdt,solhr,xcosz, ! ! wind, flag_iter, flag_guess, nstf_name1, nstf_name4, ! -! nstf_name5, lprnt, ipr, ! +! nstf_name5, lprnt, ipr, thsfc_loc, ! ! input/outputs: ! ! tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, ! ! z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, ! @@ -123,6 +123,7 @@ subroutine sfc_nst_run & ! nstf_name5 : zsea2 in mm 1 ! ! lprnt - logical, control flag for check print out 1 ! ! ipr - integer, grid index for check print out 1 ! +! thsfc_loc- logical, flag for reference pressure in theta 1 ! ! ! ! input/outputs: ! li added for oceanic components @@ -199,6 +200,7 @@ subroutine sfc_nst_run & & use_flake ! &, icy logical, intent(in) :: lprnt + logical, intent(in) :: thsfc_loc ! --- input/outputs: ! control variables of dtl system (5+2) and sl (2) and coefficients for d(tz)/d(ts) calculation @@ -297,11 +299,13 @@ subroutine sfc_nst_run & wndmag(i) = sqrt(u1(i)*u1(i) + v1(i)*v1(i)) q0(i) = max(q1(i), 1.0e-8_kp) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer -#else - theta1(i) = t1(i) * prslki(i) -#endif + + if(thsfc_loc) then ! Use local potential temperature + theta1(i) = t1(i) * prslki(i) + else ! Use potential temperature referenced to 1000 hPa + theta1(i) = t1(i) / prslk1(i) ! potential temperature at the middle of lowest model layer + endif + tv1(i) = t1(i) * (one + rvrdm1*q0(i)) rho_a(i) = prsl1(i) / (rd*tv1(i)) qss(i) = fpvs(tsurf(i)) ! pa @@ -322,11 +326,12 @@ subroutine sfc_nst_run & ! at previous time step evap(i) = elocp * rch(i) * (qss(i) - q0(i)) qsurf(i) = qss(i) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) -#else - hflx(i) = rch(i) * (tsurf(i) - theta1(i)) -#endif + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tsurf(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tsurf(i)/prsik1(i) - theta1(i)) + endif ! if (lprnt .and. i == ipr) print *,' tskin=',tskin(i),' theta1=', ! & theta1(i),' hflx=',hflx(i),' t1=',t1(i),'prslki=',prslki(i) @@ -621,11 +626,13 @@ subroutine sfc_nst_run & qss(i) = eps*qss(i) / (ps(i) + epsm1*qss(i)) qsurf(i) = qss(i) evap(i) = elocp*rch(i) * (qss(i) - q0(i)) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) -#else - hflx(i) = rch(i) * (tskin(i) - theta1(i)) -#endif + + if(thsfc_loc) then ! Use local potential temperature + hflx(i) = rch(i) * (tskin(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflx(i) = rch(i) * (tskin(i)/prsik1(i) - theta1(i)) + endif + endif enddo endif ! if ( nstf_name1 > 1 ) then diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index a29f10f90..dc0056aeb 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -410,6 +410,14 @@ type = integer intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [tskin] standard_name = surface_skin_temperature_for_nsst long_name = ocean surface skin temperature diff --git a/physics/sfc_sice.f b/physics/sfc_sice.f index e739e724c..93f7ca16d 100644 --- a/physics/sfc_sice.f +++ b/physics/sfc_sice.f @@ -41,16 +41,17 @@ end subroutine sfc_sice_finalize !! !> @{ subroutine sfc_sice_run & - & ( im, kice, sbc, hvap, tgice, cp, eps, epsm1, rvrdm1, grav, & ! --- inputs: - & t0c, rd, ps, t1, q1, delt, & - & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & - & cm, ch, prsl1, prslki, prsik1, prslk1, wind, & - & flag_iter, lprnt, ipr, & - & hice, fice, tice, weasd, tskin, tprcp, tiice, ep, & ! --- input/outputs: - & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! - & frac_grid, icy, islmsk_cice, & - & min_lakeice, min_seaice, oceanfrac, & - & errmsg, errflg ) + & ( im, kice, sbc, hvap, tgice, cp, eps, epsm1, rvrdm1, grav, & ! --- inputs: + & t0c, rd, ps, t1, q1, delt, & + & sfcemis, dlwflx, sfcnsw, sfcdsw, srflag, & + & cm, ch, prsl1, prslki, prsik1, prslk1, wind, & + & flag_iter, lprnt, ipr, thsfc_loc, & + & hice, fice, tice, weasd, tskin, tprcp, tiice, ep, & ! --- input/outputs: + & snwdph, qsurf, snowmt, gflux, cmm, chh, evap, hflx, & ! + & frac_grid, icy, islmsk_cice, & + & min_lakeice, min_seaice, oceanfrac, & + & errmsg, errflg + & ) ! ===================================================================== ! ! description: ! @@ -110,6 +111,7 @@ subroutine sfc_sice_run & ! islimsk - integer, sea/land/ice mask (=0/1/2) im ! ! wind - real, im ! ! flag_iter- logical, im ! +! thsfc_loc- logical, reference pressure for potential temp im ! ! ! ! input/outputs: ! ! hice - real, sea-ice thickness im ! @@ -152,6 +154,7 @@ subroutine sfc_sice_run & ! --- inputs: integer, intent(in) :: im, kice, ipr logical, intent(in) :: lprnt + logical, intent(in) :: thsfc_loc logical, intent(in) :: frac_grid real (kind=kind_phys), intent(in) :: sbc, hvap, tgice, cp, eps, & @@ -276,11 +279,13 @@ subroutine sfc_sice_run & q0 = max(q1(i), qmin) ! tsurf(i) = tskin(i) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - theta1(i) = t1(i) / prslk1(i) ! potential temperature in middle of lowest atm. layer -#else - theta1(i) = t1(i) * prslki(i) -#endif + + if(thsfc_loc) then ! Use local potential temperature + theta1(i) = t1(i) * prslki(i) + else ! Use potential temperature referenced to 1000 hPa + theta1(i) = t1(i) / prslk1(i) ! potential temperature in middle of lowest atm. layer + endif + rho(i) = prsl1(i) / (rd*t1(i)*(one+rvrdm1*q0)) qs1 = fpvs(t1(i)) qs1 = max(eps*qs1 / (prsl1(i) + epsm1*qs1), qmin) @@ -333,13 +338,14 @@ subroutine sfc_sice_run & !> - Calculate net non-solar and upir heat flux @ ice surface \a hfi. -#ifdef GSD_SURFACE_FLUXES_BUGFIX - hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & - & + rch(i)*(tice(i)/prsik1(i) - theta1(i)) -#else - hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & - & + rch(i)*(tice(i) - theta1(i)) -#endif + if(thsfc_loc) then ! Use local potential temperature + hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & + & + rch(i)*(tice(i) - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hfi(i) = -dlwflx(i) + sfcemis(i)*sbc*t14 + evapi(i) & + & + rch(i)*(tice(i)/prsik1(i) - theta1(i)) + endif + !> - Calculate heat flux derivative at surface \a hfd. hfd(i) = 4.0_kind_phys*sfcemis(i)*sbc*tice(i)*t12 & & + (one + elocp*eps*hvap*qs1/(rd*t12)) * rch(i) @@ -415,13 +421,14 @@ subroutine sfc_sice_run & if (flag(i)) then ! --- ... calculate sensible heat flux (& evap over sea ice) -#ifdef GSD_SURFACE_FLUXES_BUGFIX - hflxi = rch(i) * (tice(i)/prsik1(i) - theta1(i)) - hflxw = rch(i) * (tgice / prsik1(i) - theta1(i)) -#else - hflxi = rch(i) * (tice(i) - theta1(i)) - hflxw = rch(i) * (tgice - theta1(i)) -#endif + if(thsfc_loc) then ! Use local potential temperature + hflxi = rch(i) * (tice(i) - theta1(i)) + hflxw = rch(i) * (tgice - theta1(i)) + else ! Use potential temperature referenced to 1000 hPa + hflxi = rch(i) * (tice(i)/prsik1(i) - theta1(i)) + hflxw = rch(i) * (tgice / prsik1(i) - theta1(i)) + endif + hflx(i) = fice(i)*hflxi + ffw(i)*hflxw evap(i) = fice(i)*evapi(i) + ffw(i)*evapw(i) ! diff --git a/physics/sfc_sice.meta b/physics/sfc_sice.meta index 4ce931bac..b256d54ff 100644 --- a/physics/sfc_sice.meta +++ b/physics/sfc_sice.meta @@ -281,6 +281,14 @@ type = integer intent = in optional = F +[thsfc_loc] + standard_name = flag_for_reference_pressure_theta + long_name = flag for reference pressure in theta calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [hice] standard_name = sea_ice_thickness long_name = sea-ice thickness