INTERFACE:
subroutine SurfaceRadiation(lbp, ubp, num_nourbanp, filter_nourbanp)DESCRIPTION:
Solar fluxes absorbed by vegetation and ground surface Note possible problem when land is on different grid than atmosphere. Land may have sun above the horizon (coszen > 0) but atmosphere may have sun below the horizon (forc_solad = 0 and forc_solai = 0). This is okay because all fluxes (absorbed, reflected, transmitted) are multiplied by the incoming flux and all will equal zero. Atmosphere may have sun above horizon (forc_solad > 0 and forc_solai > 0) but land may have sun below horizon. This is okay because fabd, fabi, ftdd, ftid, and ftii all equal zero so that sabv=sabg=fsa=0. Also, albd and albi equal one so that fsr=forc_solad+forc_solai. In other words, all the radiation is reflected. NDVI should equal zero in this case. However, the way the code is currently implemented this is only true if (forc_solad+forc_solai)|vis = (forc_solad+forc_solai)|nir. Output variables are parsun,parsha,sabv,sabg,fsa,fsr,ndvi
USES:
use clmtype
use clm_atmlnd , only : clm_a2l
use clm_varpar , only : numrad
use clm_varcon , only : spval, istsoil, degpsec, isecspday
use clm_varcon , only : istice_mec
use clm_varcon , only : istcrop
use clm_time_manager, only : get_curr_date, get_step_size
use clm_varpar , only : nlevsno
use SNICARMod , only : DO_SNO_OC
use abortutils , only : endrun
ARGUMENTS:
implicit none
integer, intent(in) :: lbp, ubp ! pft upper and lower bounds
integer, intent(in) :: num_nourbanp ! number of pfts in non-urban points in pft filter
integer, intent(in) :: filter_nourbanp(ubp-lbp+1) ! pft filter for non-urban points
CALLED FROM:
subroutine Biogeophysics1 in module Biogeophysics1Mod subroutine BiogeophysicsLake in module BiogeophysicsLakeModREVISION HISTORY:
Author: Gordon Bonan
2/18/02, Peter Thornton: Migrated to new data structures. Added a pft loop.
6/05/03, Peter Thornton: Modified sunlit/shaded canopy treatment. Original code
had all radiation being absorbed in the sunlit canopy, and now the sunlit and shaded
canopies are each given the appropriate fluxes. There was also an inconsistency in
the original code, where parsun was not being scaled by leaf area, and so represented
the entire canopy flux. This goes into Stomata (in CanopyFluxes) where it is assumed
to be a flux per unit leaf area. In addition, the fpsn flux coming out of Stomata was
being scaled back up to the canopy by multiplying by lai, but the input radiation flux was
for the entire canopy to begin with. Corrected this inconsistency in this version, so that
the parsun and parsha fluxes going into canopy fluxes are per unit lai in the sunlit and
shaded canopies.
6/9/03, Peter Thornton: Moved coszen from g%gps to c%cps to avoid problem
with OpenMP threading over columns, where different columns hit the radiation
time step at different times during execution.
6/10/03, Peter Thornton: Added constraint on negative tot_aid, instead of
exiting with error. Appears to be happening only at roundoff level.
6/11/03, Peter Thornton: Moved calculation of ext inside if (coszen),
and added check on laisun = 0 and laisha = 0 in calculation of sun_aperlai
and sha_aperlai.
11/26/03, Peter Thornton: During migration to new vector code, created
this as a new routine to handle sunlit/shaded canopy calculations.
03/28/08, Mark Flanner: Incorporated SNICAR, including absorbed solar radiation
in each snow layer and top soil layer, and optional radiative forcing calculation
LOCAL VARIABLES:
local pointers to original implicit in arguments
integer , pointer :: ivt(:) ! pft vegetation type
integer , pointer :: pcolumn(:) ! pft's column index
integer , pointer :: pgridcell(:) ! pft's gridcell index
real(r8), pointer :: pwtgcell(:) ! pft's weight relative to corresponding gridcell
real(r8), pointer :: elai(:) ! one-sided leaf area index with burying by snow
real(r8), pointer :: esai(:) ! one-sided stem area index with burying by snow
real(r8), pointer :: londeg(:) ! longitude (degrees)
real(r8), pointer :: latdeg(:) ! latitude (degrees)
real(r8), pointer :: slasun(:) ! specific leaf area for sunlit canopy, projected area basis (m^2/gC)
real(r8), pointer :: slasha(:) ! specific leaf area for shaded canopy, projected area basis (m^2/gC)
real(r8), pointer :: gdir(:) ! leaf projection in solar direction (0 to 1)
real(r8), pointer :: omega(:,:) ! fraction of intercepted radiation that is scattered (0 to 1)
real(r8), pointer :: coszen(:) ! cosine of solar zenith angle
real(r8), pointer :: forc_solad(:,:) ! direct beam radiation (W/m**2)
real(r8), pointer :: forc_solai(:,:) ! diffuse radiation (W/m**2)
real(r8), pointer :: fabd(:,:) ! flux absorbed by veg per unit direct flux
real(r8), pointer :: fabi(:,:) ! flux absorbed by veg per unit diffuse flux
real(r8), pointer :: ftdd(:,:) ! down direct flux below veg per unit dir flx
real(r8), pointer :: ftid(:,:) ! down diffuse flux below veg per unit dir flx
real(r8), pointer :: ftii(:,:) ! down diffuse flux below veg per unit dif flx
real(r8), pointer :: albgrd(:,:) ! ground albedo (direct)
real(r8), pointer :: albgri(:,:) ! ground albedo (diffuse)
real(r8), pointer :: albd(:,:) ! surface albedo (direct)
real(r8), pointer :: albi(:,:) ! surface albedo (diffuse)
real(r8), pointer :: slatop(:) ! specific leaf area at top of canopy, projected area basis [m^2/gC]
real(r8), pointer :: dsladlai(:) ! dSLA/dLAI, projected area basis [m^2/gC]
local pointers to original implicit out arguments
real(r8), pointer :: fsun(:) ! sunlit fraction of canopy
real(r8), pointer :: laisun(:) ! sunlit leaf area
real(r8), pointer :: laisha(:) ! shaded leaf area
real(r8), pointer :: sabg(:) ! solar radiation absorbed by ground (W/m**2)
real(r8), pointer :: sabv(:) ! solar radiation absorbed by vegetation (W/m**2)
real(r8), pointer :: fsa(:) ! solar radiation absorbed (total) (W/m**2)
real(r8), pointer :: fsa_r(:) ! rural solar radiation absorbed (total) (W/m**2)
integer , pointer :: ityplun(:) ! landunit type
integer , pointer :: plandunit(:) ! index into landunit level quantities
real(r8), pointer :: parsun(:) ! average absorbed PAR for sunlit leaves (W/m**2)
real(r8), pointer :: parsha(:) ! average absorbed PAR for shaded leaves (W/m**2)
real(r8), pointer :: fsr(:) ! solar radiation reflected (W/m**2)
real(r8), pointer :: fsds_vis_d(:) ! incident direct beam vis solar radiation (W/m**2)
real(r8), pointer :: fsds_nir_d(:) ! incident direct beam nir solar radiation (W/m**2)
real(r8), pointer :: fsds_vis_i(:) ! incident diffuse vis solar radiation (W/m**2)
real(r8), pointer :: fsds_nir_i(:) ! incident diffuse nir solar radiation (W/m**2)
real(r8), pointer :: fsr_vis_d(:) ! reflected direct beam vis solar radiation (W/m**2)
real(r8), pointer :: fsr_nir_d(:) ! reflected direct beam nir solar radiation (W/m**2)
real(r8), pointer :: fsr_vis_i(:) ! reflected diffuse vis solar radiation (W/m**2)
real(r8), pointer :: fsr_nir_i(:) ! reflected diffuse nir solar radiation (W/m**2)
real(r8), pointer :: fsds_vis_d_ln(:) ! incident direct beam vis solar rad at local noon (W/m**2)
real(r8), pointer :: fsds_nir_d_ln(:) ! incident direct beam nir solar rad at local noon (W/m**2)
real(r8), pointer :: fsr_vis_d_ln(:) ! reflected direct beam vis solar rad at local noon (W/m**2)
real(r8), pointer :: fsr_nir_d_ln(:) ! reflected direct beam nir solar rad at local noon (W/m**2)
real(r8), pointer :: eff_kid(:,:) ! effective extinction coefficient for indirect from direct
real(r8), pointer :: eff_kii(:,:) ! effective extinction coefficient for indirect from indirect
real(r8), pointer :: sun_faid(:,:) ! fraction sun canopy absorbed indirect from direct
real(r8), pointer :: sun_faii(:,:) ! fraction sun canopy absorbed indirect from indirect
real(r8), pointer :: sha_faid(:,:) ! fraction shade canopy absorbed indirect from direct
real(r8), pointer :: sha_faii(:,:) ! fraction shade canopy absorbed indirect from indirect
real(r8), pointer :: sun_add(:,:) ! sun canopy absorbed direct from direct (W/m**2)
real(r8), pointer :: tot_aid(:,:) ! total canopy absorbed indirect from direct (W/m**2)
real(r8), pointer :: sun_aid(:,:) ! sun canopy absorbed indirect from direct (W/m**2)
real(r8), pointer :: sun_aii(:,:) ! sun canopy absorbed indirect from indirect (W/m**2)
real(r8), pointer :: sha_aid(:,:) ! shade canopy absorbed indirect from direct (W/m**2)
real(r8), pointer :: sha_aii(:,:) ! shade canopy absorbed indirect from indirect (W/m**2)
real(r8), pointer :: sun_atot(:,:) ! sun canopy total absorbed (W/m**2)
real(r8), pointer :: sha_atot(:,:) ! shade canopy total absorbed (W/m**2)
real(r8), pointer :: sun_alf(:,:) ! sun canopy total absorbed by leaves (W/m**2)
real(r8), pointer :: sha_alf(:,:) ! shade canopy total absored by leaves (W/m**2)
real(r8), pointer :: sun_aperlai(:,:) ! sun canopy total absorbed per unit LAI (W/m**2)
real(r8), pointer :: sha_aperlai(:,:) ! shade canopy total absorbed per unit LAI (W/m**2)
real(r8), pointer :: flx_absdv(:,:) ! direct flux absorption factor (col,lyr): VIS [frc]
real(r8), pointer :: flx_absdn(:,:) ! direct flux absorption factor (col,lyr): NIR [frc]
real(r8), pointer :: flx_absiv(:,:) ! diffuse flux absorption factor (col,lyr): VIS [frc]
real(r8), pointer :: flx_absin(:,:) ! diffuse flux absorption factor (col,lyr): NIR [frc]
integer , pointer :: snl(:) ! negative number of snow layers [nbr]
real(r8), pointer :: albgrd_pur(:,:) ! pure snow ground albedo (direct)
real(r8), pointer :: albgri_pur(:,:) ! pure snow ground albedo (diffuse)
real(r8), pointer :: albgrd_bc(:,:) ! ground albedo without BC (direct) (col,bnd)
real(r8), pointer :: albgri_bc(:,:) ! ground albedo without BC (diffuse) (col,bnd)
real(r8), pointer :: albgrd_oc(:,:) ! ground albedo without OC (direct) (col,bnd)
real(r8), pointer :: albgri_oc(:,:) ! ground albedo without OC (diffuse) (col,bnd)
real(r8), pointer :: albgrd_dst(:,:) ! ground albedo without dust (direct) (col,bnd)
real(r8), pointer :: albgri_dst(:,:) ! ground albedo without dust (diffuse) (col,bnd)
real(r8), pointer :: albsnd_hst(:,:) ! snow albedo, direct, for history files (col,bnd) [frc]
real(r8), pointer :: albsni_hst(:,:) ! snow ground albedo, diffuse, for history files (col,bnd
real(r8), pointer :: sabg_lyr(:,:) ! absorbed radiative flux (pft,lyr) [W/m2]
real(r8), pointer :: sfc_frc_aer(:) ! surface forcing of snow with all aerosols (pft) [W/m2]
real(r8), pointer :: sfc_frc_bc(:) ! surface forcing of snow with BC (pft) [W/m2]
real(r8), pointer :: sfc_frc_oc(:) ! surface forcing of snow with OC (pft) [W/m2]
real(r8), pointer :: sfc_frc_dst(:) ! surface forcing of snow with dust (pft) [W/m2]
real(r8), pointer :: sfc_frc_aer_sno(:) ! surface forcing of snow with all aerosols, averaged only when snow is present (pft) [W/m2]
real(r8), pointer :: sfc_frc_bc_sno(:) ! surface forcing of snow with BC, averaged only when snow is present (pft) [W/m2]
real(r8), pointer :: sfc_frc_oc_sno(:) ! surface forcing of snow with OC, averaged only when snow is present (pft) [W/m2]
real(r8), pointer :: sfc_frc_dst_sno(:) ! surface forcing of snow with dust, averaged only when snow is present (pft) [W/m2]
real(r8), pointer :: frac_sno(:) ! fraction of ground covered by snow (0 to 1)
real(r8), pointer :: fsr_sno_vd(:) ! reflected visible, direct radiation from snow (for history files) (pft) [W/m2]
real(r8), pointer :: fsr_sno_nd(:) ! reflected near-IR, direct radiation from snow (for history files) (pft) [W/m2]
real(r8), pointer :: fsr_sno_vi(:) ! reflected visible, diffuse radiation from snow (for history files) (pft) [W/m2]
real(r8), pointer :: fsr_sno_ni(:) ! reflected near-IR, diffuse radiation from snow (for history files) (pft) [W/m2]
real(r8), pointer :: fsds_sno_vd(:) ! incident visible, direct radiation on snow (for history files) (pft) [W/m2]
real(r8), pointer :: fsds_sno_nd(:) ! incident near-IR, direct radiation on snow (for history files) (pft) [W/m2]
real(r8), pointer :: fsds_sno_vi(:) ! incident visible, diffuse radiation on snow (for history files) (pft) [W/m2]
real(r8), pointer :: fsds_sno_ni(:) ! incident near-IR, diffuse radiation on snow (for history files) (pft) [W/m2]
real(r8), pointer :: snowdp(:) ! snow height (m)
!OTHER LOCAL VARIABLES: