!****************************************************************************** ! This source code is part of the ! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model. ! This work is licensed under the CSIRO Open Source Software License ! Agreement (variation of the BSD / MIT License). ! ! You may not use this file except in compliance with this License. ! A copy of the License (CSIRO_BSD_MIT_License_v2.0_CABLE.txt) can be found ! at https://github.com/CABLE-LSM/CABLE/blob/main/ !****************************************************************************** MODULE cbl_albedo_mod !----------------------------------------------------------------------------- ! Description: ! Computes 4-band (visible/near-infrared, beam/diffuse) reflectances ! and albedo ! ! IMPORTANT NOTE regarding the masks (Ticket 333) ! Prior to #333, 3 masks were used here - veg_mask, sunlit_mask, veg_mask ! - although passed in sunlit_mask was not used ! For JAC we will not be able to populate the sunlit masks and instead will ! evaluate the EffExtCoeff outside their bounds of applicability here by ! using inclusive masks in their place from the calling routines, ! ie. JAC will use veg_mask in place of veg_mask ! ! To avoid confusion the mask names here are renamed: ! sunlit_mask now called mask1, veg_mask now called mask2 ! ! This MODULE is USEd by: ! cable_cbm.F90 (ESM1.5), ! cable_rad_driver.F90 (ESM1.5), ! cbl_model_driver_offline.F90 (CABLE), ! rad_driver_cbl.F90 (JULES) ! ! This MODULE contains 1 public Subroutine: ! albedo ! Other subroutines: ! CanopyReflectance, ! CanopyTransmitance, ! EffectiveSurfaceReflectance, ! EffectiveReflectance, ! FbeamRadAlbedo, ! ! Module specific documentation: https://trac.nci.org.au/trac/cable/wiki/TBC ! Where it fits in the model flow: https://trac.nci.org.au/trac/cable/wiki/TBC !----------------------------------------------------------------------------- IMPLICIT NONE PUBLIC :: albedo PRIVATE CONTAINS SUBROUTINE Albedo( AlbSnow, AlbSoil, mp, nrb, ICE_SoilType, lakes_cable, & jls_radiation, veg_mask, Ccoszen_tols, cgauss_w, & SurfaceType, SoilType, VegRefl, VegTaul, & coszen, reducedLAIdue2snow, SnowDepth, SnowDensity, & SoilTemp, SnowAge, xk, c1, rhoch, RadFbeam, RadAlbedo, & ExtCoeff_beam, ExtCoeff_dif, EffExtCoeff_beam, & EffExtCoeff_dif, CanopyRefl_beam,CanopyRefl_dif, & CanopyTransmit_beam, CanopyTransmit_dif, & EffSurfRefl_beam, EffSurfRefl_dif) ! Description: ! Computes the 4-band (visible/near-infrared, beam/diffuse) reflectances ! and albedo !subrs called USE cbl_snow_albedo_module, ONLY: surface_albedosn IMPLICIT NONE !model dimensions INTEGER, INTENT(IN) :: mp ! total number of "tiles" INTEGER, INTENT(IN) :: nrb ! # rad bands: VIS,NIR(,LW) ! Return: Effective Surface Relectance as seen by atmosphere REAL, INTENT(OUT) :: AlbSnow(mp,nrb) ! Alb adjusted for snow (ssnow%albsoilsn) REAL, INTENT(OUT) :: EffSurfRefl_beam(mp,nrb) ! Direct Beam [SW] (rad%reffbm) REAL, INTENT(OUT) :: EffSurfRefl_dif(mp,nrb) ! Diffuse [SW] (rad%reffdf) REAL, INTENT(OUT) :: RadAlbedo(mp,nrb) ! Tot albedo given RadFbeam (rad%albedo) !--- IN: CABLE specific surface_type indexes INTEGER, INTENT(IN) :: ICE_SoilType ! Index of ICE soil type INTEGER, INTENT(IN) :: lakes_cable ! Index of lakes surface type !constants REAL, INTENT(IN) :: Ccoszen_tols ! zenith angle threshold for SUNLIT REAL, INTENT(IN) :: Cgauss_w(nrb) LOGICAL, INTENT(IN) :: jls_radiation ! runtime switch = radiation pathway here !masks LOGICAL, INTENT(IN) :: veg_mask(mp) ! TRUE where vegetated !Vegetation parameters REAL, INTENT(IN) :: VegTaul(mp,nrb) ! PARAMETER leaf transmisivity (veg%taul) REAL, INTENT(IN) :: VegRefl(mp,nrb) ! PARAMETER leaf reflectivity (veg%refl) INTEGER, INTENT(IN) :: SurfaceType(mp) ! Integer index of Surface type (veg%iveg) INTEGER, INTENT(IN) :: SoilType(mp) ! Integer index of Soil type (soil%isoilm) REAL :: reducedLAIdue2snow(mp) ! Reduced LAI given snow coverage ! Albedos REAL, INTENT(IN) :: AlbSoil(mp,nrb) ! Param'ed Bare Soil Albedo(soil%albsoil) !Forcing REAL, INTENT(IN) :: coszen(mp) ! cosine zenith angle (met%coszen) !Prognostics REAL, INTENT(IN) :: SnowDepth(mp) ! Total Snow depth - water eqivalent REAL, INTENT(IN) :: SnowDensity(mp) ! Total Snow density (assumes 1 layer) REAL, INTENT(IN) :: SoilTemp(mp) ! Top layer Soil Temp. (ssnow%tgg) REAL, INTENT(IN) :: SnowAge(mp) ! Snow age (assumes 1 layer ) ! Variables shared primarily between radiation and albedo and possibly elsewhere REAL, INTENT(IN) :: RadFbeam(mp,nrb) ! Beam Fraction of total SW (rad%fbeam) !common radiation scalings - computed in init_radiation() REAL, INTENT(IN) :: xk(mp,nrb) REAL, INTENT(IN) :: c1(mp,nrb) REAL, INTENT(IN) :: rhoch(mp,nrb) !Raw Extinction co-efficients computed in init_radiation() REAL, INTENT(IN) :: ExtCoeff_beam(mp) ! Direct Beam component (rad%extkb) REAL, INTENT(IN) :: ExtCoeff_dif(mp) ! Diffuse component(rad%extkd) !Effecctive Extinction co-efficients computed in init_radiation() REAL, INTENT(IN) :: EffExtCoeff_beam(mp,nrb) ! Direct Beam (rad%extkbm) REAL, INTENT(IN) :: EffExtCoeff_dif(mp,nrb) ! Diffuse component (rad%extkdm) !Canopy reflectance/transmitance compued in albedo() REAL, INTENT(OUT) :: CanopyRefl_beam(mp,nrb) ! Beam Canopy refl (rad%rhocbm) REAL, INTENT(OUT) :: CanopyRefl_dif(mp,nrb) ! Difuse Canopy refl(rad%rhocdf REAL, INTENT(OUT) :: CanopyTransmit_beam(mp,nrb) ! Beam Transmit (rad%cexpkdm) REAL, INTENT(OUT) :: CanopyTransmit_dif(mp,nrb) ! Difuse Transmit (rad%cexpkbm) ! local vars INTEGER :: i ! END header AlbSnow(:,:) = 0.0 CanopyRefl_beam(:,:) = 0.0 CanopyRefl_dif(:,:) = 0.0 !CanopyTransmit_beam(:,:) = 1.0 ! Flushing this =1or0 changes answer - implying? !CanopyTransmit_dif(:,:) = 1.0 ! MPI (at least inits this = 1.0 at dt=0) !Modify parametrised soil albedo based on snow coverage CALL surface_albedosn( AlbSnow, AlbSoil, mp, nrb, ICE_SoilType, lakes_cable, & SurfaceType, SoilType, SnowDepth, SnowDensity, & SoilTemp, SnowAge, Coszen ) ! Update fractional leaf transmittance and reflection !---1 = visible, 2 = nir radiaition ! Define canopy Reflectance for diffuse/direct radiation ! Formerly rad%rhocbm, rad%rhocdf CALL CanopyReflectance( CanopyRefl_beam, CanopyRefl_dif, & mp, nrb, CGauss_w, veg_mask, & AlbSnow, xk, rhoch, & ExtCoeff_beam, ExtCoeff_dif) ! Define canopy diffuse transmittance ! Formerly rad%cexpkbm, rad%cexpkdm CALL CanopyTransmitance(CanopyTransmit_beam, CanopyTransmit_dif, mp, nrb, & veg_mask, reducedLAIdue2snow, & EffExtCoeff_beam, EffExtCoeff_dif) !---1 = visible, 2 = nir radiaition ! Finally compute Effective 4-band albedo for diffuse/direct radiation- ! In the UM this is the required variable to be passed back on the rad call ! Formerly rad%reffbm, rad%reffdf ! Even when there is no vegetation, albedo is at least snow modified soil albedo EffSurfRefl_beam = AlbSnow EffSurfRefl_dif = AlbSnow CALL EffectiveSurfaceReflectance( EffSurfRefl_beam, EffSurfRefl_dif, & mp, nrb, veg_mask, CanopyRefl_beam, & CanopyRefl_dif, CanopyTransmit_beam, & CanopyTransmit_dif, AlbSnow ) ! Compute total albedo to SW given the Effective Surface Reflectance ! (considering Canopy/Soil/Snow contributions) ! we dont need to do this on rad call AND may not haveappropriate RadFbeam RadAlbedo = AlbSnow IF (.NOT. jls_radiation) & CALL FbeamRadAlbedo( RadAlbedo, mp, nrb, veg_mask, radfbeam, & EffSurfRefl_beam, EffSurfRefl_dif, AlbSnow ) RETURN END SUBROUTINE albedo !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE CanopyReflectance( CanopyRefl_beam, CanopyRefl_dif, & mp, nrb, CGauss_w, veg_mask, & AlbSnow, xk, rhoch, & ExtCoeff_beam, ExtCoeff_dif ) ! Description: ! Computes canopy Reflectance for diffuse/direct radiation IMPLICIT NONE INTEGER, INTENT(IN) :: mp ! total number of "tiles" INTEGER, INTENT(IN) :: nrb ! # rad bands [VIS,NIR(,LW)] REAL, INTENT(OUT) :: CanopyRefl_dif(mp,nrb) ! Beam Canopy refl (rad%rhocbm) REAL, INTENT(OUT) :: CanopyRefl_beam(mp,nrb) ! Difuse Canopy refl(rad%rhocdf REAL, INTENT(IN) :: Cgauss_w(nrb) LOGICAL, INTENT(IN) :: veg_mask(mp) ! TRUE where vegetated REAL, INTENT(IN) :: AlbSnow(mp,nrb) ! Ground Albedo with snow REAL, INTENT(IN) :: xk(mp,nrb) REAL, INTENT(IN) :: rhoch(mp,nrb) REAL, INTENT(IN) :: ExtCoeff_beam(mp) ! Extinction co-efficient REAL, INTENT(IN) :: ExtCoeff_dif(mp) ! Extinction co-efficient !local INTEGER :: i, b ! Canopy reflection (6.21) beam: DO i = 1,mp DO b = 1, (nrb-1) !because nrb=3 due to legacy IF ( veg_mask(i) ) & CanopyRefl_beam(i,b) = 2.0 * ExtCoeff_beam(i) / & ( ExtCoeff_beam(i) + ExtCoeff_dif(i) ) & * rhoch(i,b) END DO END DO ! Canopy REFLection of diffuse radiation for black leaves: DO i=1,(nrb-1) !because nrb=3 due to legacy CanopyRefl_dif(:,i) = rhoch(:,i) * 2.0 * & ( cgauss_w(1) * xk(:,1) / ( xk(:,1) + ExtCoeff_dif(:) ) & + cgauss_w(2) * xk(:,2) / ( xk(:,2) + ExtCoeff_dif(:) ) & + cgauss_w(3) * xk(:,3) / ( xk(:,3) + ExtCoeff_dif(:) ) ) END DO RETURN END SUBROUTINE CanopyReflectance !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE CanopyTransmitance( CanopyTransmit_beam, CanopyTransmit_dif, mp, & nrb,mask, reducedLAIdue2snow, EffExtCoeff_beam, & EffExtCoeff_dif ) ! Description: ! Computes canopy diffuse transmittance IMPLICIT NONE INTEGER, INTENT(IN) :: mp ! total number of "tiles" INTEGER, INTENT(IN) :: nrb ! # rad bands [VIS,NIR(,LW)] REAL, INTENT(OUT) :: CanopyTransmit_dif(mp,nrb) ! Transmitance (rad%cexpkdm) REAL, INTENT(OUT) :: CanopyTransmit_beam(mp,nrb) ! Transmitance (rad%cexpkbm) LOGICAL, INTENT(IN) :: mask(mp) ! TRUE where vegetated REAL, INTENT(IN) :: reducedLAIdue2snow(mp) ! Reduced LAI given snow REAL, INTENT(IN) :: EffExtCoeff_beam(mp,nrb) ! Extinction co-efficient REAL, INTENT(IN) :: EffExtCoeff_dif(mp,nrb) ! Extinction co-efficient !local vars INTEGER :: i,b REAL :: dummy(mp,nrb) ! For beam, compute canopy trasmitance when sunlit (and vegetated) DO i = 1,mp DO b = 1,(nrb-1) IF ( mask(i) ) THEN dummy(i,b) = MIN( EffExtCoeff_beam(i,b) * reducedLAIdue2snow(i), 20.0 ) CanopyTransmit_beam(i,b) = EXP( -1.0* dummy(i,b) ) END IF END DO END DO ! For diffuse rad, always compute canopy trasmitance DO i = 1,mp DO b = 1, (nrb-1) !because nrb=3 due to legacy dummy(i,b) = EffExtCoeff_dif(i,b) * reducedLAIdue2snow(i) CanopyTransmit_dif(i,b) = EXP( -1.0* dummy(i,b) ) END DO END DO RETURN END SUBROUTINE CanopyTransmitance !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE EffectiveSurfaceReflectance(EffSurfRefl_beam, EffSurfRefl_dif, & mp, nrb, veg_mask, CanopyRefl_beam, & CanopyRefl_dif, CanopyTransmit_beam, & CanopyTransmit_dif, AlbSnow ) ! Description: ! Computes the effective 4-band albedo for diffuse/direct radiation. IMPLICIT NONE INTEGER, INTENT(IN) :: mp ! total number of "tiles" INTEGER, INTENT(IN) :: nrb ! # rad bands [VIS,NIR(,LW) REAL, INTENT(OUT) :: EffSurfRefl_dif(mp,nrb) ! Diffuse Surf Refl (rad%reffdf) REAL, INTENT(OUT) :: EffSurfRefl_beam(mp,nrb) ! Beam Surf Refl (rad%reffbm) LOGICAL, INTENT(IN) :: veg_mask(mp) ! TRUE where vegetated REAL, INTENT(IN) :: CanopyRefl_beam(mp,nrb) ! Beam Canopy refl (rad%rhocbm) REAL, INTENT(IN) :: CanopyRefl_dif(mp,nrb) ! Difuse Canopy refl(rad%rhocdf) REAL, INTENT(IN) :: CanopyTransmit_dif(mp,nrb) ! Transmitance (rad%cexpkdm) REAL, INTENT(IN) :: CanopyTransmit_beam(mp,nrb) ! Transmitance (rad%cexpkbm) REAL, INTENT(IN) :: AlbSnow(mp,nrb) ! snow adjustd Alb ssnow%albsoilsn !Surface reflectance to Difuse Radiation CALL EffectiveReflectance( EffSurfRefl_dif, mp, nrb, CanopyRefl_dif, AlbSnow, & CanopyTransmit_dif, veg_mask ) !Surface reflectance to Direct Beam Radiation CALL EffectiveReflectance( EffSurfRefl_beam, mp, nrb, CanopyRefl_beam, AlbSnow,& CanopyTransmit_beam, veg_mask ) RETURN END SUBROUTINE EffectiveSurfaceReflectance !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE EffectiveReflectance( EffRefl, mp, nrb, CanopyRefl, AlbSnow, & CanopyTransmit, mask ) ! Description: ! Computes the Surface reflectance for a given radiation IMPLICIT NONE INTEGER, INTENT(IN) :: mp ! total number of "tiles" INTEGER, INTENT(IN) :: nrb ! # rad bands [VIS,NIR(,LW) REAL, INTENT(OUT) :: EffRefl(mp,nrb) ! Effective Surface Reflectance REAL, INTENT(IN) :: AlbSnow(mp,nrb) ! snow adjustd Alb ssnow%albsoilsn REAL, INTENT(IN) :: CanopyRefl(mp,nrb) ! Beam Canopy refl (rad%rhocbm) REAL, INTENT(IN) :: CanopyTransmit(mp,nrb) ! Difuse Canopy refl(rad%rhocdf nrb) LOGICAL, INTENT(IN) :: mask(mp) ! TRUE where vegetated !local vars INTEGER :: i,b DO i = 1,mp DO b = 1, (nrb-1) !because nrb=3 due to legacy IF ( mask(i) ) THEN ! Calculate effective beam reflectance (fraction): EffRefl(i,b) = CanopyRefl(i,b) + ( AlbSnow(i,b) - CanopyRefl(i,b) ) & * CanopyTransmit(i,b)**2 END IF END DO END DO RETURN END SUBROUTINE EffectiveReflectance !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! SUBROUTINE FbeamRadAlbedo( RadAlbedo, mp, nrb, veg_mask, radfbeam, & EffSurfRefl_beam, EffSurfRefl_dif, AlbSnow ) ! Description: ! Computes total albedo to SW given the Effective Surface Reflectance ! (considering Canopy/Soil/Snow contributions) IMPLICIT NONE INTEGER, INTENT(IN) :: mp ! total number of "tiles" INTEGER, INTENT(IN) :: nrb ! # rad bands [VIS,NIR(,LW) REAL, INTENT(OUT) :: RadAlbedo(mp,nrb) ! RadFbeam albedo (rad%albedo) LOGICAL, INTENT(IN) :: veg_mask(mp) ! TRUE where vegetated REAL, INTENT(IN) :: AlbSnow(mp,nrb) ! snow adjustd Alb (ssnow%albsoilsn REAL, INTENT(IN) :: RadFbeam(mp,nrb) ! Beam Fraction of SW (rad%fbeam) REAL, INTENT(IN) :: EffSurfRefl_dif(mp,nrb) ! Direct Beam [SW] (rad%reffbm) REAL, INTENT(IN) :: EffSurfRefl_beam(mp,nrb) ! Diffuse [SW] (rad%reffdf) !local vars INTEGER :: b !rad. band 1=visible, 2=near-infrared, 3=long-wave INTEGER :: i ! Initialise total albedo: RadAlbedo = AlbSnow DO i = 1,mp DO b = 1,(nrb-1) !because nrb=3 due to legacy ! Define albedo: IF ( veg_mask(i) ) & RadAlbedo(i,b) = ( 1.0 - radfbeam(i,b) )*EffSurfRefl_dif(i,b) & + radfbeam(i,b) * EffSurfRefl_beam(i,b) END DO END DO RETURN END SUBROUTINE FbeamRadAlbedo END MODULE cbl_albedo_mod