diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index 727f735ee..8a912544a 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -732,8 +732,8 @@ intent = inout optional = F [do_sppt] - standard_name = flag_for_stochastic_surface_physics_perturbations - long_name = flag for stochastic surface physics perturbations + standard_name = flag_for_stochastic_physics_perturbations + long_name = flag for stochastic physics perturbations units = flag dimensions = () type = logical diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index 0562324ee..aba480382 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -484,7 +484,7 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts ) call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts ) end if - if (Model%do_sfcperts) then + if (Model%lndp_type .NE. 0) then call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts' , Coupling%sfc_wts ) end if if (Model%do_ca) then diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index 6dc14497a..31099819c 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -931,12 +931,15 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input ! perturbation size ! --- turn vegetation fraction pattern into percentile pattern alb1d(:) = 0. - if (Model%do_sfcperts) then - if (Model%pertalb(1) > 0.) then - do i=1,im - call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + if (Model%lndp_type==1) then + do k =1,Model%n_var_lndp + if (Model%lndp_var_list(k) == 'alb') then + do i=1,im + call cdfnor(Coupling%sfc_wts(i,k),alb1d(i)) + !lndp_alb = Model%lndp_prt_list(k) + enddo + endif enddo - endif endif ! mg, sfc-perts diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index c4208d872..f6aac60b1 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -27,8 +27,9 @@ 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, nsfcpert, lsswr, do_sfcperts, solhr, & - pertalb, lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf, & + subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, lndp_type, n_var_lndp,lndp_var_list, & + lndp_prt_list, lsswr, solhr, & + lon, coslat, sinlat, snowd, sncovr, snoalb, zorl, tsfc, hprime, alvsf, & alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, lsmask, sfc_wts, p_lay, tv_lay, & relhum, p_lev, sw_gas_props, & nday, idxday, alb1d, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, & @@ -39,14 +40,16 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, s me, & ! Current MPI rank nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers - nsfcpert ! Number of surface perturbations + n_var_lndp, & ! Number of surface variables perturbed + lndp_type ! Type of land perturbations scheme used + character(len=3), dimension(n_var_lndp), intent(in) :: & + lndp_var_list + real(kind_phys), dimension(n_var_lndp), intent(in) :: & + lndp_prt_list logical,intent(in) :: & - lsswr, & ! Call RRTMGP SW radiation? - do_sfcperts + lsswr ! Call RRTMGP SW radiation? real(kind_phys), intent(in) :: & - solhr ! Time in hours after 00z at the current timestep - real(kind_phys), dimension(5), intent(in) :: & - pertalb ! Magnitude of surface albedo perturbation (frac) + solhr ! Time in hours after 00z at the current timestep real(kind_phys), dimension(nCol), intent(in) :: & lsmask, & ! Landmask: sea/land/ice=0/1/2 lon, & ! Longitude @@ -66,7 +69,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, s 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(nCol,nsfcpert), intent(in) :: & + real(kind_phys), dimension(nCol,n_var_lndp), intent(in) :: & sfc_wts ! Weights for stochastic surface physics perturbation () real(kind_phys), dimension(nCol,nLev),intent(in) :: & p_lay, & ! Layer pressure @@ -100,6 +103,7 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, s ! Local variables integer :: i, j, iCol, iBand, iLay real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb + real(kind_phys) :: lndp_alb ! Initialize CCPP error handling variables errmsg = '' @@ -130,13 +134,17 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, nLev, nsfcpert, lsswr, do_sfcperts, s ! --- turn vegetation fraction pattern into percentile pattern ! ####################################################################################### alb1d(:) = 0. - if (do_sfcperts) then - if (pertalb(1) > 0.) then + lndp_alb = -999. + if (lndp_type ==1) then + do k =1,n_var_lndp + if (lndp_var_list(k) == 'alb') then do i=1,ncol - call cdfnor(sfc_wts(i,5),alb1d(i)) + call cdfnor(sfc_wts(i,k),alb1d(i)) + lndp_alb = lndp_prt_list(k) enddo - endif - endif + endif + enddo + endif ! ####################################################################################### ! Call module_radiation_surface::setalb() to setup surface albedo. diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 1cccf6ffd..543c56bbf 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -25,25 +25,43 @@ type = integer intent = in optional = F -[nsfcpert] - standard_name = number_of_surface_perturbations - long_name = number of surface perturbations +[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 - units = flag +[lndp_type] + standard_name = index_for_stochastic_land_surface_perturbation_type + long_name = index for stochastic land surface perturbations type + units = index dimensions = () - type = logical + type = integer + 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 +[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 -[do_sfcperts] - standard_name = flag_for_stochastic_surface_perturbations - long_name = flag for stochastic surface perturbations option +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls units = flag dimensions = () type = logical @@ -58,15 +76,6 @@ kind = kind_phys intent = in optional = F -[pertalb] - standard_name = magnitude_of_surface_albedo_perturbation - long_name = magnitude of surface albedo perturbation - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in - optional = F [lon] standard_name = longitude long_name = longitude diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index bd0dbf487..0849e49bc 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -26,8 +26,8 @@ intent = in optional = F [do_sppt] - standard_name = flag_for_stochastic_surface_physics_perturbations - long_name = flag for stochastic surface physics perturbations + standard_name = flag_for_stochastic_physics_perturbations + long_name = flag for stochastic physics perturbations units = flag dimensions = () type = logical diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 337e4c58d..b6d4dfb02 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -27,8 +27,9 @@ 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, do_sppt, ca_global,dtdtr,& - drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, do_sfcperts, nsfcpert, sfc_wts, & - pertz0, pertzt, pertshc, pertlai, pertvegf, z01d, zt1d, bexp1d, xlai1d, vegf1d, & + 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, & cplflx, flag_cice, islmsk_cice, slimskin_cpl, tisfc, tsfco, fice, hice, & wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg) @@ -56,19 +57,17 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(out) :: dsnow_cpl real(kind=kind_phys), dimension(im), intent(in) :: rain_cpl real(kind=kind_phys), dimension(im), intent(in) :: snow_cpl - logical, intent(in) :: do_sfcperts - integer, intent(in) :: nsfcpert - real(kind=kind_phys), dimension(im,nsfcpert), intent(in) :: sfc_wts - real(kind=kind_phys), dimension(:), intent(in) :: pertz0 - real(kind=kind_phys), dimension(:), intent(in) :: pertzt - real(kind=kind_phys), dimension(:), intent(in) :: pertshc - real(kind=kind_phys), dimension(:), intent(in) :: pertlai - real(kind=kind_phys), dimension(:), intent(in) :: pertvegf + integer, intent(in) :: lndp_type + integer, intent(in) :: n_var_lndp + character(len=3), dimension(n_var_lndp), intent(in) :: lndp_var_list + real(kind=kind_phys), dimension(n_var_lndp), intent(in) :: lndp_prt_list + real(kind=kind_phys), dimension(im,n_var_lndp), intent(in) :: sfc_wts real(kind=kind_phys), dimension(im), intent(out) :: z01d real(kind=kind_phys), dimension(im), intent(out) :: zt1d real(kind=kind_phys), dimension(im), intent(out) :: bexp1d real(kind=kind_phys), dimension(im), intent(out) :: xlai1d real(kind=kind_phys), dimension(im), intent(out) :: vegf1d + real(kind=kind_phys), intent(out) :: lndp_vgf logical, intent(in) :: cplflx real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl @@ -89,7 +88,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, integer, intent(out) :: errflg ! Local variables - integer :: i + integer :: i, k real(kind=kind_phys) :: onebg real(kind=kind_phys) :: cdfz @@ -107,34 +106,28 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, ! Scale random patterns for surface perturbations with perturbation size ! Turn vegetation fraction pattern into percentile pattern - if (do_sfcperts) then - if (pertz0(1) > zero) then - z01d(:) = pertz0(1) * sfc_wts(:,1) -! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) -! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) - endif - if (pertzt(1) > zero) then - zt1d(:) = pertzt(1) * sfc_wts(:,2) - endif - if (pertshc(1) > zero) then - bexp1d(:) = pertshc(1) * sfc_wts(:,3) - endif - if (pertlai(1) > zero) then - xlai1d(:) = pertlai(1) * sfc_wts(:,4) - endif -! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! -! if (pertalb(1) > 0.) then -! do i=1,im -! call cdfnor(sfc_wts(i,5),cdfz) -! alb1d(i) = cdfz -! enddo -! endif - if (pertvegf(1) > zero) then - do i=1,im - call cdfnor(sfc_wts(i,6),cdfz) - vegf1d(i) = cdfz - enddo - endif + lndp_vgf=-999. + + if (lndp_type==1) then + do k =1,n_var_lndp + select case(lndp_var_list(k)) + case ('rz0') + z01d(:) = lndp_prt_list(k)* sfc_wts(:,k) + case ('rzt') + zt1d(:) = lndp_prt_list(k)* sfc_wts(:,k) + case ('shc') + bexp1d(:) = lndp_prt_list(k) * sfc_wts(:,k) + case ('lai') + xlai1d(:) = lndp_prt_list(k)* sfc_wts(:,k) + case ('vgf') + ! note that the pertrubed vegfrac is being used in sfc_drv, but not sfc_diff + do i=1,im + call cdfnor(sfc_wts(i,k),cdfz) + vegf1d(i) = cdfz + enddo + lndp_vgf = lndp_prt_list(k) + end select + enddo endif ! End of stochastic physics / surface perturbation diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index d37f7ec64..86b52b87c 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -183,8 +183,8 @@ intent = inout optional = F [do_sppt] - standard_name = flag_for_stochastic_surface_physics_perturbations - long_name = flag for stochastic surface physics perturbations + standard_name = flag_for_stochastic_physics_perturbations + long_name = flag for stochastic physics perturbations units = flag dimensions = () type = logical @@ -243,17 +243,17 @@ kind = kind_phys intent = in optional = F -[do_sfcperts] - standard_name = flag_for_stochastic_surface_perturbations - long_name = flag for stochastic surface perturbations option - units = flag +[lndp_type] + standard_name = index_for_stochastic_land_surface_perturbation_type + long_name = index for stochastic land surface perturbations type + units = index dimensions = () - type = logical + type = integer intent = in optional = F -[nsfcpert] - standard_name = number_of_surface_perturbations - long_name = number of surface perturbations +[n_var_lndp] + standard_name = number_of_land_surface_variables_perturbed + long_name = number of land surface variables perturbed units = count dimensions = () type = integer @@ -263,55 +263,28 @@ standard_name = weights_for_stochastic_surface_physics_perturbation long_name = weights for stochastic surface physics perturbation units = none - dimensions = (horizontal_dimension,number_of_surface_perturbations) - type = real - kind = kind_phys - intent = in - optional = F -[pertz0] - standard_name = magnitude_of_perturbation_of_momentum_roughness_length - long_name = magnitude of perturbation of momentum roughness length - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in - optional = F -[pertzt] - standard_name = magnitude_of_perturbation_of_heat_to_momentum_roughness_length_ratio - long_name = magnitude of perturbation of heat to momentum roughness length r. - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in - optional = F -[pertshc] - standard_name = magnitude_of_perturbation_of_soil_type_b_parameter - long_name = magnitude of perturbation of soil type b parameter - units = frac - dimensions = (5) + dimensions = (horizontal_dimension,number_of_land_surface_variables_perturbed) type = real kind = kind_phys intent = in optional = F -[pertlai] - standard_name = magnitude_of_perturbation_of_leaf_area_index - long_name = magnitude of perturbation of leaf area index - units = frac - dimensions = (5) +[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 + intent = in optional = F -[pertvegf] - standard_name = magnitude_of_perturbation_of_vegetation_fraction - long_name = magnitude of perturbation of vegetation fraction - units = frac - dimensions = (5) - type = real - kind = kind_phys - intent = in +[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 [z01d] standard_name = perturbation_of_momentum_roughness_length @@ -358,6 +331,15 @@ kind = kind_phys intent = out optional = F +[lndp_vgf] + standard_name = magnitude_of_perturbation_of_vegetation_fraction + long_name = magnitude of perturbation of vegetation fraction + units = frac + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F [cplflx] standard_name = flag_for_flux_coupling long_name = flag controlling cplflx collection (default off) diff --git a/physics/radiation_surface.f b/physics/radiation_surface.f index a2cbf55ac..f0cbdd18a 100644 --- a/physics/radiation_surface.f +++ b/physics/radiation_surface.f @@ -390,7 +390,7 @@ subroutine setalb & & slmsk, snowf, zorlf, coszf, tsknf, tairf, hprif, & & alvsf, alnsf, alvwf, alnwf, facsf, facwf, fice, tisfc, & & sncovr, snoalb, albPpert ! sfc-perts, mgehne - real (kind=kind_phys), dimension(5), intent(in) :: pertalb ! sfc-perts, mgehne + real (kind=kind_phys), intent(in) :: pertalb ! sfc-perts, mgehne ! --- outputs real (kind=kind_phys), dimension(IMAX,NF_ALBD), intent(out) :: & @@ -628,12 +628,12 @@ subroutine setalb & ! sfc-perts, mgehne *** !> - Call ppebet () to perturb all 4 elements of surface albedo sfcalb(:,1:4). - if (pertalb(1)>0.0) then + if (pertalb>0.0) then do i = 1, imax do kk=1, 4 ! compute beta distribution parameters for all 4 albedos m = sfcalb(i,kk) - s = pertalb(1)*m*(1.-m) + s = pertalb*m*(1.-m) alpha = m*m*(1.-m)/(s*s)-m beta = alpha*(1.-m)/m ! compute beta distribution value corresponding diff --git a/physics/rrtmg_sw_pre.F90 b/physics/rrtmg_sw_pre.F90 index 05e8d4c7b..5bdaab56b 100644 --- a/physics/rrtmg_sw_pre.F90 +++ b/physics/rrtmg_sw_pre.F90 @@ -44,6 +44,8 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & integer :: i real(kind=kind_phys), dimension(size(Grid%xlon,1),NF_ALBD) :: sfcalb + real(kind=kind_phys) :: lndp_alb + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -63,6 +65,16 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & endif enddo +! set albedo pert, if requested. + lndp_alb = -999. + if (Model%lndp_type==1) then + do i =1,Model%n_var_lndp + if (Model%lndp_var_list(i) == 'alb') then + lndp_alb = Model%lndp_prt_list(i) + endif + enddo + endif + !> - Call module_radiation_surface::setalb() to setup surface albedo. !! for SW radiation. @@ -72,8 +84,8 @@ subroutine rrtmg_sw_pre_run (Model, Grid, Sfcprop, Radtend, im, & Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, & Sfcprop%facsf, Sfcprop%facwf, Sfcprop%fice, & Sfcprop%tisfc, IM, & - alb1d, Model%pertalb, & ! mg, sfc-perts - sfcalb) ! --- outputs + alb1d, lndp_alb, & ! mg, sfc-perts + sfcalb) ! --- outputs !> -# Approximate mean surface albedo from vis- and nir- diffuse values. Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) diff --git a/physics/sfc_drv.f b/physics/sfc_drv.f index 5d8e19643..54e596db6 100644 --- a/physics/sfc_drv.f +++ b/physics/sfc_drv.f @@ -211,7 +211,7 @@ subroutine lsm_noah_run & integer, intent(in) :: im, km, isot, ivegsrc real (kind=kind_phys), intent(in) :: grav, cp, hvap, rd, eps, & & epsm1, rvrdm1 - real (kind=kind_phys), dimension(5), intent(in) :: pertvegf + real (kind=kind_phys), intent(in) :: pertvegf integer, dimension(im), intent(in) :: soiltyp, vegtype, slopetyp @@ -413,10 +413,10 @@ subroutine lsm_noah_run & !! 0.5 and the perturbations go to zero as vegetation fraction approaches its upper !! or lower bound. vegfp = vegfpert(i) ! sfc-perts, mgehne - if (pertvegf(1) > zero) then + if (pertvegf>zero) then ! compute beta distribution parameters for vegetation fraction mv = shdfac - sv = pertvegf(1)*mv*(1.-mv) + sv = pertvegf*mv*(one-mv) alphav = mv*mv*(one-mv)/(sv*sv)-mv betav = alphav*(one-mv)/mv ! compute beta distribution value corresponding diff --git a/physics/sfc_drv.meta b/physics/sfc_drv.meta index 7728ee375..7db9221bb 100644 --- a/physics/sfc_drv.meta +++ b/physics/sfc_drv.meta @@ -439,7 +439,7 @@ standard_name = magnitude_of_perturbation_of_vegetation_fraction long_name = magnitude of perturbation of vegetation fraction units = frac - dimensions = (5) + dimensions = () type = real kind = kind_phys intent = in