diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index e5f12189c..567cbbd32 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) @@ -614,6 +667,16 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%v1 ', Diag%v1) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%chh ', Diag%chh) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%cmm ', Diag%cmm) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dlwsfci ', Diag%dlwsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%ulwsfci ', Diag%ulwsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dswsfci ', Diag%dswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%nswsfci ', Diag%nswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%uswsfci ', Diag%uswsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dusfci ', Diag%dusfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dvsfci ', Diag%dvsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dtsfci ', Diag%dtsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dqsfci ', Diag%dqsfci) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%gfluxi ', Diag%gfluxi) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%epi ', Diag%epi) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%smcwlt2 ', Diag%smcwlt2) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%smcref2 ', Diag%smcref2) @@ -634,19 +697,21 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%shum_wts ', Diag%shum_wts) call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%zmtnblck ', Diag%zmtnblck) if (Model%ldiag3d) then - do itracer=2,Model%ntracp100 - do iprocess=1,Model%nprocess - idtend = Model%dtidx(itracer,iprocess) - if(idtend>=1) then - call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, & - 'dtend_'//Model%dtend_tracer_labels(itracer)//'_' & - //Model%dtend_cause_labels(iprocess), Diag%dtend(1,1,idtend)) - endif - enddo - enddo - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) - !call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) + !do itracer=2,Model%ntracp100 + ! do iprocess=1,Model%nprocess + ! idtend = Model%dtidx(itracer,iprocess) + ! if(idtend>=1) then + ! call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, & + ! 'dtend_'//Model%dtend_tracer_labels(itracer)//'_' & + ! //Model%dtend_cause_labels(iprocess), Diag%dtend(1,1,idtend)) + ! endif + ! enddo + !enddo + if (Model%qdiag3d) then + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%upd_mf ', Diag%upd_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%dwn_mf ', Diag%dwn_mf) + call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%det_mf ', Diag%det_mf) + end if end if if(Model%lradar) then call print_var(mpirank, omprank, blkno, Grid%xlat_d, Grid%xlon_d, 'Diag%refl_10cm ', Diag%refl_10cm) @@ -829,6 +894,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 ) @@ -837,17 +909,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 ) @@ -883,10 +955,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, & @@ -918,6 +993,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 @@ -1227,7 +1336,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 ) @@ -1251,6 +1359,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 ) @@ -1339,8 +1450,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 9d0e42643..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,12 +43,12 @@ 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, & norad_precip, idate, iflip, & - im, faerlw, faersw, aerodp, & ! for consistency checks + do_RRTMGP, im, faerlw, faersw, aerodp, & ! for consistency checks me, errmsg, errflg) ! ================= subprogram documentation block ================ ! ! ! @@ -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 @@ -188,6 +173,8 @@ subroutine GFS_rrtmg_setup_init ( & integer, intent(in) :: idate(:) integer, intent(in) :: iflip ! For consistency checks + + logical, intent(in) :: do_RRTMGP integer, intent(in) :: im real(kind_phys), intent(in) :: faerlw(:,:,:,:) real(kind_phys), intent(in) :: faersw(:,:,:,:) @@ -208,6 +195,12 @@ subroutine GFS_rrtmg_setup_init ( & errflg = 0 if (is_initialized) return + + if (do_RRTMGP) then + write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set to .false." + errflg = 1 + return + end if ! Consistency checks for dimensions of arrays, this is required ! to detect differences in FV3's parameters that are used to @@ -277,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 @@ -292,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, & @@ -448,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) ! @@ -489,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 ! ! ! @@ -499,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 @@ -521,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 @@ -543,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 @@ -598,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: @@ -614,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 @@ -623,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 513594ab2..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) @@ -185,6 +169,14 @@ type = integer intent = in optional = F +[do_RRTMGP] + standard_name = flag_for_rrtmgp_radiation_scheme + long_name = flag for RRTMGP scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [im] standard_name = horizontal_dimension long_name = horizontal dimension 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 a55c84ae7..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,13 +39,14 @@ module GFS_rrtmgp_setup !! \section arg_table_GFS_rrtmgp_setup_init !! \htmlinclude GFS_rrtmgp_setup_init.html !! - subroutine GFS_rrtmgp_setup_init(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 + logical, intent(in) :: do_RRTMGP integer, intent(in) :: & imp_physics, & ! Flag for MP scheme imp_physics_fer_hires, & ! Flag for fer-hires scheme @@ -58,8 +58,8 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics 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 @@ -75,14 +75,19 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics errflg = 0 if (is_initialized) return - + + ! Consistency checks + if (.not. do_RRTMGP) then + write(errmsg,'(*(a))') "Logic error: do_RRTMGP must be set to .true." + errflg = 1 + return + end if + ! Set radiation parameters isolar = isol ! solar constant control flag 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 @@ -105,8 +110,6 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics ' isol = ',isol, & ' ico2 = ',ico2, & ' iaer = ',iaer, & - ' ialb = ',ialb, & - ' iems = ',iems, & ' ntcw = ',ntcw print *,' np3d = ',num_p3d, & ' ntoz = ',ntoz, & @@ -118,14 +121,6 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics ' 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 @@ -135,7 +130,6 @@ subroutine GFS_rrtmgp_setup_init(imp_physics, imp_physics_fer_hires, imp_physics 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 7890d3d48..3d58d7fb0 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -2,12 +2,20 @@ 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] name = GFS_rrtmgp_setup_init type = scheme +[do_RRTMGP] + standard_name = flag_for_rrtmgp_radiation_scheme + long_name = flag for RRTMGP scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [imp_physics] standard_name = flag_for_microphysics_scheme long_name = choice of microphysics scheme @@ -123,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..48a4b7808 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, flag_restart, 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, flag_restart, 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 .or. flag_restart) .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..9caf9db04 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,22 @@ 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 +[flag_restart] + standard_name = flag_for_restart + long_name = flag for restart (warmstart) or coldstart + 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 +39,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 +198,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 +450,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 +556,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 +664,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 +866,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 +916,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 +956,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 +1035,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 +1044,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 +1053,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 +1379,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 +1882,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/cires_ugwp.F90 b/physics/cires_ugwp.F90 index a40da85ca..6efce96f5 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -40,7 +40,7 @@ module cires_ugwp ! subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & - pa_rf_in, tau_rf_in, con_p0, do_ugwp, errmsg, errflg) + pa_rf_in, tau_rf_in, con_p0, gwd_opt,do_ugwp, errmsg, errflg) !---- initialization of cires_ugwp implicit none @@ -58,6 +58,7 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & real(kind=kind_phys), intent (in) :: cdmbgwd(:), cgwf(:) ! "scaling" controls for "old" GFS-GW schemes real(kind=kind_phys), intent (in) :: pa_rf_in, tau_rf_in real(kind=kind_phys), intent (in) :: con_p0 + integer, intent(in) :: gwd_opt logical, intent (in) :: do_ugwp character(len=*), intent (in) :: fn_nml2 @@ -76,6 +77,14 @@ subroutine cires_ugwp_init (me, master, nlunit, input_nml_file, logunit, & errflg = 0 if (is_initialized) return + + ! Consistency checks + if (gwd_opt/=1) then + write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & + & drag is different from cires_ugwp scheme" + errflg = 1 + return + end if if (do_ugwp .or. cdmbgwd(3) > 0.0) then call cires_ugwpv0_mod_init (me, master, nlunit, input_nml_file, logunit, & diff --git a/physics/cires_ugwp.meta b/physics/cires_ugwp.meta index 643ea3f18..0d93f1820 100644 --- a/physics/cires_ugwp.meta +++ b/physics/cires_ugwp.meta @@ -155,6 +155,14 @@ kind = kind_phys intent = in optional = F +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [do_ugwp] standard_name = do_ugwp long_name = flag to activate CIRES UGWP diff --git a/physics/cu_gf_driver.F90 b/physics/cu_gf_driver.F90 index ffa10a8dd..157247f6a 100644 --- a/physics/cu_gf_driver.F90 +++ b/physics/cu_gf_driver.F90 @@ -23,10 +23,13 @@ module cu_gf_driver !! \section arg_table_cu_gf_driver_init Argument Table !! \htmlinclude cu_gf_driver_init.html !! - subroutine cu_gf_driver_init(mpirank, mpiroot, errmsg, errflg) + subroutine cu_gf_driver_init(imfshalcnv, imfshalcnv_gf, imfdeepcnv, & + imfdeepcnv_gf,mpirank, mpiroot, errmsg, errflg) implicit none - + + integer, intent(in) :: imfshalcnv, imfshalcnv_gf + integer, intent(in) :: imfdeepcnv, imfdeepcnv_gf integer, intent(in) :: mpirank integer, intent(in) :: mpiroot character(len=*), intent( out) :: errmsg @@ -44,6 +47,15 @@ subroutine cu_gf_driver_init(mpirank, mpiroot, errmsg, errflg) end if ! *DH temporary + ! Consistency checks + if (.not. (imfshalcnv == imfshalcnv_gf .or. & + & imfdeepcnv == imfdeepcnv_gf)) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' convection is different from Grell-Freitas scheme' + errflg = 1 + return + end if + end subroutine cu_gf_driver_init subroutine cu_gf_driver_finalize() diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index c6dcd1a33..84db197bc 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -7,6 +7,38 @@ [ccpp-arg-table] name = cu_gf_driver_init type = scheme +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_gf] + standard_name = flag_for_gf_shallow_convection_scheme + long_name = flag for Grell-Freitas shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_gf] + standard_name = flag_for_gf_deep_convection_scheme + long_name = flag for Grell-Freitas deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [mpirank] standard_name = mpi_rank long_name = current MPI-rank diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index 0fab755dc..c9b95a816 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -106,10 +106,13 @@ module cu_ntiedtke !! \section arg_table_cu_ntiedtke_init Argument Table !! \htmlinclude cu_ntiedtke_init.html !! - subroutine cu_ntiedtke_init(mpirank, mpiroot, errmsg, errflg) + subroutine cu_ntiedtke_init(imfshalcnv, imfshalcnv_ntiedtke, imfdeepcnv, & + imfdeepcnv_ntiedtke,mpirank, mpiroot, errmsg, errflg) implicit none + integer, intent(in) :: imfshalcnv, imfshalcnv_ntiedtke + integer, intent(in) :: imfdeepcnv, imfdeepcnv_ntiedtke integer, intent(in) :: mpirank integer, intent(in) :: mpiroot character(len=*), intent( out) :: errmsg @@ -127,6 +130,21 @@ subroutine cu_ntiedtke_init(mpirank, mpiroot, errmsg, errflg) end if ! *DH temporary + ! Consistency checks + if (imfshalcnv/=imfshalcnv_ntiedtke) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' shallow convection is different from new Tiedtke scheme' + errflg = 1 + return + end if + + if (imfdeepcnv/=imfdeepcnv_ntiedtke) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' deep convection is different from new Tiedtke scheme' + errflg = 1 + return + end if + end subroutine cu_ntiedtke_init subroutine cu_ntiedtke_finalize() diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index 70e977eed..4d4c6597a 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -7,6 +7,38 @@ [ccpp-arg-table] name = cu_ntiedtke_init type = scheme +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_ntiedtke] + standard_name = flag_for_ntiedtke_shallow_convection_scheme + long_name = flag for new Tiedtke shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_ntiedtke] + standard_name = flag_for_ntiedtke_deep_convection_scheme + long_name = flag for new Tiedtke deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [mpirank] standard_name = mpi_rank long_name = current MPI-rank diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 6ae2cefc7..9b110d689 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -7,7 +7,24 @@ module drag_suite contains - subroutine drag_suite_init() + subroutine drag_suite_init(gwd_opt, errmsg, errflg) + + integer, intent(in) :: gwd_opt + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (gwd_opt/=3 .and. gwd_opt/=33) then + write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & + & drag is different from drag_suite scheme" + errflg = 1 + return + end if end subroutine drag_suite_init ! \defgroup GFS_ogwd GFS Orographic Gravity Wave Drag @@ -201,7 +218,7 @@ subroutine drag_suite_run( & & do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & & dtend, dtidx, index_of_process_orographic_gwd, & & index_of_temperature, index_of_x_wind, & - & index_of_y_wind, ldiag3d, errmsg, errflg ) + & index_of_y_wind, ldiag3d, errmsg, errflg) ! ******************************************************************** ! -----> I M P L E M E N T A T I O N V E R S I O N <---------- @@ -487,8 +504,12 @@ subroutine drag_suite_run( & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - var_temp2 = 0. + ! Initialize local variables + var_temp2 = 0. + udtend = -1 + vdtend = -1 + Tdtend = -1 if(ldiag3d) then udtend = dtidx(index_of_x_wind,index_of_process_orographic_gwd) diff --git a/physics/drag_suite.meta b/physics/drag_suite.meta index 288075087..79f3af325 100644 --- a/physics/drag_suite.meta +++ b/physics/drag_suite.meta @@ -3,6 +3,36 @@ type = scheme dependencies = +######################################################################## +[ccpp-arg-table] + name = unified_ugwp_init + type = scheme +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + 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 = drag_suite_run diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index 97d12c3f6..4852310fc 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -14,7 +14,22 @@ module shoc contains -subroutine shoc_init () +subroutine shoc_init (do_shoc, errmsg, errflg) + implicit none + logical, intent(in) :: do_shoc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + +! Consistency checks + if (.not. do_shoc) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: do_shoc == .false.' + return + end if end subroutine shoc_init subroutine shoc_finalize () diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index 047286317..b021fa306 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -3,6 +3,36 @@ type = scheme dependencies = funcphys.f90,machine.F +######################################################################## +[ccpp-arg-table] + name = shoc_init + type = scheme +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + 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 = shoc_run diff --git a/physics/gscond.f b/physics/gscond.f index 6466d989d..1606bc93a 100644 --- a/physics/gscond.f +++ b/physics/gscond.f @@ -5,14 +5,50 @@ !> This module contains the CCPP-compliant zhao_carr_gscond scheme. module zhaocarr_gscond - contains + + implicit none + public :: zhaocarr_gscond_init, zhaocarr_gscond_run, & + & zhaocarr_gscond_finalize + private + logical :: is_initialized = .False. + contains ! \brief Brief description of the subroutine ! !> \section arg_table_zhaocarr_gscond_init Argument Table !! - subroutine zhaocarr_gscond_init + subroutine zhaocarr_gscond_init (imp_physics, & + & imp_physics_zhao_carr, & + & imp_physics_zhao_carr_pdf, & + & errmsg, errflg) + implicit none + + ! Interface variables + integer, intent(in ) :: imp_physics + integer, intent(in ) :: imp_physics_zhao_carr, & + & imp_physics_zhao_carr_pdf + + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + ! Consistency checks + if (imp_physics/=imp_physics_zhao_carr .and. & + & imp_physics/=imp_physics_zhao_carr_pdf) then + write(errmsg,'(*(a))') "Logic error: namelist choice of & + & microphysics is different from Zhao-Carr MP" + errflg = 1 + return + end if + + is_initialized = .true. end subroutine zhaocarr_gscond_init ! \brief Brief description of the subroutine diff --git a/physics/gscond.meta b/physics/gscond.meta index d8eb2f01e..006fe4472 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -7,6 +7,47 @@ [ccpp-arg-table] name = zhaocarr_gscond_init type = scheme +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + 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] diff --git a/physics/h2ophys.f b/physics/h2ophys.f index 17119f320..e21417e80 100644 --- a/physics/h2ophys.f +++ b/physics/h2ophys.f @@ -12,7 +12,22 @@ module h2ophys contains - subroutine h2ophys_init() + subroutine h2ophys_init(h2o_phys, errmsg, errflg) + + implicit none + logical, intent(in) :: h2o_phys + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.h2o_phys) then + write (errmsg,'(*(a))') 'Logic error: h2o_phys == .false.' + errflg = 1 + return + endif end subroutine h2ophys_init !>\defgroup GFS_h2ophys GFS Water Vapor Photochemical Production and Loss Module diff --git a/physics/h2ophys.meta b/physics/h2ophys.meta index 3275b89d2..c99e20ad9 100644 --- a/physics/h2ophys.meta +++ b/physics/h2ophys.meta @@ -3,6 +3,36 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = h2ophys_init + type = scheme +[h2o_phys] + standard_name = flag_for_stratospheric_water_vapor_physics + long_name = flag for stratospheric water vapor physics + units = flag + dimensions = () + type = logical + 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 = h2ophys_run diff --git a/physics/module_MYJPBL_wrapper.F90 b/physics/module_MYJPBL_wrapper.F90 index 8dd01ef9c..9010b4cdb 100644 --- a/physics/module_MYJPBL_wrapper.F90 +++ b/physics/module_MYJPBL_wrapper.F90 @@ -8,7 +8,22 @@ MODULE myjpbl_wrapper contains - subroutine myjpbl_wrapper_init () + subroutine myjpbl_wrapper_init (do_myjpbl,errmsg,errflg) + + logical, intent(in) :: do_myjpbl + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. do_myjpbl) then + write(errmsg,fmt='(*(a))') 'Logic error: do_myjpbl=.false.' + errflg = 1 + return + end if end subroutine myjpbl_wrapper_init subroutine myjpbl_wrapper_finalize () diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index acc35fe53..e9509d66c 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -3,6 +3,36 @@ type = scheme dependencies = module_BL_MYJPBL.F90 +######################################################################## +[ccpp-arg-table] + name = myjpbl_wrapper_init + type = scheme +[do_myjpbl] + standard_name = do_myjpbl + long_name = flag to activate MYJ PBL scheme + units = flag + dimensions = () + type = logical + 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 = myjpbl_wrapper_run diff --git a/physics/module_MYJSFC_wrapper.F90 b/physics/module_MYJSFC_wrapper.F90 index d908900c4..3d2b2e017 100644 --- a/physics/module_MYJSFC_wrapper.F90 +++ b/physics/module_MYJSFC_wrapper.F90 @@ -8,7 +8,23 @@ MODULE myjsfc_wrapper contains - subroutine myjsfc_wrapper_init () + subroutine myjsfc_wrapper_init (do_myjsfc, & + & errmsg,errflg) + + logical, intent(in) :: do_myjsfc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. do_myjsfc) then + write(errmsg,fmt='(*(a))') 'Logic error: do_myjsfc = .false.' + errflg = 1 + return + end if end subroutine myjsfc_wrapper_init subroutine myjsfc_wrapper_finalize () diff --git a/physics/module_MYJSFC_wrapper.meta b/physics/module_MYJSFC_wrapper.meta index f3ec33193..828e584e1 100644 --- a/physics/module_MYJSFC_wrapper.meta +++ b/physics/module_MYJSFC_wrapper.meta @@ -3,6 +3,36 @@ type = scheme dependencies = module_SF_JSFC.F90 +######################################################################## +[ccpp-arg-table] + name = myjsfc_wrapper_init + type = scheme +[do_myjsfc] + standard_name = do_myjsfc + long_name = flag to activate MYJ surface layer scheme + units = flag + dimensions = () + type = logical + 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 = myjsfc_wrapper_run diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 4e43b2cbc..532fc7b16 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -13,9 +13,10 @@ MODULE mynnedmf_wrapper !> \section arg_table_mynnedmf_wrapper_init Argument Table !! \htmlinclude mynnedmf_wrapper_init.html !! - subroutine mynnedmf_wrapper_init (lheatstrg, errmsg, errflg) + subroutine mynnedmf_wrapper_init (do_mynnedmf, lheatstrg, errmsg, errflg) implicit none - + + logical, intent(in) :: do_mynnedmf logical, intent(in) :: lheatstrg character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -24,6 +25,13 @@ subroutine mynnedmf_wrapper_init (lheatstrg, errmsg, errflg) errmsg = '' errflg = 0 + ! Consistency checks + if (.not. do_mynnedmf) then + errmsg = 'Logic error: do_mynnedmf = .false.' + errflg = 1 + return + end if + if (lheatstrg) then errmsg = 'Logic error: lheatstrg not implemented for MYNN PBL' errflg = 1 diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 3a5909e23..453fb8963 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = mynnedmf_wrapper_init type = scheme +[do_mynnedmf] + standard_name = do_mynnedmf + long_name = flag to activate MYNN-EDMF + units = flag + dimensions = () + type = logical + intent = in + optional = F [lheatstrg] standard_name = flag_for_canopy_heat_storage long_name = flag for canopy heat storage parameterization diff --git a/physics/module_MYNNSFC_wrapper.F90 b/physics/module_MYNNSFC_wrapper.F90 index 2de8cd408..a27b02e0d 100644 --- a/physics/module_MYNNSFC_wrapper.F90 +++ b/physics/module_MYNNSFC_wrapper.F90 @@ -15,8 +15,10 @@ MODULE mynnsfc_wrapper !! \htmlinclude mynnsfc_wrapper_init.html !! - subroutine mynnsfc_wrapper_init(errmsg, errflg) + subroutine mynnsfc_wrapper_init(do_mynnsfclay, & + & errmsg, errflg) + logical, intent(in) :: do_mynnsfclay character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -24,6 +26,13 @@ subroutine mynnsfc_wrapper_init(errmsg, errflg) errmsg = '' errflg = 0 + ! Consistency checks + if (.not. do_mynnsfclay) then + write(errmsg,fmt='(*(a))') 'Logic error: do_mynnsfclay = .false.' + errflg = 1 + return + end if + ! initialize tables for psih and psim (stable and unstable) CALL PSI_INIT(psi_opt,errmsg,errflg) diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index 1f16ff161..d082752c4 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = mynnsfc_wrapper_init type = scheme +[do_mynnsfclay] + standard_name = do_mynnsfclay + long_name = flag to activate MYNN surface layer + units = flag + dimensions = () + type = logical + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -756,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/moninedmf.f b/physics/moninedmf.f index 8fca7638d..19e055da4 100644 --- a/physics/moninedmf.f +++ b/physics/moninedmf.f @@ -11,16 +11,26 @@ module hedmf !> \section arg_table_hedmf_init Argument Table !! \htmlinclude hedmf_init.html !! - subroutine hedmf_init (moninq_fac,errmsg,errflg) + subroutine hedmf_init (hybedmf,moninq_fac,errmsg,errflg) use machine, only : kind_phys implicit none - real(kind=kind_phys), intent(in ) :: moninq_fac + + logical, intent(in) :: hybedmf + + real(kind=kind_phys), intent(in) :: moninq_fac character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + ! Consistency checks + if (.not. hybedmf) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: hybedmf = .false.' + return + end if + if (moninq_fac == 0) then errflg = 1 write(errmsg,'(*(a))') 'Logic error: moninq_fac == 0', diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 3af1a8fc8..ac1d5006c 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = hedmf_init type = scheme +[hybedmf] + standard_name = flag_for_hedmf + long_name = flag for hybrid edmf pbl scheme (moninedmf) + units = flag + dimensions = () + type = logical + intent = in + optional = F [moninq_fac] standard_name = atmosphere_diffusivity_coefficient_factor long_name = multiplicative constant for atmospheric diffusivities diff --git a/physics/moninshoc.f b/physics/moninshoc.f index e287d3389..4e9e60b46 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -6,7 +6,24 @@ module moninshoc contains - subroutine moninshoc_init () + subroutine moninshoc_init (do_shoc, errmsg, errflg) + + implicit none + logical, intent(in) :: do_shoc + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. do_shoc) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: do_shoc = .false.' + return + end if + end subroutine moninshoc_init subroutine moninshoc_finalize () diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index e54795267..aeb337a95 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -3,6 +3,36 @@ type = scheme dependencies = funcphys.f90,machine.F,tridi.f +######################################################################## +[ccpp-arg-table] + name = moninshoc_init + type = scheme +[do_shoc] + standard_name = flag_for_shoc + long_name = flag for SHOC + units = flag + dimensions = () + type = logical + 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 = moninshoc_run diff --git a/physics/precpd.f b/physics/precpd.f index 2cc2e169a..2279356b3 100644 --- a/physics/precpd.f +++ b/physics/precpd.f @@ -4,9 +4,44 @@ !> This module contains the CCPP-compliant zhao_carr_precpd scheme. module zhaocarr_precpd + + implicit none + public :: zhaocarr_precpd_init, zhaocarr_precpd_run, & + & zhaocarr_precpd_finalize + private + logical :: is_initialized = .False. contains - subroutine zhaocarr_precpd_init () + subroutine zhaocarr_precpd_init (imp_physics, & + & imp_physics_zhao_carr, & + & imp_physics_zhao_carr_pdf, & + & errmsg, errflg) + implicit none + + ! Interface variables + integer, intent(in ) :: imp_physics + integer, intent(in ) :: imp_physics_zhao_carr, & + & imp_physics_zhao_carr_pdf + ! CCPP error handling + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (is_initialized) return + + ! Consistency checks + if (imp_physics/=imp_physics_zhao_carr .and. & + & imp_physics/=imp_physics_zhao_carr_pdf) then + write(errmsg,'(*(a))') "Logic error: namelist choice of & + & microphysics is different from Zhao-Carr MP" + errflg = 1 + return + end if + + is_initialized = .true. end subroutine zhaocarr_precpd_init !> \defgroup precip GFS precpd Main diff --git a/physics/precpd.meta b/physics/precpd.meta index 715991990..4a8009113 100644 --- a/physics/precpd.meta +++ b/physics/precpd.meta @@ -3,6 +3,52 @@ type = scheme dependencies = funcphys.f90,machine.F,physcons.F90 +######################################################################## +[ccpp-arg-table] + name = zhaocarr_precpd_init + type = scheme +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr] + standard_name = flag_for_zhao_carr_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imp_physics_zhao_carr_pdf] + standard_name = flag_for_zhao_carr_pdf_microphysics_scheme + long_name = choice of Zhao-Carr microphysics scheme with PDF clouds + 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 = zhaocarr_precpd_run 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/samfdeepcnv.f b/physics/samfdeepcnv.f index a0d884e03..425aa92a9 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -10,7 +10,23 @@ module samfdeepcnv contains - subroutine samfdeepcnv_init() + subroutine samfdeepcnv_init(imfdeepcnv,imfdeepcnv_samf, & + & errmsg, errflg) + + integer, intent(in) :: imfdeepcnv + integer, intent(in) :: imfdeepcnv_samf + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + + ! Consistency checks + if (imfdeepcnv/=imfdeepcnv_samf) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' deep convection is different from SAMF scheme' + errflg = 1 + return + end if + end subroutine samfdeepcnv_init subroutine samfdeepcnv_finalize() diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 802aeb50a..ff3c0d115 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -3,6 +3,44 @@ type = scheme dependencies = funcphys.f90,machine.F,samfaerosols.F +######################################################################## +[ccpp-arg-table] + name = samfdeepcnv_init + type = scheme +[imfdeepcnv] + standard_name = flag_for_mass_flux_deep_convection_scheme + long_name = flag for mass-flux deep convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfdeepcnv_samf] + standard_name = flag_for_samf_deep_convection_scheme + long_name = flag for SAMF deep convection scheme + 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 = samfdeepcnv_run diff --git a/physics/samfshalcnv.f b/physics/samfshalcnv.f index f2a22b38c..1697cfe35 100644 --- a/physics/samfshalcnv.f +++ b/physics/samfshalcnv.f @@ -9,7 +9,23 @@ module samfshalcnv contains - subroutine samfshalcnv_init() + subroutine samfshalcnv_init(imfshalcnv, imfshalcnv_samf, & + & errmsg, errflg) + + integer, intent(in) :: imfshalcnv + integer, intent(in) :: imfshalcnv_samf + + ! CCPP error handling + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Consistency checks + if (imfshalcnv/=imfshalcnv_samf) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of', & + & ' shallow convection is different from SAMF' + errflg = 1 + return + end if end subroutine samfshalcnv_init subroutine samfshalcnv_finalize() diff --git a/physics/samfshalcnv.meta b/physics/samfshalcnv.meta index 7f5421b70..a454da3e7 100644 --- a/physics/samfshalcnv.meta +++ b/physics/samfshalcnv.meta @@ -3,6 +3,44 @@ type = scheme dependencies = funcphys.f90,machine.F,samfaerosols.F +######################################################################## +[ccpp-arg-table] + name = samfshalcnv_init + type = scheme +[imfshalcnv] + standard_name = flag_for_mass_flux_shallow_convection_scheme + long_name = flag for mass-flux shallow convection scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[imfshalcnv_samf] + standard_name = flag_for_samf_shallow_convection_scheme + long_name = flag for SAMF shallow convection scheme + 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 = samfshalcnv_run diff --git a/physics/satmedmfvdif.F b/physics/satmedmfvdif.F index 26412d066..feb4ef870 100644 --- a/physics/satmedmfvdif.F +++ b/physics/satmedmfvdif.F @@ -10,9 +10,11 @@ module satmedmfvdif !> \section arg_table_satmedmfvdif_init Argument Table !! \htmlinclude satmedmfvdif_init.html !! - subroutine satmedmfvdif_init (isatmedmf,isatmedmf_vdif, + subroutine satmedmfvdif_init (satmedmf, + & isatmedmf,isatmedmf_vdif, & errmsg,errflg) + logical, intent(in) :: satmedmf integer, intent(in) :: isatmedmf,isatmedmf_vdif character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -21,6 +23,13 @@ subroutine satmedmfvdif_init (isatmedmf,isatmedmf_vdif, errmsg = '' errflg = 0 +! Consistency checks + if (.not. satmedmf) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmf = .false.' + errflg = 1 + return + end if + if (.not. isatmedmf==isatmedmf_vdif) then write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', & 'called, but isatmedmf/=isatmedmf_vdif.' diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 612ec0601..40bc129bc 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -7,6 +7,16 @@ [ccpp-arg-table] name = satmedmfvdif_init type = scheme +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F + intent = in + optional = F [isatmedmf] standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL long_name = choice of scale-aware TKE moist EDMF PBL scheme diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 18da6f2b0..a165df5c7 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -19,10 +19,13 @@ module satmedmfvdifq !> \section arg_table_satmedmfvdifq_init Argument Table !! \htmlinclude satmedmfvdifq_init.html !! - subroutine satmedmfvdifq_init (isatmedmf,isatmedmf_vdifq, + subroutine satmedmfvdifq_init (satmedmf, + & isatmedmf,isatmedmf_vdifq, & errmsg,errflg) + logical, intent(in ) :: satmedmf integer, intent(in) :: isatmedmf,isatmedmf_vdifq + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -30,6 +33,13 @@ subroutine satmedmfvdifq_init (isatmedmf,isatmedmf_vdifq, errmsg = '' errflg = 0 +! Consistency checks + if (.not. satmedmf) then + write(errmsg,fmt='(*(a))') 'Logic error: satmedmf = .false.' + errflg = 1 + return + end if + if (.not. isatmedmf==isatmedmf_vdifq) then write(errmsg,fmt='(*(a))') 'Logic error: satmedmfvdif is ', & 'called, but isatmedmf/=isatmedmf_vdifq.' diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index b8f8a6e4d..e0a5dba26 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -7,6 +7,14 @@ [ccpp-arg-table] name = satmedmfvdifq_init type = scheme +[satmedmf] + standard_name = flag_for_scale_aware_TKE_moist_EDMF_PBL + long_name = flag for scale-aware TKE moist EDMF PBL scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F [isatmedmf] standard_name = choice_of_scale_aware_TKE_moist_EDMF_PBL long_name = choice of scale-aware TKE moist EDMF PBL scheme 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.f b/physics/sfc_drv.f index 1f786b496..d50a8505e 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -21,10 +21,12 @@ module lsm_noah !! \section arg_table_lsm_noah_init Argument Table !! \htmlinclude lsm_noah_init.html !! - subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, + subroutine lsm_noah_init(lsm, lsm_noah, me, isot, ivegsrc, nlunit, & pores, resid, errmsg, errflg) implicit none + integer, intent(in) :: lsm + integer, intent(in) :: lsm_noah integer, intent(in) :: me, isot, ivegsrc, nlunit @@ -37,6 +39,14 @@ subroutine lsm_noah_init(me, isot, ivegsrc, nlunit, errmsg = '' errflg = 0 + ! Consistency checks + if (lsm/=lsm_noah) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', + & 'LSM is different from Noah' + errflg = 1 + return + end if + if (ivegsrc > 2) then errmsg = 'The NOAH LSM expects that the ivegsrc physics '// & 'namelist parameter is 0, 1, or 2. Exiting...' diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index 9f2e51df3..c68102e7e 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -7,6 +7,22 @@ [ccpp-arg-table] name = lsm_noah_init type = scheme +[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_noah] + standard_name = flag_for_noah_land_surface_scheme + long_name = flag for NOAH land surface model + units = flag + dimensions = () + type = integer + intent = in + optional = F [me] standard_name = mpi_rank long_name = current MPI-rank diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 916144cf5..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 @@ -79,6 +117,14 @@ subroutine lsm_ruc_init (me, master, isot, ivegsrc, nlunit, & ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + + ! Consistency checks + if (lsm/=lsm_ruc) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & + & 'LSM is different from RUC' + errflg = 1 + return + end if ipr = 10 debug_print = .false. @@ -141,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 ) @@ -207,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 ! @@ -267,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 @@ -289,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, & @@ -307,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: @@ -318,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 @@ -367,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, & @@ -376,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, & @@ -400,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, & @@ -414,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, & @@ -452,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 ! @@ -469,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) @@ -762,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 @@ -800,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): @@ -827,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 @@ -887,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. @@ -957,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), & @@ -1095,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) @@ -1114,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 @@ -1141,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. @@ -1189,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), & @@ -1206,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 ) @@ -1235,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) @@ -1473,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.F90 b/physics/sfc_noahmp_drv.F90 index a1f65f26a..129601e94 100644 --- a/physics/sfc_noahmp_drv.F90 +++ b/physics/sfc_noahmp_drv.F90 @@ -25,7 +25,8 @@ module noahmpdrv !! \section arg_table_noahmpdrv_init Argument Table !! \htmlinclude noahmpdrv_init.html !! - subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & + subroutine noahmpdrv_init(lsm, lsm_noahmp, me, isot, ivegsrc, & + nlunit, pores, resid, & errmsg, errflg) use machine, only: kind_phys @@ -33,7 +34,8 @@ subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & use namelist_soilveg implicit none - + integer, intent(in) :: lsm + integer, intent(in) :: lsm_noahmp integer, intent(in) :: me, isot, ivegsrc, nlunit real (kind=kind_phys), dimension(:), intent(out) :: pores, resid @@ -45,6 +47,14 @@ subroutine noahmpdrv_init(me, isot, ivegsrc, nlunit, pores, resid, & errmsg = '' errflg = 0 + ! Consistency checks + if (lsm/=lsm_noahmp) then + write(errmsg,'(*(a))') 'Logic error: namelist choice of ', & + & 'LSM is different from Noah' + errflg = 1 + return + end if + if (ivegsrc /= 1) then errmsg = 'The NOAHMP LSM expects that the ivegsrc physics '// & 'namelist parameter is 1. Exiting...' diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 76811a378..949f0d6a6 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -7,6 +7,22 @@ [ccpp-arg-table] name = noahmpdrv_init type = scheme +[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 [me] standard_name = mpi_rank long_name = current MPI-rank @@ -1018,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 @@ -1027,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 @@ -1036,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 @@ -1045,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 @@ -1054,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 diff --git a/physics/shinhongvdif.F90 b/physics/shinhongvdif.F90 index dbd21d255..7c476e0b8 100644 --- a/physics/shinhongvdif.F90 +++ b/physics/shinhongvdif.F90 @@ -11,7 +11,22 @@ module shinhongvdif contains - subroutine shinhongvdif_init () + subroutine shinhongvdif_init (shinhong,errmsg,errflg) + + logical, intent(in) :: shinhong + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. shinhong) then + write(errmsg,fmt='(*(a))') 'Logic error: shinhong = .false.' + errflg = 1 + return + end if end subroutine shinhongvdif_init subroutine shinhongvdif_finalize () diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index 41e177695..eed8fee71 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -3,6 +3,36 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = shinhongvdif_init + type = scheme +[shinhong] + standard_name = flag_for_scale_aware_Shinhong_PBL + long_name = flag for scale-aware Shinhong PBL scheme + units = flag + dimensions = () + type = logical + 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 = shinhongvdif_run diff --git a/physics/ugwpv1_gsldrag.F90 b/physics/ugwpv1_gsldrag.F90 index 518aefab4..104fc8e3f 100644 --- a/physics/ugwpv1_gsldrag.F90 +++ b/physics/ugwpv1_gsldrag.F90 @@ -429,8 +429,7 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd ! real(kind=kind_phys), intent(inout), dimension(:,:) :: dudt, dvdt, dtdt - ! dtend is only allocated if ldiag=.true. - real(kind=kind_phys), optional, intent(inout) :: dtend(:,:,:) + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), & index_of_x_wind, index_of_y_wind, index_of_temperature, & index_of_process_orographic_gwd, index_of_process_nonorographic_gwd @@ -548,16 +547,18 @@ subroutine ugwpv1_gsldrag_run(me, master, im, levs, ntrac, lonr, dtp, fhzero,kd kpbl,prsi,del,prsl,prslk,phii,phil,dtp, & kdt,hprime,oc,oa4,clx,varss,oc1ss,oa4ss, & ol4ss,theta,sigma,gamma,elvmax, & - dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & - dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & - dusfcg, dvsfcg, & - du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & - du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & + dudt_ogw, dvdt_ogw, dudt_obl, dvdt_obl, & + dudt_oss, dvdt_oss, dudt_ofd, dvdt_ofd, & + dusfcg, dvsfcg, & + du_ogwcol, dv_ogwcol, du_oblcol, dv_oblcol, & + du_osscol, dv_osscol, du_ofdcol, dv_ofdcol, & slmsk,br1,hpbl, con_g,con_cp,con_rd,con_rv, & con_fv, con_pi, lonr, & cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & - errmsg,errflg) + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, errmsg, errflg) ! ! dusfcg = du_ogwcol + du_oblcol + du_osscol + du_ofdcol ! diff --git a/physics/ugwpv1_gsldrag.meta b/physics/ugwpv1_gsldrag.meta index c751b901c..5cfae9dd1 100644 --- a/physics/ugwpv1_gsldrag.meta +++ b/physics/ugwpv1_gsldrag.meta @@ -1156,7 +1156,6 @@ dimensions = (horizontal_loop_extent,vertical_dimension,number_of_cumulative_change_processes) type = real kind = kind_phys - active = (flag_diagnostics_3D) intent = inout optional = F [dtidx] diff --git a/physics/unified_ugwp.F90 b/physics/unified_ugwp.F90 index 597d6ba0e..da79ecde8 100644 --- a/physics/unified_ugwp.F90 +++ b/physics/unified_ugwp.F90 @@ -63,7 +63,7 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & fn_nml2, jdat, lonr, latr, levs, ak, bk, dtp, cdmbgwd, cgwf, & con_pi, con_rerth, pa_rf_in, tau_rf_in, con_p0, do_ugwp, & do_ugwp_v0, do_ugwp_v0_orog_only, do_ugwp_v0_nst_only, & - do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, & + do_gsl_drag_ls_bl, do_gsl_drag_ss, do_gsl_drag_tofd, gwd_opt, & errmsg, errflg) !---- initialization of unified_ugwp @@ -96,7 +96,8 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & logical :: exists real :: dxsg integer :: k - + + integer, intent(in) :: gwd_opt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -104,6 +105,13 @@ subroutine unified_ugwp_init (me, master, nlunit, input_nml_file, logunit, & errmsg = '' errflg = 0 + ! Consistency checks + if (gwd_opt/=2 .and. gwd_opt/=22) then + write(errmsg,'(*(a))') "Logic error: namelist choice of gravity wave & + & drag is different from unified_ugwp scheme" + errflg = 1 + return + end if ! Test to make sure that at most only one large-scale/blocking ! orographic drag scheme is chosen @@ -260,8 +268,7 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, real(kind=kind_phys), intent(out), dimension(:,:) :: dudt_mtb, dudt_tms real(kind=kind_phys), intent(out), dimension(:,:) :: dtaux2d_ls, dtauy2d_ls - ! The dtend array is are only allocated if ldiag=.true. - real(kind=kind_phys), intent(inout), optional :: dtend(:,:,:) + real(kind=kind_phys), intent(inout) :: dtend(:,:,:) integer, intent(in) :: dtidx(:,:), index_of_temperature, index_of_x_wind, & index_of_y_wind, index_of_process_nonorographic_gwd, & index_of_process_orographic_gwd @@ -332,9 +339,11 @@ subroutine unified_ugwp_run(me, master, im, levs, ntrac, dtp, fhzero, kdt, dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd, & slmsk,br1,hpbl,con_g,con_cp,con_rd,con_rv, & con_fvirt,con_pi,lonr, & - cdmbgwd(1:2),me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & + cdmbgwd,me,master,lprnt,ipr,rdxzb,dx,gwd_opt, & do_gsl_drag_ls_bl,do_gsl_drag_ss,do_gsl_drag_tofd, & - errmsg,errflg) + dtend, dtidx, index_of_process_orographic_gwd, & + index_of_temperature, index_of_x_wind, & + index_of_y_wind, ldiag3d, errmsg, errflg) ! ! put zeros due to xy GSL-drag style: dtaux2d_bl,dtauy2d_bl,dtaux2d_ss.......dusfc_ls,dvsfc_ls ! diff --git a/physics/unified_ugwp.meta b/physics/unified_ugwp.meta index fa84f9b48..a20911645 100644 --- a/physics/unified_ugwp.meta +++ b/physics/unified_ugwp.meta @@ -238,6 +238,14 @@ type = logical intent = in optional = F +[gwd_opt] + standard_name = gwd_opt + long_name = flag to choose gwd scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index 73f078d01..bed2f2a66 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -11,7 +11,22 @@ module ysuvdif contains - subroutine ysuvdif_init () + subroutine ysuvdif_init (do_ysu,errmsg,errflg) + + logical, intent(in) :: do_ysu + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + ! Consistency checks + if (.not. do_ysu) then + write(errmsg,fmt='(*(a))') 'Logic error: do_ysu = .false.' + errflg = 1 + return + end if end subroutine ysuvdif_init subroutine ysuvdif_finalize () diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index 5474d9a80..ba3516f7d 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -3,6 +3,36 @@ type = scheme dependencies = machine.F +######################################################################## +[ccpp-arg-table] + name = ysuvdif_init + type = scheme +[do_ysu] + standard_name = flag_for_ysu + long_name = flag for YSU PBL scheme + units = flag + dimensions = () + type = logical + 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 = ysuvdif_run