diff --git a/drivers/hrldas/ConfigVarInTransferMod.F90 b/drivers/hrldas/ConfigVarInTransferMod.F90 index f71caa17..0218b97c 100644 --- a/drivers/hrldas/ConfigVarInTransferMod.F90 +++ b/drivers/hrldas/ConfigVarInTransferMod.F90 @@ -93,6 +93,23 @@ subroutine ConfigVarInTransfer(noahmp, NoahmpIO) noahmp%config%domain%RunoffSlopeType = NoahmpIO%SLOPETYP noahmp%config%domain%DepthSoilTempBottom = NoahmpIO%ZBOT_TABLE + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + noahmp%config%nmlist%OptSnicarSnowShape = NoahmpIO%SNICAR_SNOWSHAPE_OPT + noahmp%config%nmlist%OptSnicarRTSolver = NoahmpIO%SNICAR_RTSOLVER_OPT + noahmp%config%nmlist%FlagSnicarSnowBCIntmix = NoahmpIO%SNICAR_SNOWBC_INTMIX + noahmp%config%nmlist%FlagSnicarSnowDustIntmix = NoahmpIO%SNICAR_SNOWDUST_INTMIX + noahmp%config%nmlist%FlagSnicarUseAerosol = NoahmpIO%SNICAR_USE_AEROSOL + noahmp%config%nmlist%FlagSnicarUseOC = NoahmpIO%SNICAR_USE_OC + noahmp%config%nmlist%FlagSnicarAerosolReadTable = NoahmpIO%SNICAR_AEROSOL_READTABLE + + noahmp%config%domain%idx_T_max = NoahmpIO%idx_T_max + noahmp%config%domain%idx_Tgrd_max = NoahmpIO%idx_Tgrd_max + noahmp%config%domain%idx_rhos_max = NoahmpIO%idx_rhos_max + noahmp%config%domain%NumSnicarRadBand = NoahmpIO%snicar_numrad_snw + noahmp%config%domain%idx_Mie_snw_mx = NoahmpIO%idx_Mie_snw_mx + endif + ! the following initialization cannot be done in ConfigVarInitMod ! because the NumSoilLayer and NumSnowLayerMax are initialized with input values in this module if ( .not. allocated(noahmp%config%domain%DepthSoilLayer) ) & diff --git a/drivers/hrldas/EnergyVarInTransferMod.F90 b/drivers/hrldas/EnergyVarInTransferMod.F90 index 2f4f8cee..f4dbadca 100644 --- a/drivers/hrldas/EnergyVarInTransferMod.F90 +++ b/drivers/hrldas/EnergyVarInTransferMod.F90 @@ -40,7 +40,9 @@ subroutine EnergyVarInTransfer(noahmp, NoahmpIO) FlagUrban => noahmp%config%domain%FlagUrban ,& NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& - NumSwRadBand => noahmp%config%domain%NumSwRadBand & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& + NumSnicarRadBand=> noahmp%config%domain%NumSnicarRadBand,& + idx_Mie_snw_mx => noahmp%config%domain%idx_Mie_snw_mx & ) ! ------------------------------------------------------------------------- @@ -128,6 +130,43 @@ subroutine EnergyVarInTransfer(noahmp, NoahmpIO) noahmp%energy%param%AlbedoSoilDry (1:NumSwRadBand) = NoahmpIO%ALBDRY_TABLE(SoilColor,1:NumSwRadBand) noahmp%energy%param%AlbedoLakeFrz (1:NumSwRadBand) = NoahmpIO%ALBLAK_TABLE(1:NumSwRadBand) noahmp%energy%param%ScatterCoeffSnow (1:NumSwRadBand) = NoahmpIO%OMEGAS_TABLE(1:NumSwRadBand) + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + noahmp%energy%state%AlbedoSoilDir (1:NumSwRadBand) = NoahmpIO%ALBSOILDIRXY(I,1:NumSwRadBand,J) + noahmp%energy%state%AlbedoSoilDif (1:NumSwRadBand) = NoahmpIO%ALBSOILDIFXY(I,1:NumSwRadBand,J) + noahmp%energy%param%flx_wgt_dif (1:NumSnicarRadBand) = NoahmpIO%flx_wgt_dif(1:NumSnicarRadBand) + noahmp%energy%param%flx_wgt_dir (1:NumSnicarRadBand) = NoahmpIO%flx_wgt_dir(1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_snw_drc (1:idx_Mie_snw_mx,1:NumSnicarRadBand) = NoahmpIO%ss_alb_snw_drc (1:idx_Mie_snw_mx,1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_snw_drc (1:idx_Mie_snw_mx,1:NumSnicarRadBand) = NoahmpIO%asm_prm_snw_drc (1:idx_Mie_snw_mx,1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_snw_drc (1:idx_Mie_snw_mx,1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_snw_drc (1:idx_Mie_snw_mx,1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_snw_dfs (1:idx_Mie_snw_mx,1:NumSnicarRadBand) = NoahmpIO%ss_alb_snw_dfs (1:idx_Mie_snw_mx,1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_snw_dfs (1:idx_Mie_snw_mx,1:NumSnicarRadBand) = NoahmpIO%asm_prm_snw_dfs (1:idx_Mie_snw_mx,1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_snw_dfs (1:idx_Mie_snw_mx,1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_snw_dfs (1:idx_Mie_snw_mx,1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_bc1 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_bc1 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_bc1 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_bc2 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_bc2 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_bc2 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_oc1 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_oc1 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_oc1 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_oc2 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_oc2 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_oc2 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_dst1 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_dst1 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_dst1 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_dst2 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_dst2 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_dst2 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_dst3 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_dst3 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_dst3 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%ss_alb_dst4 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst4 (1:NumSnicarRadBand) + noahmp%energy%param%asm_prm_dst4 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst4 (1:NumSnicarRadBand) + noahmp%energy%param%ext_cff_mss_dst4 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst4 (1:NumSnicarRadBand) + endif do SoilLayerIndex = 1, size(SoilType) noahmp%energy%param%SoilQuartzFrac(SoilLayerIndex) = NoahmpIO%QUARTZ_TABLE(SoilType(SoilLayerIndex)) diff --git a/drivers/hrldas/EnergyVarOutTransferMod.F90 b/drivers/hrldas/EnergyVarOutTransferMod.F90 index 00658527..1bb72971 100644 --- a/drivers/hrldas/EnergyVarOutTransferMod.F90 +++ b/drivers/hrldas/EnergyVarOutTransferMod.F90 @@ -38,6 +38,7 @@ subroutine EnergyVarOutTransfer(noahmp, NoahmpIO) NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& IndicatorIceSfc => noahmp%config%domain%IndicatorIceSfc & ) !----------------------------------------------------------------------- @@ -142,6 +143,17 @@ subroutine EnergyVarOutTransfer(noahmp, NoahmpIO) NoahmpIO%TSLB (I,1:NumSoilLayer,J) = noahmp%energy%state%TemperatureSoilSnow(1:NumSoilLayer) NoahmpIO%TSNOXY (I,-NumSnowLayerMax+1:0,J) = noahmp%energy%state%TemperatureSoilSnow(-NumSnowLayerMax+1:0) + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + NoahmpIO%ALBSOILDIRXY(I,1:NumSwRadBand,J)=noahmp%energy%state%AlbedoSoilDir(1:NumSwRadBand) + NoahmpIO%ALBSOILDIFXY(I,1:NumSwRadBand,J)=noahmp%energy%state%AlbedoSoilDif(1:NumSwRadBand) + endif + + NoahmpIO%ALBSFCDIRXY(I,1:NumSwRadBand,J)=noahmp%energy%state%AlbedoSfcDir(1:NumSwRadBand) + NoahmpIO%ALBSFCDIFXY(I,1:NumSwRadBand,J)=noahmp%energy%state%AlbedoSfcDif(1:NumSwRadBand) + NoahmpIO%ALBSNOWDIRXY(I,1:NumSwRadBand,J)=noahmp%energy%state%AlbedoSnowDir(1:NumSwRadBand) + NoahmpIO%ALBSNOWDIFXY(I,1:NumSwRadBand,J)=noahmp%energy%state%AlbedoSnowDif(1:NumSwRadBand) + ! New Calculation of total Canopy/Stomatal Conductance Based on Bonan et al. (2011), Inverse of Canopy Resistance (below) LeafAreaIndSunlit = max(noahmp%energy%state%LeafAreaIndSunlit, 0.0) LeafAreaIndShade = max(noahmp%energy%state%LeafAreaIndShade, 0.0) diff --git a/drivers/hrldas/ForcingVarInTransferMod.F90 b/drivers/hrldas/ForcingVarInTransferMod.F90 index 5cef99c5..579df6c9 100644 --- a/drivers/hrldas/ForcingVarInTransferMod.F90 +++ b/drivers/hrldas/ForcingVarInTransferMod.F90 @@ -62,6 +62,34 @@ subroutine ForcingVarInTransfer(noahmp, NoahmpIO) noahmp%forcing%PrecipNonConvRefHeight = noahmp%forcing%PrecipNonConvRefHeight + PrecipOtherRefHeight noahmp%forcing%PrecipSnowRefHeight = noahmp%forcing%PrecipSnowRefHeight + PrecipOtherRefHeight * NoahmpIO%SR(I,J) + noahmp%forcing%DirFrac = NoahmpIO%DirFrac(I,J) + noahmp%forcing%VisFrac = NoahmpIO%VisFrac(I,J) + + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + if (noahmp%config%nmlist%FlagSnicarAerosolReadTable == .true.) then + noahmp%forcing%DepBChydropho = NoahmpIO%DepBChydropho_TABLE + noahmp%forcing%DepBChydrophi = NoahmpIO%DepBChydrophi_TABLE + noahmp%forcing%DepOChydropho = NoahmpIO%DepOChydropho_TABLE + noahmp%forcing%DepOChydrophi = NoahmpIO%DepOChydrophi_TABLE + noahmp%forcing%DepDust1 = NoahmpIO%DepDust1_TABLE + noahmp%forcing%DepDust2 = NoahmpIO%DepDust2_TABLE + noahmp%forcing%DepDust3 = NoahmpIO%DepDust3_TABLE + noahmp%forcing%DepDust4 = NoahmpIO%DepDust4_TABLE + noahmp%forcing%DepDust5 = NoahmpIO%DepDust5_TABLE + else + noahmp%forcing%DepBChydropho = NoahmpIO%DepBChydrophoXY(I,J) + noahmp%forcing%DepBChydrophi = NoahmpIO%DepBChydrophiXY(I,J) + noahmp%forcing%DepOChydropho = NoahmpIO%DepOChydrophoXY(I,J) + noahmp%forcing%DepOChydrophi = NoahmpIO%DepOChydrophiXY(I,J) + noahmp%forcing%DepDust1 = NoahmpIO%DepDust1XY(I,J) + noahmp%forcing%DepDust2 = NoahmpIO%DepDust2XY(I,J) + noahmp%forcing%DepDust3 = NoahmpIO%DepDust3XY(I,J) + noahmp%forcing%DepDust4 = NoahmpIO%DepDust4XY(I,J) + noahmp%forcing%DepDust5 = NoahmpIO%DepDust5XY(I,J) + endif + endif + end associate end subroutine ForcingVarInTransfer diff --git a/drivers/hrldas/ForcingVarOutTransferMod.F90 b/drivers/hrldas/ForcingVarOutTransferMod.F90 index 87e6da36..ac64d244 100644 --- a/drivers/hrldas/ForcingVarOutTransferMod.F90 +++ b/drivers/hrldas/ForcingVarOutTransferMod.F90 @@ -37,6 +37,10 @@ subroutine ForcingVarOutTransfer(noahmp, NoahmpIO) NoahmpIO%FORCWLSM (I,J) = sqrt(noahmp%forcing%WindEastwardRefHeight**2 + & noahmp%forcing%WindNorthwardRefHeight**2) + NoahmpIO%DirFrac (I,J) = noahmp%forcing%DirFrac + NoahmpIO%VisFrac (I,J) = noahmp%forcing%VisFrac + + end associate end subroutine ForcingVarOutTransfer diff --git a/drivers/hrldas/NoahmpDriverMainMod.F90 b/drivers/hrldas/NoahmpDriverMainMod.F90 index eaa36a21..1d1e0693 100644 --- a/drivers/hrldas/NoahmpDriverMainMod.F90 +++ b/drivers/hrldas/NoahmpDriverMainMod.F90 @@ -195,7 +195,6 @@ subroutine NoahmpDriverMain(NoahmpIO) noahmp%config%domain%IndicatorIceSfc = 0 ! land soil point. call NoahmpMain(noahmp) endif ! glacial split ends - !--------------------------------------------------------------------- ! Transfer 1-D Noah-MP column variables to 2-D output variables !--------------------------------------------------------------------- diff --git a/drivers/hrldas/NoahmpIOVarInitMod.F90 b/drivers/hrldas/NoahmpIOVarInitMod.F90 index b09a0cd7..507410f7 100644 --- a/drivers/hrldas/NoahmpIOVarInitMod.F90 +++ b/drivers/hrldas/NoahmpIOVarInitMod.F90 @@ -32,7 +32,8 @@ subroutine NoahmpIOVarInitDefault(NoahmpIO) KDS => NoahmpIO%KDS ,& KDE => NoahmpIO%KDE ,& NSOIL => NoahmpIO%NSOIL ,& - NSNOW => NoahmpIO%NSNOW & + NSNOW => NoahmpIO%NSNOW ,& + NUMRAD => NoahmpIO%NUMRAD & ) ! ------------------------------------------------- @@ -317,6 +318,94 @@ subroutine NoahmpIOVarInitDefault(NoahmpIO) if ( .not. allocated (NoahmpIO%RIVERMASK) ) allocate ( NoahmpIO%RIVERMASK (XSTART:XEND,YSTART:YEND) ) if ( .not. allocated (NoahmpIO%NONRIVERXY) ) allocate ( NoahmpIO%NONRIVERXY (XSTART:XEND,YSTART:YEND) ) + ! Needed for SNICAR_SNOW_ALBEDO (IOPT_ALB = 3) + if ( NoahmpIO%IOPT_ALB == 3 ) then + + if (NoahmpIO%SNICAR_BANDNUMBER_OPT == 1) then + NoahmpIO%snicar_numrad_snw=5 + elseif (NoahmpIO%SNICAR_BANDNUMBER_OPT == 2) then + NoahmpIO%snicar_numrad_snw=480 + endif + + if ( .not. allocated (NoahmpIO%ss_alb_snw_drc) ) allocate ( NoahmpIO%ss_alb_snw_drc (NoahmpIO%idx_Mie_snw_mx,NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_snw_drc) ) allocate ( NoahmpIO%asm_prm_snw_drc (NoahmpIO%idx_Mie_snw_mx,NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_snw_drc) ) allocate ( NoahmpIO%ext_cff_mss_snw_drc (NoahmpIO%idx_Mie_snw_mx,NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_snw_dfs) ) allocate ( NoahmpIO%ss_alb_snw_dfs (NoahmpIO%idx_Mie_snw_mx,NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_snw_dfs) ) allocate ( NoahmpIO%asm_prm_snw_dfs (NoahmpIO%idx_Mie_snw_mx,NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_snw_dfs) ) allocate ( NoahmpIO%ext_cff_mss_snw_dfs (NoahmpIO%idx_Mie_snw_mx,NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_bc1) ) allocate ( NoahmpIO%ss_alb_bc1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_bc1) ) allocate ( NoahmpIO%asm_prm_bc1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_bc1) ) allocate ( NoahmpIO%ext_cff_mss_bc1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_bc2) ) allocate ( NoahmpIO%ss_alb_bc2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_bc2) ) allocate ( NoahmpIO%asm_prm_bc2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_bc2) ) allocate ( NoahmpIO%ext_cff_mss_bc2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_oc1) ) allocate ( NoahmpIO%ss_alb_oc1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_oc1) ) allocate ( NoahmpIO%asm_prm_oc1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_oc1) ) allocate ( NoahmpIO%ext_cff_mss_oc1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_oc2) ) allocate ( NoahmpIO%ss_alb_oc2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_oc2) ) allocate ( NoahmpIO%asm_prm_oc2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_oc2) ) allocate ( NoahmpIO%ext_cff_mss_oc2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_dst1) ) allocate ( NoahmpIO%ss_alb_dst1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_dst1) ) allocate ( NoahmpIO%asm_prm_dst1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_dst1)) allocate ( NoahmpIO%ext_cff_mss_dst1 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_dst2) ) allocate ( NoahmpIO%ss_alb_dst2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_dst2) ) allocate ( NoahmpIO%asm_prm_dst2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_dst2)) allocate ( NoahmpIO%ext_cff_mss_dst2 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_dst3) ) allocate ( NoahmpIO%ss_alb_dst3 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_dst3) ) allocate ( NoahmpIO%asm_prm_dst3 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_dst3)) allocate ( NoahmpIO%ext_cff_mss_dst3 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_dst4) ) allocate ( NoahmpIO%ss_alb_dst4 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_dst4) ) allocate ( NoahmpIO%asm_prm_dst4 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_dst4)) allocate ( NoahmpIO%ext_cff_mss_dst4 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ss_alb_dst5) ) allocate ( NoahmpIO%ss_alb_dst5 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%asm_prm_dst5) ) allocate ( NoahmpIO%asm_prm_dst5 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%ext_cff_mss_dst5)) allocate ( NoahmpIO%ext_cff_mss_dst5 (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%flx_wgt_dir) ) allocate ( NoahmpIO%flx_wgt_dir (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%flx_wgt_dif) ) allocate ( NoahmpIO%flx_wgt_dif (NoahmpIO%snicar_numrad_snw) ) + if ( .not. allocated (NoahmpIO%snowage_tau) ) allocate ( NoahmpIO%snowage_tau (NoahmpIO%idx_rhos_max,NoahmpIO%idx_Tgrd_max,NoahmpIO%idx_T_max) ) + if ( .not. allocated (NoahmpIO%snowage_kappa) ) allocate ( NoahmpIO%snowage_kappa (NoahmpIO%idx_rhos_max,NoahmpIO%idx_Tgrd_max,NoahmpIO%idx_T_max) ) + if ( .not. allocated (NoahmpIO%snowage_drdt0) ) allocate ( NoahmpIO%snowage_drdt0 (NoahmpIO%idx_rhos_max,NoahmpIO%idx_Tgrd_max,NoahmpIO%idx_T_max) ) + if ( .not. allocated (NoahmpIO%ALBSOILDIRXY)) allocate ( NoahmpIO%ALBSOILDIRXY (XSTART:XEND,1:NUMRAD,YSTART:YEND) ) ! soil albedo (direct) + if ( .not. allocated (NoahmpIO%ALBSOILDIFXY)) allocate ( NoahmpIO%ALBSOILDIFXY (XSTART:XEND,1:NUMRAD,YSTART:YEND) ) ! soil albedo (diffuse) + if ( .not. allocated (NoahmpIO%SNRDSXY) ) allocate ( NoahmpIO%SNRDSXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) ! snow layer effective grain radius [microns, m-6] + if ( .not. allocated (NoahmpIO%SNFRXY) ) allocate ( NoahmpIO%SNFRXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) ! snow layer rate of snow freezing [mm/s] + if ( .not. allocated (NoahmpIO%BCPHIXY) ) allocate ( NoahmpIO%BCPHIXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%BCPHOXY) ) allocate ( NoahmpIO%BCPHOXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%OCPHIXY) ) allocate ( NoahmpIO%OCPHIXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%OCPHOXY) ) allocate ( NoahmpIO%OCPHOXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DUST1XY) ) allocate ( NoahmpIO%DUST1XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DUST2XY) ) allocate ( NoahmpIO%DUST2XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DUST3XY) ) allocate ( NoahmpIO%DUST3XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DUST4XY) ) allocate ( NoahmpIO%DUST4XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DUST5XY) ) allocate ( NoahmpIO%DUST5XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcBCPHIXY) ) allocate ( NoahmpIO%MassConcBCPHIXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcBCPHOXY) ) allocate ( NoahmpIO%MassConcBCPHOXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcOCPHIXY) ) allocate ( NoahmpIO%MassConcOCPHIXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcOCPHOXY) ) allocate ( NoahmpIO%MassConcOCPHOXY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcDUST1XY) ) allocate ( NoahmpIO%MassConcDUST1XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcDUST2XY) ) allocate ( NoahmpIO%MassConcDUST2XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcDUST3XY) ) allocate ( NoahmpIO%MassConcDUST3XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcDUST4XY) ) allocate ( NoahmpIO%MassConcDUST4XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%MassConcDUST5XY) ) allocate ( NoahmpIO%MassConcDUST5XY (XSTART:XEND,-NSNOW+1:0, YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepBChydrophoXY) ) allocate ( NoahmpIO%DepBChydrophoXY (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepBChydrophiXY) ) allocate ( NoahmpIO%DepBChydrophiXY (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepOChydrophoXY) ) allocate ( NoahmpIO%DepOChydrophoXY (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepOChydrophiXY) ) allocate ( NoahmpIO%DepOChydrophiXY (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepDust1XY) ) allocate ( NoahmpIO%DepDust1XY (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepDust2XY) ) allocate ( NoahmpIO%DepDust2XY (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepDust3XY) ) allocate ( NoahmpIO%DepDust3XY (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepDust4XY) ) allocate ( NoahmpIO%DepDust4XY (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DepDust5XY) ) allocate ( NoahmpIO%DepDust5XY (XSTART:XEND,YSTART:YEND) ) + endif + + if ( .not. allocated (NoahmpIO%ALBSNOWDIRXY)) allocate ( NoahmpIO%ALBSNOWDIRXY (XSTART:XEND,1:NUMRAD,YSTART:YEND) ) ! snow albedo (direct) + if ( .not. allocated (NoahmpIO%ALBSNOWDIFXY)) allocate ( NoahmpIO%ALBSNOWDIFXY (XSTART:XEND,1:NUMRAD,YSTART:YEND) ) ! snow albedo (diffuse) + if ( .not. allocated (NoahmpIO%ALBSFCDIRXY)) allocate ( NoahmpIO%ALBSFCDIRXY (XSTART:XEND,1:NUMRAD,YSTART:YEND) ) ! surface albedo (direct) + if ( .not. allocated (NoahmpIO%ALBSFCDIFXY)) allocate ( NoahmpIO%ALBSFCDIFXY (XSTART:XEND,1:NUMRAD,YSTART:YEND) ) ! surface albedo (diffuse) + + if ( .not. allocated (NoahmpIO%VisFrac) ) allocate ( NoahmpIO%VisFrac (XSTART:XEND,YSTART:YEND) ) + if ( .not. allocated (NoahmpIO%DirFrac) ) allocate ( NoahmpIO%DirFrac (XSTART:XEND,YSTART:YEND) ) + ! Needed for crop model (OPT_CROP=1) if ( .not. allocated (NoahmpIO%PGSXY) ) allocate ( NoahmpIO%PGSXY (XSTART:XEND, YSTART:YEND) ) if ( .not. allocated (NoahmpIO%CROPCAT) ) allocate ( NoahmpIO%CROPCAT (XSTART:XEND, YSTART:YEND) ) @@ -530,6 +619,8 @@ subroutine NoahmpIOVarInitDefault(NoahmpIO) NoahmpIO%TSNOXY = undefined_real NoahmpIO%SNICEXY = undefined_real NoahmpIO%SNLIQXY = undefined_real + NoahmpIO%ALBSNOWDIRXY = undefined_real + NoahmpIO%ALBSNOWDIFXY = undefined_real NoahmpIO%LFMASSXY = undefined_real NoahmpIO%RTMASSXY = undefined_real NoahmpIO%STMASSXY = undefined_real @@ -671,6 +762,79 @@ subroutine NoahmpIOVarInitDefault(NoahmpIO) NoahmpIO%QSLATXY = undefined_real NoahmpIO%QLATXY = undefined_real + ! SNICAR snow albedo + if ( NoahmpIO%IOPT_ALB == 3 ) then + NoahmpIO%ss_alb_snw_drc = undefined_real + NoahmpIO%asm_prm_snw_drc = undefined_real + NoahmpIO%ext_cff_mss_snw_drc = undefined_real + NoahmpIO%ss_alb_snw_dfs = undefined_real + NoahmpIO%asm_prm_snw_dfs = undefined_real + NoahmpIO%ext_cff_mss_snw_dfs = undefined_real + NoahmpIO%ss_alb_bc1 = undefined_real + NoahmpIO%asm_prm_bc1 = undefined_real + NoahmpIO%ext_cff_mss_bc1 = undefined_real + NoahmpIO%ss_alb_bc2 = undefined_real + NoahmpIO%asm_prm_bc2 = undefined_real + NoahmpIO%ext_cff_mss_bc2 = undefined_real + NoahmpIO%ss_alb_oc1 = undefined_real + NoahmpIO%asm_prm_oc1 = undefined_real + NoahmpIO%ext_cff_mss_oc1 = undefined_real + NoahmpIO%ss_alb_oc2 = undefined_real + NoahmpIO%asm_prm_oc2 = undefined_real + NoahmpIO%ext_cff_mss_oc2 = undefined_real + NoahmpIO%ss_alb_dst1 = undefined_real + NoahmpIO%asm_prm_dst1 = undefined_real + NoahmpIO%ext_cff_mss_dst1 = undefined_real + NoahmpIO%ss_alb_dst2 = undefined_real + NoahmpIO%asm_prm_dst2 = undefined_real + NoahmpIO%ext_cff_mss_dst2 = undefined_real + NoahmpIO%ss_alb_dst3 = undefined_real + NoahmpIO%asm_prm_dst3 = undefined_real + NoahmpIO%ext_cff_mss_dst3 = undefined_real + NoahmpIO%ss_alb_dst4 = undefined_real + NoahmpIO%asm_prm_dst4 = undefined_real + NoahmpIO%ext_cff_mss_dst4 = undefined_real + NoahmpIO%ss_alb_dst5 = undefined_real + NoahmpIO%asm_prm_dst5 = undefined_real + NoahmpIO%ext_cff_mss_dst5 = undefined_real + NoahmpIO%flx_wgt_dir = undefined_real + NoahmpIO%flx_wgt_dif = undefined_real + NoahmpIO%snowage_tau = undefined_real + NoahmpIO%snowage_kappa = undefined_real + NoahmpIO%snowage_drdt0 = undefined_real + NoahmpIO%SNRDSXY = undefined_real + NoahmpIO%SNFRXY = undefined_real + NoahmpIO%ALBSOILDIRXY = undefined_real + NoahmpIO%ALBSOILDIFXY = undefined_real + NoahmpIO%BCPHOXY = undefined_real + NoahmpIO%BCPHIXY = undefined_real + NoahmpIO%OCPHOXY = undefined_real + NoahmpIO%OCPHIXY = undefined_real + NoahmpIO%DUST1XY = undefined_real + NoahmpIO%DUST2XY = undefined_real + NoahmpIO%DUST3XY = undefined_real + NoahmpIO%DUST4XY = undefined_real + NoahmpIO%DUST5XY = undefined_real + NoahmpIO%MassConcBCPHOXY = undefined_real + NoahmpIO%MassConcBCPHIXY = undefined_real + NoahmpIO%MassConcOCPHOXY = undefined_real + NoahmpIO%MassConcOCPHIXY = undefined_real + NoahmpIO%MassConcDUST1XY = undefined_real + NoahmpIO%MassConcDUST2XY = undefined_real + NoahmpIO%MassConcDUST3XY = undefined_real + NoahmpIO%MassConcDUST4XY = undefined_real + NoahmpIO%MassConcDUST5XY = undefined_real + NoahmpIO%DepBChydrophoXY = undefined_real + NoahmpIO%DepBChydrophiXY = undefined_real + NoahmpIO%DepOChydrophoXY = undefined_real + NoahmpIO%DepOChydrophiXY = undefined_real + NoahmpIO%DepDust1XY = undefined_real + NoahmpIO%DepDust2XY = undefined_real + NoahmpIO%DepDust3XY = undefined_real + NoahmpIO%DepDust4XY = undefined_real + NoahmpIO%DepDust5XY = undefined_real + endif + ! crop model NoahmpIO%PGSXY = undefined_int NoahmpIO%CROPCAT = undefined_int diff --git a/drivers/hrldas/NoahmpIOVarType.F90 b/drivers/hrldas/NoahmpIOVarType.F90 index a936dc04..ffdf2b7e 100644 --- a/drivers/hrldas/NoahmpIOVarType.F90 +++ b/drivers/hrldas/NoahmpIOVarType.F90 @@ -48,7 +48,7 @@ module NoahmpIOVarType integer :: IOPT_FRZ ! supercooled liquid water (1-> NY06; 2->Koren99) integer :: IOPT_INF ! frozen soil permeability (1-> NY06; 2->Koren99) integer :: IOPT_RAD ! radiation transfer (1->gap=F(3D,cosz); 2->gap=0; 3->gap=1-Fveg) - integer :: IOPT_ALB ! snow surface albedo (1->BATS; 2->CLASS) + integer :: IOPT_ALB ! snow surface albedo (1->BATS; 2->CLASS; 3->SNICAR) integer :: IOPT_SNF ! rainfall & snowfall (1-Jordan91; 2->BATS; 3->Noah) integer :: IOPT_TKSNO ! snow thermal conductivity: 1 -> Stieglitz(yen,1965) scheme (default), 2 -> Anderson, 1976 scheme, 3 -> constant, 4 -> Verseghy (1991) scheme, 5 -> Douvill(Yen, 1981) scheme integer :: IOPT_TBOT ! lower boundary of soil temperature (1->zero-flux; 2->Noah) @@ -354,6 +354,138 @@ module NoahmpIOVarType real(kind=kind_noahmp), allocatable, dimension(:,:) :: NONRIVERXY ! non-river portion real(kind=kind_noahmp) :: WTDDT = 30.0 ! frequency of groundwater call [minutes] integer :: STEPWTD ! step of groundwater call + integer :: NUMRAD = 2 ! number of shortwave band + +!------------------------------------------------------------------------ +! Needed for SNICAR SNOW ALBEDO (IOPT_ALB = 3) +!------------------------------------------------------------------------ + integer :: SNICAR_BANDNUMBER_OPT !number of wavelength bands used in SNICAR snow albedo calculation + ! 1->5;2->480 + integer :: SNICAR_SOLARSPEC_OPT !type of downward solar radiation spectrum for SNICAR snow albedo calculation + ! 1->mid-latitude winter;2->mid-latitude summer;3->sub-Arctic winter; + ! 4->sub-Arctic summer;5->Summit,Greenland,summer;6->High Mountain summer; + integer :: SNICAR_SNOWOPTICS_OPT !snow optics type using different refractive index databases in SNICAR + ! 1->Warren (1984);2->Warren and Brandt (2008);3->Picard et al (2016) + integer :: SNICAR_DUSTOPTICS_OPT !dust optics type for SNICAR snow albedo calculation + ! 1->Saharan dust (Balkanski et al., 2007, central hematite) + ! 2->San Juan Mountains dust, CO (Skiles et al, 2017) + ! 3->Greenland dust (Polashenski et al., 2015, central absorptivity) + integer :: SNICAR_RTSOLVER_OPT !option for two different SNICAR radiative transfer solver + ! 1->Toon et a 1989 2-stream (Flanner et al. 2007) + ! 2->Adding-doubling 2-stream (Dang et al.2019) + integer :: SNICAR_SNOWSHAPE_OPT !option for snow grain shape in SNICAR (He et al. 2017 JC) + ! 1->sphere; 2->spheroid; 3->hexagonal plate; 4->Koch snowflake + logical :: SNICAR_USE_AEROSOL !option to turn on/off aerosol deposition flux effect in snow in SNICAR + logical :: SNICAR_SNOWBC_INTMIX !option to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC) + ! false->external mixing for all BC; true->internal mixing for hydrophilic BC + logical :: SNICAR_SNOWDUST_INTMIX !option to activate dust-snow internal mixing in SNICAR (He et al. 2017 JC) + ! false->external mixing for all dust; true->internal mixing for all dust + logical :: SNICAR_USE_OC !option to activate OC in snow in SNICAR + logical :: SNICAR_AEROSOL_READTABLE !option to read aerosol deposition fluxes from table (on) or NetCDF forcing file (off) + integer :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx] + integer :: snicar_numrad_snw ! wavelength bands used in SNICAR snow albedo calculation + integer :: idx_T_max = 11 ! maxiumum temperature index used in aging lookup table [idx] + integer :: idx_Tgrd_max = 31 ! maxiumum temperature gradient index used in aging lookup table [idx] + integer :: idx_rhos_max = 8 ! maxiumum snow density index used in aging lookup table [idx] + integer :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx] + integer :: idx_Tgrd_min = 1 ! minimum temperature gradient index used in aging lookup table [idx] + integer :: idx_rhos_min = 1 ! minimum snow density index used in aging lookup table [idx] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ss_alb_snw_drc ! Mie single scatter albedos for direct-beam ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: asm_prm_snw_drc ! asymmetry parameter of direct-beam ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ext_cff_mss_snw_drc ! mass extinction coefficient for direct-beam ice [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ss_alb_snw_dfs ! Mie single scatter albedos for diffuse ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: asm_prm_snw_dfs ! asymmetry parameter of diffuse ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ext_cff_mss_snw_dfs ! mass extinction coefficient for diffuse ice [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_bc1 ! Mie single scatter albedos for hydrophillic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_bc1 ! asymmetry parameter for hydrophillic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_bc1 ! mass extinction coefficient for hydrophillic BC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_bc2 ! Mie single scatter albedos for hydrophobic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_bc2 ! asymmetry parameter for hydrophobic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_bc2 ! mass extinction coefficient for hydrophobic BC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_oc1 ! Mie single scatter albedos for hydrophillic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_oc1 ! asymmetry parameter for hydrophillic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_oc1 ! mass extinction coefficient for hydrophillic OC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_oc2 ! Mie single scatter albedos for hydrophobic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_oc2 ! asymmetry parameter for hydrophobic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_oc2 ! mass extinction coefficient for hydrophobic OC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst1 ! Mie single scatter albedos for dust species 1 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst1 ! asymmetry parameter for dust species 1 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst1 ! mass extinction coefficient for dust species 1 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst2 ! Mie single scatter albedos for dust species 2 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst2 ! asymmetry parameter for dust species 2 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst2 ! mass extinction coefficient for dust species 2 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst3 ! Mie single scatter albedos for dust species 3 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst3 ! asymmetry parameter for dust species 3 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst3 ! mass extinction coefficient for dust species 3 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst4 ! Mie single scatter albedos for dust species 4 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst4 ! asymmetry parameter for dust species 4 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst4 ! mass extinction coefficient for dust species 4 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst5 ! Mie single scatter albedos for dust species 5 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst5 ! asymmetry parameter for dust species 5 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst5 ! mass extinction coefficient for dust species 5 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: flx_wgt_dir ! downward direct solar radiation spectral weights for wavelength band + real(kind=kind_noahmp), allocatable, dimension(:) :: flx_wgt_dif ! downward diffuse solar radiation spectral weights for wavelength band + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: snowage_tau ! Snow aging parameters retrieved from lookup table [hour] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: snowage_kappa ! Snow aging parameters retrieved from lookup table [unitless] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: snowage_drdt0 ! Snow aging parameters retrieved from lookup table [m2 kg-1 hr-1] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: SNRDSXY ! snow layer effective grain radius [microns, m-6] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: SNFRXY ! snow layer rate of snow freezing [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: ALBSOILDIRXY ! soil albedo (direct) + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: ALBSOILDIFXY ! soil albedo (diffuse) + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: BCPHIXY ! mass of hydrophillic Black Carbon in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: BCPHOXY ! mass of hydrophobic Black Carbon in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: OCPHIXY ! mass of hydrophillic Organic Carbon in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: OCPHOXY ! mass of hydrophobic Organic Carbon in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: DUST1XY ! mass of dust species 1 in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: DUST2XY ! mass of dust species 2 in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: DUST3XY ! mass of dust species 3 in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: DUST4XY ! mass of dust species 4 in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: DUST5XY ! mass of dust species 5 in snow [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcBCPHIXY ! mass concentration of hydrophillic Black Carbon in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcBCPHOXY ! mass concentration of hydrophobic Black Carbon in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcOCPHIXY ! mass concentration of hydrophillic Organic Carbon in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcOCPHOXY ! mass concentration of hydrophobic Organic Carbon in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcDUST1XY ! mass concentration of dust species 1 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcDUST2XY ! mass concentration of dust species 2 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcDUST3XY ! mass concentration of dust species 3 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcDUST4XY ! mass concentration of dust species 4 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: MassConcDUST5XY ! mass concentration of dust species 5 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepBChydrophoXY ! hydrophobic Black Carbon deposition [kg m-2 s-1] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepBChydrophiXY ! hydrophillic Black Carbon deposition [kg m-2 s-1] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepOChydrophoXY ! hydrophobic Organic Carbon deposition [kg m-2 s-1] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepOChydrophiXY ! hydrophillic Organic Carbon deposition [kg m-2 s-1] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepDust1XY ! dust species 1 deposition [kg m-2 s-1] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepDust2XY ! dust species 2 deposition [kg m-2 s-1] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepDust3XY ! dust species 3 deposition [kg m-2 s-1] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepDust4XY ! dust species 4 deposition [kg m-2 s-1] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DepDust5XY ! dust species 5 deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepBChydropho_TABLE ! hydrophobic Black Carbon deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepBChydrophi_TABLE ! hydrophillic Black Carbon deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepOChydropho_TABLE ! hydrophobic Organic Carbon deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepOChydrophi_TABLE ! hydrophillic Organic Carbon deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust1_TABLE ! dust species 1 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust2_TABLE ! dust species 2 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust3_TABLE ! dust species 3 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust4_TABLE ! dust species 4 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust5_TABLE ! dust species 5 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: SnowRadiusMin_TABLE ! minimum allowed snow effective radius (also cold "fresh snow" value) [microns] + real(kind=kind_noahmp) :: FreshSnowRadiusMax_TABLE ! maximum warm fresh snow effective radius [microns] + real(kind=kind_noahmp) :: SnowRadiusRefrz_TABLE ! effective radius of re-frozen snow [microns] + character(len=256) :: forcing_name_BCPHI + character(len=256) :: forcing_name_BCPHO + character(len=256) :: forcing_name_OCPHI + character(len=256) :: forcing_name_OCPHO + character(len=256) :: forcing_name_DUST1 + character(len=256) :: forcing_name_DUST2 + character(len=256) :: forcing_name_DUST3 + character(len=256) :: forcing_name_DUST4 + character(len=256) :: forcing_name_DUST5 + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: ALBSNOWDIRXY ! snow albedo (direct) + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: ALBSNOWDIFXY ! snow albedo (diffuse) + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: ALBSFCDIRXY ! surface albedo (direct) + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: ALBSFCDIFXY ! surface albedo (diffuse) + real(kind=kind_noahmp), allocatable, dimension(:,:) :: VisFrac ! fraction of visible band + real(kind=kind_noahmp), allocatable, dimension(:,:) :: DirFrac ! fraction of direct band !------------------------------------------------------------------------ ! Needed for TILE DRAINAGE IF IOPT_TDRN = 1 OR 2 @@ -545,6 +677,7 @@ module NoahmpIOVarType logical :: update_lai, update_veg integer :: spinup_loop logical :: reset_spinup_date + logical :: reset_spinup_datea !--------------------------------------------------------------------- ! File naming, parallel diff --git a/drivers/hrldas/NoahmpInitMainMod.F90 b/drivers/hrldas/NoahmpInitMainMod.F90 index 7a590791..efdd9f3e 100644 --- a/drivers/hrldas/NoahmpInitMainMod.F90 +++ b/drivers/hrldas/NoahmpInitMainMod.F90 @@ -24,7 +24,7 @@ subroutine NoahmpInitMain(NoahmpIO) ! local variables integer :: ide,jde,its,jts,itf,jtf - integer :: I,J,errflag,NS + integer :: I,J,errflag,NS,IZ logical :: urbanpt_flag real(kind=kind_noahmp) :: BEXP, SMCMAX, PSISAT, FK real(kind=kind_noahmp), parameter :: BLIM = 5.5 @@ -265,6 +265,40 @@ subroutine NoahmpInitMain(NoahmpIO) NoahmpIO%STEPWTD = max(NoahmpIO%STEPWTD,1) endif + else + + if (NoahmpIO%IOPT_ALB == 3 )then + itf = min0(NoahmpIO%ite, ide-1) + jtf = min0(NoahmpIO%jte, jde-1) + do J = jts, jtf + do I = its, itf + do IZ = -NoahmpIO%NSNOW+1, 0 + if ((NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) > 0.0) then + NoahmpIO%MassConcBCPHIXY (I,IZ,J) = NoahmpIO%BCPHIXY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + NoahmpIO%MassConcBCPHOXY (I,IZ,J) = NoahmpIO%BCPHOXY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + NoahmpIO%MassConcOCPHIXY (I,IZ,J) = NoahmpIO%OCPHIXY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + NoahmpIO%MassConcOCPHOXY (I,IZ,J) = NoahmpIO%OCPHOXY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + NoahmpIO%MassConcDUST1XY (I,IZ,J) = NoahmpIO%DUST1XY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + NoahmpIO%MassConcDUST2XY (I,IZ,J) = NoahmpIO%DUST2XY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + NoahmpIO%MassConcDUST3XY (I,IZ,J) = NoahmpIO%DUST3XY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + NoahmpIO%MassConcDUST4XY (I,IZ,J) = NoahmpIO%DUST4XY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + NoahmpIO%MassConcDUST5XY (I,IZ,J) = NoahmpIO%DUST5XY (I,IZ,J) / (NoahmpIO%SNLIQXY(I,IZ,J)+NoahmpIO%SNICEXY(I,IZ,J)) + else + NoahmpIO%MassConcBCPHIXY (I,IZ,J) = 0.0 + NoahmpIO%MassConcBCPHOXY (I,IZ,J) = 0.0 + NoahmpIO%MassConcOCPHIXY (I,IZ,J) = 0.0 + NoahmpIO%MassConcOCPHOXY (I,IZ,J) = 0.0 + NoahmpIO%MassConcDUST1XY (I,IZ,J) = 0.0 + NoahmpIO%MassConcDUST2XY (I,IZ,J) = 0.0 + NoahmpIO%MassConcDUST3XY (I,IZ,J) = 0.0 + NoahmpIO%MassConcDUST4XY (I,IZ,J) = 0.0 + NoahmpIO%MassConcDUST5XY (I,IZ,J) = 0.0 + endif + enddo + enddo + enddo + endif + endif ! NoahmpIO%restart_flag end subroutine NoahmpInitMain diff --git a/drivers/hrldas/NoahmpReadNamelistMod.F90 b/drivers/hrldas/NoahmpReadNamelistMod.F90 index 0b3e1c97..454cabe0 100644 --- a/drivers/hrldas/NoahmpReadNamelistMod.F90 +++ b/drivers/hrldas/NoahmpReadNamelistMod.F90 @@ -109,7 +109,28 @@ subroutine NoahmpReadNamelist(NoahmpIO) integer :: yend = 0 integer, parameter :: MAX_SOIL_LEVELS = 10 ! maximum soil levels in namelist real(kind=kind_noahmp), dimension(MAX_SOIL_LEVELS) :: soil_thick_input ! depth to soil interfaces from namelist [m] - + ! Snow, Ice, and Aerosol Radiative (SNICAR) model parameters + integer :: snicar_bandnumber_option = 1 + integer :: snicar_solarspec_option = 1 + integer :: snicar_snowoptics_option = 3 + integer :: snicar_dustoptics_option = 1 + integer :: snicar_rtsolver_option = 2 + integer :: snicar_snowshape_option = 3 + logical :: snicar_use_aerosol = .true. + logical :: snicar_snowbc_intmix = .true. + logical :: snicar_snowdust_intmix = .true. + logical :: snicar_use_oc = .true. + logical :: snicar_aerosol_readtable = .false. + character(len=256) :: forcing_name_BCPHI = "BCPHI" + character(len=256) :: forcing_name_BCPHO = "BCPHO" + character(len=256) :: forcing_name_OCPHI = "OCPHI" + character(len=256) :: forcing_name_OCPHO = "OCPHO" + character(len=256) :: forcing_name_DUST1 = "DUST1" + character(len=256) :: forcing_name_DUST2 = "DUST2" + character(len=256) :: forcing_name_DUST3 = "DUST3" + character(len=256) :: forcing_name_DUST4 = "DUST4" + character(len=256) :: forcing_name_DUST5 = "DUST5" + namelist / NOAHLSM_OFFLINE / & #ifdef WRF_HYDRO finemesh,finemesh_factor,forc_typ, snow_assim , GEO_STATIC_FLNM, HRLDAS_ini_typ, & @@ -136,8 +157,13 @@ subroutine NoahmpReadNamelist(NoahmpIO) khour, kday, zlvl, hrldas_setup_file, & spatial_filename, agdata_flnm, tdinput_flnm, & external_veg_filename_template, external_lai_filename_template, & - xstart, xend, ystart, yend - + xstart, xend, ystart, yend, & + snicar_bandnumber_option, snicar_solarspec_option, snicar_snowoptics_option, & + snicar_dustoptics_option, snicar_rtsolver_option, snicar_snowshape_option, & + snicar_use_aerosol, snicar_snowbc_intmix, snicar_snowdust_intmix, & + snicar_use_oc, snicar_aerosol_readtable, forcing_name_BCPHI, forcing_name_BCPHO, & + forcing_name_OCPHI, forcing_name_OCPHO, forcing_name_DUST1, forcing_name_DUST2, & + forcing_name_DUST3, forcing_name_DUST4, forcing_name_DUST5 !--------------------------------------------------------------- ! Initialize namelist variables to dummy values, so we can tell @@ -396,7 +422,28 @@ subroutine NoahmpReadNamelist(NoahmpIO) NoahmpIO%yend = yend NoahmpIO%MAX_SOIL_LEVELS = MAX_SOIL_LEVELS NoahmpIO%soil_thick_input = soil_thick_input - + ! SNICAR + NoahmpIO%SNICAR_BANDNUMBER_OPT = snicar_bandnumber_option + NoahmpIO%SNICAR_SOLARSPEC_OPT = snicar_solarspec_option + NoahmpIO%SNICAR_SNOWOPTICS_OPT = snicar_snowoptics_option + NoahmpIO%SNICAR_DUSTOPTICS_OPT = snicar_dustoptics_option + NoahmpIO%SNICAR_RTSOLVER_OPT = snicar_rtsolver_option + NoahmpIO%SNICAR_SNOWSHAPE_OPT = snicar_snowshape_option + NoahmpIO%SNICAR_USE_AEROSOL = snicar_use_aerosol + NoahmpIO%SNICAR_SNOWBC_INTMIX = snicar_snowbc_intmix + NoahmpIO%SNICAR_SNOWDUST_INTMIX = snicar_snowdust_intmix + NoahmpIO%SNICAR_USE_OC = snicar_use_oc + NoahmpIO%SNICAR_AEROSOL_READTABLE = snicar_aerosol_readtable + NoahmpIO%forcing_name_BCPHI = forcing_name_BCPHI + NoahmpIO%forcing_name_BCPHO = forcing_name_BCPHO + NoahmpIO%forcing_name_OCPHI = forcing_name_OCPHI + NoahmpIO%forcing_name_OCPHO = forcing_name_OCPHO + NoahmpIO%forcing_name_DUST1 = forcing_name_DUST1 + NoahmpIO%forcing_name_DUST2 = forcing_name_DUST2 + NoahmpIO%forcing_name_DUST3 = forcing_name_DUST3 + NoahmpIO%forcing_name_DUST4 = forcing_name_DUST4 + NoahmpIO%forcing_name_DUST5 = forcing_name_DUST5 + !--------------------------------------------------------------------- ! NAMELIST check end !--------------------------------------------------------------------- diff --git a/drivers/hrldas/NoahmpReadTableMod.F90 b/drivers/hrldas/NoahmpReadTableMod.F90 index eb01ceb2..31562c6a 100644 --- a/drivers/hrldas/NoahmpReadTableMod.F90 +++ b/drivers/hrldas/NoahmpReadTableMod.F90 @@ -203,6 +203,13 @@ subroutine NoahmpReadTable(NoahmpIO) sr2006_psi_et_d, sr2006_psi_et_e, sr2006_psi_et_f, sr2006_psi_et_g, & sr2006_psi_e_a, sr2006_psi_e_b, sr2006_psi_e_c, sr2006_smcmax_a, & sr2006_smcmax_b + ! SNICAR + real(kind=kind_noahmp) :: DepBChydropho,DepBChydrophi,DepOChydropho,DepOChydrophi, & + DepDust1,DepDust2,DepDust3,DepDust4,DepDust5, & + SnowRadiusMin,FreshSnowRadiusMax,SnowRadiusRefrz + namelist / noahmp_snicar_parameters / DepBChydropho,DepBChydrophi,DepOChydropho,DepOChydrophi, & + DepDust1,DepDust2,DepDust3,DepDust4,DepDust5, & + SnowRadiusMin,FreshSnowRadiusMax,SnowRadiusRefrz !-------------------------------------------------- !=== allocate multi-dim input table variables @@ -640,6 +647,20 @@ subroutine NoahmpReadTable(NoahmpIO) NoahmpIO%sr2006_psi_e_c_TABLE = undefined_real NoahmpIO%sr2006_smcmax_a_TABLE = undefined_real NoahmpIO%sr2006_smcmax_b_TABLE = undefined_real + + !SNICAR + NoahmpIO%DepBChydropho_TABLE = undefined_real + NoahmpIO%DepBChydrophi_TABLE = undefined_real + NoahmpIO%DepOChydropho_TABLE = undefined_real + NoahmpIO%DepOChydrophi_TABLE = undefined_real + NoahmpIO%DepDust1_TABLE = undefined_real + NoahmpIO%DepDust2_TABLE = undefined_real + NoahmpIO%DepDust3_TABLE = undefined_real + NoahmpIO%DepDust4_TABLE = undefined_real + NoahmpIO%DepDust5_TABLE = undefined_real + NoahmpIO%SnowRadiusMin_TABLE = undefined_real + NoahmpIO%FreshSnowRadiusMax_TABLE = undefined_real + NoahmpIO%SnowRadiusRefrz_TABLE = undefined_real !--------------------------------------------------------------- ! transfer values from table to input variables @@ -1177,6 +1198,33 @@ subroutine NoahmpReadTable(NoahmpIO) NoahmpIO%sr2006_smcmax_a_TABLE = sr2006_smcmax_a NoahmpIO%sr2006_smcmax_b_TABLE = sr2006_smcmax_b + !---------------- NoahmpTable.TBL snicar parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if (ierr /= 0) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15,noahmp_snicar_parameters) + close(15) + + ! assign values + NoahmpIO%DepBChydropho_TABLE = DepBChydropho + NoahmpIO%DepBChydrophi_TABLE = DepBChydrophi + NoahmpIO%DepOChydropho_TABLE = DepOChydropho + NoahmpIO%DepOChydrophi_TABLE = DepOChydrophi + NoahmpIO%DepDust1_TABLE = DepDust1 + NoahmpIO%DepDust2_TABLE = DepDust2 + NoahmpIO%DepDust3_TABLE = DepDust3 + NoahmpIO%DepDust4_TABLE = DepDust4 + NoahmpIO%DepDust5_TABLE = DepDust5 + NoahmpIO%SnowRadiusMin_TABLE = SnowRadiusMin + NoahmpIO%FreshSnowRadiusMax_TABLE = FreshSnowRadiusMax + NoahmpIO%SnowRadiusRefrz_TABLE = SnowRadiusRefrz + end subroutine NoahmpReadTable end module NoahmpReadTableMod diff --git a/drivers/hrldas/NoahmpSnowInitMod.F90 b/drivers/hrldas/NoahmpSnowInitMod.F90 index 6c5dd3c8..e987d3d5 100644 --- a/drivers/hrldas/NoahmpSnowInitMod.F90 +++ b/drivers/hrldas/NoahmpSnowInitMod.F90 @@ -35,6 +35,8 @@ subroutine NoahmpSnowInitMain(NoahmpIO) ! SNICEXY is the frozen content of a snow layer. Initial estimate based on SNOWH and SNOW ! SNLIQXY is the liquid content of a snow layer. Initialized to 0.0 ! ZNSNOXY is the layer depth from the surface. +! SNRDSXY is the snow layer effective grain radius [microns, m-6] +! SNFRXY is the snow layer rate of snow freezing [mm/s] !------------------------------------------------------------------------------------------ itf = min0(NoahmpIO%ite, (NoahmpIO%ide+1)-1) @@ -108,6 +110,23 @@ subroutine NoahmpSnowInitMain(NoahmpIO) NoahmpIO%ZSNSOXY(I,IZ,J) = NoahmpIO%ZSNSOXY(I,IZ-1,J) + DZSNSO(IZ) enddo + !SNICAR, can move out to initial file later + if (NoahmpIO%IOPT_ALB == 3 )then + NoahmpIO%ALBSOILDIRXY(I,:,J) = 0.0 + NoahmpIO%ALBSOILDIFXY(I,:,J) = 0.0 + NoahmpIO%SNRDSXY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%SNFRXY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%BCPHIXY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%BCPHOXY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%OCPHIXY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%OCPHOXY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%DUST1XY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%DUST2XY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%DUST3XY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%DUST4XY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + NoahmpIO%DUST5XY (I,-NoahmpIO%NSNOW+1:0,J) = 0.0 + endif + enddo ! I enddo ! J diff --git a/drivers/hrldas/WaterVarInTransferMod.F90 b/drivers/hrldas/WaterVarInTransferMod.F90 index b7208851..20bac1e2 100644 --- a/drivers/hrldas/WaterVarInTransferMod.F90 +++ b/drivers/hrldas/WaterVarInTransferMod.F90 @@ -147,6 +147,36 @@ subroutine WaterVarInTransfer(noahmp, NoahmpIO) noahmp%water%param%NumSoilLayerRoot = NoahmpIO%NROOT_TABLE(VegType) noahmp%water%param%SoilDrainSlope = NoahmpIO%SLOPE_TABLE(RunoffSlopeType) + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + noahmp%water%state%SnowRadius (-NumSnowLayerMax+1:0) = NoahmpIO%SNRDSXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%flux%SnowFreezeRate(-NumSnowLayerMax+1:0) = NoahmpIO%SNFRXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%param%snowage_tau = NoahmpIO%snowage_tau + noahmp%water%param%snowage_kappa = NoahmpIO%snowage_kappa + noahmp%water%param%snowage_drdt0 = NoahmpIO%snowage_drdt0 + noahmp%water%state%MassBChydrophi(-NumSnowLayerMax+1:0) = NoahmpIO%BCPHIXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassBChydropho(-NumSnowLayerMax+1:0) = NoahmpIO%BCPHOXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassOChydrophi(-NumSnowLayerMax+1:0) = NoahmpIO%OCPHIXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassOChydropho(-NumSnowLayerMax+1:0) = NoahmpIO%OCPHOXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassDust1(-NumSnowLayerMax+1:0) = NoahmpIO%DUST1XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassDust2(-NumSnowLayerMax+1:0) = NoahmpIO%DUST2XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassDust3(-NumSnowLayerMax+1:0) = NoahmpIO%DUST3XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassDust4(-NumSnowLayerMax+1:0) = NoahmpIO%DUST4XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassDust5(-NumSnowLayerMax+1:0) = NoahmpIO%DUST5XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcBChydrophi(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcBCPHIXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcBChydropho(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcBCPHOXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcOChydrophi(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcOCPHIXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcOChydropho(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcOCPHOXY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcDust1(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcDUST1XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcDust2(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcDUST2XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcDust3(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcDUST3XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcDust4(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcDUST4XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%state%MassConcDust5(-NumSnowLayerMax+1:0) = NoahmpIO%MassConcDUST5XY (I,-NumSnowLayerMax+1:0,J) + noahmp%water%param%SnowRadiusMin = NoahmpIO%SnowRadiusMin_TABLE + noahmp%water%param%FreshSnowRadiusMax = NoahmpIO%FreshSnowRadiusMax_TABLE + noahmp%water%param%SnowRadiusRefrz = NoahmpIO%SnowRadiusRefrz_TABLE + endif + do IndexSoilLayer = 1, size(SoilType) noahmp%water%param%SoilMoistureSat (IndexSoilLayer) = NoahmpIO%SMCMAX_TABLE(SoilType(IndexSoilLayer)) noahmp%water%param%SoilMoistureWilt (IndexSoilLayer) = NoahmpIO%SMCWLT_TABLE(SoilType(IndexSoilLayer)) @@ -219,7 +249,7 @@ subroutine WaterVarInTransfer(noahmp, NoahmpIO) noahmp%water%state%SnowIceFracPrev = 0.0 noahmp%water%state%SnowIceFracPrev(NumSnowLayerNeg+1:0) = NoahmpIO%SNICEXY(I,NumSnowLayerNeg+1:0,J) / & (NoahmpIO%SNICEXY(I,NumSnowLayerNeg+1:0,J) + & - NoahmpIO%SNLIQXY(I,NumSnowLayerNeg+1:0,J)) + NoahmpIO%SNLIQXY(I,NumSnowLayerNeg+1:0,J)) if ( (noahmp%config%nmlist%OptSoilProperty == 3) .and. (.not. noahmp%config%domain%FlagUrban) ) then if (.not. allocated(SoilSand)) allocate( SoilSand(1:NumSoilLayer) ) diff --git a/drivers/hrldas/WaterVarOutTransferMod.F90 b/drivers/hrldas/WaterVarOutTransferMod.F90 index 7a30df02..0bb0fde1 100644 --- a/drivers/hrldas/WaterVarOutTransferMod.F90 +++ b/drivers/hrldas/WaterVarOutTransferMod.F90 @@ -129,6 +129,30 @@ subroutine WaterVarOutTransfer(noahmp, NoahmpIO) NoahmpIO%SNICEXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%SnowIce(-NumSnowLayerMax+1:0) NoahmpIO%SNLIQXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%SnowLiqWater(-NumSnowLayerMax+1:0) + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + NoahmpIO%SNRDSXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%SnowRadius(-NumSnowLayerMax+1:0) + NoahmpIO%SNFRXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%flux%SnowFreezeRate(-NumSnowLayerMax+1:0) + NoahmpIO%BCPHIXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassBChydrophi(-NumSnowLayerMax+1:0) + NoahmpIO%BCPHOXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassBChydropho(-NumSnowLayerMax+1:0) + NoahmpIO%OCPHIXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassOChydrophi(-NumSnowLayerMax+1:0) + NoahmpIO%OCPHOXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassOChydropho(-NumSnowLayerMax+1:0) + NoahmpIO%DUST1XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassDust1(-NumSnowLayerMax+1:0) + NoahmpIO%DUST2XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassDust2(-NumSnowLayerMax+1:0) + NoahmpIO%DUST3XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassDust3(-NumSnowLayerMax+1:0) + NoahmpIO%DUST4XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassDust4(-NumSnowLayerMax+1:0) + NoahmpIO%DUST5XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassDust5(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcBCPHIXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcBChydrophi(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcBCPHOXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcBChydropho(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcOCPHIXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcOChydrophi(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcOCPHOXY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcOChydropho(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcDUST1XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcDust1(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcDUST2XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcDust2(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcDUST3XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcDust3(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcDUST4XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcDust4(-NumSnowLayerMax+1:0) + NoahmpIO%MassConcDUST5XY (I,-NumSnowLayerMax+1:0,J) = noahmp%water%state%MassConcDust5(-NumSnowLayerMax+1:0) + endif + ! irrigation NoahmpIO%IRNUMSI (I,J) = noahmp%water%state%IrrigationCntSprinkler NoahmpIO%IRNUMMI (I,J) = noahmp%water%state%IrrigationCntMicro diff --git a/parameters/NoahmpTable.TBL b/parameters/NoahmpTable.TBL index c9d37c5b..2ff46d21 100644 --- a/parameters/NoahmpTable.TBL +++ b/parameters/NoahmpTable.TBL @@ -854,3 +854,18 @@ ! GDVIC: mean capilary drive (m) for dynamic VIC runoff GDVIC = 0.050, 0.070, 0.130, 0.200, 0.170, 0.110, 0.260, 0.350, 0.260, 0.300, 0.380, 0.410, 0.500, 0.001, 0.010, 0.001, 0.001, 0.050, 0.020 / + +&noahmp_snicar_parameters + SnowRadiusMin = 54.526 ! minimum allowed snow effective radius (also cold "fresh snow" value), can't be lower than 30.0 [microns] + FreshSnowRadiusMax = 204.526 ! maximum warm fresh snow effective radius [microns] + SnowRadiusRefrz = 1000.0 ! Effective radius of re-frozen snow [microns] + DepBChydropho = 0.0 ! hydrophobic Black Carbon deposition [kg m-2 s-1], assume constant read from table + DepBChydrophi = 0.0 ! hydrophillic Black Carbon deposition [kg m-2 s-1], assume constant read from table + DepOChydropho = 0.0 ! hydrophobic Organic Carbon deposition [kg m-2 s-1], assume constant read from table + DepOChydrophi = 0.0 ! hydrophillic Organic Carbon deposition [kg m-2 s-1], assume constant read from table + DepDust1 = 0.0 ! dust species 1 deposition [kg m-2 s-1], assume constant read from table + DepDust2 = 0.0 ! dust species 2 deposition [kg m-2 s-1], assume constant read from table + DepDust3 = 0.0 ! dust species 3 deposition [kg m-2 s-1], assume constant read from table + DepDust4 = 0.0 ! dust species 4 deposition [kg m-2 s-1], assume constant read from table + DepDust5 = 0.0 ! dust species 5 deposition [kg m-2 s-1], assume constant read from table +/ diff --git a/parameters/snicar_drdt_bst_fit_60_c070416.nc b/parameters/snicar_drdt_bst_fit_60_c070416.nc new file mode 100644 index 00000000..c13c828b Binary files /dev/null and b/parameters/snicar_drdt_bst_fit_60_c070416.nc differ diff --git a/parameters/snicar_optics_480bnd_c012422.nc b/parameters/snicar_optics_480bnd_c012422.nc new file mode 100644 index 00000000..cca3c4e0 Binary files /dev/null and b/parameters/snicar_optics_480bnd_c012422.nc differ diff --git a/parameters/snicar_optics_5bnd_c013122.nc b/parameters/snicar_optics_5bnd_c013122.nc new file mode 100644 index 00000000..dbdb797d Binary files /dev/null and b/parameters/snicar_optics_5bnd_c013122.nc differ diff --git a/src/AtmosForcingMod.F90 b/src/AtmosForcingMod.F90 index 94451a74..488689d5 100644 --- a/src/AtmosForcingMod.F90 +++ b/src/AtmosForcingMod.F90 @@ -50,6 +50,8 @@ subroutine ProcessAtmosForcing(noahmp) RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height WindEastwardRefHeight => noahmp%forcing%WindEastwardRefHeight ,& ! in, wind speed [m/s] in eastward direction at reference height WindNorthwardRefHeight => noahmp%forcing%WindNorthwardRefHeight ,& ! in, wind speed [m/s] in northward direction at reference height + VisFrac => noahmp%forcing%VisFrac ,& ! in, + DirFrac => noahmp%forcing%DirFrac ,& ! in, SnowfallDensityMax => noahmp%water%param%SnowfallDensityMax ,& ! in, maximum fresh snowfall density [kg/m3] TemperaturePotRefHeight => noahmp%energy%state%TemperaturePotRefHeight ,& ! out, surface potential temperature [K] PressureVaporRefHeight => noahmp%energy%state%PressureVaporRefHeight ,& ! out, vapor pressure air [Pa] at reference height @@ -78,6 +80,19 @@ subroutine ProcessAtmosForcing(noahmp) ! downward solar radiation RadDirFrac = 0.7 RadVisFrac = 0.5 + + if (DirFrac >=0.0 .and. DirFrac <=1.0) then + RadDirFrac=DirFrac + else + DirFrac=RadDirFrac + endif + + if (VisFrac >=0.0 .and. VisFrac <=1.0) then + RadVisFrac=VisFrac + else + VisFrac=RadVisFrac + endif + if ( CosSolarZenithAngle <= 0.0 ) RadSwDownRefHeight = 0.0 ! filter by solar zenith angle RadSwDownDir(1) = RadSwDownRefHeight * RadDirFrac * RadVisFrac ! direct vis RadSwDownDir(2) = RadSwDownRefHeight * RadDirFrac * (1.0-RadVisFrac) ! direct nir diff --git a/src/BalanceErrorCheckGlacierMod.F90 b/src/BalanceErrorCheckGlacierMod.F90 index 7b5e8391..f82c8685 100644 --- a/src/BalanceErrorCheckGlacierMod.F90 +++ b/src/BalanceErrorCheckGlacierMod.F90 @@ -105,6 +105,7 @@ subroutine BalanceEnergyCheckGlacier(noahmp) ! Original Noah-MP subroutine: ERROR_GLACIER ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding snicar solar radiation check (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- implicit none @@ -112,20 +113,22 @@ subroutine BalanceEnergyCheckGlacier(noahmp) type(noahmp_type), intent(inout) :: noahmp ! -------------------------------------------------------------------- - associate( & - GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction - GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction - RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height - RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! in, total absorbed solar radiation [W/m2] - RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! in, total reflected solar radiation [W/m2] - RadLwNetSfc => noahmp%energy%flux%RadLwNetSfc ,& ! in, total net longwave rad [W/m2] (+ to atm) - HeatSensibleSfc => noahmp%energy%flux%HeatSensibleSfc ,& ! in, total sensible heat [W/m2] (+ to atm) - HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! in, total ground latent heat [W/m2] (+ to atm) - HeatGroundTot => noahmp%energy%flux%HeatGroundTot ,& ! in, total ground heat flux [W/m2] (+ to soil/snow) - RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] - HeatPrecipAdvSfc => noahmp%energy%flux%HeatPrecipAdvSfc ,& ! in, precipitation advected heat - total [W/m2] - EnergyBalanceError => noahmp%energy%state%EnergyBalanceError ,& ! out, error in surface energy balance [W/m2] - RadSwBalanceError => noahmp%energy%state%RadSwBalanceError & ! out, error in shortwave radiation balance [W/m2] + associate( & + GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction + GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo + RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height + RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! in, total absorbed solar radiation [W/m2] + RadSwAbsSnowSoilLayer=> noahmp%energy%flux%RadSwAbsSnowSoilLayer,& ! in, total absorbed solar radiation by snow for each layer [W/m2] + RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! in, total reflected solar radiation [W/m2] + RadLwNetSfc => noahmp%energy%flux%RadLwNetSfc ,& ! in, total net longwave rad [W/m2] (+ to atm) + HeatSensibleSfc => noahmp%energy%flux%HeatSensibleSfc ,& ! in, total sensible heat [W/m2] (+ to atm) + HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! in, total ground latent heat [W/m2] (+ to atm) + HeatGroundTot => noahmp%energy%flux%HeatGroundTot ,& ! in, total ground heat flux [W/m2] (+ to soil/snow) + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] + HeatPrecipAdvSfc => noahmp%energy%flux%HeatPrecipAdvSfc ,& ! in, precipitation advected heat - total [W/m2] + EnergyBalanceError => noahmp%energy%state%EnergyBalanceError ,& ! out, error in surface energy balance [W/m2] + RadSwBalanceError => noahmp%energy%state%RadSwBalanceError & ! out, error in shortwave radiation balance [W/m2] ) ! ---------------------------------------------------------------------- @@ -142,6 +145,15 @@ subroutine BalanceEnergyCheckGlacier(noahmp) stop "Error: Solar radiation budget problem in NoahMP LSM" endif + !SNICAR + if ( OptSnowAlbedo == 3 .and. abs(RadSwAbsGrd-sum(RadSwAbsSnowSoilLayer))>0.001) then !original check is 0.0001, precision issue + write(*,*) "RadSwAbsGrd gridmean = ", RadSwAbsGrd + write(*,*) "sum(RadSwAbsSnowSoilLayer) gridmean = ", sum(RadSwAbsSnowSoilLayer) + write(*,*) "RadSwAbsSnowSoilLayer gridmean = ", RadSwAbsSnowSoilLayer + write(*,*) "RadSwAbsGrd-sum(RadSwAbsSnowSoilLayer) gridmean = ", RadSwAbsGrd-sum(RadSwAbsSnowSoilLayer) + stop + endif + ! error in surface energy balance should be <0.01 W/m2 EnergyBalanceError = RadSwAbsGrd + HeatPrecipAdvSfc - (RadLwNetSfc + HeatSensibleSfc + HeatLatentGrd + HeatGroundTot) ! print out diagnostics when error is large diff --git a/src/BalanceErrorCheckMod.F90 b/src/BalanceErrorCheckMod.F90 index f076e2a5..f79e3e33 100644 --- a/src/BalanceErrorCheckMod.F90 +++ b/src/BalanceErrorCheckMod.F90 @@ -169,6 +169,7 @@ subroutine BalanceEnergyCheck(noahmp) ! Original Noah-MP subroutine: ERROR ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding snicar solar radiation check (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- implicit none @@ -179,9 +180,11 @@ subroutine BalanceEnergyCheck(noahmp) associate( & GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! in, total absorbed solar radiation [W/m2] + RadSwAbsSnowSoilLayer=> noahmp%energy%flux%RadSwAbsSnowSoilLayer,& ! in, total absorbed solar radiation by snow for each layer [W/m2] RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! in, total reflected solar radiation [W/m2] RadSwReflVeg => noahmp%energy%flux%RadSwReflVeg ,& ! in, reflected solar radiation by vegetation [W/m2] RadSwReflGrd => noahmp%energy%flux%RadSwReflGrd ,& ! in, reflected solar radiation by ground [W/m2] @@ -191,6 +194,7 @@ subroutine BalanceEnergyCheck(noahmp) HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! in, total ground latent heat [W/m2] (+ to atm) HeatLatentTransp => noahmp%energy%flux%HeatLatentTransp ,& ! in, latent heat flux from transpiration [W/m2] (+ to atm) HeatGroundTot => noahmp%energy%flux%HeatGroundTot ,& ! in, total ground heat flux [W/m2] (+ to soil/snow) + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction RadSwAbsVeg => noahmp%energy%flux%RadSwAbsVeg ,& ! in, solar radiation absorbed by vegetation [W/m2] RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] HeatPrecipAdvSfc => noahmp%energy%flux%HeatPrecipAdvSfc ,& ! in, precipitation advected heat - total [W/m2] @@ -199,6 +203,7 @@ subroutine BalanceEnergyCheck(noahmp) HeatPrecipAdvCanopy => noahmp%energy%flux%HeatPrecipAdvCanopy ,& ! in, precipitation advected heat - vegetation net [W/m2] HeatLatentIrriEvap => noahmp%energy%flux%HeatLatentIrriEvap ,& ! in, latent heating due to sprinkler evaporation [W/m2] HeatCanStorageChg => noahmp%energy%flux%HeatCanStorageChg ,& ! in, canopy heat storage change [W/m2] + RadSwPenetrateGrd => noahmp%energy%flux%RadSwPenetrateGrd ,& ! out, light penetrating through soil/snow water [W/m2] EnergyBalanceError => noahmp%energy%state%EnergyBalanceError ,& ! out, error in surface energy balance [W/m2] RadSwBalanceError => noahmp%energy%state%RadSwBalanceError & ! out, error in shortwave radiation balance [W/m2] ) @@ -227,6 +232,15 @@ subroutine BalanceEnergyCheck(noahmp) stop "Error: Solar radiation budget problem in NoahMP LSM" endif + !SNICAR + if ( OptSnowAlbedo == 3 .and. abs(RadSwAbsGrd-sum(RadSwAbsSnowSoilLayer))>0.001) then !original check is 0.0001, precision issue + write(*,*) "RadSwAbsGrd gridmean = ", RadSwAbsGrd + write(*,*) "sum(RadSwAbsSnowSoilLayer) gridmean = ", sum(RadSwAbsSnowSoilLayer) + write(*,*) "RadSwAbsSnowSoilLayer gridmean = ", RadSwAbsSnowSoilLayer + write(*,*) "RadSwAbsGrd-sum(RadSwAbsSnowSoilLayer) gridmean = ", RadSwAbsGrd-sum(RadSwAbsSnowSoilLayer) + stop + endif + ! error in surface energy balance should be <0.01 W/m2 EnergyBalanceError = RadSwAbsVeg + RadSwAbsGrd + HeatPrecipAdvSfc - & (RadLwNetSfc + HeatSensibleSfc + HeatLatentCanopy + HeatLatentGrd + & @@ -244,6 +258,7 @@ subroutine BalanceEnergyCheck(noahmp) write(*,'(a17,F10.4)' ) "Sprinkler: ", HeatLatentIrriEvap write(*,'(a17,F10.4)' ) "Canopy heat storage change: ", HeatCanStorageChg write(*,'(a17,4F10.4)') "Precip advected: ", HeatPrecipAdvSfc,HeatPrecipAdvCanopy,HeatPrecipAdvVegGrd,HeatPrecipAdvBareGrd + write(*,*) "Light through soil/snow water:", RadSwPenetrateGrd,sum(RadSwPenetrateGrd) write(*,'(a17,F10.4)' ) "Veg fraction: ", VegFrac stop "Error: Energy budget problem in NoahMP LSM" endif diff --git a/src/CanopyHydrologyMod.F90 b/src/CanopyHydrologyMod.F90 index 24fab3b4..caae6b86 100644 --- a/src/CanopyHydrologyMod.F90 +++ b/src/CanopyHydrologyMod.F90 @@ -34,6 +34,7 @@ subroutine CanopyHydrology(noahmp) VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction SnowfallDensity => noahmp%water%state%SnowfallDensity ,& ! in, bulk density of snowfall [kg/m3] CanopyLiqHoldCap => noahmp%water%param%CanopyLiqHoldCap ,& ! in, maximum intercepted liquid water per unit veg area index [mm] + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction CanopyLiqWater => noahmp%water%state%CanopyLiqWater ,& ! inout, intercepted canopy liquid water [mm] CanopyIce => noahmp%water%state%CanopyIce ,& ! inout, intercepted canopy ice [mm] TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! inout, vegetation temperature [K] diff --git a/src/ConfigVarInitMod.F90 b/src/ConfigVarInitMod.F90 index 5c8af537..6d59d244 100644 --- a/src/ConfigVarInitMod.F90 +++ b/src/ConfigVarInitMod.F90 @@ -84,6 +84,22 @@ subroutine ConfigVarInitDefault(noahmp) noahmp%config%domain%Latitude = undefined_real noahmp%config%domain%DepthSoilTempBottom = undefined_real + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + noahmp%config%nmlist%OptSnicarSnowShape = undefined_int + noahmp%config%nmlist%OptSnicarRTSolver = undefined_int + noahmp%config%nmlist%FlagSnicarSnowBCIntmix = .true. + noahmp%config%nmlist%FlagSnicarSnowDustIntmix = .true. + noahmp%config%nmlist%FlagSnicarUseAerosol = .true. + noahmp%config%nmlist%FlagSnicarUseOC = .true. + noahmp%config%nmlist%FlagSnicarAerosolReadTable = .false. + noahmp%config%domain%idx_T_max = undefined_int + noahmp%config%domain%idx_Tgrd_max = undefined_int + noahmp%config%domain%idx_rhos_max = undefined_int + noahmp%config%domain%NumSnicarRadBand = undefined_int + noahmp%config%domain%idx_Mie_snw_mx = undefined_int + endif + end subroutine ConfigVarInitDefault end module ConfigVarInitMod diff --git a/src/ConfigVarType.F90 b/src/ConfigVarType.F90 index dc7979f3..d1d6c49f 100644 --- a/src/ConfigVarType.F90 +++ b/src/ConfigVarType.F90 @@ -6,6 +6,7 @@ module ConfigVarType ! ------------------------ Code history ----------------------------------- ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding related variables (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- use Machine @@ -51,6 +52,7 @@ module ConfigVarType integer :: OptSnowAlbedo ! options for ground snow surface albedo ! 1 -> BATS snow albedo scheme (default) ! 2 -> CLASS snow albedo scheme + ! 3 -> SNICAR snow albedo scheme integer :: OptCanopyRadiationTransfer ! options for canopy radiation transfer ! 1 -> modified two-stream (gap=F(solar angle,3D structure, etc)<1-VegFrac) ! 2 -> two-stream applied to grid-cell (gap = 0) @@ -120,8 +122,27 @@ module ConfigVarType integer :: OptGlacierTreatment ! options for glacier treatment ! 1 -> include phase change of ice (default) ! 2 -> ice treatment more like original Noah - - end type namelist_type + !SNICAR + integer :: OptSnicarSnowShape ! options for snow grain shape in SNICAR (He et al. 2017 JC) + ! 1 -> sphere + ! 2 -> spheroid + ! 3 -> hexagonal plate + ! 4 -> Koch snowflake + integer :: OptSnicarRTSolver ! option for two different SNICAR radiative transfer solver + ! 1 -> Toon et a 1989 2-stream (Flanner et al. 2007) + ! 2 -> Adding-doubling 2-stream (Dang et al.2019) + logical :: FlagSnicarSnowBCIntmix ! flag to determine SNICAR, false->external mixing for all BC ; true->internal mixing for hydrophilic BC + logical :: FlagSnicarSnowDustIntmix ! flag to determine SNICAR, false->external mixing for all dust; true->internal mixing for all dust + logical :: FlagSnicarUseAerosol ! option to turn on/off aerosol deposition flux effect in snow in SNICAR + ! .false. -> without aerosol deposition flux effect + ! .true. -> with aerosol deposition flux effect + logical :: FlagSnicarUseOC ! option to activate OC in snow in SNICAR + ! .false. -> without organic carbon in snow + ! .true. -> with organic carbon in snow + logical :: FlagSnicarAerosolReadTable ! option to read aerosol deposition fluxes from table or not + ! .false. -> data read from NetCDF forcing file + ! .true. -> data read from table + end type namelist_type !=== define "domain" sub-type of config (config%domain%variable) @@ -153,6 +174,11 @@ module ConfigVarType integer :: NumDayInYear ! Number of days in the particular year integer :: RunoffSlopeType ! underground runoff slope term type integer :: NumSoilTimeStep ! number of timesteps to calculate soil processes + integer :: idx_T_max ! maxiumum temperature index used in aging lookup table [idx] + integer :: idx_Tgrd_max ! maxiumum temperature gradient index used in aging lookup table [idx] + integer :: idx_rhos_max ! maxiumum snow density index used in aging lookup table [idx] + integer :: NumSnicarRadBand ! wavelength bands used in SNICAR snow albedo calculation + integer :: idx_Mie_snw_mx ! number of effective radius indices used in Mie lookup table [idx] real(kind=kind_noahmp) :: MainTimeStep ! noahmp main timestep [sec] real(kind=kind_noahmp) :: SoilTimeStep ! soil timestep [sec] real(kind=kind_noahmp) :: GridSize ! noahmp model grid spacing [m] diff --git a/src/EnergyMainMod.F90 b/src/EnergyMainMod.F90 index 0bd1df9f..b040014d 100644 --- a/src/EnergyMainMod.F90 +++ b/src/EnergyMainMod.F90 @@ -342,7 +342,6 @@ subroutine EnergyMain(noahmp) else AlbedoSfc = undefined_real endif - end associate end subroutine EnergyMain diff --git a/src/EnergyVarInitMod.F90 b/src/EnergyVarInitMod.F90 index 16484712..c138d410 100644 --- a/src/EnergyVarInitMod.F90 +++ b/src/EnergyVarInitMod.F90 @@ -25,7 +25,9 @@ subroutine EnergyVarInitDefault(noahmp) associate( & NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& - NumSwRadBand => noahmp%config%domain%NumSwRadBand & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& + NumSnicarRadBand=> noahmp%config%domain%NumSnicarRadBand,& + idx_Mie_snw_mx => noahmp%config%domain%idx_Mie_snw_mx & ) ! energy state variables @@ -287,7 +289,7 @@ subroutine EnergyVarInitDefault(noahmp) allocate( noahmp%energy%flux%RadSwDownDif(1:NumSwRadBand) ) if ( .not. allocated(noahmp%energy%flux%RadSwPenetrateGrd) ) & allocate( noahmp%energy%flux%RadSwPenetrateGrd(-NumSnowLayerMax+1:NumSoilLayer) ) - + noahmp%energy%flux%RadSwAbsVegDir (:) = undefined_real noahmp%energy%flux%RadSwAbsVegDif (:) = undefined_real noahmp%energy%flux%RadSwDirTranGrdDir(:) = undefined_real @@ -301,7 +303,7 @@ subroutine EnergyVarInitDefault(noahmp) noahmp%energy%flux%RadSwDownDir (:) = undefined_real noahmp%energy%flux%RadSwDownDif (:) = undefined_real noahmp%energy%flux%RadSwPenetrateGrd (:) = undefined_real - + ! energy parameter variables noahmp%energy%param%TreeCrownRadius = undefined_real noahmp%energy%param%HeightCanopyTop = undefined_real @@ -375,8 +377,8 @@ subroutine EnergyVarInitDefault(noahmp) if ( .not. allocated(noahmp%energy%param%EmissivitySoilLake) ) & allocate( noahmp%energy%param%EmissivitySoilLake(1:2) ) if ( .not. allocated(noahmp%energy%param%AlbedoLandIce) ) & - allocate( noahmp%energy%param%AlbedoLandIce(1:NumSwRadBand) ) - + allocate( noahmp%energy%param%AlbedoLandIce(1:NumSwRadBand) ) + noahmp%energy%param%LeafAreaIndexMon (:) = undefined_real noahmp%energy%param%StemAreaIndexMon (:) = undefined_real noahmp%energy%param%SoilQuartzFrac (:) = undefined_real @@ -390,7 +392,129 @@ subroutine EnergyVarInitDefault(noahmp) noahmp%energy%param%TransmittanceStem (:) = undefined_real noahmp%energy%param%EmissivitySoilLake(:) = undefined_real noahmp%energy%param%AlbedoLandIce (:) = undefined_real - + + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + + if ( .not. allocated(noahmp%energy%flux%FracRadSwAbsSnowDir) ) & + allocate( noahmp%energy%flux%FracRadSwAbsSnowDir(-NumSnowLayerMax+1:1,1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%FracRadSwAbsSnowDif) ) & + allocate( noahmp%energy%flux%FracRadSwAbsSnowDif(-NumSnowLayerMax+1:1,1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwAbsSnowSoilLayer) ) & + allocate( noahmp%energy%flux%RadSwAbsSnowSoilLayer(-NumSnowLayerMax+1:1) ) + + noahmp%energy%flux%FracRadSwAbsSnowDir (:,:) = undefined_real + noahmp%energy%flux%FracRadSwAbsSnowDif (:,:) = undefined_real + noahmp%energy%flux%RadSwAbsSnowSoilLayer (:) = undefined_real + + if ( .not. allocated(noahmp%energy%param%flx_wgt_dir) ) & + allocate( noahmp%energy%param%flx_wgt_dir(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%flx_wgt_dif) ) & + allocate( noahmp%energy%param%flx_wgt_dif(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_snw_drc) ) & + allocate( noahmp%energy%param%ss_alb_snw_drc(1:idx_Mie_snw_mx,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_snw_drc) ) & + allocate( noahmp%energy%param%asm_prm_snw_drc(1:idx_Mie_snw_mx,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_snw_drc) ) & + allocate( noahmp%energy%param%ext_cff_mss_snw_drc(1:idx_Mie_snw_mx,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_snw_dfs) ) & + allocate( noahmp%energy%param%ss_alb_snw_dfs(1:idx_Mie_snw_mx,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_snw_dfs) ) & + allocate( noahmp%energy%param%asm_prm_snw_dfs(1:idx_Mie_snw_mx,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_snw_dfs) ) & + allocate( noahmp%energy%param%ext_cff_mss_snw_dfs(1:idx_Mie_snw_mx,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_bc1) ) & + allocate( noahmp%energy%param%ss_alb_bc1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_bc1) ) & + allocate( noahmp%energy%param%asm_prm_bc1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_bc1) ) & + allocate( noahmp%energy%param%ext_cff_mss_bc1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_bc2) ) & + allocate( noahmp%energy%param%ss_alb_bc2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_bc2) ) & + allocate( noahmp%energy%param%asm_prm_bc2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_bc2) ) & + allocate( noahmp%energy%param%ext_cff_mss_bc2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_oc1) ) & + allocate( noahmp%energy%param%ss_alb_oc1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_oc1) ) & + allocate( noahmp%energy%param%asm_prm_oc1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_oc1) ) & + allocate( noahmp%energy%param%ext_cff_mss_oc1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_oc2) ) & + allocate( noahmp%energy%param%ss_alb_oc2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_oc2) ) & + allocate( noahmp%energy%param%asm_prm_oc2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_oc2) ) & + allocate( noahmp%energy%param%ext_cff_mss_oc2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_dst1) ) & + allocate( noahmp%energy%param%ss_alb_dst1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_dst1) ) & + allocate( noahmp%energy%param%asm_prm_dst1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_dst1) ) & + allocate( noahmp%energy%param%ext_cff_mss_dst1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_dst2) ) & + allocate( noahmp%energy%param%ss_alb_dst2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_dst2) ) & + allocate( noahmp%energy%param%asm_prm_dst2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_dst2) ) & + allocate( noahmp%energy%param%ext_cff_mss_dst2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_dst3) ) & + allocate( noahmp%energy%param%ss_alb_dst3(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_dst3) ) & + allocate( noahmp%energy%param%asm_prm_dst3(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_dst3) ) & + allocate( noahmp%energy%param%ext_cff_mss_dst3(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_dst4) ) & + allocate( noahmp%energy%param%ss_alb_dst4(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_dst4) ) & + allocate( noahmp%energy%param%asm_prm_dst4(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_dst4) ) & + allocate( noahmp%energy%param%ext_cff_mss_dst4(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ss_alb_dst5) ) & + allocate( noahmp%energy%param%ss_alb_dst5(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%asm_prm_dst5) ) & + allocate( noahmp%energy%param%asm_prm_dst5(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ext_cff_mss_dst5) ) & + allocate( noahmp%energy%param%ext_cff_mss_dst5(1:NumSnicarRadBand) ) + + noahmp%energy%param%flx_wgt_dir (:) = undefined_real + noahmp%energy%param%flx_wgt_dif (:) = undefined_real + noahmp%energy%param%ss_alb_snw_drc (:,:) = undefined_real + noahmp%energy%param%asm_prm_snw_drc (:,:) = undefined_real + noahmp%energy%param%ext_cff_mss_snw_drc (:,:) = undefined_real + noahmp%energy%param%ss_alb_snw_dfs (:,:) = undefined_real + noahmp%energy%param%asm_prm_snw_dfs (:,:) = undefined_real + noahmp%energy%param%ext_cff_mss_snw_dfs (:,:) = undefined_real + noahmp%energy%param%ss_alb_bc1 (:) = undefined_real + noahmp%energy%param%asm_prm_bc1 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_bc1 (:) = undefined_real + noahmp%energy%param%ss_alb_bc2 (:) = undefined_real + noahmp%energy%param%asm_prm_bc2 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_bc2 (:) = undefined_real + noahmp%energy%param%ss_alb_oc1 (:) = undefined_real + noahmp%energy%param%asm_prm_oc1 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_oc1 (:) = undefined_real + noahmp%energy%param%ss_alb_oc2 (:) = undefined_real + noahmp%energy%param%asm_prm_oc2 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_oc2 (:) = undefined_real + noahmp%energy%param%ss_alb_dst1 (:) = undefined_real + noahmp%energy%param%asm_prm_dst1 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_dst1 (:) = undefined_real + noahmp%energy%param%ss_alb_dst2 (:) = undefined_real + noahmp%energy%param%asm_prm_dst2 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_dst2 (:) = undefined_real + noahmp%energy%param%ss_alb_dst3 (:) = undefined_real + noahmp%energy%param%asm_prm_dst3 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_dst3 (:) = undefined_real + noahmp%energy%param%ss_alb_dst4 (:) = undefined_real + noahmp%energy%param%asm_prm_dst4 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_dst4 (:) = undefined_real + noahmp%energy%param%ss_alb_dst5 (:) = undefined_real + noahmp%energy%param%asm_prm_dst5 (:) = undefined_real + noahmp%energy%param%ext_cff_mss_dst5 (:) = undefined_real + endif + end associate end subroutine EnergyVarInitDefault diff --git a/src/EnergyVarType.F90 b/src/EnergyVarType.F90 index 0805d303..9e7e9a20 100644 --- a/src/EnergyVarType.F90 +++ b/src/EnergyVarType.F90 @@ -6,6 +6,7 @@ module EnergyVarType ! ------------------------ Code history ----------------------------------- ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding related variables (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- use Machine @@ -68,6 +69,10 @@ module EnergyVarType real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDownDir ! incoming direct solar radiation [W/m2] real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDownDif ! incoming diffuse solar radiation [W/m2] real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwPenetrateGrd ! light penetrating through soil/snow water [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDir ! direct solar flux factor absorbed by snow layer [frc] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDif ! diffuse solar flux factor absorbed by snow layer [frc] + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsSnowSoilLayer ! solar flux absorbed by snow for each layer [W/m2] + end type flux_type @@ -293,6 +298,41 @@ module EnergyVarType real(kind=kind_noahmp), allocatable, dimension(:) :: TransmittanceStem ! stem transmittance: 1=vis, 2=nir real(kind=kind_noahmp), allocatable, dimension(:) :: EmissivitySoilLake ! emissivity soil surface: 1=soil, 2=lake real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoLandIce ! land/glacier ice albedo: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: flx_wgt_dir ! downward solar radiation spectral weights (direct) + real(kind=kind_noahmp), allocatable, dimension(:) :: flx_wgt_dif ! downward solar radiation spectral weights (diffuse) + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ss_alb_snw_drc ! Mie single scatter albedos for direct-beam ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: asm_prm_snw_drc ! asymmetry parameter of direct-beam ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ext_cff_mss_snw_drc ! mass extinction coefficient for direct-beam ice [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ss_alb_snw_dfs ! Mie single scatter albedos for diffuse ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: asm_prm_snw_dfs ! asymmetry parameter of diffuse ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ext_cff_mss_snw_dfs ! mass extinction coefficient for diffuse ice [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_bc1 ! Mie single scatter albedos for hydrophillic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_bc1 ! asymmetry parameter for hydrophillic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_bc1 ! mass extinction coefficient for hydrophillic BC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_bc2 ! Mie single scatter albedos for hydrophobic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_bc2 ! asymmetry parameter for hydrophobic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_bc2 ! mass extinction coefficient for hydrophobic BC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_oc1 ! Mie single scatter albedos for hydrophillic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_oc1 ! asymmetry parameter for hydrophillic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_oc1 ! mass extinction coefficient for hydrophillic OC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_oc2 ! Mie single scatter albedos for hydrophobic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_oc2 ! asymmetry parameter for hydrophobic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_oc2 ! mass extinction coefficient for hydrophobic OC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst1 ! Mie single scatter albedos for dust species 1 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst1 ! asymmetry parameter for dust species 1 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst1 ! mass extinction coefficient for dust species 1 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst2 ! Mie single scatter albedos for dust species 2 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst2 ! asymmetry parameter for dust species 2 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst2 ! mass extinction coefficient for dust species 3 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst3 ! Mie single scatter albedos for dust species 3 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst3 ! asymmetry parameter for dust species 3 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst3 ! mass extinction coefficient for dust species 3 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst4 ! Mie single scatter albedos for dust species 4 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst4 ! asymmetry parameter for dust species 4 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst4 ! mass extinction coefficient for dust species 4 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: ss_alb_dst5 ! Mie single scatter albedos for dust species 5 + real(kind=kind_noahmp), allocatable, dimension(:) :: asm_prm_dst5 ! asymmetry parameter for dust species 5 + real(kind=kind_noahmp), allocatable, dimension(:) :: ext_cff_mss_dst5 ! mass extinction coefficient for dust species 5 [m2/kg] end type parameter_type diff --git a/src/ForcingVarInitMod.F90 b/src/ForcingVarInitMod.F90 index b69c589e..fce5fe5d 100644 --- a/src/ForcingVarInitMod.F90 +++ b/src/ForcingVarInitMod.F90 @@ -38,6 +38,19 @@ subroutine ForcingVarInitDefault(noahmp) noahmp%forcing%PressureAirRefHeight = undefined_real noahmp%forcing%TemperatureSoilBottom = undefined_real + noahmp%forcing%DepBChydropho = undefined_real + noahmp%forcing%DepBChydrophi = undefined_real + noahmp%forcing%DepOChydropho = undefined_real + noahmp%forcing%DepOChydrophi = undefined_real + noahmp%forcing%DepDust1 = undefined_real + noahmp%forcing%DepDust2 = undefined_real + noahmp%forcing%DepDust3 = undefined_real + noahmp%forcing%DepDust4 = undefined_real + noahmp%forcing%DepDust5 = undefined_real + + noahmp%forcing%VisFrac = undefined_real + noahmp%forcing%DirFrac = undefined_real + end subroutine ForcingVarInitDefault end module ForcingVarInitMod diff --git a/src/ForcingVarType.F90 b/src/ForcingVarType.F90 index a88aa316..da90cdb8 100644 --- a/src/ForcingVarType.F90 +++ b/src/ForcingVarType.F90 @@ -6,6 +6,7 @@ module ForcingVarType ! ------------------------ Code history ----------------------------------- ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding aerosol and dust mass (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- use Machine @@ -31,7 +32,18 @@ module ForcingVarType real(kind=kind_noahmp) :: PrecipGraupelRefHeight ! graupel rate [mm/s] at reference height real(kind=kind_noahmp) :: PrecipHailRefHeight ! hail rate [mm/s] at reference height real(kind=kind_noahmp) :: TemperatureSoilBottom ! bottom boundary condition for soil temperature [K] - + real(kind=kind_noahmp) :: DepBChydropho ! hydrophobic Black Carbon deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepBChydrophi ! hydrophillic Black Carbon deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepOChydropho ! hydrophobic Organic Carbon deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepOChydrophi ! hydrophillic Organic Carbon deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust1 ! dust species 1 deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust2 ! dust species 2 deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust3 ! dust species 3 deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust4 ! dust species 4 deposition [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust5 ! dust species 4 deposition [kg m-2 s-1] + + real(kind=kind_noahmp) :: VisFrac ! fraction of visible band radiation + real(kind=kind_noahmp) :: DirFrac ! fraction of direct raidation end type forcing_type end module ForcingVarType diff --git a/src/GlacierTemperatureMainMod.F90 b/src/GlacierTemperatureMainMod.F90 index 80938077..0d960ae5 100644 --- a/src/GlacierTemperatureMainMod.F90 +++ b/src/GlacierTemperatureMainMod.F90 @@ -21,6 +21,7 @@ subroutine GlacierTemperatureMain(noahmp) ! Original Noah-MP subroutine: TSNOSOI_GLACIER ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding snicar solar fluxes redistribution in snow layer (T.-S. Lin, C. He et al. 2023) ! ---------------------------------------------------------------------------------------- implicit none @@ -29,6 +30,7 @@ subroutine GlacierTemperatureMain(noahmp) type(noahmp_type) , intent(inout) :: noahmp ! local variable + integer :: IndLoop ! snow and soil layer loop real(kind=kind_noahmp), allocatable, dimension(:) :: MatRight ! right-hand side term of the matrix real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft1 ! left-hand side term of the matrix real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft2 ! left-hand side term of the matrix @@ -38,10 +40,13 @@ subroutine GlacierTemperatureMain(noahmp) associate( & NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of glacier/soil layers NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] DepthSoilTempBottom => noahmp%config%domain%DepthSoilTempBottom ,& ! in, depth [m] from glacier surface for lower soil temperature boundary SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + RadSwAbsSnowSoilLayer => noahmp%energy%flux%RadSwAbsSnowSoilLayer ,& ! in, total absorbed solar radiation by snow for each layer [W/m2] + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] DepthSoilTempBotToSno => noahmp%energy%state%DepthSoilTempBotToSno ,& ! out, depth of lower boundary condition [m] from snow surface RadSwPenetrateGrd => noahmp%energy%flux%RadSwPenetrateGrd & ! out, light penetrating through snow/ice [W/m2] ) @@ -58,7 +63,17 @@ subroutine GlacierTemperatureMain(noahmp) MatLeft3(:) = 0.0 ! compute solar penetration through water, needs more work - RadSwPenetrateGrd(NumSnowLayerNeg+1:NumSoilLayer) = 0.0 + RadSwPenetrateGrd(-NumSnowLayerMax+1:NumSoilLayer) = 0.0 + + if (NumSnowLayerNeg < 0 .and. sum(RadSwAbsSnowSoilLayer) > 0.0 .and. OptSnowAlbedo == 3) then + do IndLoop = NumSnowLayerNeg+1, 1, 1 + if (IndLoop == NumSnowLayerNeg+1) then + RadSwPenetrateGrd (IndLoop) = RadSwAbsSnowSoilLayer (IndLoop) - RadSwAbsGrd + else + RadSwPenetrateGrd (IndLoop) = RadSwAbsSnowSoilLayer (IndLoop) + endif + enddo + endif ! adjust DepthSoilTempBottom from glacier ice surface to DepthSoilTempBotToSno from snow surface DepthSoilTempBotToSno = DepthSoilTempBottom - SnowDepth diff --git a/src/GroundAlbedoMod.F90 b/src/GroundAlbedoMod.F90 index 6ca4b105..b292b9d2 100644 --- a/src/GroundAlbedoMod.F90 +++ b/src/GroundAlbedoMod.F90 @@ -60,10 +60,8 @@ subroutine GroundAlbedo(noahmp) AlbedoSoilDir(IndSwBnd) = AlbedoLakeFrz(IndSwBnd) AlbedoSoilDif(IndSwBnd) = AlbedoSoilDir(IndSwBnd) endif - AlbedoGrdDir(IndSwBnd) = AlbedoSoilDir(IndSwBnd)*(1.0-SnowCoverFrac) + AlbedoSnowDir(IndSwBnd)*SnowCoverFrac AlbedoGrdDif(IndSwBnd) = AlbedoSoilDif(IndSwBnd)*(1.0-SnowCoverFrac) + AlbedoSnowDif(IndSwBnd)*SnowCoverFrac - enddo end associate diff --git a/src/GroundWaterMmfMod.F90 b/src/GroundWaterMmfMod.F90 index da9ef7c9..236ef3fa 100644 --- a/src/GroundWaterMmfMod.F90 +++ b/src/GroundWaterMmfMod.F90 @@ -43,10 +43,10 @@ subroutine WTABLE_mmf_noahmp (NoahmpIO ,NSOIL ,XLAND ,XICE ,XICE_THRESH INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte - REAL, INTENT(IN) :: WTDDT - REAL, INTENT(IN) :: XICE_THRESHOLD + REAL(kind=kind_noahmp), INTENT(IN) :: WTDDT + REAL(kind=kind_noahmp), INTENT(IN) :: XICE_THRESHOLD INTEGER, INTENT(IN ) :: ISICE - REAL, DIMENSION( ims:ime, jms:jme ) , & + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ) , & & INTENT(IN ) :: XLAND, & XICE INTEGER, DIMENSION( ims:ime, jms:jme ) , & @@ -54,10 +54,10 @@ subroutine WTABLE_mmf_noahmp (NoahmpIO ,NSOIL ,XLAND ,XICE ,XICE_THRESH IVGTYP INTEGER, INTENT(IN) :: nsoil INTEGER, INTENT(IN) :: ISURBAN - REAL, DIMENSION( ims:ime , 1:nsoil, jms:jme ), & + REAL(kind=kind_noahmp), DIMENSION( ims:ime , 1:nsoil, jms:jme ), & & INTENT(IN) :: SMOISEQ - REAL, DIMENSION(1:nsoil), INTENT(IN) :: DZS - REAL, DIMENSION( ims:ime, jms:jme ) , & + REAL(kind=kind_noahmp), DIMENSION(1:nsoil), INTENT(IN) :: DZS + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ) , & & INTENT(IN) :: FDEPTH, & AREA, & TOPO, & @@ -68,12 +68,12 @@ subroutine WTABLE_mmf_noahmp (NoahmpIO ,NSOIL ,XLAND ,XICE ,XICE_THRESH ! IN and OUT - REAL, DIMENSION( ims:ime , 1:nsoil, jms:jme ), & + REAL(kind=kind_noahmp), DIMENSION( ims:ime , 1:nsoil, jms:jme ), & & INTENT(INOUT) :: SMOIS, & & SH2OXY - REAL, DIMENSION( ims:ime, jms:jme ) , & + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ) , & & INTENT(INOUT) :: WTD, & SMCWTD, & DEEPRECH, & @@ -84,23 +84,23 @@ subroutine WTABLE_mmf_noahmp (NoahmpIO ,NSOIL ,XLAND ,XICE ,XICE_THRESH !OUT - REAL, DIMENSION( ims:ime, jms:jme ) , & + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ) , & & INTENT(OUT) :: QRF, & !groundwater - river water flux QSPRING !water springing at the surface from groundwater convergence in the column !LOCAL INTEGER :: I,J,K - REAL, DIMENSION( 0:NSOIL) :: ZSOIL !depth of soil layer-bottom [m] - REAL, DIMENSION( 1:NSOIL) :: SMCEQ !equilibrium soil water content [m3/m3] - REAL, DIMENSION( 1:NSOIL) :: SMC,SH2O - REAL :: DELTAT,RCOND,TOTWATER,PSI & + REAL(kind=kind_noahmp), DIMENSION( 0:NSOIL) :: ZSOIL !depth of soil layer-bottom [m] + REAL(kind=kind_noahmp), DIMENSION( 1:NSOIL) :: SMCEQ !equilibrium soil water content [m3/m3] + REAL(kind=kind_noahmp), DIMENSION( 1:NSOIL) :: SMC,SH2O + REAL(kind=kind_noahmp) :: DELTAT,RCOND,TOTWATER,PSI & ,WFLUXDEEP,WCNDDEEP,DDZ,SMCWTDMID & ,WPLUS,WMINUS - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: QLAT + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: QLAT INTEGER, DIMENSION( ims:ime, jms:jme ) :: LANDMASK !-1 for water (ice or no ice) and glacial areas, 1 for land where the LSM does its soil moisture calculations. - REAL :: BEXP,DKSAT,PSISAT,SMCMAX,SMCWLT + REAL(kind=kind_noahmp) :: BEXP,DKSAT,PSISAT,SMCMAX,SMCWLT DELTAT = WTDDT * 60. !timestep in seconds for this calculation @@ -238,31 +238,31 @@ subroutine LATERALFLOW (NoahmpIO, ISLTYP,WTD,QLAT,FDEPTH,TOPO,LANDMASK,DELTAT,A INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & & ims,ime, jms,jme, kms,kme, & & its,ite, jts,jte, kts,kte - REAL , INTENT(IN) :: DELTAT + REAL(kind=kind_noahmp) , INTENT(IN) :: DELTAT INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: ISLTYP, LANDMASK - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FDEPTH,WTD,TOPO,AREA + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FDEPTH,WTD,TOPO,AREA !output - REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: QLAT + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: QLAT !local INTEGER :: I, J, itsh, iteh, jtsh, jteh, nx, ny - REAL :: Q, KLAT + REAL(kind=kind_noahmp) :: Q, KLAT #ifdef MPP_LAND ! halo'ed arrays - REAL, DIMENSION(ims-1:ime+1, jms-1:jme+1) :: KCELL, HEAD + REAL(kind=kind_noahmp), DIMENSION(ims-1:ime+1, jms-1:jme+1) :: KCELL, HEAD integer, dimension(ims-1:ime+1, jms-1:jme+1) :: landmask_h - real, dimension(ims-1:ime+1, jms-1:jme+1) :: area_h, qlat_h + real(kind=kind_noahmp), dimension(ims-1:ime+1, jms-1:jme+1) :: area_h, qlat_h #else - REAL, DIMENSION(ims:ime, jms:jme) :: KCELL, HEAD + REAL(kind=kind_noahmp), DIMENSION(ims:ime, jms:jme) :: KCELL, HEAD #endif - REAL, DIMENSION(19) :: KLATFACTOR + REAL(kind=kind_noahmp), DIMENSION(19) :: KLATFACTOR DATA KLATFACTOR /2.,3.,4.,10.,10.,12.,14.,20.,24.,28.,40.,48.,2.,0.,10.,0.,20.,2.,2./ - REAL, PARAMETER :: PI = 3.14159265 - REAL, PARAMETER :: FANGLE = 0.22754493 ! = 0.5*sqrt(0.5*tan(pi/8)) + REAL(kind=kind_noahmp), PARAMETER :: PI = 3.14159265 + REAL(kind=kind_noahmp), PARAMETER :: FANGLE = 0.22754493 ! = 0.5*sqrt(0.5*tan(pi/8)) #ifdef MPP_LAND ! create halo'ed local copies of tile vars @@ -386,32 +386,32 @@ subroutine UPDATEWTD (NSOIL, DZS, ZSOIL ,SMCEQ ,& !in ! input INTEGER, INTENT(IN) :: NSOIL !no. of soil layers INTEGER, INTENT(IN) :: ILOC, JLOC - REAL, INTENT(IN) :: SMCMAX - REAL, INTENT(IN) :: SMCWLT - REAL, INTENT(IN) :: PSISAT - REAL, INTENT(IN) :: BEXP - REAL, DIMENSION( 0:NSOIL), INTENT(IN) :: ZSOIL !depth of soil layer-bottom [m] - REAL, DIMENSION( 1:NSOIL), INTENT(IN) :: SMCEQ !equilibrium soil water content [m3/m3] - REAL, DIMENSION( 1:NSOIL), INTENT(IN) :: DZS ! soil layer thickness [m] + REAL(kind=kind_noahmp), INTENT(IN) :: SMCMAX + REAL(kind=kind_noahmp), INTENT(IN) :: SMCWLT + REAL(kind=kind_noahmp), INTENT(IN) :: PSISAT + REAL(kind=kind_noahmp), INTENT(IN) :: BEXP + REAL(kind=kind_noahmp), DIMENSION( 0:NSOIL), INTENT(IN) :: ZSOIL !depth of soil layer-bottom [m] + REAL(kind=kind_noahmp), DIMENSION( 1:NSOIL), INTENT(IN) :: SMCEQ !equilibrium soil water content [m3/m3] + REAL(kind=kind_noahmp), DIMENSION( 1:NSOIL), INTENT(IN) :: DZS ! soil layer thickness [m] ! input-output - REAL , INTENT(INOUT) :: TOTWATER - REAL , INTENT(INOUT) :: WTD - REAL , INTENT(INOUT) :: SMCWTD - REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SMC - REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SH2O + REAL(kind=kind_noahmp) , INTENT(INOUT) :: TOTWATER + REAL(kind=kind_noahmp) , INTENT(INOUT) :: WTD + REAL(kind=kind_noahmp) , INTENT(INOUT) :: SMCWTD + REAL(kind=kind_noahmp), DIMENSION( 1:NSOIL), INTENT(INOUT) :: SMC + REAL(kind=kind_noahmp), DIMENSION( 1:NSOIL), INTENT(INOUT) :: SH2O ! output - REAL , INTENT(OUT) :: QSPRING + REAL(kind=kind_noahmp) , INTENT(OUT) :: QSPRING !local INTEGER :: K INTEGER :: K1 INTEGER :: IWTD INTEGER :: KWTD - REAL :: MAXWATUP, MAXWATDW ,WTDOLD - REAL :: WGPMID - REAL :: SYIELDDW - REAL :: DZUP - REAL :: SMCEQDEEP - REAL, DIMENSION( 1:NSOIL) :: SICE + REAL(kind=kind_noahmp) :: MAXWATUP, MAXWATDW ,WTDOLD + REAL(kind=kind_noahmp) :: WGPMID + REAL(kind=kind_noahmp) :: SYIELDDW + REAL(kind=kind_noahmp) :: DZUP + REAL(kind=kind_noahmp) :: SMCEQDEEP + REAL(kind=kind_noahmp), DIMENSION( 1:NSOIL) :: SICE ! ------------------------------------------------------------- diff --git a/src/Makefile b/src/Makefile index 706c0219..70b69ce5 100644 --- a/src/Makefile +++ b/src/Makefile @@ -66,9 +66,15 @@ OBJS = ConstantDefineMod.o \ GroundThermalPropertyMod.o \ EnergyMainMod.o \ NoahmpMainMod.o \ + SnowAerosolSnicarMod.o \ SnowAgingBatsMod.o \ + SnowAgingSnicarMod.o \ SnowAlbedoBatsMod.o \ SnowAlbedoClassMod.o \ + SnowAlbedoSnicarMod.o \ + SnowFreshRadiusMod.o \ + SnowInputSnicarMod.o \ + SnowRadiationSnicarMod.o \ GroundAlbedoMod.o \ CanopyRadiationTwoStreamMod.o \ SurfaceAlbedoMod.o \ @@ -139,7 +145,7 @@ GroundWaterMmfMod.o: GroundWaterMmfMod.F90 $(RM) GroundWaterMmfMod.f90 $(CPP) $(CPPFLAGS) $(*).F90 > $(*).f90 $(COMPILERF90) -c -I../../hrldas/MPP -I. -I../../hrldas/Utility_routines \ - -I../utility -I../drivers/hrldas $(F90FLAGS) $(FREESOURCE) $(NETCDFMOD) $(*).f90 + -I../utility -I../drivers/hrldas $(F90FLAGS) $(FREESOURCE) $(NETCDFMOD) $(*).f90 @echo "" .F90.o: @@ -209,7 +215,7 @@ SnowpackHydrologyMod.o: ../utility/Machine.o NoahmpVarType.o Const SnowLayerCombineMod.o SnowWaterMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ SnowfallBelowCanopyMod.o SnowpackCompactionMod.o SnowLayerDivideMod.o \ - SnowLayerCombineMod.o SnowpackHydrologyMod.o + SnowLayerCombineMod.o SnowpackHydrologyMod.o SnowAerosolSnicarMod.o SoilHydraulicPropertyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SoilMoistureSolverMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ MatrixSolverTriDiagonalMod.o @@ -251,12 +257,21 @@ GroundThermalPropertyMod.o: ../utility/Machine.o NoahmpVarType.o Const SnowThermalPropertyMod.o SoilThermalPropertyMod.o CanopyRadiationTwoStreamMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o GroundAlbedoMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowAerosolSnicarMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowAgingBatsMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowAgingSnicarMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowAlbedoBatsMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowAlbedoClassMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowAlbedoSnicarMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SnowRadiationSnicarMod.o +SnowFreshRadiusMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowInputSnicarMod.o: ../utility/Machine.o ../drivers/hrldas/NoahmpIOVarType.o +SnowRadiationSnicarMod.o: ../utility/Machine.o ../utility/PiecewiseLinearInterp1dMod.o \ + NoahmpVarType.o ConstantDefineMod.o SurfaceAlbedoMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ SnowAgingBatsMod.o SnowAlbedoBatsMod.o SnowAlbedoClassMod.o \ - GroundAlbedoMod.o CanopyRadiationTwoStreamMod.o + SnowAlbedoSnicarMod.o GroundAlbedoMod.o CanopyRadiationTwoStreamMod.o \ + SnowAgingSnicarMod.o SnowFreshRadiusMod.o SurfaceRadiationMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o EnergyMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ GroundThermalPropertyMod.o SurfaceEnergyFluxVegetatedMod.o \ @@ -313,7 +328,7 @@ BiochemCropMainMod.o: ../utility/Machine.o NoahmpVarType.o Co IrrigationPrepareMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o IrrigationTriggerMod.o BalanceErrorCheckMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o GeneralInitMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o -GroundWaterMmfMod.o: ../utility/Machine.o NoahmpVarType.o ../drivers/hrldas/NoahmpIOVarType.o +GroundWaterMmfMod.o: ../utility/Machine.o NoahmpVarType.o ../drivers/hrldas/NoahmpIOVarType.o BalanceErrorCheckGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o EnergyMainGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowCoverGlacierMod.o \ GroundRoughnessPropertyGlacierMod.o GroundThermalPropertyGlacierMod.o \ @@ -340,10 +355,11 @@ ResistanceGroundEvaporationGlacierMod.o: ../utility/Machine.o NoahmpVarType.o Co SnowCoverGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowWaterMainGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowfallBelowCanopyMod.o \ SnowpackCompactionMod.o SnowLayerCombineMod.o SnowLayerDivideMod.o \ - SnowpackHydrologyGlacierMod.o + SnowpackHydrologyGlacierMod.o SnowAerosolSnicarMod.o SnowpackHydrologyGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowLayerCombineMod.o SurfaceAlbedoGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowAgingBatsMod.o \ - SnowAlbedoBatsMod.o SnowAlbedoClassMod.o GroundAlbedoGlacierMod.o + SnowAlbedoBatsMod.o SnowAlbedoClassMod.o GroundAlbedoGlacierMod.o SnowAlbedoSnicarMod.o \ + SnowAgingSnicarMod.o SnowFreshRadiusMod.o SurfaceEmissivityGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SurfaceEnergyFluxGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ VaporPressureSaturationMod.o ResistanceBareGroundMostMod.o diff --git a/src/ResistanceCanopyStomataBallBerryMod.F90 b/src/ResistanceCanopyStomataBallBerryMod.F90 index d479bec0..e094deaf 100644 --- a/src/ResistanceCanopyStomataBallBerryMod.F90 +++ b/src/ResistanceCanopyStomataBallBerryMod.F90 @@ -79,6 +79,7 @@ subroutine ResistanceCanopyStomataBallBerry(noahmp, IndexShade) TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] VapPresSatCanopy => noahmp%energy%state%VapPresSatCanopy ,& ! in, canopy saturation vapor pressure at TV [Pa] PressureVaporCanAir => noahmp%energy%state%PressureVaporCanAir ,& ! in, canopy air vapor pressure [Pa] + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction PressureAtmosO2 => noahmp%energy%state%PressureAtmosO2 ,& ! in, atmospheric o2 pressure [Pa] PressureAtmosCO2 => noahmp%energy%state%PressureAtmosCO2 ,& ! in, atmospheric co2 pressure [Pa] ResistanceLeafBoundary => noahmp%energy%state%ResistanceLeafBoundary ,& ! in, leaf boundary layer resistance [s/m] diff --git a/src/ResistanceCanopyStomataJarvisMod.F90 b/src/ResistanceCanopyStomataJarvisMod.F90 index 39388bd1..8daf2a18 100644 --- a/src/ResistanceCanopyStomataJarvisMod.F90 +++ b/src/ResistanceCanopyStomataJarvisMod.F90 @@ -71,6 +71,7 @@ subroutine ResistanceCanopyStomataJarvis(noahmp, IndexShade) if ( IndexShade == 0 ) RadPhotoActAbsTmp = RadPhotoActAbsSunlit / max(VegFrac,1.0e-6) ! Sunlit case if ( IndexShade == 1 ) RadPhotoActAbsTmp = RadPhotoActAbsShade / max(VegFrac,1.0e-6) ! Shaded case + ! compute MixingRatioTmp and MixingRatioSat SpecHumidityTmp = 0.622 * PressureVaporCanAir / (PressureAirRefHeight - 0.378*PressureVaporCanAir) ! specific humidity MixingRatioTmp = SpecHumidityTmp / (1.0 - SpecHumidityTmp) ! convert to mixing ratio [kg/kg] diff --git a/src/SnowAerosolSnicarMod.F90 b/src/SnowAerosolSnicarMod.F90 new file mode 100644 index 00000000..11d18dc0 --- /dev/null +++ b/src/SnowAerosolSnicarMod.F90 @@ -0,0 +1,273 @@ +module SnowAerosolSnicarMod + + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowAerosolSnicar(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original code: CTSM, AerosolFluxes, AerosolMasses, CalcAndApplyAerosolFluxes +! Refactered code: T.-S. Lin, C. He, et al. (2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! do loop/array indices + real(kind=kind_noahmp) :: SnowMass ! liquid+ice snow mass in a layer [kg/m2] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_sf = 1.0 ! Scaling factor modifying scavenging factors for BC, OC, and dust species inclusion in meltwater (-) + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_bcphi = 0.20 ! scavenging factor for hydrophillic BC inclusion in meltwater [frc] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_bcpho = 0.03 ! scavenging factor for hydrophobic BC inclusion in meltwater [frc] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_ocphi = 0.20 ! scavenging factor for hydrophillic OC inclusion in meltwater [frc] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_ocpho = 0.03 ! scavenging factor for hydrophobic OC inclusion in meltwater [frc] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_dst1 = 0.02 ! scavenging factor for dust species 1 inclusion in meltwater [frc] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_dst2 = 0.02 ! scavenging factor for dust species 2 inclusion in meltwater [frc] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_dst3 = 0.01 ! scavenging factor for dust species 3 inclusion in meltwater [frc] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_dst4 = 0.01 ! scavenging factor for dust species 4 inclusion in meltwater [frc] + real(kind=kind_noahmp), parameter :: scvng_fct_mlt_dst5 = 0.01 ! scavenging factor for dust species 5 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: FluxInBChydrophi ! flux of hydrophilic BC into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutBChydrophi ! flux of hydrophilic BC out of layer [kg/s] + real(kind=kind_noahmp) :: FluxInBChydropho ! flux of hydrophobic BC into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutBChydropho ! flux of hydrophobic BC out of layer [kg/s] + real(kind=kind_noahmp) :: FluxInOChydrophi ! flux of hydrophilic OC into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutOChydrophi ! flux of hydrophilic OC out of layer [kg/s] + real(kind=kind_noahmp) :: FluxInOChydropho ! flux of hydrophobic OC into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutOChydropho ! flux of hydrophobic OC out of layer [kg/s] + real(kind=kind_noahmp) :: FluxInDust1 ! flux of dust species 1 into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutDust1 ! flux of dust species 1 out of layer [kg/s] + real(kind=kind_noahmp) :: FluxInDust2 ! flux of dust species 2 into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutDust2 ! flux of dust species 2 out of layer [kg/s] + real(kind=kind_noahmp) :: FluxInDust3 ! flux of dust species 3 into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutDust3 ! flux of dust species 3 out of layer [kg/s] + real(kind=kind_noahmp) :: FluxInDust4 ! flux of dust species 4 into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutDust4 ! flux of dust species 4 out of layer [kg/s] + real(kind=kind_noahmp) :: FluxInDust5 ! flux of dust species 5 into layer [kg/s] + real(kind=kind_noahmp) :: FluxOutDust5 ! flux of dust species 5 out of layer [kg/s] + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + SnowIce => noahmp%water%state%SnowIce ,& ! in, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! in, snow layer liquid water [mm] + OutflowSnowLayer => noahmp%water%flux%OutflowSnowLayer ,& ! in, water flow out of each snow layer [mm/s] + DepBChydropho => noahmp%forcing%DepBChydropho ,& ! in, hydrophobic Black Carbon deposition [kg m-2 s-1] + DepBChydrophi => noahmp%forcing%DepBChydrophi ,& ! in, hydrophillic Black Carbon deposition [kg m-2 s-1] + DepOChydropho => noahmp%forcing%DepOChydropho ,& ! in, hydrophobic Organic Carbon deposition [kg m-2 s-1] + DepOChydrophi => noahmp%forcing%DepOChydrophi ,& ! in, hydrophillic Organic Carbon deposition [kg m-2 s-1] + DepDust1 => noahmp%forcing%DepDust1 ,& ! in, dust species 1 deposition [kg m-2 s-1] + DepDust2 => noahmp%forcing%DepDust2 ,& ! in, dust species 2 deposition [kg m-2 s-1] + DepDust3 => noahmp%forcing%DepDust3 ,& ! in, dust species 3 deposition [kg m-2 s-1] + DepDust4 => noahmp%forcing%DepDust4 ,& ! in, dust species 4 deposition [kg m-2 s-1] + DepDust5 => noahmp%forcing%DepDust5 ,& ! in, dust species 5 deposition [kg m-2 s-1] + MassBChydropho => noahmp%water%state%MassBChydropho ,& ! inout, mass of hydrophobic Black Carbon in snow [kg m-2] + MassBChydrophi => noahmp%water%state%MassBChydrophi ,& ! inout, mass of hydrophillic Black Carbon in snow [kg m-2] + MassOChydropho => noahmp%water%state%MassOChydropho ,& ! inout, mass of hydrophobic Organic Carbon in snow [kg m-2] + MassOChydrophi => noahmp%water%state%MassOChydrophi ,& ! inout, mass of hydrophillic Organic Carbon in snow [kg m-2] + MassDust1 => noahmp%water%state%MassDust1 ,& ! inout, mass of dust species 1 in snow [kg m-2] + MassDust2 => noahmp%water%state%MassDust2 ,& ! inout, mass of dust species 2 in snow [kg m-2] + MassDust3 => noahmp%water%state%MassDust3 ,& ! inout, mass of dust species 3 in snow [kg m-2] + MassDust4 => noahmp%water%state%MassDust4 ,& ! inout, mass of dust species 4 in snow [kg m-2] + MassDust5 => noahmp%water%state%MassDust5 ,& ! inout, mass of dust species 5 in snow [kg m-2] + MassConcBChydropho => noahmp%water%state%MassConcBChydropho ,& ! inout, mass concentration of hydrophobic Black Carbon in snow [kg/kg] + MassConcBChydrophi => noahmp%water%state%MassConcBChydrophi ,& ! inout, mass concentration of hydrophillic Black Carbon in snow [kg/kg] + MassConcOChydropho => noahmp%water%state%MassConcOChydropho ,& ! inout, mass concentration of hydrophobic Organic Carbon in snow [kg/kg] + MassConcOChydrophi => noahmp%water%state%MassConcOChydrophi ,& ! inout, mass concentration of hydrophillic Organic Carbon in snow [kg/kg] + MassConcDust1 => noahmp%water%state%MassConcDust1 ,& ! inout, mass concentration of dust species 1 in snow [kg/kg] + MassConcDust2 => noahmp%water%state%MassConcDust2 ,& ! inout, mass concentration of dust species 2 in snow [kg/kg] + MassConcDust3 => noahmp%water%state%MassConcDust3 ,& ! inout, mass concentration of dust species 3 in snow [kg/kg] + MassConcDust4 => noahmp%water%state%MassConcDust4 ,& ! inout, mass concentration of dust species 4 in snow [kg/kg] + MassConcDust5 => noahmp%water%state%MassConcDust5 & ! inout, mass concentration of dust species 5 in snow [kg/kg] +) +! ---------------------------------------------------------------------- + + FluxInBChydropho = 0.0 + FluxInBChydrophi = 0.0 + FluxInOChydropho = 0.0 + FluxInOChydrophi = 0.0 + FluxInDust1 = 0.0 + FluxInDust2 = 0.0 + FluxInDust3 = 0.0 + FluxInDust4 = 0.0 + FluxInDust5 = 0.0 + + do LoopInd = -NumSnowLayerMax+1, 0 + SnowMass = SnowLiqWater(LoopInd) + SnowIce(LoopInd) + + if (LoopInd >= NumSnowLayerNeg+1) then + MassBChydropho(LoopInd) = MassBChydropho (LoopInd) + FluxInBChydropho * MainTimeStep + MassBChydrophi(LoopInd) = MassBChydrophi (LoopInd) + FluxInBChydrophi * MainTimeStep + MassOChydropho(LoopInd) = MassOChydropho (LoopInd) + FluxInOChydropho * MainTimeStep + MassOChydrophi(LoopInd) = MassOChydrophi (LoopInd) + FluxInOChydrophi * MainTimeStep + MassDust1(LoopInd) = MassDust1 (LoopInd) + FluxInDust1 * MainTimeStep + MassDust2(LoopInd) = MassDust2 (LoopInd) + FluxInDust2 * MainTimeStep + MassDust3(LoopInd) = MassDust3 (LoopInd) + FluxInDust3 * MainTimeStep + MassDust4(LoopInd) = MassDust4 (LoopInd) + FluxInDust4 * MainTimeStep + MassDust5(LoopInd) = MassDust5 (LoopInd) + FluxInDust5 * MainTimeStep + + !BCPHO + FluxOutBChydropho = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_bcpho*(MassBChydropho(LoopInd)/SnowMass) + if (FluxOutBChydropho * MainTimeStep > MassBChydropho(LoopInd)) then + FluxOutBChydropho = MassBChydropho(LoopInd) / MainTimeStep + MassBChydropho(LoopInd) = 0.0 + else + MassBChydropho(LoopInd) = MassBChydropho(LoopInd) - FluxOutBChydropho * MainTimeStep + end if + FluxInBChydropho = FluxOutBChydropho + + !BCPHI + FluxOutBChydrophi = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_bcphi*(MassBChydrophi(LoopInd)/SnowMass) + if (FluxOutBChydrophi * MainTimeStep > MassBChydrophi(LoopInd)) then + FluxOutBChydrophi = MassBChydrophi(LoopInd) / MainTimeStep + MassBChydrophi(LoopInd) = 0.0 + else + MassBChydrophi(LoopInd) = MassBChydrophi(LoopInd) - FluxOutBChydrophi * MainTimeStep + end if + FluxInBChydrophi = FluxOutBChydrophi + + !OCPHO + FluxOutOChydropho = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_ocpho*(MassOChydropho(LoopInd)/SnowMass) + if (FluxOutOChydropho * MainTimeStep > MassOChydropho(LoopInd)) then + FluxOutOChydropho = MassOChydropho(LoopInd) / MainTimeStep + MassOChydropho(LoopInd) = 0.0 + else + MassOChydropho(LoopInd) = MassOChydropho(LoopInd) - FluxOutOChydropho * MainTimeStep + end if + FluxInOChydropho = FluxOutOChydropho + + !OCPHI + FluxOutOChydrophi = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_ocphi*(MassOChydrophi(LoopInd)/SnowMass) + if (FluxOutOChydrophi * MainTimeStep > MassOChydrophi(LoopInd)) then + FluxOutOChydrophi = MassOChydrophi(LoopInd) / MainTimeStep + MassOChydrophi(LoopInd) = 0.0 + else + MassOChydrophi(LoopInd) = MassOChydrophi(LoopInd) - FluxOutOChydrophi * MainTimeStep + end if + FluxInOChydrophi = FluxOutOChydrophi + + !Dust 1 + FluxOutDust1 = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_dst1*(MassDust1(LoopInd)/SnowMass) + if (FluxOutDust1 * MainTimeStep > MassDust1(LoopInd)) then + FluxOutDust1 = MassDust1(LoopInd) / MainTimeStep + MassDust1(LoopInd) = 0.0 + else + MassDust1(LoopInd) = MassDust1(LoopInd) - FluxOutDust1 * MainTimeStep + end if + FluxInDust1 = FluxOutDust1 + + !Dust 2 + FluxOutDust2 = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_dst2*(MassDust2(LoopInd)/SnowMass) + if (FluxOutDust2 * MainTimeStep > MassDust2(LoopInd)) then + FluxOutDust2 = MassDust2(LoopInd) / MainTimeStep + MassDust2(LoopInd) = 0.0 + else + MassDust2(LoopInd) = MassDust2(LoopInd) - FluxOutDust2 * MainTimeStep + end if + FluxInDust2 = FluxOutDust2 + + !Dust 3 + FluxOutDust3 = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_dst3*(MassDust3(LoopInd)/SnowMass) + if (FluxOutDust3 * MainTimeStep > MassDust3(LoopInd)) then + FluxOutDust3 = MassDust3(LoopInd) / MainTimeStep + MassDust3(LoopInd) = 0.0 + else + MassDust3(LoopInd) = MassDust3(LoopInd) - FluxOutDust3 * MainTimeStep + end if + FluxInDust3 = FluxOutDust3 + + !Dust 4 + FluxOutDust4 = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_dst4*(MassDust4(LoopInd)/SnowMass) + if (FluxOutDust4 * MainTimeStep > MassDust4(LoopInd)) then + FluxOutDust4 = MassDust4(LoopInd) / MainTimeStep + MassDust4(LoopInd) = 0.0 + else + MassDust4(LoopInd) = MassDust4(LoopInd) - FluxOutDust4 * MainTimeStep + end if + FluxInDust4 = FluxOutDust4 + + !Dust 5 + FluxOutDust5 = OutflowSnowLayer(LoopInd)*scvng_fct_mlt_sf* & + scvng_fct_mlt_dst5*(MassDust5(LoopInd)/SnowMass) + if (FluxOutDust5 * MainTimeStep > MassDust5(LoopInd)) then + FluxOutDust5 = MassDust5(LoopInd) / MainTimeStep + MassDust5(LoopInd) = 0.0 + else + MassDust5(LoopInd) = MassDust5(LoopInd) - FluxOutDust5 * MainTimeStep + end if + FluxInDust5 = FluxOutDust5 + + endif + enddo + + if (NumSnowLayerNeg < 0 ) then + MassBChydropho(NumSnowLayerNeg+1) = MassBChydropho (NumSnowLayerNeg+1) + DepBChydropho * MainTimeStep + MassBChydrophi(NumSnowLayerNeg+1) = MassBChydrophi (NumSnowLayerNeg+1) + DepBChydrophi * MainTimeStep + MassOChydropho(NumSnowLayerNeg+1) = MassOChydropho (NumSnowLayerNeg+1) + DepOChydropho * MainTimeStep + MassOChydrophi(NumSnowLayerNeg+1) = MassOChydrophi (NumSnowLayerNeg+1) + DepOChydrophi * MainTimeStep + MassDust1(NumSnowLayerNeg+1) = MassDust1 (NumSnowLayerNeg+1) + DepDust1 * MainTimeStep + MassDust2(NumSnowLayerNeg+1) = MassDust2 (NumSnowLayerNeg+1) + DepDust2 * MainTimeStep + MassDust3(NumSnowLayerNeg+1) = MassDust3 (NumSnowLayerNeg+1) + DepDust3 * MainTimeStep + MassDust4(NumSnowLayerNeg+1) = MassDust4 (NumSnowLayerNeg+1) + DepDust4 * MainTimeStep + MassDust5(NumSnowLayerNeg+1) = MassDust5 (NumSnowLayerNeg+1) + DepDust5 * MainTimeStep + endif + + do LoopInd = -NumSnowLayerMax+1, 0 + + SnowMass = SnowLiqWater(LoopInd) + SnowIce(LoopInd) + + if (LoopInd >= NumSnowLayerNeg+1 .and. SnowMass > 0.0) then + MassConcBChydropho(LoopInd) = MassBChydropho(LoopInd) / SnowMass + MassConcBChydrophi(LoopInd) = MassBChydrophi(LoopInd) / SnowMass + MassConcOChydropho(LoopInd) = MassOChydropho(LoopInd) / SnowMass + MassConcOChydrophi(LoopInd) = MassOChydrophi(LoopInd) / SnowMass + MassConcDust1(LoopInd) = MassDust1(LoopInd) / SnowMass + MassConcDust2(LoopInd) = MassDust2(LoopInd) / SnowMass + MassConcDust3(LoopInd) = MassDust3(LoopInd) / SnowMass + MassConcDust4(LoopInd) = MassDust4(LoopInd) / SnowMass + MassConcDust5(LoopInd) = MassDust5(LoopInd) / SnowMass + else + MassConcBChydropho(LoopInd) = 0.0 + MassConcBChydrophi(LoopInd) = 0.0 + MassConcOChydropho(LoopInd) = 0.0 + MassConcOChydrophi(LoopInd) = 0.0 + MassConcDust1(LoopInd) = 0.0 + MassConcDust2(LoopInd) = 0.0 + MassConcDust3(LoopInd) = 0.0 + MassConcDust4(LoopInd) = 0.0 + MassConcDust5(LoopInd) = 0.0 + + MassBChydropho(LoopInd) = 0.0 + MassBChydrophi(LoopInd) = 0.0 + MassOChydropho(LoopInd) = 0.0 + MassOChydrophi(LoopInd) = 0.0 + MassDust1(LoopInd) = 0.0 + MassDust2(LoopInd) = 0.0 + MassDust3(LoopInd) = 0.0 + MassDust4(LoopInd) = 0.0 + MassDust5(LoopInd) = 0.0 + endif + + enddo + + end associate + + end subroutine SnowAerosolSnicar + +end module SnowAerosolSnicarMod diff --git a/src/SnowAgingSnicarMod.F90 b/src/SnowAgingSnicarMod.F90 new file mode 100644 index 00000000..264821ec --- /dev/null +++ b/src/SnowAgingSnicarMod.F90 @@ -0,0 +1,273 @@ +module SnowAgingSnicarMod + + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowAgingSnicar(noahmp) + +! ------------------------ Code history ----------------------------------- +! Compute snow effective grain size (radius) based on SNICAR scheme (Flanner et al. (2021) GMD) +! Original code: Flanner and Zender (2006) from CTSM, SnowAge_grain +! Refactered code: T.-S. Lin, C. He, et al. (2023) +! Description: +! Contributions to grain size evolution are from: +! 1. vapor redistribution (dry snow) +! 2. liquid water redistribution (wet snow) +! 3. re-freezing of liquid water +! Vapor redistribution: Method is to retrieve 3 best-bit parameters that +! depend on snow temperature, temperature gradient, and density, +! that are derived from the microphysical model described in: +! Flanner and Zender (2006), Linking snowpack microphysics and albedo +! evolution, J. Geophys. Res., 111, D12208, doi:10.1029/2005JD006834. +! The parametric equation has the form: +! dr/dt = drdt_0*(tau/(dr_fresh+tau))^(1/kappa), where: +! r is the effective radius, +! tau and kappa are best-fit parameters, +! drdt_0 is the initial rate of change of effective radius, and +! dr_fresh is the difference between the current and fresh snow states +! (r_current - r_fresh). +! +! Liquid water redistribution: Apply the grain growth function from: +! Brun, E. (1989), Investigation of wet-snow metamorphism in respect of +! liquid-water content, Annals of Glaciology, 13, 22-26. +! There are two parameters that describe the grain growth rate as +! a function of snow liquid water content (LWC). The "LWC=0" parameter +! is zeroed here because we are accounting for dry snowing with a +! different representation +! +! Re-freezing of liquid water: Assume that re-frozen liquid water clumps +! into an arbitrarily large effective grain size (SnowRadiusRefrz). +! The phenomenon is observed (Grenfell), but so far unquantified, as far as +! I am aware. +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: SnowLayerTop ! top snow layer index [idx] + integer :: SnowLayerBottom ! bottom snow layer index [idx] + integer :: TemperatureInd ! snow aging lookup table temperature index [idx] + integer :: TemperatureGradientInd ! snow aging lookup table temperature gradient index [idx] + integer :: SnowDensityInd ! snow aging lookup table snow density index [idx] + integer :: LoopInd ! do loop/array indices + integer, parameter :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx] + integer, parameter :: idx_Tgrd_min = 1 ! minimum temperature gradient index used in aging lookup table [idx] + integer, parameter :: idx_rhos_min = 1 ! minimum snow density index used in aging lookup table [idx] + real(kind=kind_noahmp) :: bst_tau ! best fit snow aging parameter retrieved from lookup table [hour] + real(kind=kind_noahmp) :: bst_kappa ! best fit snow aging parameter retrieved from lookup table [unitless] + real(kind=kind_noahmp) :: bst_drdt0 ! best fit snow aging parameter retrieved from lookup table [um hr-1] + real(kind=kind_noahmp) :: h2osno_lyr ! liquid + solid H2O in snow layer [kg m-2] + real(kind=kind_noahmp) :: TemperatureSnowLayerTop ! temperature at upper layer boundary [K] + real(kind=kind_noahmp) :: TemperatureSnowLayerBottom ! temperature at lower layer boundary [K] + real(kind=kind_noahmp) :: SnowDensity ! snow density [kg m-3] + real(kind=kind_noahmp) :: SnowRadiusMax = 1500 ! maximum allowed snow effective radius [microns] + real(kind=kind_noahmp), parameter:: C1_liq_Brun89 = 0.0 ! constant for liquid water grain growth [m3 s-1], from Brun89: zeroed to accomodate dry snow aging + real(kind=kind_noahmp), parameter:: C2_liq_Brun89 = 4.22e-13 ! Constant for liquid water grain growth [m3 s-1], from Brun89: corrected for LWC in units of percent + real(kind=kind_noahmp), parameter:: xdrdt = 1.0 ! Arbitrary factor applied to snow aging rate (-) tuning factor + real(kind=kind_noahmp) :: dr ! incremental change in snow effective radius [um] + real(kind=kind_noahmp) :: dr_wet ! incremental change in snow effective radius from wet growth [um] + real(kind=kind_noahmp) :: dr_fresh ! difference between fresh snow r_e and current r_e [um] + real(kind=kind_noahmp) :: NewSnow ! fresh snowfall [kg m-2] + real(kind=kind_noahmp) :: RefrzSnow ! re-frozen snow [kg m-2] + real(kind=kind_noahmp) :: FracRefrz ! fraction of layer mass that is re-frozen snow [frc] + real(kind=kind_noahmp) :: FracNewSnow ! fraction of layer mass that is new snow [frc] + real(kind=kind_noahmp) :: FracOldSnow ! fraction of layer mass that is old snow [frc] + real(kind=kind_noahmp) :: FracLiqWater ! fraction of layer mass that is liquid water[frc] + real(kind=kind_noahmp), allocatable, dimension(:) :: TemperatureGradient ! snow temperature gradient (lyr) [K m-1] + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + SnowIce => noahmp%water%state%SnowIce ,& ! in, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! in, snow layer liquid water [mm] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + SnowfallGround => noahmp%water%flux%SnowfallGround ,& ! in, snowfall at ground surface [mm/s] + SnowFreezeRate => noahmp%water%flux%SnowFreezeRate ,& ! in, rate of snow freezing [mm/s] + SnowRadiusFresh => noahmp%water%state%SnowRadiusFresh ,& ! in, fresh snow radius [microns] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + idx_T_max => noahmp%config%domain%idx_T_max ,& ! in, maxiumum temperature index used in aging lookup table [idx] + idx_Tgrd_max => noahmp%config%domain%idx_Tgrd_max ,& ! in, maxiumum temperature gradient index used in aging lookup table [idx] + idx_rhos_max => noahmp%config%domain%idx_rhos_max ,& ! in, maxiumum snow density index used in aging lookup table [idx] + SnowRadiusMin => noahmp%water%param%SnowRadiusMin ,& ! in, minimum allowed snow effective radius (also cold "fresh snow" value) [microns] + SnowRadiusRefrz => noahmp%water%param%SnowRadiusRefrz ,& ! in, effective radius of re-frozen snow [microns] + snowage_tau => noahmp%water%param%snowage_tau ,& ! in, snowage tau from table [hours] + snowage_kappa => noahmp%water%param%snowage_kappa ,& ! in, snowage kappa from table [unitless] + snowage_drdt0 => noahmp%water%param%snowage_drdt0 ,& ! in, snowage dr/dt_0 from table [m2 kg-1 hr-1] + SnowRadius => noahmp%water%state%SnowRadius & ! out, effective grain radius [microns, m-6] + ) +! ---------------------------------------------------------------------- + + if (.not. allocated(TemperatureGradient) ) allocate(TemperatureGradient (-NumSnowLayerMax:0)) + + SnowLayerBottom = 0 + SnowLayerTop = NumSnowLayerNeg + 1 + + ! loop over snow layers + do LoopInd=SnowLayerTop,SnowLayerBottom,1 + + !********** 1. DRY SNOW AGING *********** + h2osno_lyr = SnowLiqWater(LoopInd) + SnowIce(LoopInd) + + ! temperature gradient + if (LoopInd == SnowLayerTop) then + ! top layer + TemperatureSnowLayerTop = TemperatureSoilSnow(SnowLayerTop) + TemperatureSnowLayerBottom = (TemperatureSoilSnow(LoopInd+1)*ThicknessSnowSoilLayer(LoopInd) & + + TemperatureSoilSnow(LoopInd)*ThicknessSnowSoilLayer(LoopInd+1)) & + / (ThicknessSnowSoilLayer(LoopInd)+ThicknessSnowSoilLayer(LoopInd+1)) + else + TemperatureSnowLayerTop = (TemperatureSoilSnow(LoopInd-1)*ThicknessSnowSoilLayer(LoopInd) & + + TemperatureSoilSnow(LoopInd)*ThicknessSnowSoilLayer(LoopInd-1)) & + / (ThicknessSnowSoilLayer(LoopInd)+ThicknessSnowSoilLayer(LoopInd-1)) + TemperatureSnowLayerBottom = (TemperatureSoilSnow(LoopInd+1)*ThicknessSnowSoilLayer(LoopInd) & + + TemperatureSoilSnow(LoopInd)*ThicknessSnowSoilLayer(LoopInd+1)) & + / (ThicknessSnowSoilLayer(LoopInd)+ThicknessSnowSoilLayer(LoopInd+1)) + endif + + TemperatureGradient(LoopInd) = abs((TemperatureSnowLayerTop - TemperatureSnowLayerBottom) / ThicknessSnowSoilLayer(LoopInd)) + + ! snow density + SnowDensity = (SnowLiqWater(LoopInd)+SnowIce(LoopInd)) / ThicknessSnowSoilLayer(LoopInd) + + ! make sure snow density doesn't drop below 50 (see SnowDensityInd below) + SnowDensity = max(50.0,SnowDensity) + + ! best-fit table indecies + TemperatureInd = nint((TemperatureSoilSnow(LoopInd)-223.15) / 5) + 1 + TemperatureGradientInd = nint(TemperatureGradient(LoopInd) / 10) + 1 + SnowDensityInd = nint((SnowDensity-50) / 50) + 1 + + ! boundary check: + if (TemperatureInd < idx_T_min) then + TemperatureInd = idx_T_min + endif + if (TemperatureInd > idx_T_max) then + TemperatureInd = idx_T_max + endif + if (TemperatureGradientInd < idx_Tgrd_min) then + TemperatureGradientInd = idx_Tgrd_min + endif + if (TemperatureGradientInd > idx_Tgrd_max) then + TemperatureGradientInd = idx_Tgrd_max + endif + if (SnowDensityInd < idx_rhos_min) then + SnowDensityInd = idx_rhos_min + endif + if (SnowDensityInd > idx_rhos_max) then + SnowDensityInd = idx_rhos_max + endif + + ! best-fit parameters + bst_tau = snowage_tau(SnowDensityInd,TemperatureGradientInd,TemperatureInd) + bst_kappa = snowage_kappa(SnowDensityInd,TemperatureGradientInd,TemperatureInd) + bst_drdt0 = snowage_drdt0(SnowDensityInd,TemperatureGradientInd,TemperatureInd) + + !LvK extra boundary check, to prevent when using old restart file with lower SnowRadiusMin than current run + if (SnowRadius(LoopInd) < SnowRadiusMin) then + SnowRadius(LoopInd) = SnowRadiusMin + endif + + ! change in snow effective radius, using best-fit parameters + dr_fresh = SnowRadius(LoopInd)-SnowRadiusMin + dr = (bst_drdt0*(bst_tau/(dr_fresh+bst_tau))**(1.0/bst_kappa)) * (MainTimeStep/3600.0) + + !********** 2. WET SNOW AGING *********** + ! We are assuming wet and dry evolution occur simultaneously, and + ! the contributions from both can be summed. + ! This is justified by setting the linear offset constant C1_liq_Brun89 to zero [Brun, 1989] + + ! liquid water faction + FracLiqWater = min(0.1, (SnowLiqWater(LoopInd) / (SnowLiqWater(LoopInd)+SnowIce(LoopInd)))) + dr_wet = 1E18*(MainTimeStep*(C1_liq_Brun89 + C2_liq_Brun89*(FracLiqWater**(3))) / & + (4*ConstPI*SnowRadius(LoopInd)**(2))) + + dr = dr + dr_wet + + !********** 3. SNOWAGE SCALING (TUNING OPTION) *********** + ! Multiply rate of change of effective radius by some constant, xdrdt + + dr = dr*xdrdt + + !********** 4. INCREMENT EFFECTIVE RADIUS, ACCOUNTING FOR: *********** + ! DRY AGING + ! WET AGING + ! FRESH SNOW + ! RE-FREEZING + ! + ! new snowfall [kg/m2] + NewSnow = max(0.0, (SnowfallGround*MainTimeStep)) + + ! snow that has re-frozen [kg/m2] + RefrzSnow = max(0.0, (SnowFreezeRate(LoopInd)*MainTimeStep)) + + ! fraction of layer mass that is re-frozen + FracRefrz = RefrzSnow / h2osno_lyr + + ! fraction of layer mass that is new snow + if (LoopInd == SnowLayerTop) then + FracNewSnow = NewSnow / h2osno_lyr + else + FracNewSnow = 0.0 + endif + + if ((FracRefrz + FracNewSnow) > 1.0) then + FracRefrz = FracRefrz / (FracRefrz + FracNewSnow) + FracNewSnow = 1.0 - FracRefrz + FracOldSnow = 0.0 + else + FracOldSnow = 1.0 - FracRefrz - FracNewSnow + endif + + + ! mass-weighted mean of fresh snow, old snow, and re-frozen snow effective radius + SnowRadius(LoopInd) = (SnowRadius(LoopInd)+dr)*FracOldSnow + SnowRadiusFresh*FracNewSnow + & + SnowRadiusRefrz*FracRefrz + + !********** 5. CHECK BOUNDARIES *********** + ! + ! boundary check + if (SnowRadius(LoopInd) < SnowRadiusMin) then + SnowRadius(LoopInd) = SnowRadiusMin + endif + + if (SnowRadius(LoopInd) > SnowRadiusMax) then + SnowRadius(LoopInd) = SnowRadiusMax + end if + + + enddo + + if (-NumSnowLayerMax /= NumSnowLayerNeg) then + SnowRadius(-NumSnowLayerMax:NumSnowLayerNeg) = 0.0 + endif + + if (NumSnowLayerNeg == 0) then + SnowRadius(:) = 0.0 + endif + + ! Special case: snow on ground, but not enough to have defined a snow layer: + ! set SnowRadius to fresh snow grain size: + + if (NumSnowLayerNeg == 0 .and. ((SnowfallGround > 0.0) .or. (SnowWaterEquiv > 0.0) .or. (SnowDepth > 0.0))) then + SnowRadius(SnowLayerBottom) = SnowRadiusFresh!SnowRadiusMin + endif + + deallocate(TemperatureGradient) + + end associate + + end subroutine SnowAgingSnicar + +end module SnowAgingSnicarMod diff --git a/src/SnowAlbedoSnicarMod.F90 b/src/SnowAlbedoSnicarMod.F90 new file mode 100644 index 00000000..2d41d96e --- /dev/null +++ b/src/SnowAlbedoSnicarMod.F90 @@ -0,0 +1,49 @@ +module SnowAlbedoSnicarMod + +!!! Compute snow albedo based on SNICAR scheme (Flanner et al. (2021) GMD) + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowRadiationSnicarMod, only : SnowRadiationSnicar + + implicit none + +contains + + subroutine SnowAlbedoSnicar(noahmp) + +! ------------------------ Code history ----------------------------------- +! code: T.-S. Lin, C. He, et al. (2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: flg_slr_in ! flag: 1 for direct-beam incident flux, 2 for diffuse incident flux +! -------------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! out, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif & ! out, snow albedo for diffuse(1=vis, 2=nir) + + ) +! ---------------------------------------------------------------------- + + ! initialization + AlbedoSnowDir(1:NumSwRadBand) = 0.0 + AlbedoSnowDif(1:NumSwRadBand) = 0.0 + + flg_slr_in = 1 !Direct + call SnowRadiationSnicar(noahmp,flg_slr_in) + + flg_slr_in = 2 !Diffuse + call SnowRadiationSnicar(noahmp,flg_slr_in) + + end associate + + end subroutine SnowAlbedoSnicar + +end module SnowAlbedoSnicarMod diff --git a/src/SnowFreshRadiusMod.F90 b/src/SnowFreshRadiusMod.F90 new file mode 100644 index 00000000..67e2fcd3 --- /dev/null +++ b/src/SnowFreshRadiusMod.F90 @@ -0,0 +1,63 @@ +module SnowFreshRadiusMod + +!!! Compute snow albedo based on BATS scheme (Yang et al. (1997) J.of Climate) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowFreshRadius(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original CTSM function: FreshSnowRadius +! Refactered code: T.-S. Lin, C. He, et al. (2023) +! Description: +! Returns fresh snow grain radius, which is linearly dependent on temperature. +! This is implemented to remedy an outstanding bias that SNICAR has in initial +! grain size. See e.g. Sandells et al, 2017 for a discussion (10.5194/tc-11-229-2017). +! Yang et al. (2017), 10.1016/j.jqsrt.2016.03.033 +! discusses grain size observations, which suggest a temperature dependence. +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: Tmin ! start of linear ramp + real(kind=kind_noahmp) :: Tmax ! start of linear ramp + +! -------------------------------------------------------------------- + associate( & + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + SnowRadiusMin => noahmp%water%param%SnowRadiusMin ,& ! in, minimum allowed snow effective radius (also cold "fresh snow" value) [microns] + FreshSnowRadiusMax => noahmp%water%param%FreshSnowRadiusMax ,& ! in, maximum warm fresh snow effective radius [microns] + SnowRadiusFresh => noahmp%water%state%SnowRadiusFresh & ! out, fresh snow radius [microns] + ) +! ---------------------------------------------------------------------- + + Tmin = ConstFreezePoint-30.0 + Tmax = ConstFreezePoint + + if ( FreshSnowRadiusMax <= SnowRadiusMin )then + SnowRadiusFresh = SnowRadiusMin + else + if (TemperatureAirRefHeight < Tmin) then + SnowRadiusFresh = SnowRadiusMin + else if (TemperatureAirRefHeight > Tmax) then + SnowRadiusFresh = FreshSnowRadiusMax + else + SnowRadiusFresh = (Tmax-TemperatureAirRefHeight)/(Tmax-Tmin)*SnowRadiusMin + & + (TemperatureAirRefHeight-Tmin)/(Tmax-Tmin)*FreshSnowRadiusMax + end if + end if + + end associate + + end subroutine SnowFreshRadius + +end module SnowFreshRadiusMod diff --git a/src/SnowInputSnicarMod.F90 b/src/SnowInputSnicarMod.F90 new file mode 100644 index 00000000..b4b1f81b --- /dev/null +++ b/src/SnowInputSnicarMod.F90 @@ -0,0 +1,4833 @@ +module SnowInputSnicarMod + + use netcdf + use Machine + use NoahmpIOVarType + +#ifdef _PARALLEL_ + use mpi +#endif + + implicit none + +contains + + subroutine SnowInputSnicar(NoahmpIO) + +! ------------------------ Code history ----------------------------------- +! Code: T.-S. Lin, C. He, et al. (2023) +! Required input parameters for snow albedo SNICAR scheme (Flanner et al. (2021) GMD) +! ------------------------------------------------------------------------- + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + + !local variables + character(len= 34) :: subname_optics ! file name + character(len= 34) :: subname_age = 'snicar_drdt_bst_fit_60_c070416.nc' ! file name + character(len= 30) :: name + integer :: rank + integer :: ierr,iret + integer :: ncid, varid + +! -------------------------------------------------------------------- + associate( & + idx_Mie_snw_mx => NoahmpIO%idx_Mie_snw_mx ,& ! in, number of effective radius indices used in Mie lookup table [idx] + idx_T_max => NoahmpIO%idx_T_max ,& ! in, maxiumum temperature index used in aging lookup table [idx] + idx_Tgrd_max => NoahmpIO%idx_Tgrd_max ,& ! in, maxiumum temperature gradient index used in aging lookup table [idx] + idx_rhos_max => NoahmpIO%idx_rhos_max ,& ! in, maxiumum snow density index used in aging lookup table [idx] + snicar_numrad_snw => NoahmpIO%snicar_numrad_snw ,& ! in, wavelength bands used in SNICAR snow albedo calculation + snicar_snw_optics => NoahmpIO%SNICAR_SNOWOPTICS_OPT ,& ! in, snow optics type using different refractive index databases in SNICAR + snicar_dust_optics => NoahmpIO%SNICAR_DUSTOPTICS_OPT ,& ! in, dust optics type for SNICAR snow albedo calculation + snicar_solarspec => NoahmpIO%SNICAR_SOLARSPEC_OPT ,& ! in, type of downward solar radiation spectrum for SNICAR snow albedo calculation + ss_alb_snw_drc => NoahmpIO%ss_alb_snw_drc ,& ! out, Mie single scatter albedos for direct-beam ice + asm_prm_snw_drc => NoahmpIO%asm_prm_snw_drc ,& ! out, asymmetry parameter of direct-beam ice + ext_cff_mss_snw_drc => NoahmpIO%ext_cff_mss_snw_drc ,& ! out, mass extinction coefficient for direct-beam ice [m2/kg] + ss_alb_snw_dfs => NoahmpIO%ss_alb_snw_dfs ,& ! out, Mie single scatter albedos for diffuse ice + asm_prm_snw_dfs => NoahmpIO%asm_prm_snw_dfs ,& ! out, asymmetry parameter of diffuse ice + ext_cff_mss_snw_dfs => NoahmpIO%ext_cff_mss_snw_dfs ,& ! out, mass extinction coefficient for diffuse ice [m2/kg] + ss_alb_bc1 => NoahmpIO%ss_alb_bc1 ,& ! out, Mie single scatter albedos for hydrophillic BC + asm_prm_bc1 => NoahmpIO%asm_prm_bc1 ,& ! out, asymmetry parameter for hydrophillic BC + ext_cff_mss_bc1 => NoahmpIO%ext_cff_mss_bc1 ,& ! out, mass extinction coefficient for hydrophillic BC [m2/kg] + ss_alb_bc2 => NoahmpIO%ss_alb_bc2 ,& ! out, Mie single scatter albedos for hydrophobic BC + asm_prm_bc2 => NoahmpIO%asm_prm_bc2 ,& ! out, asymmetry parameter for hydrophobic BC + ext_cff_mss_bc2 => NoahmpIO%ext_cff_mss_bc2 ,& ! out, mass extinction coefficient for hydrophobic BC [m2/kg] + ss_alb_oc1 => NoahmpIO%ss_alb_oc1 ,& ! out, Mie single scatter albedos for hydrophillic OC + asm_prm_oc1 => NoahmpIO%asm_prm_oc1 ,& ! out, asymmetry parameter for hydrophillic OC + ext_cff_mss_oc1 => NoahmpIO%ext_cff_mss_oc1 ,& ! out, mass extinction coefficient for hydrophillic OC [m2/kg] + ss_alb_oc2 => NoahmpIO%ss_alb_oc2 ,& ! out, Mie single scatter albedos for hydrophobic OC + asm_prm_oc2 => NoahmpIO%asm_prm_oc2 ,& ! out, asymmetry parameter for hydrophobic OC + ext_cff_mss_oc2 => NoahmpIO%ext_cff_mss_oc2 ,& ! out, mass extinction coefficient for hydrophobic OC [m2/kg] + ss_alb_dst1 => NoahmpIO%ss_alb_dst1 ,& ! out, Mie single scatter albedos for dust species 1 + asm_prm_dst1 => NoahmpIO%asm_prm_dst1 ,& ! out, asymmetry parameter for dust species 1 + ext_cff_mss_dst1 => NoahmpIO%ext_cff_mss_dst1 ,& ! out, mass extinction coefficient for dust species 1 [m2/kg] + ss_alb_dst2 => NoahmpIO%ss_alb_dst2 ,& ! out, Mie single scatter albedos for dust species 2 + asm_prm_dst2 => NoahmpIO%asm_prm_dst2 ,& ! out, asymmetry parameter for dust species 2 + ext_cff_mss_dst2 => NoahmpIO%ext_cff_mss_dst2 ,& ! out, mass extinction coefficient for dust species 2 [m2/kg] + ss_alb_dst3 => NoahmpIO%ss_alb_dst3 ,& ! out, Mie single scatter albedos for dust species 3 + asm_prm_dst3 => NoahmpIO%asm_prm_dst3 ,& ! out, asymmetry parameter for dust species 3 + ext_cff_mss_dst3 => NoahmpIO%ext_cff_mss_dst3 ,& ! out, mass extinction coefficient for dust species 3 [m2/kg] + ss_alb_dst4 => NoahmpIO%ss_alb_dst4 ,& ! out, Mie single scatter albedos for dust species 4 + asm_prm_dst4 => NoahmpIO%asm_prm_dst4 ,& ! out, asymmetry parameter for dust species 4 + ext_cff_mss_dst4 => NoahmpIO%ext_cff_mss_dst4 ,& ! out, mass extinction coefficient for dust species 4 [m2/kg] + ss_alb_dst5 => NoahmpIO%ss_alb_dst5 ,& ! out, Mie single scatter albedos for dust species 5 + asm_prm_dst5 => NoahmpIO%asm_prm_dst5 ,& ! out, asymmetry parameter for dust species 5 + ext_cff_mss_dst5 => NoahmpIO%ext_cff_mss_dst5 ,& ! out, mass extinction coefficient for dust species 5 [m2/kg] + flx_wgt_dir => NoahmpIO%flx_wgt_dir ,& ! out, downward direct solar radiation spectral weights for wavelength band + flx_wgt_dif => NoahmpIO%flx_wgt_dif ,& ! out, downward diffuse solar radiation spectral weights for wavelength band + snowage_tau => NoahmpIO%snowage_tau ,& ! out, Snow aging parameters retrieved from lookup table [hour] + snowage_kappa => NoahmpIO%snowage_kappa ,& ! out, Snow aging parameters retrieved from lookup table [unitless] + snowage_drdt0 => NoahmpIO%snowage_drdt0 & ! out, Snow aging parameters retrieved from lookup table [m2 kg-1 hr-1] + ) +! ---------------------------------------------------------------------- + + if (snicar_numrad_snw==5) then + subname_optics='snicar_optics_5bnd_c013122.nc' + elseif (snicar_numrad_snw==480) then + subname_optics = 'snicar_optics_480bnd_c012422.nc' + endif + +#ifdef _PARALLEL_ + call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr) + if (ierr /= MPI_SUCCESS) stop "MPI_COMM_RANK" +#else + rank = 0 +#endif + + ! Open the NetCDF file. + if (rank == 0) write(*,'("Snicar SnowOptics init: ''", A, "''")') trim(subname_optics) +#ifdef _PARALLEL_ + ierr = nf90_open_par(subname_optics, NF90_NOWRITE, MPI_COMM_WORLD, MPI_INFO_NULL, ncid) +#else + ierr = nf90_open(subname_optics, NF90_NOWRITE, ncid) +#endif + if (ierr /= 0) then + write(*,'("read_snicar_data: Problem opening file: ''", A, "''")') trim(subname_optics) +#ifdef _PARALLEL_ + call mpi_finalize(ierr) + if (ierr /= 0) write(*, '("Problem with MPI_finalize.")') +#endif + stop + endif + + if (snicar_numrad_snw==5) then + + ! mid-latitude winter spectrum + if (snicar_solarspec == 1) then + + ! flux weights/spectrum + name = "flx_wgt_dir5_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif5_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + name = "ss_alb_bcphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 2 Mie parameters, uncoated BC + name = "ss_alb_bcphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + name = "ss_alb_ocphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 2 Mie parameters, uncoated OC + name = "ss_alb_ocphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! ice refractive index options + if (snicar_snw_optics == 1) then ! Warren (1984) + name = "ss_alb_ice_wrn84_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn84_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + name = "ss_alb_ice_wrn08_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn08_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + name = "ss_alb_ice_pic16_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dir_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_pic16_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + ! dust optical properties + if(snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_sah_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_col_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_gre_dif_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + ! mid-latitude summer spectrum + elseif (snicar_solarspec == 2) then + ! flux weights/spectrum + name = "flx_wgt_dir5_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif5_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + name = "ss_alb_bcphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 2 Mie parameters, uncoated BC + name = "ss_alb_bcphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + name = "ss_alb_ocphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 2 Mie parameters, uncoated OC + name = "ss_alb_ocphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + if (snicar_snw_optics == 1) then ! Warren (1984) + name = "ss_alb_ice_wrn84_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn84_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + name = "ss_alb_ice_wrn08_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn08_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + name = "ss_alb_ice_pic16_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dir_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_pic16_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_sah_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_col_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_gre_dif_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + ! sub-Arctic winter spectrum + elseif (snicar_solarspec == 3) then + ! flux weights/spectrum + name = "flx_wgt_dir5_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif5_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + name = "ss_alb_bcphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 2 Mie parameters, uncoated BC + name = "ss_alb_bcphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + name = "ss_alb_ocphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 2 Mie parameters, uncoated OC + name = "ss_alb_ocphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + if (snicar_snw_optics == 1) then ! Warren (1984) + name = "ss_alb_ice_wrn84_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn84_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + name = "ss_alb_ice_wrn08_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn08_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + name = "ss_alb_ice_pic16_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dir_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_pic16_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_sah_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_col_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_gre_dif_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + ! sub-Arctic summer spectrum + elseif (snicar_solarspec == 4) then + ! flux weights/spectrum + name = "flx_wgt_dir5_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif5_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + name = "ss_alb_bcphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 2 Mie parameters, uncoated BC + name = "ss_alb_bcphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + name = "ss_alb_ocphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 2 Mie parameters, uncoated OC + name = "ss_alb_ocphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + if (snicar_snw_optics == 1) then ! Warren (1984) + name = "ss_alb_ice_wrn84_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn84_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + name = "ss_alb_ice_wrn08_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn08_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + name = "ss_alb_ice_pic16_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dir_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_pic16_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_sah_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_col_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_gre_dif_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + ! Summit,Greenland,summer spectrum + elseif (snicar_solarspec == 5) then + ! flux weights/spectrum + name = "flx_wgt_dir5_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif5_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + name = "ss_alb_bcphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 2 Mie parameters, uncoated BC + name = "ss_alb_bcphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + name = "ss_alb_ocphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 2 Mie parameters, uncoated OC + name = "ss_alb_ocphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + if (snicar_snw_optics == 1) then ! Warren (1984) + name = "ss_alb_ice_wrn84_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn84_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + name = "ss_alb_ice_wrn08_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn08_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + name = "ss_alb_ice_pic16_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dir_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_pic16_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_sah_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_col_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_gre_dif_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + ! High Mountain summer spectrum + elseif (snicar_solarspec == 6) then + ! flux weights/spectrum + name = "flx_wgt_dir5_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif5_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + name = "ss_alb_bcphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 2 Mie parameters, uncoated BC + name = "ss_alb_bcphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + name = "ss_alb_ocphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 2 Mie parameters, uncoated OC + name = "ss_alb_ocphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + if (snicar_snw_optics == 1) then ! Warren (1984) + name = "ss_alb_ice_wrn84_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn84_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + name = "ss_alb_ice_wrn08_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn08_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + name = "ss_alb_ice_pic16_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dir_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_pic16_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_sah_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_col_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_gre_dif_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + endif !end of snicar_solarspec + + endif !end snicar five bands + + if (snicar_numrad_snw==480) then + + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + name = "ss_alb_bcphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! BC species 2 Mie parameters, uncoated BC + name = "ss_alb_bcphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_bcphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_bcphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_bc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + name = "ss_alb_ocphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! OC species 2 Mie parameters, uncoated OC + name = "ss_alb_ocphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ocphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ocphob" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_oc2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! snow optical properties derived from different ice refractive index dataset + ! same value for direct and diffuse due to high spectral res without spectra averaging in database + if (snicar_snw_optics == 1) then ! Warren (1984) + name = "ss_alb_ice_wrn84" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn84" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn84" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn84" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + name = "ss_alb_ice_wrn08" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_wrn08" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_wrn08" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_wrn08" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + name = "ss_alb_ice_pic16" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_drc, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ss_alb_ice_pic16" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_ice_pic16" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_ice_pic16" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_snw_dfs, start=(/1,1/), count=(/idx_Mie_snw_mx,snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + ! dust optical properties + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_sah" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_col" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + name = "ss_alb_dust01_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust01_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust01_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst1, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 2 Mie parameters + name = "ss_alb_dust02_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust02_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust02_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst2, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 3 Mie parameters + name = "ss_alb_dust03_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust03_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust03_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst3, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 4 Mie parameters + name = "ss_alb_dust04_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust04_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust04_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst4, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! dust species 5 Mie parameters + name = "ss_alb_dust05_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ss_alb_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "asm_prm_dust05_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, asm_prm_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "ext_cff_mss_dust05_gre" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, ext_cff_mss_dst5, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + ! downward solar radiation spectral weights for 480-band + if (snicar_solarspec == 1) then ! mid-latitude winter + name = "flx_wgt_dir480_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif480_mlw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_solarspec == 2) then ! mid-latitude summer + name = "flx_wgt_dir480_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif480_mls" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_solarspec == 3) then ! sub-Arctic winter + name = "flx_wgt_dir480_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif480_saw" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_solarspec == 4) then ! sub-Arctic summer + name = "flx_wgt_dir480_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif480_sas" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + elseif (snicar_solarspec == 5) then ! Summit,Greenland,summer + name = "flx_wgt_dir480_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif480_smm" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + + elseif (snicar_solarspec == 6) then ! High Mountain summer + name = "flx_wgt_dir480_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dir, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "flx_wgt_dif480_hmn" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, flx_wgt_dif, start=(/1/), count=(/snicar_numrad_snw/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + endif + + endif + ! Close the NetCDF file + ierr = nf90_close(ncid) + if (ierr /= 0) stop "MODULE_NOAHLSM_HRLDAS_INPUT: read_snicar_data: NF90_CLOSE" + + write(*,*) 'Successfully read snow optical properties' + write(*,*) 'band numbers', snicar_numrad_snw + write (*,*) 'SNICAR: Mie single scatter albedos for direct-beam ice, rds=100um: ', & + ss_alb_snw_drc(71,1), ss_alb_snw_drc(71,2), ss_alb_snw_drc(71,3), & + ss_alb_snw_drc(71,4), ss_alb_snw_drc(71,5) + write (*,*) 'SNICAR: Mie single scatter albedos for diffuse ice, rds=100um: ', & + ss_alb_snw_dfs(71,1), ss_alb_snw_dfs(71,2), ss_alb_snw_dfs(71,3), & + ss_alb_snw_dfs(71,4), ss_alb_snw_dfs(71,5) + write (*,*) 'SNICAR: Mie single scatter albedos for hydrophillic BC (before): ', & + ss_alb_bc1(1), ss_alb_bc1(2), ss_alb_bc1(3), ss_alb_bc1(4), ss_alb_bc1(5) + write (*,*) 'SNICAR: Mie single scatter albedos for hydrophobic BC: ', & + ss_alb_bc2(1), ss_alb_bc2(2), ss_alb_bc2(3), ss_alb_bc2(4), ss_alb_bc2(5) + write (*,*) 'SNICAR: Mie single scatter albedos for dust species 1: ', & + ss_alb_dst1(1), ss_alb_dst1(2), ss_alb_dst1(3), ss_alb_dst1(4), ss_alb_dst1(5) + write (*,*) 'SNICAR: Mie single scatter albedos for dust species 2: ', & + ss_alb_dst2(1), ss_alb_dst2(2), ss_alb_dst2(3), ss_alb_dst2(4), ss_alb_dst2(5) + write (*,*) 'SNICAR: Mie single scatter albedos for dust species 3: ', & + ss_alb_dst3(1), ss_alb_dst3(2), ss_alb_dst3(3), ss_alb_dst3(4), ss_alb_dst3(5) + write (*,*) 'SNICAR: Mie single scatter albedos for dust species 4: ', & + ss_alb_dst4(1), ss_alb_dst4(2), ss_alb_dst4(3), ss_alb_dst4(4), ss_alb_dst4(5) + + ! Open the NetCDF file. + if (rank == 0) write(*,'("Snicar SnowAge init: ''", A, "''")') trim(subname_age) +#ifdef _PARALLEL_ + ierr = nf90_open_par(subname_age, NF90_NOWRITE, MPI_COMM_WORLD, MPI_INFO_NULL, ncid) +#else + ierr = nf90_open(subname_age, NF90_NOWRITE, ncid) +#endif + if (ierr /= 0) then + write(*,'("read_snicar_data: Problem opening file: ''", A, "''")') trim(subname_age) +#ifdef _PARALLEL_ + call mpi_finalize(ierr) + if (ierr /= 0) write(*, '("Problem with MPI_finalize.")') +#endif + stop + endif + + name = "tau" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, snowage_tau, start=(/1,1,1/), count=(/idx_rhos_max,idx_Tgrd_max,idx_T_max/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "kappa" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, snowage_kappa, start=(/1,1,1/), count=(/idx_rhos_max,idx_Tgrd_max,idx_T_max/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + name = "drdsdt0" + iret = nf90_inq_varid(ncid, name, varid) + if (iret == 0) then + ierr = nf90_get_var(ncid, varid, snowage_drdt0, start=(/1,1,1/), count=(/idx_rhos_max,idx_Tgrd_max,idx_T_max/)) + else + write(*,*) "MODULE_HRLDAS_NETCDF_IO: Problem finding variable '"//trim(name)//"' in NetCDF file." + endif + + ! Close the NetCDF file + ierr = nf90_close(ncid) + if (ierr /= 0) stop "MODULE_NOAHLSM_HRLDAS_INPUT: read_snicar_data: NF90_CLOSE" + + write(*,*) 'Successfully read snow aging properties' + + ! print some diagnostics: + write (*,*) 'SNICAR: snowage tau for T=263.15K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_tau(3,11,9) + write (*,*) 'SNICAR: snowage kappa for T=263.15K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_kappa(3,11,9) + write (*,*) 'SNICAR: snowage dr/dt_0 for T=263.15K, dTdz = 100 K/m, rhos = 150 kg/m3: ', snowage_drdt0(3,11,9) + + end associate + + end subroutine SnowInputSnicar + +end module SnowInputSnicarMod + diff --git a/src/SnowLayerCombineMod.F90 b/src/SnowLayerCombineMod.F90 index 909542f2..bd1950d2 100644 --- a/src/SnowLayerCombineMod.F90 +++ b/src/SnowLayerCombineMod.F90 @@ -37,6 +37,7 @@ subroutine SnowLayerCombine(noahmp) ! -------------------------------------------------------------------- associate( & + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] @@ -46,6 +47,16 @@ subroutine SnowLayerCombine(noahmp) SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil liquid moisture [m3/m3] SoilIce => noahmp%water%state%SoilIce ,& ! inout, soil ice moisture [m3/m3] TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + MassBChydropho => noahmp%water%state%MassBChydropho ,& ! inout, mass of hydrophobic Black Carbon in snow [kg m-2] + MassBChydrophi => noahmp%water%state%MassBChydrophi ,& ! inout, mass of hydrophillic Black Carbon in snow [kg m-2] + MassOChydropho => noahmp%water%state%MassOChydropho ,& ! inout, mass of hydrophobic Organic Carbon in snow [kg m-2] + MassOChydrophi => noahmp%water%state%MassOChydrophi ,& ! inout, mass of hydrophillic Organic Carbon in snow [kg m-2] + MassDust1 => noahmp%water%state%MassDust1 ,& ! inout, mass of dust species 1 in snow [kg m-2] + MassDust2 => noahmp%water%state%MassDust2 ,& ! inout, mass of dust species 2 in snow [kg m-2] + MassDust3 => noahmp%water%state%MassDust3 ,& ! inout, mass of dust species 3 in snow [kg m-2] + MassDust4 => noahmp%water%state%MassDust4 ,& ! inout, mass of dust species 4 in snow [kg m-2] + MassDust5 => noahmp%water%state%MassDust5 ,& ! inout, mass of dust species 5 in snow [kg m-2] + SnowRadius => noahmp%water%state%SnowRadius ,& ! inout, effective grain radius [microns, m-6] PondSfcThinSnwComb => noahmp%water%state%PondSfcThinSnwComb ,& ! out, surface ponding [mm] from liquid in thin snow layer combination PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow liquid during transition from multilayer to no layer ) @@ -60,11 +71,38 @@ subroutine SnowLayerCombine(noahmp) SnowLiqWater(J+1) = SnowLiqWater(J+1) + SnowLiqWater(J) SnowIce(J+1) = SnowIce(J+1) + SnowIce(J) ThicknessSnowSoilLayer(J+1) = ThicknessSnowSoilLayer(J+1) + ThicknessSnowSoilLayer(J) + + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(J+1) = MassBChydropho(J+1) + MassBChydropho(J) + MassBChydrophi(J+1) = MassBChydrophi(J+1) + MassBChydrophi(J) + MassOChydropho(J+1) = MassOChydropho(J+1) + MassOChydropho(J) + MassOChydrophi(J+1) = MassOChydrophi(J+1) + MassOChydrophi(J) + MassDust1(J+1) = MassDust1(J+1) + MassDust1(J) + MassDust2(J+1) = MassDust2(J+1) + MassDust2(J) + MassDust3(J+1) = MassDust3(J+1) + MassDust3(J) + MassDust4(J+1) = MassDust4(J+1) + MassDust4(J) + MassDust5(J+1) = MassDust5(J+1) + MassDust5(J) + endif + else if ( NumSnowLayerNeg < -1 ) then ! MB/KM: change to NumSnowLayerNeg +! if ( NumSnowLayerOld < -1 ) then ! MB/KM: change to NumSnowLayerNeg !samlin SnowLiqWater(J-1) = SnowLiqWater(J-1) + SnowLiqWater(J) SnowIce(J-1) = SnowIce(J-1) + SnowIce(J) ThicknessSnowSoilLayer(J-1) = ThicknessSnowSoilLayer(J-1) + ThicknessSnowSoilLayer(J) + + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(J-1) = MassBChydropho(J-1) + MassBChydropho(J) + MassBChydrophi(J-1) = MassBChydrophi(J-1) + MassBChydrophi(J) + MassOChydropho(J-1) = MassOChydropho(J-1) + MassOChydropho(J) + MassOChydrophi(J-1) = MassOChydrophi(J-1) + MassOChydrophi(J) + MassDust1(J-1) = MassDust1(J-1) + MassDust1(J) + MassDust2(J-1) = MassDust2(J-1) + MassDust2(J) + MassDust3(J-1) = MassDust3(J-1) + MassDust3(J) + MassDust4(J-1) = MassDust4(J-1) + MassDust4(J) + MassDust5(J-1) = MassDust5(J-1) + MassDust5(J) + endif + else if ( SnowIce(J) >= 0.0 ) then PondSfcThinSnwComb = SnowLiqWater(J) ! NumSnowLayerNeg WILL GET SET TO ZERO BELOW; PondSfcThinSnwComb WILL GET @@ -82,6 +120,21 @@ subroutine SnowLayerCombine(noahmp) SnowLiqWater(J) = 0.0 SnowIce(J) = 0.0 ThicknessSnowSoilLayer(J) = 0.0 + + !SNICAR, aerosol flux may infiltrate into top soil like PondSfcThinSnwComb, it + !would be more thorough to do so later + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(J) = 0.0 + MassBChydrophi(J) = 0.0 + MassOChydropho(J) = 0.0 + MassOChydrophi(J) = 0.0 + MassDust1(J) = 0.0 + MassDust2(J) = 0.0 + MassDust3(J) = 0.0 + MassDust4(J) = 0.0 + MassDust5(J) = 0.0 + endif + endif ! if(NumSnowLayerOld < -1) !SoilLiqWater(1) = SoilLiqWater(1) + SnowLiqWater(J)/(ThicknessSnowSoilLayer(1)*1000.0) @@ -95,6 +148,20 @@ subroutine SnowLayerCombine(noahmp) SnowLiqWater(I) = SnowLiqWater(I-1) SnowIce(I) = SnowIce(I-1) ThicknessSnowSoilLayer(I) = ThicknessSnowSoilLayer(I-1) + + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(I) = MassBChydropho(I-1) + MassBChydrophi(I) = MassBChydrophi(I-1) + MassOChydropho(I) = MassOChydropho(I-1) + MassOChydrophi(I) = MassOChydrophi(I-1) + MassDust1(I) = MassDust1(I-1) + MassDust2(I) = MassDust2(I-1) + MassDust3(I) = MassDust3(I-1) + MassDust4(I) = MassDust4(I-1) + MassDust5(I) = MassDust5(I-1) + SnowRadius(I) = SnowRadius(I-1) + endif + enddo endif NumSnowLayerNeg = NumSnowLayerNeg + 1 @@ -128,6 +195,8 @@ subroutine SnowLayerCombine(noahmp) NumSnowLayerNeg = 0 SnowWaterEquiv = SnowIceTmp PondSfcThinSnwTrans = SnowLiqTmp ! LIMIT OF NumSnowLayerNeg < 0 MEANS INPUT PONDING + !SNICAR, aerosol flux may infiltrate into top soil like PondSfcThinSnwTrans, it + !would be more thorough to do so later if ( SnowWaterEquiv <= 0.0 ) SnowDepth = 0.0 ! SHOULD BE ZERO; SEE ABOVE endif @@ -155,10 +224,25 @@ subroutine SnowLayerCombine(noahmp) L = IndNeighbor endif + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(J) = MassBChydropho(J) + MassBChydropho(L) + MassBChydrophi(J) = MassBChydrophi(J) + MassBChydrophi(L) + MassOChydropho(J) = MassOChydropho(J) + MassOChydropho(L) + MassOChydrophi(J) = MassOChydrophi(J) + MassOChydrophi(L) + MassDust1(J) = MassDust1(J) + MassDust1(L) + MassDust2(J) = MassDust2(J) + MassDust2(L) + MassDust3(J) = MassDust3(J) + MassDust3(L) + MassDust4(J) = MassDust4(J) + MassDust4(L) + MassDust5(J) = MassDust5(J) + MassDust5(L) + SnowRadius(J) = (SnowRadius(J) * (SnowLiqWater(J) + SnowIce(J)) + SnowRadius(L) * (SnowLiqWater(L) + SnowIce(L)) ) / & + (SnowLiqWater(J) + SnowIce(J) + SnowLiqWater(L) + SnowIce(L)) + endif + ! update combined snow water & temperature call SnowLayerWaterCombo(ThicknessSnowSoilLayer(J), SnowLiqWater(J), SnowIce(J), TemperatureSoilSnow(J), & ThicknessSnowSoilLayer(L), SnowLiqWater(L), SnowIce(L), TemperatureSoilSnow(L) ) + ! Now shift all elements above this down one. if ( (J-1) > (NumSnowLayerNeg+1) ) then do K = J-1, NumSnowLayerNeg+2, -1 @@ -166,6 +250,20 @@ subroutine SnowLayerCombine(noahmp) SnowIce(K) = SnowIce(K-1) SnowLiqWater(K) = SnowLiqWater(K-1) ThicknessSnowSoilLayer(K) = ThicknessSnowSoilLayer(K-1) + + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(K) = MassBChydropho(K-1) + MassBChydrophi(K) = MassBChydrophi(K-1) + MassOChydropho(K) = MassOChydropho(K-1) + MassOChydrophi(K) = MassOChydrophi(K-1) + MassDust1(K) = MassDust1(K-1) + MassDust2(K) = MassDust2(K-1) + MassDust3(K) = MassDust3(K-1) + MassDust4(K) = MassDust4(K-1) + MassDust5(K) = MassDust5(K-1) + SnowRadius(K) = SnowRadius(K-1) + endif + enddo endif ! Decrease the number of snow layers diff --git a/src/SnowLayerDivideMod.F90 b/src/SnowLayerDivideMod.F90 index 6254978a..110a7700 100644 --- a/src/SnowLayerDivideMod.F90 +++ b/src/SnowLayerDivideMod.F90 @@ -32,19 +32,49 @@ subroutine SnowLayerDivide(noahmp) real(kind=kind_noahmp) :: SnowLiqExtra ! extra snow liquid water to be divided compared to allowed layer thickness real(kind=kind_noahmp) :: SnowFracExtra ! fraction of extra snow to be divided compared to allowed layer thickness real(kind=kind_noahmp) :: SnowTempGrad ! temperature gradient between two snow layers + real(kind=kind_noahmp) :: MassBChydrophoExtra ! extra mass of hydrophobic Black Carbon in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassBChydrophiExtra ! extra mass of hydrophillic Black Carbon in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassOChydrophoExtra ! extra mass of hydrophobic Organic Carbon in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassOChydrophiExtra ! extra mass of hydrophillic Organic Carbon in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassDust1Extra ! extra mass of dust species 1 in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassDust2Extra ! extra mass of dust species 2 in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassDust3Extra ! extra mass of dust species 3 in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassDust4Extra ! extra mass of dust species 4 in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassDust5Extra ! extra mass of dust species 5 in snow [kg m-2] to be divided compared to allowed layer thickness real(kind=kind_noahmp), allocatable, dimension(:) :: SnowThickTmp ! snow layer thickness [m] real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIceTmp ! partial volume of ice [m3/m3] real(kind=kind_noahmp), allocatable, dimension(:) :: SnowLiqTmp ! partial volume of liquid water [m3/m3] real(kind=kind_noahmp), allocatable, dimension(:) :: TemperatureSnowTmp ! node temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassBChydrophoTmp ! mass of hydrophobic Black Carbon in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassBChydrophiTmp ! mass of hydrophillic Black Carbon in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassOChydrophoTmp ! mass of hydrophobic Organic Carbon in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassOChydrophiTmp ! mass of hydrophillic Organic Carbon in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust1Tmp ! mass of dust species 1 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust2Tmp ! mass of dust species 2 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust3Tmp ! mass of dust species 3 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust4Tmp ! mass of dust species 4 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust5Tmp ! mass of dust species 5 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowRadiusTmp ! effective grain radius [microns, m-6] ! -------------------------------------------------------------------- associate( & NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] - SnowLiqWater => noahmp%water%state%SnowLiqWater & ! inout, snow layer liquid water [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + MassBChydropho => noahmp%water%state%MassBChydropho ,& ! inout, mass of hydrophobic Black Carbon in snow [kg m-2] + MassBChydrophi => noahmp%water%state%MassBChydrophi ,& ! inout, mass of hydrophillic Black Carbon in snow [kg m-2] + MassOChydropho => noahmp%water%state%MassOChydropho ,& ! inout, mass of hydrophobic Organic Carbon in snow [kg m-2] + MassOChydrophi => noahmp%water%state%MassOChydrophi ,& ! inout, mass of hydrophillic Organic Carbon in snow [kg m-2] + MassDust1 => noahmp%water%state%MassDust1 ,& ! inout, mass of dust species 1 in snow [kg m-2] + MassDust2 => noahmp%water%state%MassDust2 ,& ! inout, mass of dust species 2 in snow [kg m-2] + MassDust3 => noahmp%water%state%MassDust3 ,& ! inout, mass of dust species 3 in snow [kg m-2] + MassDust4 => noahmp%water%state%MassDust4 ,& ! inout, mass of dust species 4 in snow [kg m-2] + MassDust5 => noahmp%water%state%MassDust5 ,& ! inout, mass of dust species 5 in snow [kg m-2] + SnowRadius => noahmp%water%state%SnowRadius & ! inout, effective grain radius [microns, m-6] ) ! ---------------------------------------------------------------------- @@ -53,17 +83,58 @@ subroutine SnowLayerDivide(noahmp) if (.not. allocated(SnowLiqTmp) ) allocate(SnowLiqTmp (1:NumSnowLayerMax)) if (.not. allocated(TemperatureSnowTmp)) allocate(TemperatureSnowTmp(1:NumSnowLayerMax)) if (.not. allocated(SnowThickTmp) ) allocate(SnowThickTmp (1:NumSnowLayerMax)) + + if ( OptSnowAlbedo == 3 ) then + if (.not. allocated(MassBChydrophoTmp) ) allocate(MassBChydrophoTmp (1:NumSnowLayerMax)) + if (.not. allocated(MassBChydrophiTmp) ) allocate(MassBChydrophiTmp (1:NumSnowLayerMax)) + if (.not. allocated(MassOChydrophoTmp) ) allocate(MassOChydrophoTmp (1:NumSnowLayerMax)) + if (.not. allocated(MassOChydrophiTmp) ) allocate(MassOChydrophiTmp (1:NumSnowLayerMax)) + if (.not. allocated(MassDust1Tmp) ) allocate(MassDust1Tmp (1:NumSnowLayerMax)) + if (.not. allocated(MassDust2Tmp) ) allocate(MassDust2Tmp (1:NumSnowLayerMax)) + if (.not. allocated(MassDust3Tmp) ) allocate(MassDust3Tmp (1:NumSnowLayerMax)) + if (.not. allocated(MassDust4Tmp) ) allocate(MassDust4Tmp (1:NumSnowLayerMax)) + if (.not. allocated(MassDust5Tmp) ) allocate(MassDust5Tmp (1:NumSnowLayerMax)) + if (.not. allocated(SnowRadiusTmp) ) allocate(SnowRadiusTmp (1:NumSnowLayerMax)) + endif + SnowIceTmp (:) = 0.0 SnowLiqTmp (:) = 0.0 TemperatureSnowTmp(:) = 0.0 SnowThickTmp (:) = 0.0 + if ( OptSnowAlbedo == 3 ) then + MassBChydrophoTmp (:) = 0.0 + MassBChydrophiTmp (:) = 0.0 + MassOChydrophoTmp (:) = 0.0 + MassOChydrophiTmp (:) = 0.0 + MassDust1Tmp (:) = 0.0 + MassDust2Tmp (:) = 0.0 + MassDust3Tmp (:) = 0.0 + MassDust4Tmp (:) = 0.0 + MassDust5Tmp (:) = 0.0 + SnowRadiusTmp (:) = 0.0 + endif + do LoopInd = 1, NumSnowLayerMax if ( LoopInd <= abs(NumSnowLayerNeg) ) then SnowThickTmp(LoopInd) = ThicknessSnowSoilLayer(LoopInd+NumSnowLayerNeg) SnowIceTmp(LoopInd) = SnowIce(LoopInd+NumSnowLayerNeg) SnowLiqTmp(LoopInd) = SnowLiqWater(LoopInd+NumSnowLayerNeg) TemperatureSnowTmp(LoopInd) = TemperatureSoilSnow(LoopInd+NumSnowLayerNeg) + + if ( OptSnowAlbedo == 3 ) then + MassBChydrophoTmp(LoopInd) = MassBChydropho(LoopInd+NumSnowLayerNeg) + MassBChydrophiTmp(LoopInd) = MassBChydrophi(LoopInd+NumSnowLayerNeg) + MassOChydrophoTmp(LoopInd) = MassOChydropho(LoopInd+NumSnowLayerNeg) + MassOChydrophiTmp(LoopInd) = MassOChydrophi(LoopInd+NumSnowLayerNeg) + MassDust1Tmp(LoopInd) = MassDust1(LoopInd+NumSnowLayerNeg) + MassDust2Tmp(LoopInd) = MassDust2(LoopInd+NumSnowLayerNeg) + MassDust3Tmp(LoopInd) = MassDust3(LoopInd+NumSnowLayerNeg) + MassDust4Tmp(LoopInd) = MassDust4(LoopInd+NumSnowLayerNeg) + MassDust5Tmp(LoopInd) = MassDust5(LoopInd+NumSnowLayerNeg) + SnowRadiusTmp(LoopInd) = SnowRadius(LoopInd+NumSnowLayerNeg) + endif + endif enddo @@ -81,19 +152,79 @@ subroutine SnowLayerDivide(noahmp) SnowIceTmp(2) = SnowIceTmp(1) SnowLiqTmp(2) = SnowLiqTmp(1) TemperatureSnowTmp(2) = TemperatureSnowTmp(1) + + if ( OptSnowAlbedo == 3 ) then + MassBChydrophoTmp(1) = MassBChydrophoTmp(1)/2.0 + MassBChydrophoTmp(2) = MassBChydrophoTmp(1) + MassBChydrophiTmp(1) = MassBChydrophiTmp(1)/2.0 + MassBChydrophiTmp(2) = MassBChydrophiTmp(1) + MassOChydrophoTmp(1) = MassOChydrophoTmp(1)/2.0 + MassOChydrophoTmp(2) = MassOChydrophoTmp(1) + MassOChydrophiTmp(1) = MassOChydrophiTmp(1)/2.0 + MassOChydrophiTmp(2) = MassOChydrophiTmp(1) + MassDust1Tmp(1) = MassDust1Tmp(1)/2.0 + MassDust1Tmp(2) = MassDust1Tmp(1) + MassDust2Tmp(1) = MassDust2Tmp(1)/2.0 + MassDust2Tmp(2) = MassDust2Tmp(1) + MassDust3Tmp(1) = MassDust3Tmp(1)/2.0 + MassDust3Tmp(2) = MassDust3Tmp(1) + MassDust4Tmp(1) = MassDust4Tmp(1)/2.0 + MassDust4Tmp(2) = MassDust4Tmp(1) + MassDust5Tmp(1) = MassDust5Tmp(1)/2.0 + MassDust5Tmp(2) = MassDust5Tmp(1) + SnowRadiusTmp(2) = SnowRadiusTmp(1) + endif + endif endif if ( NumSnowLayerTmp > 1 ) then if ( SnowThickTmp(1) > 0.05 ) then ! maximum allowed thickness (5cm) for top snow layer - SnowThickCombTmp = SnowThickTmp(1) - 0.05 - SnowFracExtra = SnowThickCombTmp / SnowThickTmp(1) - SnowIceExtra = SnowFracExtra * SnowIceTmp(1) - SnowLiqExtra = SnowFracExtra * SnowLiqTmp(1) - SnowFracExtra = 0.05 / SnowThickTmp(1) - SnowIceTmp(1) = SnowFracExtra*SnowIceTmp(1) - SnowLiqTmp(1) = SnowFracExtra*SnowLiqTmp(1) - SnowThickTmp(1) = 0.05 + SnowThickCombTmp = SnowThickTmp(1) - 0.05 + SnowFracExtra = SnowThickCombTmp / SnowThickTmp(1) + SnowIceExtra = SnowFracExtra * SnowIceTmp(1) + SnowLiqExtra = SnowFracExtra * SnowLiqTmp(1) + + if ( OptSnowAlbedo == 3 ) then + MassBChydrophoExtra = SnowFracExtra * MassBChydrophoTmp(1) + MassBChydrophiExtra = SnowFracExtra * MassBChydrophiTmp(1) + MassOChydrophoExtra = SnowFracExtra * MassOChydrophoTmp(1) + MassOChydrophiExtra = SnowFracExtra * MassOChydrophiTmp(1) + MassDust1Extra = SnowFracExtra * MassDust1Tmp(1) + MassDust2Extra = SnowFracExtra * MassDust2Tmp(1) + MassDust3Extra = SnowFracExtra * MassDust3Tmp(1) + MassDust4Extra = SnowFracExtra * MassDust4Tmp(1) + MassDust5Extra = SnowFracExtra * MassDust5Tmp(1) + endif + + SnowFracExtra = 0.05 / SnowThickTmp(1) + SnowIceTmp(1) = SnowFracExtra*SnowIceTmp(1) + SnowLiqTmp(1) = SnowFracExtra*SnowLiqTmp(1) + SnowThickTmp(1) = 0.05 + + if ( OptSnowAlbedo == 3 ) then + MassBChydrophoTmp(1) = SnowFracExtra * MassBChydrophoTmp(1) + MassBChydrophiTmp(1) = SnowFracExtra * MassBChydrophiTmp(1) + MassOChydrophoTmp(1) = SnowFracExtra * MassOChydrophoTmp(1) + MassOChydrophiTmp(1) = SnowFracExtra * MassOChydrophiTmp(1) + MassDust1Tmp(1) = SnowFracExtra * MassDust1Tmp(1) + MassDust2Tmp(1) = SnowFracExtra * MassDust2Tmp(1) + MassDust3Tmp(1) = SnowFracExtra * MassDust3Tmp(1) + MassDust4Tmp(1) = SnowFracExtra * MassDust4Tmp(1) + MassDust5Tmp(1) = SnowFracExtra * MassDust5Tmp(1) + + MassBChydrophoTmp(2) = MassBChydrophoTmp(2) + MassBChydrophoExtra + MassBChydrophiTmp(2) = MassBChydrophiTmp(2) + MassBChydrophiExtra + MassOChydrophoTmp(2) = MassOChydrophoTmp(2) + MassOChydrophoExtra + MassOChydrophiTmp(2) = MassOChydrophiTmp(2) + MassOChydrophiExtra + MassDust1Tmp(2) = MassDust1Tmp(2) + MassDust1Extra + MassDust2Tmp(2) = MassDust2Tmp(2) + MassDust2Extra + MassDust3Tmp(2) = MassDust3Tmp(2) + MassDust3Extra + MassDust4Tmp(2) = MassDust4Tmp(2) + MassDust4Extra + MassDust5Tmp(2) = MassDust5Tmp(2) + MassDust5Extra + SnowRadiusTmp(2) = (SnowRadiusTmp(2) * (SnowLiqTmp(2) + SnowIceTmp(2)) + SnowRadiusTmp(1) * (SnowLiqExtra + SnowIceExtra) ) / & + (SnowLiqTmp(2) + SnowIceTmp(2) + SnowLiqExtra + SnowIceExtra) + endif ! update combined snow water & temperature call SnowLayerWaterCombo(SnowThickTmp(2), SnowLiqTmp(2), SnowIceTmp(2), TemperatureSnowTmp(2), & @@ -117,6 +248,30 @@ subroutine SnowLayerDivide(noahmp) else TemperatureSnowTmp(2) = TemperatureSnowTmp(2) + SnowTempGrad * SnowThickTmp(2) / 2.0 endif + + if ( OptSnowAlbedo == 3 ) then + MassBChydrophoTmp(2) = MassBChydrophoTmp(2) / 2.0 + MassBChydrophoTmp(3) = MassBChydrophoTmp(2) + MassBChydrophiTmp(2) = MassBChydrophiTmp(2) / 2.0 + MassBChydrophiTmp(3) = MassBChydrophiTmp(2) + MassOChydrophoTmp(2) = MassOChydrophoTmp(2) / 2.0 + MassOChydrophoTmp(3) = MassOChydrophoTmp(2) + MassOChydrophiTmp(2) = MassOChydrophiTmp(2) / 2.0 + MassOChydrophiTmp(3) = MassOChydrophiTmp(2) + + MassDust1Tmp(2) = MassDust1Tmp(2) / 2.0 + MassDust1Tmp(3) = MassDust1Tmp(2) + MassDust2Tmp(2) = MassDust2Tmp(2) / 2.0 + MassDust2Tmp(3) = MassDust2Tmp(2) + MassDust3Tmp(2) = MassDust3Tmp(2) / 2.0 + MassDust3Tmp(3) = MassDust3Tmp(2) + MassDust4Tmp(2) = MassDust4Tmp(2) / 2.0 + MassDust4Tmp(3) = MassDust4Tmp(2) + MassDust5Tmp(2) = MassDust5Tmp(2) / 2.0 + MassDust5Tmp(3) = MassDust5Tmp(2) + SnowRadiusTmp(3) = SnowRadiusTmp(2) + endif + endif endif ! if(SnowThickTmp(1) > 0.05) endif ! if (NumSnowLayerTmp > 1) @@ -127,11 +282,49 @@ subroutine SnowLayerDivide(noahmp) SnowFracExtra = SnowThickCombTmp / SnowThickTmp(2) SnowIceExtra = SnowFracExtra * SnowIceTmp(2) SnowLiqExtra = SnowFracExtra * SnowLiqTmp(2) + + if ( OptSnowAlbedo == 3 ) then + MassBChydrophoExtra = SnowFracExtra * MassBChydrophoTmp(2) + MassBChydrophiExtra = SnowFracExtra * MassBChydrophiTmp(2) + MassOChydrophoExtra = SnowFracExtra * MassOChydrophoTmp(2) + MassOChydrophiExtra = SnowFracExtra * MassOChydrophiTmp(2) + MassDust1Extra = SnowFracExtra * MassDust1Tmp(2) + MassDust2Extra = SnowFracExtra * MassDust2Tmp(2) + MassDust3Extra = SnowFracExtra * MassDust3Tmp(2) + MassDust4Extra = SnowFracExtra * MassDust4Tmp(2) + MassDust5Extra = SnowFracExtra * MassDust5Tmp(2) + endif + SnowFracExtra = 0.2 / SnowThickTmp(2) SnowIceTmp(2) = SnowFracExtra * SnowIceTmp(2) SnowLiqTmp(2) = SnowFracExtra * SnowLiqTmp(2) SnowThickTmp(2) = 0.2 + if ( OptSnowAlbedo == 3 ) then + MassBChydrophoTmp(2) = SnowFracExtra * MassBChydrophoTmp(2) + MassBChydrophiTmp(2) = SnowFracExtra * MassBChydrophiTmp(2) + MassOChydrophoTmp(2) = SnowFracExtra * MassOChydrophoTmp(2) + MassOChydrophiTmp(2) = SnowFracExtra * MassOChydrophiTmp(2) + MassDust1Tmp(2) = SnowFracExtra * MassDust1Tmp(2) + MassDust2Tmp(2) = SnowFracExtra * MassDust2Tmp(2) + MassDust3Tmp(2) = SnowFracExtra * MassDust3Tmp(2) + MassDust4Tmp(2) = SnowFracExtra * MassDust4Tmp(2) + MassDust5Tmp(2) = SnowFracExtra * MassDust5Tmp(2) + + MassBChydrophoTmp(3) = MassBChydrophoTmp(3) + MassBChydrophoExtra + MassBChydrophiTmp(3) = MassBChydrophiTmp(3) + MassBChydrophiExtra + MassOChydrophoTmp(3) = MassOChydrophoTmp(3) + MassOChydrophoExtra + MassOChydrophiTmp(3) = MassOChydrophiTmp(3) + MassOChydrophiExtra + MassDust1Tmp(3) = MassDust1Tmp(3) + MassDust1Extra + MassDust2Tmp(3) = MassDust2Tmp(3) + MassDust2Extra + MassDust3Tmp(3) = MassDust3Tmp(3) + MassDust3Extra + MassDust4Tmp(3) = MassDust4Tmp(3) + MassDust4Extra + MassDust5Tmp(3) = MassDust5Tmp(3) + MassDust5Extra + SnowRadiusTmp(3) = (SnowRadiusTmp(3) * (SnowLiqTmp(3) + SnowIceTmp(3)) + SnowRadiusTmp(2) * (SnowLiqExtra + SnowIceExtra) ) / & + (SnowLiqTmp(3) + SnowIceTmp(3) + SnowLiqExtra + SnowIceExtra) + endif + + ! update combined snow water & temperature call SnowLayerWaterCombo(SnowThickTmp(3), SnowLiqTmp(3), SnowIceTmp(3), TemperatureSnowTmp(3), & SnowThickCombTmp, SnowLiqExtra, SnowIceExtra, TemperatureSnowTmp(2)) @@ -145,6 +338,20 @@ subroutine SnowLayerDivide(noahmp) SnowIce(LoopInd) = SnowIceTmp(LoopInd-NumSnowLayerNeg) SnowLiqWater(LoopInd) = SnowLiqTmp(LoopInd-NumSnowLayerNeg) TemperatureSoilSnow(LoopInd) = TemperatureSnowTmp(LoopInd-NumSnowLayerNeg) + + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(LoopInd) = MassBChydrophoTmp(LoopInd-NumSnowLayerNeg) + MassBChydrophi(LoopInd) = MassBChydrophiTmp(LoopInd-NumSnowLayerNeg) + MassOChydropho(LoopInd) = MassOChydrophoTmp(LoopInd-NumSnowLayerNeg) + MassOChydrophi(LoopInd) = MassOChydrophiTmp(LoopInd-NumSnowLayerNeg) + MassDust1(LoopInd) = MassDust1Tmp(LoopInd-NumSnowLayerNeg) + MassDust2(LoopInd) = MassDust2Tmp(LoopInd-NumSnowLayerNeg) + MassDust3(LoopInd) = MassDust3Tmp(LoopInd-NumSnowLayerNeg) + MassDust4(LoopInd) = MassDust4Tmp(LoopInd-NumSnowLayerNeg) + MassDust5(LoopInd) = MassDust5Tmp(LoopInd-NumSnowLayerNeg) + SnowRadius(LoopInd) = SnowRadiusTmp(LoopInd-NumSnowLayerNeg) + endif + enddo ! deallocate local arrays to avoid memory leaks @@ -153,6 +360,19 @@ subroutine SnowLayerDivide(noahmp) deallocate(TemperatureSnowTmp) deallocate(SnowThickTmp ) + if ( OptSnowAlbedo == 3 ) then + deallocate(MassBChydrophoTmp ) + deallocate(MassBChydrophiTmp ) + deallocate(MassOChydrophoTmp ) + deallocate(MassOChydrophiTmp ) + deallocate(MassDust1Tmp ) + deallocate(MassDust2Tmp ) + deallocate(MassDust3Tmp ) + deallocate(MassDust4Tmp ) + deallocate(MassDust5Tmp ) + deallocate(SnowRadiusTmp ) + endif + end associate end subroutine SnowLayerDivide diff --git a/src/SnowRadiationSnicarMod.F90 b/src/SnowRadiationSnicarMod.F90 new file mode 100644 index 00000000..a26d6b94 --- /dev/null +++ b/src/SnowRadiationSnicarMod.F90 @@ -0,0 +1,1821 @@ +module SnowRadiationSnicarMod + +! Determine reflectance of, and vertically-resolved solar absorption in, +! snow with impurities. +! +! Original references on physical models of snow reflectance include: +! Wiscombe and Warren [1980] and Warren and Wiscombe [1980], +! Journal of Atmospheric Sciences, 37, +! +! The multi-layer solution for multiple-scattering used here is from: +! Toon et al. [1989], Rapid calculation of radiative heating rates +! and photodissociation rates in inhomogeneous multiple scattering atmospheres, +! J. Geophys. Res., 94, D13, 16287-16301 +! The implementation of the SNICAR model in CLM/CSIM is described in: +! Flanner, M., C. Zender, J. Randerson, and P. Rasch [2007], +! Present-day climate forcing and response from black carbon in snow, +! J. Geophys. Res., 112, D11202, doi: 10.1029/2006JD008003 +! +! Updated radiative transfer solver: +! +! The multi-layer solution for multiple-scattering used here is from: +! Briegleb, P. and Light, B.: A Delta-Eddington mutiple scattering +! parameterization for solar radiation in the sea ice component of the +! community climate system model, 2007. +! The implementation of the SNICAR-AD model in CLM is described in: +! Dang et al.2019, Inter-comparison and improvement of 2-stream shortwave +! radiative transfer models for unified treatment of cryospheric surfaces +! in ESMs; and Flanner et al. 2021, SNICAR-ADv3: a community tool for modeling +! spectral snow albedo +! +! To use this new adding-doubling solver, set snicar_rt_solver=2 in CLM namelist + + use Machine + use NoahmpVarType + use ConstantDefineMod + use PiecewiseLinearInterp1dMod + implicit none + +contains + + subroutine SnowRadiationSnicar(noahmp,flg_slr_in) + +! ------------------------ Code history ----------------------------------- +! Original CTSM subroutine: SNICAR_RT +! Refactered code: T.-S. Lin, C. He, et al. (2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + integer, intent(in) :: flg_slr_in ! flag: =1 for direct-beam incident flux,=2 for diffuse incident flux +! local variables + integer :: i,idb,igb + integer :: j ! aerosol number index [idx] + integer :: n ! tridiagonal matrix index [idx] + integer :: ng ! gaussian integration index + integer :: ngmax = 8 ! maxmimum gaussian integration index + integer :: trip ! flag: =1 to redo RT calculation if result is unrealistic + integer :: NumSnicarAerosol = 9 ! number of aerosol species in snowpack + integer :: SnowLayerTop ! top snow layer index [idx] + integer :: SnowLayerBottom ! bottom snow layer index [idx] + integer :: LoopInd ! do loop/array indices + integer :: nir_bnd_bgn ! first band index in near-IR spectrum [idx] cenlin + integer :: nir_bnd_end ! ending near-IR band index [idx] cenlin + integer :: flg_nosnl ! flag: =1 if there is snow, but zero snow layers, =0 if at least 1 snow layer [flg] + integer :: snl_lcl ! negative number of snow layers [nbr] + integer :: flg_dover ! defines conditions for RT redo (explained below) + integer :: err_idx ! counter for number of times through error loop [nbr] + integer :: APRX_TYP ! two-stream approximation type (1=Eddington, 2=Quadrature, 3=Hemispheric Mean) [nbr] + integer :: rds_idx ! snow effective radius index for retrieving, Mie parameters from lookup table [idx] + integer :: snl_btm_itf ! index of bottom snow layer interfaces (1) [idx] + integer, parameter :: snw_rds_min_tbl = 30 ! minimium effective radius defined in Mie lookup table [microns] + integer, parameter :: snw_rds_max_tbl = 1500 ! maximum effective radius defined in Mie lookup table [microns] + integer, allocatable, dimension(:) :: snw_rds_lcl ! snow effective radius [m^-6] + real(kind=kind_noahmp) :: tau_sum ! cumulative (snow+aerosol) optical depth [unitless] + real(kind=kind_noahmp) :: omega_sum ! temporary summation of single-scatter albedo of all aerosols [frc] + real(kind=kind_noahmp) :: g_sum ! temporary summation of asymmetry parameter of all aerosols [frc] + real(kind=kind_noahmp) :: F_direct_btm ! direct-beam radiation at bottom of snowpack [W/m^2] + real(kind=kind_noahmp) :: F_sfc_pls ! upward radiative flux at snowpack top [W/m^2] + real(kind=kind_noahmp) :: F_btm_net ! net flux at bottom of snowpack [W/m^2] + real(kind=kind_noahmp) :: F_sfc_net ! net flux at top of snowpack [W/m^2] + real(kind=kind_noahmp) :: energy_sum ! sum of all energy terms; should be 0.0 [W/m^2] + real(kind=kind_noahmp) :: albedo ! temporary snow albedo [frc] + real(kind=kind_noahmp) :: F_abs_sum ! total absorbed energy in column [W/m^2] + real(kind=kind_noahmp) :: flx_sum ! temporary summation variable for NIR weighting + + ! cconstant and coefficients used for SZA parameterization + real(kind=kind_noahmp) :: sza_a0 = 0.085730 + real(kind=kind_noahmp) :: sza_a1 = -0.630883 + real(kind=kind_noahmp) :: sza_a2 = 1.303723 + real(kind=kind_noahmp) :: sza_b0 = 1.467291 + real(kind=kind_noahmp) :: sza_b1 = -3.338043 + real(kind=kind_noahmp) :: sza_b2 = 6.807489 + real(kind=kind_noahmp) :: puny = 1.0e-11 + real(kind=kind_noahmp) :: mu_75 = 0.2588 ! cosine of 75 degree + real(kind=kind_noahmp) :: sza_c1 ! coefficient, SZA parameteirzation + real(kind=kind_noahmp) :: sza_c0 ! coefficient, SZA parameterization + real(kind=kind_noahmp) :: sza_factor ! factor used to adjust NIR direct albedo + real(kind=kind_noahmp) :: flx_sza_adjust ! direct NIR flux adjustment from sza_factor + real(kind=kind_noahmp) :: mu0 ! incident solar zenith angle + + ! constants used in algorithm + real(kind=kind_noahmp) :: mu_not ! cosine of solar zenith angle (used locally) [frc] + real(kind=kind_noahmp) :: c0 = 0.0 + real(kind=kind_noahmp) :: c1 = 1.0 + real(kind=kind_noahmp) :: c3 = 3.0 + real(kind=kind_noahmp) :: c4 = 4.0 + real(kind=kind_noahmp) :: c6 = 6.0 + real(kind=kind_noahmp) :: cp01 = 0.01 + real(kind=kind_noahmp) :: cp5 = 0.5 + real(kind=kind_noahmp) :: cp75 = 0.75 + real(kind=kind_noahmp) :: c1p5 = 1.5 + real(kind=kind_noahmp) :: trmin = 0.001 + real(kind=kind_noahmp) :: argmax = 10.0 ! maximum argument of exponential + real(kind=kind_noahmp) :: wvl_ct5(1:5) ! band center wavelength (um) for 5-band case + real(kind=kind_noahmp) :: wvl_ct480(1:480) ! band center wavelength (um) for 480-band case, computed below + real(kind=kind_noahmp) :: SnowWaterEquivMin ! minimum snow mass required for SNICAR RT calculation [kg m-2] !samlin, may need to change this + real(kind=kind_noahmp) :: diam_ice ! effective snow grain diameter (SSA-equivalent) unit: microns + real(kind=kind_noahmp) :: fs_sphd ! shape factor for spheroid snow + real(kind=kind_noahmp) :: fs_hex ! shape factor for reference hexagonal snow + real(kind=kind_noahmp) :: fs_hex0 ! shape factor for hexagonal plate + real(kind=kind_noahmp) :: fs_koch ! shape factor for Koch snowflake + real(kind=kind_noahmp) :: AR_tmp ! aspect ratio temporary + real(kind=kind_noahmp) :: g_ice_Cg_tmp(1:7) ! temporary asymmetry factor correction coeff + real(kind=kind_noahmp) :: gg_ice_F07_tmp(1:7) ! temporary asymmetry factor related to geometric reflection & refraction + real(kind=kind_noahmp) :: g_Cg_intp ! interpolated asymmetry factor correction coeff to target bands + real(kind=kind_noahmp) :: gg_F07_intp ! interpolated asymmetry factor related to geometric reflection & refraction + real(kind=kind_noahmp) :: g_ice_F07 ! asymmetry factor for Fu 2007 parameterization value + ! variables used for nonspherical snow grain treatment (He et al. 2017 J of Climate): + ! Constants and parameters for aspherical ice particles + ! asymmetry factor parameterization coefficients (6 bands) from Table 3 & Eqs. 6-7 in He et al. (2017) + real(kind=kind_noahmp) :: g_wvl(1:8) ! wavelength (um) division point + real(kind=kind_noahmp) :: g_wvl_ct(1:7) ! center point for wavelength band (um) + real(kind=kind_noahmp) :: g_b0(1:7) + real(kind=kind_noahmp) :: g_b1(1:7) + real(kind=kind_noahmp) :: g_b2(1:7) + ! Tables 1 & 2 and Eqs. 3.1-3.4 from Fu, 2007 JAS + real(kind=kind_noahmp) :: g_F07_c2(1:7) + real(kind=kind_noahmp) :: g_F07_c1(1:7) + real(kind=kind_noahmp) :: g_F07_c0(1:7) + real(kind=kind_noahmp) :: g_F07_p2(1:7) + real(kind=kind_noahmp) :: g_F07_p1(1:7) + real(kind=kind_noahmp) :: g_F07_p0(1:7) + ! variables used for BC-snow internal mixing (He et al. 2017 J of Climate): + real(kind=kind_noahmp) :: enh_omg_bcint ! BC-induced enhancement in snow single-scattering co-albedo (1-omega) + real(kind=kind_noahmp) :: enh_omg_bcint_tmp(1:16) ! temporary BC-induced enhancement in snow 1-omega + real(kind=kind_noahmp) :: enh_omg_bcint_tmp2(1:16) ! temporary BC-induced enhancement in snow 1-omega + real(kind=kind_noahmp) :: bcint_wvl(1:17) ! Parameterization band (0.2-1.2um) for BC-induced enhancement in snow 1-omega + real(kind=kind_noahmp) :: bcint_wvl_ct(1:16) ! Parameterization band center wavelength (um) + real(kind=kind_noahmp) :: bcint_d0(1:16) ! Parameterization coefficients at each band center wavelength + real(kind=kind_noahmp) :: bcint_d1(1:16) ! Parameterization coefficients at each band center wavelength + real(kind=kind_noahmp) :: bcint_d2(1:16) ! Parameterization coefficients at each band center wavelength + real(kind=kind_noahmp) :: den_bc = 1.49 ! target BC particle density (g/cm3) used in BC MAC adjustment + real(kind=kind_noahmp) :: Re_bc = 0.045 ! target BC effective radius (um) used in BC MAC adjustment + real(kind=kind_noahmp) :: bcint_m(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix + real(kind=kind_noahmp) :: bcint_n(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix + real(kind=kind_noahmp) :: bcint_dd ! intermediate parameter + real(kind=kind_noahmp) :: bcint_dd2 ! intermediate parameter + real(kind=kind_noahmp) :: bcint_f ! intermediate parameter + real(kind=kind_noahmp) :: enh_omg_bcint_intp ! BC-induced enhancement in snow 1-omega (logscale) interpolated to CLM wavelength + real(kind=kind_noahmp) :: enh_omg_bcint_intp2 ! BC-induced enhancement in snow 1-omega interpolated to CLM wavelength + real(kind=kind_noahmp) :: wvl_doint ! wavelength doing BC-snow int mixing (<=1.2um) + integer :: ibb ! loop index + ! variables used for dust-snow internal mixing (He et al. 2019 JAMES): + real(kind=kind_noahmp) :: enh_omg_dstint ! dust-induced enhancement in snow single-scattering co-albedo (1-omega) + real(kind=kind_noahmp) :: enh_omg_dstint_tmp(1:6) ! temporary dust-induced enhancement in snow 1-omega + real(kind=kind_noahmp) :: enh_omg_dstint_tmp2(1:6) ! temporary dust-induced enhancement in snow 1-omega + real(kind=kind_noahmp) :: dstint_wvl(1:7) ! Parameterization band (0.2-1.2um) for dust-induced enhancement in snow 1-omega + real(kind=kind_noahmp) :: dstint_wvl_ct(1:6) ! Parameterization band center wavelength (um) + real(kind=kind_noahmp) :: dstint_a1(1:6) ! Parameterization coefficients at each band center wavelength + real(kind=kind_noahmp) :: dstint_a2(1:6) ! Parameterization coefficients at each band center wavelength + real(kind=kind_noahmp) :: dstint_a3(1:6) ! Parameterization coefficients at each band center wavelength + real(kind=kind_noahmp) :: enh_omg_dstint_intp ! dust-induced enhancement in snow 1-omega (logscale) interpolated to CLM wavelength + real(kind=kind_noahmp) :: enh_omg_dstint_intp2 ! dust-induced enhancement in snow 1-omega interpolated to CLM wavelength + real(kind=kind_noahmp) :: tot_dst_snw_conc ! total dust content in snow across all size bins (ppm=ug/g) + real(kind=kind_noahmp), allocatable, dimension(:) :: sno_shp ! Snow shape type: 1=sphere; 2=spheroid; 3=hexagonal plate; 4=koch snowflake + ! currently only assuming same shapes for all snow layers + real(kind=kind_noahmp), allocatable, dimension(:) :: sno_fs ! Snow shape factor: ratio of nonspherical grain effective radii to that of equal-volume sphere + ! only activated when OptSnicarSnowShape > 1 (i.e. nonspherical) + ! 0=use recommended default value (He et al. 2017); + ! others(0 1 (i.e. nonspherical) + ! 0=use recommended default value (He et al. 2017); + ! others(0.1 noahmp%config%domain%IndicatorIceSfc ,& ! in, indicator for ice surface/point (1=sea ice, 0=non-ice, -1=land ice) + OptSnicarSnowShape => noahmp%config%nmlist%OptSnicarSnowShape ,& ! in, Snow shape type: + ! 1=sphere; 2=spheroid; 3=hexagonal plate; 4=koch snowflake + ! currently only assuming same shapes for all snow layers + OptSnicarRTSolver => noahmp%config%nmlist%OptSnicarRTSolver ,& ! in, SNICAR radiative transfer solver + ! 1=Toon et a 1989 2-stream (Flanner et al. 2007) + ! 2=Adding-doubling 2-stream (Dang et al.2019) + FlagSnicarSnowBCIntmix => noahmp%config%nmlist%FlagSnicarSnowBCIntmix ,& ! in,option to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC) + ! .false. -> external mixing for all BC + ! .true. -> internal mixing for hydrophilic BC + FlagSnicarSnowDustIntmix => noahmp%config%nmlist%FlagSnicarSnowDustIntmix,& ! in,option to activate dust-snow internal mixing in SNICAR (He et al. 2017 JC) + ! .false. -> external mixing for all dust + ! .true. -> internal mixing for all dust + FlagSnicarUseAerosol => noahmp%config%nmlist%FlagSnicarUseAerosol ,& ! option to turn on/off aerosol deposition flux effect in snow in SNICAR + ! .false. -> without aerosol deposition flux effect + ! .true. -> with aerosol deposition flux effect + FlagSnicarUseOC => noahmp%config%nmlist%FlagSnicarUseOC ,& ! option to activate OC in snow in SNICAR + ! .false. -> without organic carbon in snow + ! .true. -> with organic carbon in snow + NumSnicarRadBand => noahmp%config%domain%NumSnicarRadBand ,& ! in, wavelength bands used in SNICAR snow albedo calculation + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of shortwave radiation bands + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + CosSolarZenithAngle => noahmp%config%domain%CosSolarZenithAngle ,& ! in, cosine solar zenith angle + SnowIce => noahmp%water%state%SnowIce ,& ! in, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! in, snow layer liquid water [mm] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + SnowRadius => noahmp%water%state%SnowRadius ,& ! in, effective grain radius [microns, m-6] + AlbedoSoilDif => noahmp%energy%state%AlbedoSoilDif ,& ! in, soil albedo (diffuse) + AlbedoSoilDir => noahmp%energy%state%AlbedoSoilDir ,& ! in, soil albedo (direct) + AlbedoLandIce => noahmp%energy%param%AlbedoLandIce ,& ! in, albedo land ice: 1=vis, 2=nir + flx_wgt_dir => noahmp%energy%param%flx_wgt_dir ,& ! in, downward solar radiation spectral weights (direct) + flx_wgt_dif => noahmp%energy%param%flx_wgt_dif ,& ! in, downward solar radiation spectral weights (diffuse) + ss_alb_snw_drc => noahmp%energy%param%ss_alb_snw_drc ,& ! in, Mie single scatter albedos for direct-beam ice + asm_prm_snw_drc => noahmp%energy%param%asm_prm_snw_drc ,& ! in, asymmetry parameter of direct-beam ice + ext_cff_mss_snw_drc => noahmp%energy%param%ext_cff_mss_snw_drc ,& ! in, mass extinction coefficient for direct-beam ice [m2/kg] + ss_alb_snw_dfs => noahmp%energy%param%ss_alb_snw_dfs ,& ! in, Mie single scatter albedos for diffuse ice + asm_prm_snw_dfs => noahmp%energy%param%asm_prm_snw_dfs ,& ! in, asymmetry parameter of diffuse ice + ext_cff_mss_snw_dfs => noahmp%energy%param%ext_cff_mss_snw_dfs ,& ! in, mass extinction coefficient for diffuse ice [m2/kg] + ss_alb_bc1 => noahmp%energy%param%ss_alb_bc1 ,& ! in, Mie single scatter albedos for hydrophillic BC + asm_prm_bc1 => noahmp%energy%param%asm_prm_bc1 ,& ! in, asymmetry parameter for hydrophillic BC + ext_cff_mss_bc1 => noahmp%energy%param%ext_cff_mss_bc1 ,& ! in, mass extinction coefficient for hydrophillic BC [m2/kg] + ss_alb_bc2 => noahmp%energy%param%ss_alb_bc2 ,& ! in, Mie single scatter albedos for hydrophobic BC + asm_prm_bc2 => noahmp%energy%param%asm_prm_bc2 ,& ! in, asymmetry parameter for hydrophobic BC + ext_cff_mss_bc2 => noahmp%energy%param%ext_cff_mss_bc2 ,& ! in, mass extinction coefficient for hydrophobic BC [m2/kg] + ss_alb_oc1 => noahmp%energy%param%ss_alb_oc1 ,& ! in, Mie single scatter albedos for hydrophillic OC + asm_prm_oc1 => noahmp%energy%param%asm_prm_oc1 ,& ! in, asymmetry parameter for hydrophillic OC + ext_cff_mss_oc1 => noahmp%energy%param%ext_cff_mss_oc1 ,& ! in, mass extinction coefficient for hydrophillic OC [m2/kg] + ss_alb_oc2 => noahmp%energy%param%ss_alb_oc2 ,& ! in, Mie single scatter albedos for hydrophobic OC + asm_prm_oc2 => noahmp%energy%param%asm_prm_oc2 ,& ! in, asymmetry parameter for hydrophobic OC + ext_cff_mss_oc2 => noahmp%energy%param%ext_cff_mss_oc2 ,& ! in, mass extinction coefficient for hydrophobic OC [m2/kg] + ss_alb_dst1 => noahmp%energy%param%ss_alb_dst1 ,& ! in, Mie single scatter albedos for dust species 1 + asm_prm_dst1 => noahmp%energy%param%asm_prm_dst1 ,& ! in, asymmetry parameter for dust species 1 + ext_cff_mss_dst1 => noahmp%energy%param%ext_cff_mss_dst1 ,& ! in, mass extinction coefficient for dust species 1 [m2/kg] + ss_alb_dst2 => noahmp%energy%param%ss_alb_dst2 ,& ! in, Mie single scatter albedos for dust species 2 + asm_prm_dst2 => noahmp%energy%param%asm_prm_dst2 ,& ! in, asymmetry parameter for dust species 2 + ext_cff_mss_dst2 => noahmp%energy%param%ext_cff_mss_dst2 ,& ! in, mass extinction coefficient for dust species 2 [m2/kg] + ss_alb_dst3 => noahmp%energy%param%ss_alb_dst3 ,& ! in, Mie single scatter albedos for dust species 3 + asm_prm_dst3 => noahmp%energy%param%asm_prm_dst3 ,& ! in, asymmetry parameter for dust species 3 + ext_cff_mss_dst3 => noahmp%energy%param%ext_cff_mss_dst3 ,& ! in, mass extinction coefficient for dust species 3 [m2/kg] + ss_alb_dst4 => noahmp%energy%param%ss_alb_dst4 ,& ! in, Mie single scatter albedos for dust species 4 + asm_prm_dst4 => noahmp%energy%param%asm_prm_dst4 ,& ! in, asymmetry parameter for dust species 4 + ext_cff_mss_dst4 => noahmp%energy%param%ext_cff_mss_dst4 ,& ! in, mass extinction coefficient for dust species 4 [m2/kg] + ss_alb_dst5 => noahmp%energy%param%ss_alb_dst5 ,& ! in, Mie single scatter albedos for dust species 5 + asm_prm_dst5 => noahmp%energy%param%asm_prm_dst5 ,& ! in, asymmetry parameter for dust species 5 + ext_cff_mss_dst5 => noahmp%energy%param%ext_cff_mss_dst5 ,& ! in, mass extinction coefficient for dust species 5 [m2/kg] + MassConcBChydropho => noahmp%water%state%MassConcBChydropho ,& ! in, mass concentration of hydrophobic Black Carbon in snow [kg/kg] + MassConcBChydrophi => noahmp%water%state%MassConcBChydrophi ,& ! in, mass concentration of hydrophillic Black Carbon in snow [kg/kg] + MassConcOChydropho => noahmp%water%state%MassConcOChydropho ,& ! in, mass concentration of hydrophobic Organic Carbon in snow [kg/kg] + MassConcOChydrophi => noahmp%water%state%MassConcOChydrophi ,& ! in, mass concentration of hydrophillic Organic Carbon in snow [kg/kg] + MassConcDust1 => noahmp%water%state%MassConcDust1 ,& ! in, mass concentration of dust species 1 in snow [kg/kg] + MassConcDust2 => noahmp%water%state%MassConcDust2 ,& ! in, mass concentration of dust species 2 in snow [kg/kg] + MassConcDust3 => noahmp%water%state%MassConcDust3 ,& ! in, mass concentration of dust species 3 in snow [kg/kg] + MassConcDust4 => noahmp%water%state%MassConcDust4 ,& ! in, mass concentration of dust species 4 in snow [kg/kg] + MassConcDust5 => noahmp%water%state%MassConcDust5 ,& ! in, mass concentration of dust species 5 in snow [kg/kg] + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! out, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif ,& ! out, snow albedo for diffuse(1=vis, 2=nir) + FracRadSwAbsSnowDir => noahmp%energy%flux%FracRadSwAbsSnowDir ,& ! out, direct solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif & ! out, diffuse solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) + ) +! ---------------------------------------------------------------------- + ! initialize + if (.not. allocated(snw_rds_lcl) ) allocate(snw_rds_lcl (-NumSnowLayerMax+1:0)) + if (.not. allocated(sno_shp) ) allocate(sno_shp (-NumSnowLayerMax+1:0)) + if (.not. allocated(sno_fs) ) allocate(sno_fS (-NumSnowLayerMax+1:0)) + if (.not. allocated(sno_AR) ) allocate(sno_AR (-NumSnowLayerMax+1:0)) + if (.not. allocated(h2osno_liq_lcl)) allocate(h2osno_liq_lcl(-NumSnowLayerMax+1:0)) + if (.not. allocated(h2osno_ice_lcl)) allocate(h2osno_ice_lcl(-NumSnowLayerMax+1:0)) + if (.not. allocated(F_direct )) allocate(F_direct (-NumSnowLayerMax+1:0)) + if (.not. allocated(F_net )) allocate(F_net (-NumSnowLayerMax+1:0)) + if (.not. allocated(F_abs )) allocate(F_abs (-NumSnowLayerMax+1:0)) + + if (.not. allocated(L_snw )) allocate(L_snw (-NumSnowLayerMax+1:0)) + if (.not. allocated(tau_snw )) allocate(tau_snw (-NumSnowLayerMax+1:0)) + if (.not. allocated(tau )) allocate(tau (-NumSnowLayerMax+1:0)) + if (.not. allocated(omega )) allocate(omega (-NumSnowLayerMax+1:0)) + if (.not. allocated(g )) allocate(g (-NumSnowLayerMax+1:0)) + + if (.not. allocated(tau_star )) allocate(tau_star (-NumSnowLayerMax+1:0)) + if (.not. allocated(omega_star )) allocate(omega_star (-NumSnowLayerMax+1:0)) + if (.not. allocated(g_star )) allocate(g_star (-NumSnowLayerMax+1:0)) + if (.not. allocated(tau_clm )) allocate(tau_clm (-NumSnowLayerMax+1:0)) + + if (.not. allocated(ss_alb_snw_lcl )) allocate(ss_alb_snw_lcl (-NumSnowLayerMax+1:0)) + if (.not. allocated(asm_prm_snw_lcl )) allocate(asm_prm_snw_lcl (-NumSnowLayerMax+1:0)) + if (.not. allocated(ext_cff_mss_snw_lcl)) allocate(ext_cff_mss_snw_lcl(-NumSnowLayerMax+1:0)) + + !Toon 2-stream solver + if (.not. allocated(gamma1 )) allocate(gamma1 (-NumSnowLayerMax+1:0)) + if (.not. allocated(gamma2 )) allocate(gamma2 (-NumSnowLayerMax+1:0)) + if (.not. allocated(gamma3 )) allocate(gamma3 (-NumSnowLayerMax+1:0)) + if (.not. allocated(gamma4 )) allocate(gamma4 (-NumSnowLayerMax+1:0)) + if (.not. allocated(lambda )) allocate(lambda (-NumSnowLayerMax+1:0)) + if (.not. allocated(GAMMA )) allocate(GAMMA (-NumSnowLayerMax+1:0)) + if (.not. allocated(e1 )) allocate(e1 (-NumSnowLayerMax+1:0)) + if (.not. allocated(e2 )) allocate(e2 (-NumSnowLayerMax+1:0)) + if (.not. allocated(e3 )) allocate(e3 (-NumSnowLayerMax+1:0)) + if (.not. allocated(e4 )) allocate(e4 (-NumSnowLayerMax+1:0)) + if (.not. allocated(C_pls_btm )) allocate(C_pls_btm (-NumSnowLayerMax+1:0)) + if (.not. allocated(C_mns_btm )) allocate(C_mns_btm (-NumSnowLayerMax+1:0)) + if (.not. allocated(C_pls_top )) allocate(C_pls_top (-NumSnowLayerMax+1:0)) + if (.not. allocated(C_mns_top )) allocate(C_mns_top (-NumSnowLayerMax+1:0)) + if (.not. allocated(A )) allocate(A (-2*NumSnowLayerMax+1:0)) + if (.not. allocated(B )) allocate(B (-2*NumSnowLayerMax+1:0)) + if (.not. allocated(D )) allocate(D (-2*NumSnowLayerMax+1:0)) + if (.not. allocated(E )) allocate(E (-2*NumSnowLayerMax+1:0)) + if (.not. allocated(AS )) allocate(AS (-2*NumSnowLayerMax+1:0)) + if (.not. allocated(DS )) allocate(DS (-2*NumSnowLayerMax+1:0)) + if (.not. allocated(X )) allocate(X (-2*NumSnowLayerMax+1:0)) + if (.not. allocated(Y )) allocate(Y (-2*NumSnowLayerMax+1:0)) + + !Adding-doubling 2-stream solver based on SNICAR-ADv3 version + + if (.not. allocated(trndir )) allocate(trndir (-NumSnowLayerMax+1:1)) + if (.not. allocated(trntdr )) allocate(trntdr (-NumSnowLayerMax+1:1)) + if (.not. allocated(trndif )) allocate(trndif (-NumSnowLayerMax+1:1)) + if (.not. allocated(rupdir )) allocate(rupdir (-NumSnowLayerMax+1:1)) + if (.not. allocated(rupdif )) allocate(rupdif (-NumSnowLayerMax+1:1)) + if (.not. allocated(rdndif )) allocate(rdndif (-NumSnowLayerMax+1:1)) + if (.not. allocated(dfdir )) allocate(dfdir (-NumSnowLayerMax+1:1)) + if (.not. allocated(dfdif )) allocate(dfdif (-NumSnowLayerMax+1:1)) + if (.not. allocated(dftmp )) allocate(dftmp (-NumSnowLayerMax+1:1)) + + if (.not. allocated(rdir )) allocate(rdir (-NumSnowLayerMax+1:0)) + if (.not. allocated(rdif_a )) allocate(rdif_a (-NumSnowLayerMax+1:0)) + if (.not. allocated(rdif_b )) allocate(rdif_b (-NumSnowLayerMax+1:0)) + + if (.not. allocated(tdir )) allocate(tdir (-NumSnowLayerMax+1:0)) + if (.not. allocated(tdif_a )) allocate(tdif_a (-NumSnowLayerMax+1:0)) + if (.not. allocated(tdif_b )) allocate(tdif_b (-NumSnowLayerMax+1:0)) + if (.not. allocated(trnlay )) allocate(trnlay (-NumSnowLayerMax+1:0)) + + + if (.not. allocated(ss_alb_aer_lcl )) allocate(ss_alb_aer_lcl(1:NumSnicarAerosol)) + if (.not. allocated(asm_prm_aer_lcl )) allocate(asm_prm_aer_lcl(1: NumSnicarAerosol)) + if (.not. allocated(ext_cff_mss_aer_lcl)) allocate(ext_cff_mss_aer_lcl(1: NumSnicarAerosol)) + + if (.not. allocated(albsfc_lcl) ) allocate(albsfc_lcl (1:NumSnicarRadBand)) + if (.not. allocated(flx_wgt) ) allocate(flx_wgt (1:NumSnicarRadBand)) + if (.not. allocated(flx_slrd_lcl) ) allocate(flx_slrd_lcl (1:NumSnicarRadBand)) + if (.not. allocated(flx_slri_lcl) ) allocate(flx_slri_lcl (1:NumSnicarRadBand)) + if (.not. allocated(albout_lcl) ) allocate(albout_lcl (1:NumSnicarRadBand)) + + if (.not. allocated(L_aer )) allocate(L_aer (-NumSnowLayerMax+1:0,NumSnicarAerosol)) + if (.not. allocated(tau_aer )) allocate(tau_aer (-NumSnowLayerMax+1:0,NumSnicarAerosol)) + + if (.not. allocated(flx_abs_lcl) ) allocate(flx_abs_lcl (-NumSnowLayerMax+1:1,NumSnicarRadBand)) + if (.not. allocated(mss_cnc_aer_lcl) ) allocate(mss_cnc_aer_lcl (-NumSnowLayerMax+1:0,NumSnicarAerosol)) + + if (NumSnicarRadBand == 5) nir_bnd_bgn = 2 + if (NumSnicarRadBand == 480) nir_bnd_bgn = 51 + nir_bnd_end = NumSnicarRadBand + + ! initialize for adding-doubling solver + + difgauspt(1:8) = & ! gaussian angles (radians) + (/ 0.9894009, 0.9445750, & + 0.8656312, 0.7554044, & + 0.6178762, 0.4580168, & + 0.2816036, 0.0950125/) + + difgauswt(1:8) = & ! gaussian weights + (/ 0.0271525, 0.0622535, & + 0.0951585, 0.1246290, & + 0.1495960, 0.1691565, & + 0.1826034, 0.1894506/) + ! initialize for nonspherical snow grains + sno_shp(:) = OptSnicarSnowShape ! currently only assuming same shapes for all snow layers + sno_fs(:) = 0.0 + sno_AR(:) = 0.0 + + ! Table 3 of He et al 2017 JC + g_wvl(1:8) = (/ 0.25, 0.70, 1.41, 1.90, & + 2.50, 3.50, 4.00, 5.00 /) + g_wvl_ct(1:7) = g_wvl(2:8) / 2.0 + g_wvl(1:7) / 2.0 + g_b0(1:7) = (/ 9.76029E-1, 9.67798E-1, 1.00111, 1.00224, & + 9.64295E-1, 9.97475E-1, 9.97475E-1 /) + g_b1(1:7) = (/ 5.21042E-1, 4.96181E-1, 1.83711E-1, 1.37082E-1, & + 5.50598E-2, 8.48743E-2, 8.48743E-2 /) + g_b2(1:7) = (/ -2.66792E-4, 1.14088E-3, 2.37011E-4, -2.35905E-4, & + 8.40449E-4, -4.71484E-4, -4.71484E-4 /) + + ! Tables 1 & 2 and Eqs. 3.1-3.4 from Fu, 2007 JAS + g_F07_c2(1:7) = (/ 1.349959E-1, 1.115697E-1, 9.853958E-2, 5.557793E-2, & + -1.233493E-1, 0.0 , 0.0 /) + g_F07_c1(1:7) = (/ -3.987320E-1, -3.723287E-1, -3.924784E-1, -3.259404E-1, & + 4.429054E-2, -1.726586E-1, -1.726586E-1 /) + g_F07_c0(1:7) = (/ 7.938904E-1, 8.030084E-1, 8.513932E-1, 8.692241E-1, & + 7.085850E-1, 6.412701E-1, 6.412701E-1 /) + g_F07_p2(1:7) = (/ 3.165543E-3, 2.014810E-3, 1.780838E-3, 6.987734E-4, & + -1.882932E-2, -2.277872E-2, -2.277872E-2 /) + g_F07_p1(1:7) = (/ 1.140557E-1, 1.143152E-1, 1.143814E-1, 1.071238E-1, & + 1.353873E-1, 1.914431E-1, 1.914431E-1 /) + g_F07_p0(1:7) = (/ 5.292852E-1, 5.425909E-1, 5.601598E-1, 6.023407E-1, & + 6.473899E-1, 4.634944E-1, 4.634944E-1 /) + + ! initialize for BC-snow internal mixing + ! Eq. 8b & Table 4 in He et al., 2017 J. Climate (wavelength>1.2um, no BC-snow int mixing effect) + bcint_wvl(1:17) = (/ 0.20, 0.25, 0.30, 0.33, 0.36, 0.40, 0.44, 0.48, & + 0.52, 0.57, 0.64, 0.69, 0.75, 0.78, 0.87, 1.0, 1.2 /) + bcint_wvl_ct(1:16) = bcint_wvl(2:17)/2.0 + bcint_wvl(1:16)/2.0 + bcint_d0(1:16) = (/ 2.48045 , 4.70305 , 4.68619 , 4.67369 , 4.65040 , & + 2.40364 , 7.95408E-1, 2.92745E-1, 8.63396E-2, 2.76299E-2, & + 1.40864E-2, 8.65705E-3, 6.12971E-3, 4.45697E-3, 3.06648E-2, & + 7.96544E-1 /) + bcint_d1(1:16) = (/ 9.77209E-1, 9.73317E-1, 9.79650E-1, 9.84579E-1, 9.93537E-1, & + 9.95955E-1, 9.95218E-1, 9.74284E-1, 9.81193E-1, 9.81239E-1, & + 9.55515E-1, 9.10491E-1, 8.74196E-1, 8.27238E-1, 4.82870E-1, & + 4.36649E-2 /) + bcint_d2(1:16) = (/ 3.95960E-1, 2.04820E-1, 2.07410E-1, 2.09390E-1, 2.13030E-1, & + 4.18570E-1, 1.29682 , 3.75514 , 1.27372E+1, 3.93293E+1, & + 8.78918E+1, 1.86969E+2, 3.45600E+2, 7.08637E+2, 1.41067E+3, & + 2.57288E+2 /) + ! Eq. 1a,1b and Table S1 in He et al. 2018 GRL + bcint_m(1:3) = (/ -0.8724, -0.1866, -0.0046 /) + bcint_n(1:3) = (/ -0.0072, -0.1918, -0.5177 /) + + ! initialize for dust-snow internal mixing + ! Eq. 1 and Table 1 in He et al. 2019 JAMES (wavelength>1.2um, no dust-snow int mixing effect) + dstint_wvl(1:7) = (/ 0.2, 0.2632, 0.3448, 0.4415, 0.625, 0.7782, 1.2422/) + dstint_wvl_ct(1:6) = dstint_wvl(2:7)/2.0 + dstint_wvl(1:6)/2.0 + dstint_a1(1:6) = (/ -2.1307E+1, -1.5815E+1, -9.2880 , 1.1115 , 1.0307 , 1.0185 /) + dstint_a2(1:6) = (/ 1.1746E+2, 9.3241E+1, 4.0605E+1, 3.7389E-1, 1.4800E-2, 2.8921E-4 /) + dstint_a3(1:6) = (/ 9.9701E-1, 9.9781E-1, 9.9848E-1, 1.0035 , 1.0024 , 1.0356 /) + + ! SNICAR snow band center wavelength (um) + wvl_ct5(1:5) = (/ 0.5, 0.85, 1.1, 1.35, 3.25 /) ! 5-band + do LoopInd = 1,480 + wvl_ct480(LoopInd) = 0.205 + 0.01 * (LoopInd-1) ! 480-band + enddo + + ! Zero absorbed radiative fluxes: + do LoopInd=-NumSnowLayerMax+1,1,1 + flx_abs_lcl(LoopInd,:) = 0.0 + enddo + + + ! set threshold for precision + if (NumSnicarRadBand == 480) then + SnowWaterEquivMin = 1.0E-1 + elseif (NumSnicarRadBand == 5) then + SnowWaterEquivMin = 1.0E-3 + endif + + ! Qualifier for computing snow RT: + ! minimum amount of snow on ground. + ! Otherwise, set snow albedo to zero + if (SnowWaterEquiv >= SnowWaterEquivMin) then + ! If there is snow, but zero snow layers, we must create a layer locally. + ! This layer is presumed to have the fresh snow effective radius. + if (NumSnowLayerNeg > -1) then + flg_nosnl = 1 + snl_lcl = -1 + h2osno_ice_lcl(0) = SnowWaterEquiv + h2osno_liq_lcl(0) = 0.0 + snw_rds_lcl(0) = nint(SnowRadius(0)) + else + flg_nosnl = 0 + snl_lcl = NumSnowLayerNeg + h2osno_liq_lcl(:) = SnowLiqWater(:) + h2osno_ice_lcl(:) = SnowIce(:) + snw_rds_lcl(:) = nint(SnowRadius(:)) + endif + + SnowLayerBottom = 0 + SnowLayerTop = snl_lcl + 1 + + ! Set local aerosol array + if (FlagSnicarUseAerosol == .true.) then + mss_cnc_aer_lcl(:,1) = MassConcBChydrophi(:) + mss_cnc_aer_lcl(:,2) = MassConcBChydropho(:) + if (FlagSnicarUseOC == .true.) then + mss_cnc_aer_lcl(:,3) = MassConcOChydrophi(:) + mss_cnc_aer_lcl(:,4) = MassConcOChydropho(:) + else + mss_cnc_aer_lcl(:,3) = 0.0 + mss_cnc_aer_lcl(:,4) = 0.0 + endif + mss_cnc_aer_lcl(:,5) = MassConcDust1(:) + mss_cnc_aer_lcl(:,6) = MassConcDust2(:) + mss_cnc_aer_lcl(:,7) = MassConcDust3(:) + mss_cnc_aer_lcl(:,8) = MassConcDust4(:) + mss_cnc_aer_lcl(:,9) = MassConcDust5(:) + else + mss_cnc_aer_lcl(:,:) = 0.0 + endif + + ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos + if (IndicatorIceSfc == 0) then + if (flg_slr_in == 1) then + albsfc_lcl(1:(nir_bnd_bgn-1)) = AlbedoSoilDir(1) + albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = AlbedoSoilDir(2) + elseif (flg_slr_in == 2) then + albsfc_lcl(1:(nir_bnd_bgn-1)) = AlbedoSoilDif(1) + albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = AlbedoSoilDif(2) + endif + elseif (IndicatorIceSfc == -1) then !land ice + albsfc_lcl(1:(nir_bnd_bgn-1)) = AlbedoLandIce(1) + albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = AlbedoLandIce(2) + endif + + ! Error check for snow grain size: + do i=SnowLayerTop,SnowLayerBottom,1 + if ((snw_rds_lcl(i) < snw_rds_min_tbl) .or. (snw_rds_lcl(i) > snw_rds_max_tbl)) then + write (*,*) "SNICAR ERROR: snow grain radius of ", snw_rds_lcl(i), " out of bounds." + write (*,*) "snl= ", snl_lcl + write (*,*) "h2osno_total= ", SnowWaterEquiv + stop + endif + enddo + + + + ! Incident flux weighting parameters + ! - sum of all VIS bands must equal 1 + ! - sum of all NIR bands must equal 1 + ! + ! Spectral bands (5-band case) + ! Band 1: 0.3-0.7um (VIS) + ! Band 2: 0.7-1.0um (NIR) + ! Band 3: 1.0-1.2um (NIR) + ! Band 4: 1.2-1.5um (NIR) + ! Band 5: 1.5-5.0um (NIR) + ! + ! Hyperspectral (10-nm) bands (480-band case) + ! Bands 1~50 : 0.2-0.7um (VIS) + ! Bands 51~480: 0.7~5.0um (NIR) + ! + ! The following weights are appropriate for surface-incident flux in a mid-latitude winter atmosphere + ! + ! 3-band weights + if (NumSnicarRadBand == 3) then + ! Direct: + if (flg_slr_in == 1) then + flx_wgt(1) = 1.0 + flx_wgt(2) = 0.66628670195247 + flx_wgt(3) = 0.33371329804753 + ! Diffuse: + elseif (flg_slr_in == 2) then + flx_wgt(1) = 1.0 + flx_wgt(2) = 0.77887652162877 + flx_wgt(3) = 0.22112347837123 + endif + else ! works for both 5-band & 480-band, flux weights directly read from input data, cenlin + ! Direct: + if (flg_slr_in == 1) then + flx_wgt(1:NumSnicarRadBand) = flx_wgt_dir(1:NumSnicarRadBand) ! VIS or NIR band sum is already normalized to 1.0 in input data + ! Diffuse: + elseif (flg_slr_in == 2) then + flx_wgt(1:NumSnicarRadBand) = flx_wgt_dif(1:NumSnicarRadBand) ! VIS or NIR band sum is already normalized to 1.0 in input data + endif + endif + + exp_min = exp(-argmax) + + ! Loop over snow spectral bands + do LoopInd = 1,NumSnicarRadBand + ! Toon et al 2-stream + if (OptSnicarRTSolver == 1) then + mu_not = CosSolarZenithAngle ! must set here, because of error handling + + ! Adding-doubling 2-stream + elseif (OptSnicarRTSolver == 2) then + ! flg_dover is not used since this algorithm is stable for mu_not > 0.01 + ! mu_not is cosine solar zenith angle above the fresnel level; make + ! sure mu_not is large enough for stable and meaningful radiation + ! solution: .01 is like sun just touching horizon with its lower edge + ! equivalent to mu0 in sea-ice shortwave model ice_shortwave.F90 + mu_not = max(CosSolarZenithAngle, cp01) + endif + + flg_dover = 1 ! default is to redo + err_idx = 0 ! number of times through loop + + do while (flg_dover > 0) + + ! for Toon et al 2-stream solver: + if (OptSnicarRTSolver == 1) then + ! DEFAULT APPROXIMATIONS: + ! VIS: Delta-Eddington + ! NIR (all): Delta-Hemispheric Mean + ! WARNING: DO NOT USE DELTA-EDDINGTON FOR NIR DIFFUSE - this sometimes results in negative albedo + ! + ! ERROR CONDITIONS: + ! Conditions which cause "trip", resulting in redo of RT approximation: + ! 1. negative absorbed flux + ! 2. total absorbed flux greater than incident flux + ! 3. negative albedo + ! NOTE: These errors have only been encountered in spectral bands 4 and 5 + ! + ! ERROR HANDLING + ! 1st error (flg_dover=2): switch approximation (Edd->HM or HM->Edd) + ! 2nd error (flg_dover=3): change zenith angle by 0.02 (this happens about 1 in 10^6 cases) + ! 3rd error (flg_dover=4): switch approximation with new zenith + ! Subsequent errors: repeatedly change zenith and approximations... + + if (LoopInd < nir_bnd_bgn) then !VIS + + if (flg_dover == 2) then + APRX_TYP = 3 + elseif (flg_dover == 3) then + APRX_TYP = 1 + if (CosSolarZenithAngle > 0.5) then + mu_not = mu_not - 0.02 + else + mu_not = mu_not + 0.02 + endif + elseif (flg_dover == 4) then + APRX_TYP = 3 + else + APRX_TYP = 1 + endif + + else ! NIR + + if (flg_dover == 2) then + APRX_TYP = 1 + elseif (flg_dover == 3) then + APRX_TYP = 3 + if (CosSolarZenithAngle > 0.5) then + mu_not = mu_not - 0.02 + else + mu_not = mu_not + 0.02 + endif + elseif (flg_dover == 4) then + APRX_TYP = 1 + else + APRX_TYP = 3 + endif + + endif ! end if < nir_bnd_bgn + + endif ! end if OptSnicarRTSolver == 1 + + ! Set direct or diffuse incident irradiance to 1 + ! (This has to be within the bnd loop because mu_not is adjusted in rare cases) + if (flg_slr_in == 1) then + flx_slrd_lcl(LoopInd) = 1.0/(mu_not*ConstPI) ! this corresponds to incident irradiance of 1.0 + flx_slri_lcl(LoopInd) = 0.0 + else + flx_slrd_lcl(LoopInd) = 0.0 + flx_slri_lcl(LoopInd) = 1.0 + endif + + ! Pre-emptive error handling: aerosols can reap havoc on these absorptive bands. + ! Since extremely high soot concentrations have a negligible effect on these bands, zero them. + if ( (NumSnicarRadBand == 5).and.((LoopInd == 5).or.(LoopInd == 4)) ) then + mss_cnc_aer_lcl(:,:) = 0.0 + endif + + if ( (NumSnicarRadBand == 3).and.(LoopInd == 3) ) then + mss_cnc_aer_lcl(:,:) = 0.0 + endif + + if ( (NumSnicarRadBand == 480).and.(LoopInd > 100) ) then ! >1.2um + mss_cnc_aer_lcl(:,:) = 0.0 + endif + + !--------------------------- Start snow & aerosol optics -------------------------------- + ! Define local Mie parameters based on snow grain size and aerosol species retrieved from a lookup table. + ! Spherical snow: single-scatter albedo, mass extinction coefficient, asymmetry factor + if (flg_slr_in == 1) then + do i=SnowLayerTop,SnowLayerBottom,1 + rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 + ! snow optical properties (direct radiation) + ss_alb_snw_lcl(i) = ss_alb_snw_drc(rds_idx,LoopInd) + ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_drc(rds_idx,LoopInd) + if (sno_shp(i) == 1) asm_prm_snw_lcl(i) = asm_prm_snw_drc(rds_idx,LoopInd) + enddo + elseif (flg_slr_in == 2) then + do i=SnowLayerTop,SnowLayerBottom,1 + rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 + ! snow optical properties (diffuse radiation) + ss_alb_snw_lcl(i) = ss_alb_snw_dfs(rds_idx,LoopInd) + ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_dfs(rds_idx,LoopInd) + if (sno_shp(i) == 1) asm_prm_snw_lcl(i) = asm_prm_snw_dfs(rds_idx,LoopInd) + enddo + endif + + + ! Nonspherical snow: shape-dependent asymmetry factors + do i=SnowLayerTop,SnowLayerBottom,1 + + ! spheroid + if (sno_shp(i) == 2) then + diam_ice = 2.0 * snw_rds_lcl(i) ! unit: microns + if (sno_fs(i) == 0.0) then + fs_sphd = 0.929 ! default; He et al. (2017), Table 1 + else + fs_sphd = sno_fs(i) ! user specified value + endif + fs_hex = 0.788 ! reference shape factor + if (sno_AR(i) == 0.0) then + AR_tmp = 0.5 ! default; He et al. (2017), Table 1 + else + AR_tmp = sno_AR(i) ! user specified value + endif + do igb = 1,7 + g_ice_Cg_tmp(igb) = g_b0(igb) * ((fs_sphd/fs_hex)**g_b1(igb)) * (diam_ice**g_b2(igb)) ! Eq.7, He et al. (2017) + gg_ice_F07_tmp(igb) = g_F07_c0(igb) + g_F07_c1(igb)*AR_tmp + g_F07_c2(igb)*(AR_tmp**2.0) ! Eqn. 3.1 in Fu (2007) + enddo + + !hexagonal plate + elseif (sno_shp(i) ==3) then + diam_ice = 2.0 * snw_rds_lcl(i) ! unit: microns + if (sno_fs(i) == 0.0) then + fs_hex0 = 0.788 ! default; He et al. (2017), Table 1 + else + fs_hex0 = sno_fs(i) ! user specified value + endif + fs_hex = 0.788 ! reference shape factor + if (sno_AR(i) == 0.0) then + AR_tmp = 2.5 ! default; He et al. (2017), Table 1 + else + AR_tmp = sno_AR(i) ! user specified value + endif + do igb = 1,7 + g_ice_Cg_tmp(igb) = g_b0(igb) * ((fs_hex0/fs_hex)**g_b1(igb)) * (diam_ice**g_b2(igb)) ! Eq.7, He et al. (2017) + gg_ice_F07_tmp(igb) = g_F07_p0(igb)+g_F07_p1(igb)*LOG(AR_tmp)+g_F07_p2(igb)*((LOG(AR_tmp))**2.0) ! Eqn. 3.3 in Fu (2007) + enddo + + ! Koch snowflake + elseif (sno_shp(i) == 4) then + diam_ice = 2.0 * snw_rds_lcl(i) / 0.544 ! unit: microns + if (sno_fs(i) == 0.0) then + fs_koch = 0.712 ! default; He et al. (2017), Table 1 + else + fs_koch = sno_fs(i) ! user specified value + endif + fs_hex = 0.788 ! reference shape factor + if (sno_AR(i) == 0.0) then + AR_tmp = 2.5 ! default; He et al. (2017), Table 1 + else + AR_tmp = sno_AR(i) ! user specified value + endif + do igb = 1,7 + g_ice_Cg_tmp(igb) = g_b0(igb) * ((fs_koch/fs_hex)**g_b1(igb)) * (diam_ice**g_b2(igb)) ! Eq.7, He et al. (2017) + gg_ice_F07_tmp(igb) = g_F07_p0(igb)+g_F07_p1(igb)*LOG(AR_tmp)+g_F07_p2(igb)*((LOG(AR_tmp))**2.0) ! Eqn. 3.3 in Fu (2007) + enddo + + endif !snowshape + + ! compute nonspherical snow asymmetry factor + if (sno_shp(i) > 1) then + ! 7 wavelength bands for g_ice to be interpolated into targeted SNICAR bands here + ! use the piecewise linear interpolation subroutine created at the end of this module + ! tests showed the piecewise linear interpolation has similar results as pchip interpolation + if (NumSnicarRadBand == 5) then + call PiecewiseLinearInterp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct5(LoopInd),g_Cg_intp) + call PiecewiseLinearInterp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct5(LoopInd),gg_F07_intp) + endif + if (NumSnicarRadBand == 480) then + call PiecewiseLinearInterp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct480(LoopInd),g_Cg_intp) + call PiecewiseLinearInterp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct480(LoopInd),gg_F07_intp) + endif + g_ice_F07 = gg_F07_intp + (1.0 - gg_F07_intp) / ss_alb_snw_lcl(i) / 2.0 ! Eq.2.2 in Fu (2007) + asm_prm_snw_lcl(i) = g_ice_F07 * g_Cg_intp ! Eq.6, He et al. (2017) + endif + + if (asm_prm_snw_lcl(i) > 0.99) asm_prm_snw_lcl(i) = 0.99 !avoid unreasonable values (rarely occur in large-size spheroid cases) + + enddo !snow layer + + ! aerosol species 2 optical properties, hydrophobic BC + ss_alb_aer_lcl(2) = ss_alb_bc2(LoopInd) + asm_prm_aer_lcl(2) = asm_prm_bc2(LoopInd) + ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc2(LoopInd) + + ! aerosol species 3 optical properties, hydrophilic OC + ss_alb_aer_lcl(3) = ss_alb_oc1(LoopInd) + asm_prm_aer_lcl(3) = asm_prm_oc1(LoopInd) + ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc1(LoopInd) + + ! aerosol species 4 optical properties, hydrophobic OC + ss_alb_aer_lcl(4) = ss_alb_oc2(LoopInd) + asm_prm_aer_lcl(4) = asm_prm_oc2(LoopInd) + ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(LoopInd) + + ! 1. snow and aerosol layer column mass (L_snw, L_aer [kg/m^2]) + ! 2. optical Depths (tau_snw, tau_aer) + ! 3. weighted Mie properties (tau, omega, g) + + ! Weighted Mie parameters of each layer + do i=SnowLayerTop,SnowLayerBottom,1 + + ! Optics for BC/dust-snow external mixing: + ! aerosol species 1 optical properties, hydrophilic BC + ss_alb_aer_lcl(1) = ss_alb_bc1(LoopInd) + asm_prm_aer_lcl(1) = asm_prm_bc1(LoopInd) + ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(LoopInd) + ! aerosol species 5 optical properties, dust size1 + ss_alb_aer_lcl(5) = ss_alb_dst1(LoopInd) + asm_prm_aer_lcl(5) = asm_prm_dst1(LoopInd) + ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(LoopInd) + ! aerosol species 6 optical properties, dust size2 + ss_alb_aer_lcl(6) = ss_alb_dst2(LoopInd) + asm_prm_aer_lcl(6) = asm_prm_dst2(LoopInd) + ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(LoopInd) + ! aerosol species 7 optical properties, dust size3 + ss_alb_aer_lcl(7) = ss_alb_dst3(LoopInd) + asm_prm_aer_lcl(7) = asm_prm_dst3(LoopInd) + ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(LoopInd) + ! aerosol species 8 optical properties, dust size4 + ss_alb_aer_lcl(8) = ss_alb_dst4(LoopInd) + asm_prm_aer_lcl(8) = asm_prm_dst4(LoopInd) + ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(LoopInd) + ! aerosol species 9 optical properties, dust size5 + ss_alb_aer_lcl(9) = ss_alb_dst5(LoopInd) + asm_prm_aer_lcl(9) = asm_prm_dst5(LoopInd) + ext_cff_mss_aer_lcl(9) = ext_cff_mss_dst5(LoopInd) + + ! Start BC/dust-snow internal mixing for wavelength<=1.2um + if (NumSnicarRadBand == 5) wvl_doint = wvl_ct5(LoopInd) + if (NumSnicarRadBand == 480) wvl_doint = wvl_ct480(LoopInd) + + if (wvl_doint <= 1.2) then + ! BC-snow internal mixing applied to hydrophilic BC if activated + ! BC-snow internal mixing primarily affect snow single-scattering albedo + if ( FlagSnicarSnowBCIntmix .and. (mss_cnc_aer_lcl(i,1) > 0.0) ) then + ! result from Eq.8b in He et al.(2017) is based on BC Re=0.1um & + ! MAC=6.81 m2/g (@550 nm) & BC density=1.7g/cm3. + ! To be consistent with Bond et al. 2006 recommeded value (BC MAC=7.5 m2/g @550nm) + ! we made adjustments on BC size & density as follows to get MAC=7.5m2/g: + ! (1) We use BC Re=0.045um [geometric mean diameter=0.06um (Dentener et al.2006, + ! Yu and Luo,2009) & geometric std=1.5 (Flanner et al.2007;Aoki et al., 2011)]. + ! (2) We tune BC density from 1.7 to 1.49 g/cm3 (Aoki et al., 2011). + ! These adjustments also lead to consistent results with Flanner et al. 2012 (ACP) lookup table + ! for BC-snow internal mixing enhancement in albedo reduction (He et al. 2018 ACP) + + do ibb=1,16 + + enh_omg_bcint_tmp(ibb) = bcint_d0(ibb) * & + ( (mss_cnc_aer_lcl(i,1)*1.0E9*1.7/den_bc + bcint_d2(ibb)) **bcint_d1(ibb) ) + ! adjust enhancment factor for BC effective size from 0.1um to Re_bc (He et al. 2018 GRL Eqs.1a,1b) + if (ibb < 3) then ! near-UV + bcint_dd = (Re_bc/0.05)**bcint_m(1) + bcint_dd2 = (0.1/0.05)**bcint_m(1) + bcint_f = (Re_bc/0.1)**bcint_n(1) + endif + if ( (ibb >= 3) .and. (ibb <= 11) ) then ! visible + bcint_dd = (Re_bc/0.05)**bcint_m(2) + bcint_dd2 = (0.1/0.05)**bcint_m(2) + bcint_f = (Re_bc/0.1)**bcint_n(2) + endif + if ( ibb > 11 ) then ! NIR + bcint_dd = (Re_bc/0.05)**bcint_m(3) + bcint_dd2 = (0.1/0.05)**bcint_m(3) + bcint_f = (Re_bc/0.1)**bcint_n(3) + endif + enh_omg_bcint_tmp2(ibb)=LOG10(max(1.0,bcint_dd*((enh_omg_bcint_tmp(ibb)/bcint_dd2)**bcint_f))) + enddo + ! piecewise linear interpolate into targeted SNICAR bands in a logscale space + call PiecewiseLinearInterp1d(16,bcint_wvl_ct,enh_omg_bcint_tmp2,wvl_doint,enh_omg_bcint_intp) + ! update snow single-scattering albedo + enh_omg_bcint_intp2 = 10.0 ** enh_omg_bcint_intp + enh_omg_bcint_intp2 = min(1.0E5, max(enh_omg_bcint_intp2,1.0)) ! constrain enhancement to a reasonable range + ss_alb_snw_lcl(i) = 1.0 - (1.0 - ss_alb_snw_lcl(i)) * enh_omg_bcint_intp2 + ss_alb_snw_lcl(i) = max(0.5, min(ss_alb_snw_lcl(i),1.0)) + ! reset hydrophilic BC property to 0 since it is accounted by updated snow ss_alb above + ss_alb_aer_lcl(1) = 0.0 + asm_prm_aer_lcl(1) = 0.0 + ext_cff_mss_aer_lcl(1) = 0.0 + + endif ! end if BC-snow mixing type + + ! Dust-snow internal mixing applied to all size bins if activated + ! Dust-snow internal mixing primarily affect snow single-scattering albedo + ! default optics of externally mixed dust at 4 size bins based on effective + ! radius of 1.38um and sigma=2.0 with truncation to each size bin (Flanner et al. 2021 GMD) + ! parameterized dust-snow int mix results based on effective radius of 1.1um and sigma=2.0 + ! from (He et al. 2019 JAMES). Thus, the parameterization can be approximately applied to + ! all dust size bins here. + + tot_dst_snw_conc = (mss_cnc_aer_lcl(i,5) + mss_cnc_aer_lcl(i,6) + & + mss_cnc_aer_lcl(i,7) + mss_cnc_aer_lcl(i,8) + & + mss_cnc_aer_lcl(i,9)) * 1.0E6 !kg/kg->ppm + + if ( FlagSnicarSnowDustIntmix .and. (tot_dst_snw_conc > 0.0) ) then + do idb=1,6 + enh_omg_dstint_tmp(idb) = dstint_a1(idb)+dstint_a2(idb)*(tot_dst_snw_conc**dstint_a3(idb)) + enh_omg_dstint_tmp2(idb) = LOG10(max(enh_omg_dstint_tmp(idb),1.0)) + enddo + + ! piecewise linear interpolate into targeted SNICAR bands in a logscale space + call PiecewiseLinearInterp1d(6,dstint_wvl_ct,enh_omg_dstint_tmp2,wvl_doint,enh_omg_dstint_intp) + ! update snow single-scattering albedo + enh_omg_dstint_intp2 = 10.0 ** enh_omg_dstint_intp + enh_omg_dstint_intp2 = min(1.0E5, max(enh_omg_dstint_intp2,1.0)) ! constrain enhancement to a reasonable range + ss_alb_snw_lcl(i) = 1.0 - (1.0 - ss_alb_snw_lcl(i)) * enh_omg_dstint_intp2 + ss_alb_snw_lcl(i) = max(0.5, min(ss_alb_snw_lcl(i),1.0)) + + ! reset all dust optics to zero since it is accounted by updated snow ss_alb above + ss_alb_aer_lcl(5:9) = 0.0 + asm_prm_aer_lcl(5:9) = 0.0 + ext_cff_mss_aer_lcl(5:9) = 0.0 + endif ! end if dust-snow internal mixing + + endif ! end if BC/dust-snow internal mixing (bands<1.2um) + + L_snw(i) = h2osno_ice_lcl(i)+h2osno_liq_lcl(i) + tau_snw(i) = L_snw(i)*ext_cff_mss_snw_lcl(i) + + do j=1,NumSnicarAerosol + L_aer(i,j) = L_snw(i)*mss_cnc_aer_lcl(i,j) + tau_aer(i,j) = L_aer(i,j)*ext_cff_mss_aer_lcl(j) + enddo + + tau_sum = 0.0 + omega_sum = 0.0 + g_sum = 0.0 + + do j=1,NumSnicarAerosol + tau_sum = tau_sum + tau_aer(i,j) + omega_sum = omega_sum + (tau_aer(i,j)*ss_alb_aer_lcl(j)) + g_sum = g_sum + (tau_aer(i,j)*ss_alb_aer_lcl(j)*asm_prm_aer_lcl(j)) + enddo + + tau(i) = tau_sum + tau_snw(i) + omega(i) = (1/tau(i))*(omega_sum+(ss_alb_snw_lcl(i)*tau_snw(i))) + g(i) = (1/(tau(i)*omega(i)))*(g_sum+ (asm_prm_snw_lcl(i)*ss_alb_snw_lcl(i)*tau_snw(i))) + + enddo ! end do snow layers + + ! DELTA transformations, requested + do i=SnowLayerTop,SnowLayerBottom,1 + g_star(i) = g(i)/(1+g(i)) + omega_star(i) = ((1-(g(i)**2))*omega(i)) / (1-(omega(i)*(g(i)**2))) + tau_star(i) = (1-(omega(i)*(g(i)**2)))*tau(i) + enddo + !--------------------------- End of snow & aerosol optics -------------------------------- + + !--------------------------- Start Toon et al. RT solver -------------------------------- + if (OptSnicarRTSolver == 1) then + ! Total column optical depth: + ! tau_clm(i) = total optical depth above the bottom of layer i + tau_clm(SnowLayerTop) = 0.0 + + do i=SnowLayerTop+1,SnowLayerBottom,1 + tau_clm(i) = tau_clm(i-1)+tau_star(i-1) + enddo + + ! Direct radiation at bottom of snowpack: + F_direct_btm = albsfc_lcl(LoopInd)*mu_not * & + exp(-(tau_clm(SnowLayerBottom)+tau_star(SnowLayerBottom))/mu_not)*ConstPI*flx_slrd_lcl(LoopInd) + + ! Intermediates + ! Gamma values are approximation-specific. + + ! Eddington + if (APRX_TYP==1) then + do i=SnowLayerTop,SnowLayerBottom,1 + gamma1(i) = (7.0-(omega_star(i)*(4.0+(3.0*g_star(i)))))/4.0 + gamma2(i) = -(1.0-(omega_star(i)*(4.0-(3.0*g_star(i)))))/4.0 + gamma3(i) = (2.0-(3.0*g_star(i)*mu_not))/4.0 + gamma4(i) = 1.0-gamma3(i) + mu_one = 0.5 + enddo + + ! Quadrature + elseif (APRX_TYP==2) then + do i=SnowLayerTop,SnowLayerBottom,1 + gamma1(i) = (3.0**0.5)*(2.0-(omega_star(i)*(1.0+g_star(i))))/2.0 + gamma2(i) = omega_star(i)*(3.0**0.5)*(1.0-g_star(i))/2.0 + gamma3(i) = (1.0-((3.0**0.5)*g_star(i)*mu_not))/2.0 + gamma4(i) = 1.0-gamma3(i) + mu_one = 1.0/(3.0**0.5) + enddo + + ! Hemispheric Mean + elseif (APRX_TYP==3) then + do i=SnowLayerTop,SnowLayerBottom,1 + gamma1(i) = 2.0 - (omega_star(i)*(1.0+g_star(i))) + gamma2(i) = omega_star(i)*(1.0-g_star(i)) + gamma3(i) = (1.0-((3.0**0.5)*g_star(i)*mu_not))/2.0 + gamma4(i) = 1.0-gamma3(i) + mu_one = 0.5 + enddo + endif + + ! Intermediates for tri-diagonal solution + do i=SnowLayerTop,SnowLayerBottom,1 + lambda(i) = sqrt(abs((gamma1(i)**2) - (gamma2(i)**2))) + GAMMA(i) = gamma2(i)/(gamma1(i)+lambda(i)) + + e1(i) = 1+(GAMMA(i)*exp(-lambda(i)*tau_star(i))) + e2(i) = 1-(GAMMA(i)*exp(-lambda(i)*tau_star(i))) + e3(i) = GAMMA(i) + exp(-lambda(i)*tau_star(i)) + e4(i) = GAMMA(i) - exp(-lambda(i)*tau_star(i)) + + enddo !Snow layer + + do i=SnowLayerTop,SnowLayerBottom,1 + if (flg_slr_in == 1) then + C_pls_btm(i) = (omega_star(i)*ConstPI*flx_slrd_lcl(LoopInd)* & + exp(-(tau_clm(i)+tau_star(i))/mu_not)* & + (((gamma1(i)-(1/mu_not))*gamma3(i))+ & + (gamma4(i)*gamma2(i))))/((lambda(i)**2)-(1/(mu_not**2))) + C_mns_btm(i) = (omega_star(i)*ConstPI*flx_slrd_lcl(LoopInd)* & + exp(-(tau_clm(i)+tau_star(i))/mu_not)* & + (((gamma1(i)+(1/mu_not))*gamma4(i))+ & + (gamma2(i)*gamma3(i))))/((lambda(i)**2)-(1/(mu_not**2))) + C_pls_top(i) = (omega_star(i)*ConstPI*flx_slrd_lcl(LoopInd)* & + exp(-tau_clm(i)/mu_not)*(((gamma1(i)-(1/mu_not))* & + gamma3(i))+(gamma4(i)*gamma2(i))))/((lambda(i)**2)-(1/(mu_not**2))) + C_mns_top(i) = (omega_star(i)*ConstPI*flx_slrd_lcl(LoopInd)* & + exp(-tau_clm(i)/mu_not)*(((gamma1(i)+(1/mu_not))* & + gamma4(i))+(gamma2(i)*gamma3(i))))/((lambda(i)**2)-(1/(mu_not**2))) + + else + C_pls_btm(i) = 0.0 + C_mns_btm(i) = 0.0 + C_pls_top(i) = 0.0 + C_mns_top(i) = 0.0 + endif + enddo !Snow layer + + ! Coefficients for tridiaganol matrix solution + do i=2*snl_lcl+1,0,1 + !Boundary values for i=1 and i=2*snl_lcl, specifics for i=odd and i=even + if (i==(2*snl_lcl+1)) then + A(i) = 0.0 + B(i) = e1(SnowLayerTop) + D(i) = -e2(SnowLayerTop) + E(i) = flx_slri_lcl(LoopInd)-C_mns_top(SnowLayerTop) + elseif(i==0) then + A(i) = e1(SnowLayerBottom)-(albsfc_lcl(LoopInd)*e3(SnowLayerBottom)) + B(i) = e2(SnowLayerBottom)-(albsfc_lcl(LoopInd)*e4(SnowLayerBottom)) + D(i) = 0.0 + E(i) = F_direct_btm-C_pls_btm(SnowLayerBottom)+(albsfc_lcl(LoopInd)*C_mns_btm(SnowLayerBottom)) + elseif(mod(i,2)==-1) then ! If odd and i>=3 (n=1 for i=3) + n=floor(i/2.0) + A(i) = (e2(n)*e3(n))-(e4(n)*e1(n)) + B(i) = (e1(n)*e1(n+1))-(e3(n)*e3(n+1)) + D(i) = (e3(n)*e4(n+1))-(e1(n)*e2(n+1)) + E(i) = (e3(n)*(C_pls_top(n+1)-C_pls_btm(n)))+(e1(n)*(C_mns_btm(n)-C_mns_top(n+1))) + elseif(mod(i,2)==0) then ! If even and i<=2*snl_lcl + n=(i/2) + A(i) = (e2(n+1)*e1(n))-(e3(n)*e4(n+1)) + B(i) = (e2(n)*e2(n+1))-(e4(n)*e4(n+1)) + D(i) = (e1(n+1)*e4(n+1))-(e2(n+1)*e3(n+1)) + E(i) = (e2(n+1)*(C_pls_top(n+1)-C_pls_btm(n)))+(e4(n+1)*(C_mns_top(n+1)-C_mns_btm(n))) + endif + enddo + + AS(0) = A(0)/B(0) + DS(0) = E(0)/B(0) + + do i=-1,(2*snl_lcl+1),-1 + X(i) = 1/(B(i)-(D(i)*AS(i+1))) + AS(i) = A(i)*X(i) + DS(i) = (E(i)-(D(i)*DS(i+1)))*X(i) + enddo + + Y(2*snl_lcl+1) = DS(2*snl_lcl+1) + do i=(2*snl_lcl+2),0,1 + Y(i) = DS(i)-(AS(i)*Y(i-1)) + enddo + + ! Downward direct-beam and net flux (F_net) at the base of each layer: + do i=SnowLayerTop,SnowLayerBottom,1 + F_direct(i) = mu_not*ConstPI*flx_slrd_lcl(LoopInd)*exp(-(tau_clm(i)+tau_star(i))/mu_not) + F_net(i) = (Y(2*i-1)*(e1(i)-e3(i))) + (Y(2*i)*(e2(i)-e4(i))) + & + C_pls_btm(i) - C_mns_btm(i) - F_direct(i) + enddo + + ! Upward flux at snowpack top: + F_sfc_pls = (Y(2*snl_lcl+1)*(exp(-lambda(SnowLayerTop)*tau_star(SnowLayerTop))+ & + GAMMA(SnowLayerTop))) + (Y(2*snl_lcl+2)*(exp(-lambda(SnowLayerTop)* & + tau_star(SnowLayerTop))-GAMMA(SnowLayerTop))) + C_pls_top(SnowLayerTop) + + ! Net flux at bottom = absorbed radiation by underlying surface: + F_btm_net = -F_net(SnowLayerBottom) + + ! Bulk column albedo and surface net flux + albedo = F_sfc_pls/((mu_not*ConstPI*flx_slrd_lcl(LoopInd))+flx_slri_lcl(LoopInd)) + F_sfc_net = F_sfc_pls - ((mu_not*ConstPI*flx_slrd_lcl(LoopInd))+flx_slri_lcl(LoopInd)) + + trip = 0 + ! Absorbed flux in each layer + do i=SnowLayerTop,SnowLayerBottom,1 + if(i==SnowLayerTop) then + F_abs(i) = F_net(i)-F_sfc_net + else + F_abs(i) = F_net(i)-F_net(i-1) + endif + flx_abs_lcl(i,LoopInd) = F_abs(i) + + ! ERROR check: negative absorption + if (flx_abs_lcl(i,LoopInd) < -0.00001) then + trip = 1 + endif + enddo + + flx_abs_lcl(1,LoopInd) = F_btm_net + + + if (flg_nosnl == 1) then + ! If there are no snow layers (but still snow), all absorbed energy must be in top soil layer + !flx_abs_lcl(:,bnd_idx) = 0._r8 + !flx_abs_lcl(1,bnd_idx) = F_abs(0) + F_btm_net + + ! changed on 20070408: + ! OK to put absorbed energy in the fictitous snow layer because routine SurfaceRadiation + ! handles the case of no snow layers. Then, if a snow layer is addded between now and + ! SurfaceRadiation (called in CanopyHydrology), absorbed energy will be properly distributed. + flx_abs_lcl(0,LoopInd) = F_abs(0) + flx_abs_lcl(1,LoopInd) = F_btm_net + endif + + + !Underflow check (we've already tripped the error condition above) + do i=SnowLayerTop,1,1 + if (flx_abs_lcl(i,LoopInd) < 0.0) then + flx_abs_lcl(i,LoopInd) = 0.0 + endif + enddo + + F_abs_sum = 0.0 + do i=SnowLayerTop,SnowLayerBottom,1 + F_abs_sum = F_abs_sum + F_abs(i) + enddo + + !ERROR check: absorption greater than incident flux + ! (should make condition more generic than "1._r8") + if (F_abs_sum > 1.0) then + trip = 1 + endif + + !ERROR check: + if ((albedo < 0.0).and.(trip==0)) then + trip = 1 + endif + + ! Set conditions for redoing RT calculation + if ((trip == 1).and.(flg_dover == 1)) then + flg_dover = 2 + elseif ((trip == 1).and.(flg_dover == 2)) then + flg_dover = 3 + elseif ((trip == 1).and.(flg_dover == 3)) then + flg_dover = 4 + elseif((trip == 1).and.(flg_dover == 4).and.(err_idx < 20)) then + flg_dover = 3 + err_idx = err_idx + 1 + elseif((trip == 1).and.(flg_dover == 4).and.(err_idx >= 20)) then + flg_dover = 0 + write(*,*) "SNICAR ERROR: FOUND A WORMHOLE. STUCK IN INFINITE LOOP!" + write(*,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) + write(*,*) "SNICAR STATS: snw_rds_lcl(0)= ", snw_rds_lcl(0) + write(*,*) "SNICAR STATS: h2osno= ", SnowWaterEquiv, " snl= ", snl_lcl + write(*,*) "SNICAR STATS: BCphi(0)= ", mss_cnc_aer_lcl(0,1) + write(*,*) "SNICAR STATS: BCpho(0)= ", mss_cnc_aer_lcl(0,2) + write(*,*) "SNICAR STATS: dust1(0)= ", mss_cnc_aer_lcl(0,5) + write(*,*) "SNICAR STATS: dust2(0)= ", mss_cnc_aer_lcl(0,6) + write(*,*) "SNICAR STATS: dust3(0)= ", mss_cnc_aer_lcl(0,7) + write(*,*) "SNICAR STATS: dust4(0)= ", mss_cnc_aer_lcl(0,8) + write(*,*) "SNICAR STATS: dust5(0)= ", mss_cnc_aer_lcl(0,9) + else + flg_dover = 0 + endif + + endif ! end if OptSnicarRTSolver == 1 + + !--------------------------- Start Adding-doubling RT solver -------------------------------- + if (OptSnicarRTSolver == 2) then + ! Given input vertical profiles of optical properties, evaluate the + ! monochromatic Delta-Eddington adding-doubling solution + + ! trndir, trntdr, trndif, rupdir, rupdif, rdndif are variables at the layer interface, + ! for snow with layers from snl_top to snl_btm there are snl_top to snl_btm+1 layer interface + snl_btm_itf = SnowLayerBottom + 1 + + ! initialization for layer interface + do i = SnowLayerTop,snl_btm_itf,1 + trndir(i) = c0 + trntdr(i) = c0 + trndif(i) = c0 + rupdir(i) = c0 + rupdif(i) = c0 + rdndif(i) = c0 + enddo + + ! initialize top interface of top layer + trndir(SnowLayerTop) = c1 + trntdr(SnowLayerTop) = c1 + trndif(SnowLayerTop) = c1 + rdndif(SnowLayerTop) = c0 + + ! begin main level loop for snow layer interfaces except for the very bottom + do i = SnowLayerTop,SnowLayerBottom,1 + + ! initialize all layer apparent optical properties to 0 + rdir (i) = c0 + rdif_a(i) = c0 + rdif_b(i) = c0 + tdir (i) = c0 + tdif_a(i) = c0 + tdif_b(i) = c0 + trnlay(i) = c0 + + ! compute next layer Delta-eddington solution only if total transmission + ! of radiation to the interface just above the layer exceeds trmin. + if (trntdr(i) > trmin ) then + + ! delta-transformed single-scattering properties of this layer + ts = tau_star(i) + ws = omega_star(i) + gs = g_star(i) + + ! Delta-Eddington solution expressions, Eq. 50: Briegleb and Light 2007 + lm = sqrt(c3*(c1-ws)*(c1 - ws*gs)) + ue = c1p5*(c1 - ws*gs)/lm + extins = max(exp_min, exp(-lm*ts)) + ne = ((ue+c1)*(ue+c1)/extins) - ((ue-c1)*(ue-c1)*extins) + + ! first calculation of rdif, tdif using Delta-Eddington formulas + ! Eq.: Briegleb 1992; alpha and gamma for direct radiation + rdif_a(i) = (ue**2-c1)*(c1/extins - extins)/ne + tdif_a(i) = c4*ue/ne + + ! evaluate rdir,tdir for direct beam + trnlay(i) = max(exp_min, exp(-ts/mu_not)) + + + ! Delta-Eddington solution expressions + ! Eq. 50: Briegleb and Light 2007; alpha and gamma for direct radiation + !print *,'debug',cp75,ws,mu_not,c1,gs,lm,lm*lm*mu_not*mu_not + if (c1 - lm*lm*mu_not*mu_not /= 0.0) then + alp = cp75*ws*mu_not*((c1 + gs*(c1-ws))/(c1 - lm*lm*mu_not*mu_not)) + gam = cp5*ws*((c1 + c3*gs*(c1-ws)*mu_not*mu_not)/(c1-lm*lm*mu_not*mu_not)) + else + alp = 0.0 + gam = 0.0 + endif + apg = alp + gam + amg = alp - gam + rdir(i) = apg*rdif_a(i) + amg*(tdif_a(i)*trnlay(i) - c1) + tdir(i) = apg*tdif_a(i) + (amg* rdif_a(i)-apg+c1)*trnlay(i) + + + ! recalculate rdif,tdif using direct angular integration over rdir,tdir, + ! since Delta-Eddington rdif formula is not well-behaved (it is usually + ! biased low and can even be negative); use ngmax angles and gaussian + ! integration for most accuracy: + R1 = rdif_a(i) ! use R1 as temporary + T1 = tdif_a(i) ! use T1 as temporary + swt = c0 + smr = c0 + smt = c0 + ! gaussian angles for the AD integral + + do ng=1,ngmax + mu = difgauspt(ng) + gwt = difgauswt(ng) + swt = swt + mu*gwt + trn = max(exp_min, exp(-ts/mu)) + alp = cp75*ws*mu*((c1 + gs*(c1-ws))/(c1 - lm*lm*mu*mu)) + gam = cp5*ws*((c1 + c3*gs*(c1-ws)*mu*mu)/(c1-lm*lm*mu*mu)) + apg = alp + gam + amg = alp - gam + rdr = apg*R1 + amg*T1*trn - amg + tdr = apg*T1 + amg*R1*trn - apg*trn + trn + smr = smr + mu*rdr*gwt + smt = smt + mu*tdr*gwt + enddo ! ng + + rdif_a(i) = smr/swt + tdif_a(i) = smt/swt + + ! homogeneous layer + rdif_b(i) = rdif_a(i) + tdif_b(i) = tdif_a(i) + + endif ! trntdr(i) > trmin + + ! Calculate the solar beam transmission, total transmission, and + ! reflectivity for diffuse radiation from below at interface i, + ! the top of the current layer k: + ! + ! layers interface + ! + ! --------------------- i-1 + ! i-1 + ! --------------------- i + ! i + ! --------------------- + + + trndir(i+1) = trndir(i)*trnlay(i) ! solar beam transmission from top + refkm1 = c1/(c1 - rdndif(i)*rdif_a(i)) ! interface multiple scattering for i-1 + tdrrdir = trndir(i)*rdir(i) ! direct tran times layer direct ref + tdndif = trntdr(i) - trndir(i) ! total down diffuse = tot tran - direct tran + trntdr(i+1) = trndir(i)*tdir(i) + & ! total transmission to direct beam for layers above + (tdndif + tdrrdir*rdndif(i))*refkm1*tdif_a(i) + ! Eq. B4; Briegleb and Light 2007 + rdndif(i+1) = rdif_b(i) + & ! reflectivity to diffuse radiation for layers above + (tdif_b(i)*rdndif(i)*refkm1*tdif_a(i)) + trndif(i+1) = trndif(i)*refkm1*tdif_a(i) ! diffuse transmission to diffuse beam for layers above + + enddo !snow layer + + + ! compute reflectivity to direct and diffuse radiation for layers + ! below by adding succesive layers starting from the underlying + ! ground and working upwards: + ! + ! layers interface + ! + ! --------------------- i + ! i + ! --------------------- i+1 + ! i+1 + ! --------------------- + + ! set the underlying ground albedo == albedo of near-IR + ! unless bnd_idx < nir_bnd_bgn, for visible + if (IndicatorIceSfc == 0) then + if (flg_slr_in == 1) then + rupdir(snl_btm_itf) = AlbedoSoilDir(2) + rupdif(snl_btm_itf) = AlbedoSoilDir(2) + if (LoopInd < nir_bnd_bgn) then + rupdir(snl_btm_itf) = AlbedoSoilDir(1) + rupdif(snl_btm_itf) = AlbedoSoilDir(1) + endif + elseif (flg_slr_in == 2) then + rupdir(snl_btm_itf) = AlbedoSoilDif(2) + rupdif(snl_btm_itf) = AlbedoSoilDif(2) + if (LoopInd < nir_bnd_bgn) then + rupdir(snl_btm_itf) = AlbedoSoilDif(1) + rupdif(snl_btm_itf) = AlbedoSoilDif(1) + endif + endif + elseif (IndicatorIceSfc == -1) then !land ice + rupdir(snl_btm_itf) = AlbedoLandIce(2) + rupdif(snl_btm_itf) = AlbedoLandIce(2) + if (LoopInd < nir_bnd_bgn) then + rupdir(snl_btm_itf) = AlbedoLandIce(1) + rupdif(snl_btm_itf) = AlbedoLandIce(1) + endif + endif + + do i=SnowLayerBottom,SnowLayerTop,-1 + ! interface scattering Eq. B5; Briegleb and Light 2007 + refkp1 = c1/( c1 - rdif_b(i)*rupdif(i+1)) + ! dir from top layer plus exp tran ref from lower layer, interface + ! scattered and tran thru top layer from below, plus diff tran ref + ! from lower layer with interface scattering tran thru top from below + rupdir(i) = rdir(i) & + + ( trnlay(i) *rupdir(i+1) & + + (tdir(i)-trnlay(i))*rupdif(i+1) ) * refkp1 * tdif_b(i) + ! dif from top layer from above, plus dif tran upwards reflected and + ! interface scattered which tran top from below + rupdif(i) = rdif_a(i) + tdif_a(i)*rupdif(i+1)*refkp1*tdif_b(i) + enddo ! i + + + ! net flux (down-up) at each layer interface from the + ! snow top (i = snl_top) to bottom interface above land (i = snl_btm_itf) + ! the interface reflectivities and transmissivities required + ! to evaluate interface fluxes are returned from solution_dEdd; + ! now compute up and down fluxes for each interface, using the + ! combined layer properties at each interface: + ! + ! layers interface + ! + ! --------------------- i + ! i + ! --------------------- + + + do i = SnowLayerTop, snl_btm_itf + ! interface scattering, Eq. 52; Briegleb and Light 2007 + refk = c1/(c1 - rdndif(i)*rupdif(i)) + ! dir tran ref from below times interface scattering, plus diff + ! tran and ref from below times interface scattering + ! fdirup(i) = (trndir(i)*rupdir(i) + & + ! (trntdr(i)-trndir(i)) & + ! *rupdif(i))*refk + ! dir tran plus total diff trans times interface scattering plus + ! dir tran with up dir ref and down dif ref times interface scattering + ! fdirdn(i) = trndir(i) + (trntdr(i) & + ! - trndir(i) + trndir(i) & + ! *rupdir(i)*rdndif(i))*refk + ! diffuse tran ref from below times interface scattering + ! fdifup(i) = trndif(i)*rupdif(i)*refk + ! diffuse tran times interface scattering + ! fdifdn(i) = trndif(i)*refk + + ! netflux, down - up + ! dfdir = fdirdn - fdirup + dfdir(i) = trndir(i) & + + (trntdr(i)-trndir(i)) * (c1 - rupdif(i)) * refk & + - trndir(i)*rupdir(i) * (c1 - rdndif(i)) * refk + if (dfdir(i) < puny) dfdir(i) = c0 + ! dfdif = fdifdn - fdifup + dfdif(i) = trndif(i) * (c1 - rupdif(i)) * refk + if (dfdif(i) < puny) dfdif(i) = c0 + enddo ! i + + + ! SNICAR_AD_RT is called twice for direct and diffuse incident fluxes + ! direct incident + if (flg_slr_in == 1) then + albedo = rupdir(SnowLayerTop) + dftmp = dfdir + refk = c1/(c1 - rdndif(SnowLayerTop)*rupdif(SnowLayerTop)) + F_sfc_pls = (trndir(SnowLayerTop)*rupdir(SnowLayerTop) + & + (trntdr(SnowLayerTop)-trndir(SnowLayerTop)) & + *rupdif(SnowLayerTop))*refk + !diffuse incident + else + albedo = rupdif(SnowLayerTop) + dftmp = dfdif + refk = c1/(c1 - rdndif(SnowLayerTop)*rupdif(SnowLayerTop)) + F_sfc_pls = trndif(SnowLayerTop)*rupdif(SnowLayerTop)*refk + endif + + ! Absorbed flux in each layer + do i=SnowLayerTop,SnowLayerBottom,1 + F_abs(i) = dftmp(i)-dftmp(i+1) + flx_abs_lcl(i,LoopInd) = F_abs(i) + + ! ERROR check: negative absorption + if (flx_abs_lcl(i,LoopInd) < -0.0001) then !original -0.00001, but not work for Koch snowflake + write (*,"(a,e13.6,i,i,i,i)") "SNICAR ERROR: negative absoption : ", & + flx_abs_lcl(i,LoopInd),i,LoopInd,SnowLayerTop,SnowLayerBottom + write(*,*) "SNICAR_AD STATS: L_snw(0)= ", L_snw(0) + write(*,*) "SNICAR_AD STATS: snw_rds_lcl(0)= ", snw_rds_lcl(0) + write(*,*) "SNICAR_AD STATS: coszen= ", CosSolarZenithAngle + write(*,*) 'SNICAR_AD STATS: wavelength=', wvl_ct480(LoopInd) + write(*,*) "SNICAR_AD STATS: h2osno= ", SnowWaterEquiv, " snl= ", snl_lcl + write(*,*) "SNICAR_AD STATS: BCphi(0)= ", mss_cnc_aer_lcl(0,1) + write(*,*) "SNICAR_AD STATS: BCpho(0)= ", mss_cnc_aer_lcl(0,2) + write(*,*) "SNICAR_AD STATS: dust1(0)= ", mss_cnc_aer_lcl(0,5) + write(*,*) "SNICAR_AD STATS: dust2(0)= ", mss_cnc_aer_lcl(0,6) + write(*,*) "SNICAR_AD STATS: dust3(0)= ", mss_cnc_aer_lcl(0,7) + write(*,*) "SNICAR_AD STATS: dust4(0)= ", mss_cnc_aer_lcl(0,8) + write(*,*) "SNICAR_AD STATS: dust5(0)= ", mss_cnc_aer_lcl(0,9) + stop + endif + enddo + + ! absobed flux by the underlying ground + F_btm_net = dftmp(snl_btm_itf) + + ! note here, snl_btm_itf = 1 by snow column set up in CLM + flx_abs_lcl(1,LoopInd) = F_btm_net + + if (flg_nosnl == 1) then + ! If there are no snow layers (but still snow), all absorbed energy must be in top soil layer + !flx_abs_lcl(:,LoopInd) = 0.0 + !flx_abs_lcl(1,LoopInd) = F_abs(0) + F_btm_net + + ! changed on 20070408: + ! OK to put absorbed energy in the fictitous snow layer because routine SurfaceRadiation + ! handles the case of no snow layers. Then, if a snow layer is addded between now and + ! SurfaceRadiation (called in CanopyHydrology), absorbed energy will be properly distributed. + flx_abs_lcl(0,LoopInd) = F_abs(0) + flx_abs_lcl(1,LoopInd) = F_btm_net + endif + + !Underflow check (we've already tripped the error condition above) + do i=SnowLayerTop,1,1 + if (flx_abs_lcl(i,LoopInd) < 0.0) then + flx_abs_lcl(i,LoopInd) = 0.0 + endif + enddo + + F_abs_sum = 0.0 + do i=SnowLayerTop,SnowLayerBottom,1 + F_abs_sum = F_abs_sum + F_abs(i) + enddo + + ! no need to repeat calculations for adding-doubling solver + flg_dover = 0 + + endif ! end if OptSnicarRTSolver == 2 + !--------------------------- End of Adding-doubling RT solver -------------------------------- + + enddo !enddo while (flg_dover > 0) + + ! Energy conservation check: + ! Incident direct+diffuse radiation equals (absorbed+bulk_transmitted+bulk_reflected) + energy_sum = (mu_not*ConstPI*flx_slrd_lcl(LoopInd)) + flx_slri_lcl(LoopInd) - (F_abs_sum + F_btm_net + F_sfc_pls) + + if (abs(energy_sum) > 0.00001) then + write (*,*) "SNICAR ERROR: Energy conservation error of : ", energy_sum + write (*,*) "Snow Top layer",SnowLayerTop + write(*,*) "F_abs_sum: ",F_abs_sum + write(*,*) "F_btm_net: ",F_btm_net + write(*,*) "F_sfc_pls: ",F_sfc_pls + write(*,*) "mu_not*pi*flx_slrd_lcl(LoopInd): ", mu_not*ConstPI*flx_slrd_lcl(LoopInd) + write(*,*) "flx_slri_lcl(LoopInd)", flx_slri_lcl(LoopInd) + write(*,*) "bnd_idx", LoopInd + write(*,*) "F_abs", F_abs + write(*,*) "albedo", albedo + write(*,*) "direct soil albedo",AlbedoSoilDir(1),AlbedoSoilDir(2) + write(*,*) "diffuse soil albedo",AlbedoSoilDif(1),AlbedoSoilDif(2) + stop + endif + + albout_lcl(LoopInd) = albedo + + ! Check that albedo is less than 1 + if (albout_lcl(LoopInd) > 1.0) then + + write (*,*) "SNICAR ERROR: Albedo > 1.0" + write (*,*) "SNICAR STATS: bnd_idx= ",LoopInd + write (*,*) "SNICAR STATS: albout_lcl(bnd)= ",albout_lcl(LoopInd), & + " albsfc_lcl(bnd_idx)= ",albsfc_lcl(LoopInd) + write (*,*) "SNICAR STATS: h2osno_total= ", SnowWaterEquiv, " snl= ", snl_lcl + write (*,*) "SNICAR STATS: coszen= ", CosSolarZenithAngle, " flg_slr= ", flg_slr_in + write (*,*) "SNICAR STATS: BCphi(-2)= ", mss_cnc_aer_lcl(-2,1) + write (*,*) "SNICAR STATS: BCphi(-1)= ", mss_cnc_aer_lcl(-1,1) + write (*,*) "SNICAR STATS: BCphi(0)= ", mss_cnc_aer_lcl(0,1) + + write (*,*) "SNICAR STATS: L_snw(-2)= ", L_snw(-2) + write (*,*) "SNICAR STATS: L_snw(-1)= ", L_snw(-1) + write (*,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) + + write (*,*) "SNICAR STATS: snw_rds(-2)= ", SnowRadius(-2) + write (*,*) "SNICAR STATS: snw_rds(-1)= ", SnowRadius(-1) + write (*,*) "SNICAR STATS: snw_rds(0)= ", SnowRadius(0) + stop + + endif + + enddo ! loop over all snow spectral bands + + ! Weight output NIR albedo appropriately + ! for 5- and 3-band cases + if (NumSnicarRadBand <= 5) then + if (flg_slr_in == 1) then + AlbedoSnowDir(1) = albout_lcl(1) + elseif (flg_slr_in == 2)then + AlbedoSnowDif(1) = albout_lcl(1) + endif + + flx_sum = 0.0 + do LoopInd= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(LoopInd)*albout_lcl(LoopInd) + end do + + if (flg_slr_in == 1) then + AlbedoSnowDir(2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + elseif (flg_slr_in == 2)then + AlbedoSnowDif(2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + endif + + end if + + ! for 480-band case + if (NumSnicarRadBand == 480) then + ! average for VIS band + flx_sum = 0.0 + do LoopInd= 1, (nir_bnd_bgn-1) + flx_sum = flx_sum + flx_wgt(LoopInd)*albout_lcl(LoopInd) + end do + + if (flg_slr_in == 1) then + AlbedoSnowDir(1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + elseif (flg_slr_in == 2)then + AlbedoSnowDif(1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + endif + + ! average for NIR band + flx_sum = 0.0 + do LoopInd= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(LoopInd)*albout_lcl(LoopInd) + end do + + if (flg_slr_in == 1) then + AlbedoSnowDir(2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + elseif (flg_slr_in == 2) then + AlbedoSnowDif(2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + endif + + end if + + if (NumSnicarRadBand <= 5) then + if (flg_slr_in == 1) then + FracRadSwAbsSnowDir(:,1) = flx_abs_lcl(:,1) + elseif (flg_slr_in == 2) then + FracRadSwAbsSnowDif(:,1) = flx_abs_lcl(:,1) + endif + + do i=SnowLayerTop,1,1 + + flx_sum = 0.0 + do LoopInd= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(LoopInd)*flx_abs_lcl(i,LoopInd) + enddo + + if (flg_slr_in == 1) then + FracRadSwAbsSnowDir(i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + elseif (flg_slr_in == 2) then + FracRadSwAbsSnowDif(i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + endif + + end do + + endif + + ! for 480-band case + if (NumSnicarRadBand == 480) then + do i=SnowLayerTop,1,1 + + ! average for VIS band + flx_sum = 0.0 + do LoopInd= 1,(nir_bnd_bgn-1) + flx_sum = flx_sum + flx_wgt(LoopInd)*flx_abs_lcl(i,LoopInd) + enddo + + if (flg_slr_in == 1) then + FracRadSwAbsSnowDir(i,1)=flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + elseif (flg_slr_in == 2) then + FracRadSwAbsSnowDif(i,1)=flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + endif + + ! average for NIR band + flx_sum = 0.0 + do LoopInd= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(LoopInd)*flx_abs_lcl(i,LoopInd) + enddo + + if (flg_slr_in == 1) then + FracRadSwAbsSnowDir(i,2)=flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + elseif (flg_slr_in == 2) then + FracRadSwAbsSnowDif(i,2)=flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + endif + end do + + end if + + ! high solar zenith angle adjustment for Adding-doubling solver results + + if ( OptSnicarRTSolver==2) then + ! near-IR direct albedo/absorption adjustment for high solar zenith angles + ! solar zenith angle parameterization + ! calculate the scaling factor for NIR direct albedo if SZA>75 degree + if ((mu_not < mu_75) .and. (flg_slr_in == 1)) then + sza_c1 = sza_a0 + sza_a1 * mu_not + sza_a2 * mu_not**2 + sza_c0 = sza_b0 + sza_b1 * mu_not + sza_b2 * mu_not**2 + sza_factor = sza_c1 * (log10(snw_rds_lcl(SnowLayerTop) * c1) - c6) + sza_c0 + flx_sza_adjust = AlbedoSnowDir(2) * (sza_factor-c1) * sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + AlbedoSnowDir(2) = AlbedoSnowDir(2) * sza_factor + FracRadSwAbsSnowDir(SnowLayerTop,2) = FracRadSwAbsSnowDir(SnowLayerTop,2) - flx_sza_adjust + endif + endif ! end of OptSnicarRTSolver==2 + + + ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo + elseif ((SnowWaterEquiv < SnowWaterEquivMin) .and. (SnowWaterEquiv > 0.0) ) then + + if (IndicatorIceSfc == 0) then + if (flg_slr_in == 1) then + AlbedoSnowDir(1) = AlbedoSoilDir(1) + AlbedoSnowDir(2) = AlbedoSoilDir(2) + elseif (flg_slr_in == 2) then + AlbedoSnowDif(1) = AlbedoSoilDif(1) + AlbedoSnowDif(2) = AlbedoSoilDif(2) + endif + elseif (IndicatorIceSfc == -1) then !land ice + AlbedoSnowDif(1) = AlbedoLandIce(1) + AlbedoSnowDif(2) = AlbedoLandIce(2) + endif + ! There is either zero snow, or no sun + else + + if (flg_slr_in == 1) then + AlbedoSnowDir(1) = 0.0 + AlbedoSnowDir(2) = 0.0 + elseif (flg_slr_in == 2) then + AlbedoSnowDif(1) = 0.0 + AlbedoSnowDif(2) = 0.0 + endif + + endif ! if column has mim snow + + if (flg_slr_in == 1) then + if (AlbedoSnowDir(1)<0.0 .or. AlbedoSnowDir(2)<0.0 .or. AlbedoSnowDir(1)>1.0 .or. AlbedoSnowDir(2)>1.0)then + print *,'snow albedo',flg_slr_in,AlbedoSnowDir(1),AlbedoSnowDir(2),CosSolarZenithAngle + stop + endif + endif + + if (flg_slr_in == 2) then + if (AlbedoSnowDif(1)<0.0 .or. AlbedoSnowDif(2)<0.0 .or. AlbedoSnowDif(1)>1.0 .or. AlbedoSnowDif(2)>1.0)then + print *,'snow albedo',flg_slr_in,AlbedoSnowDif(1),AlbedoSnowDif(2),CosSolarZenithAngle + stop + endif + endif + + end associate + + end subroutine SnowRadiationSnicar + +end module SnowRadiationSnicarMod diff --git a/src/SnowWaterMainGlacierMod.F90 b/src/SnowWaterMainGlacierMod.F90 index 0fac6ec0..3d6c57d4 100644 --- a/src/SnowWaterMainGlacierMod.F90 +++ b/src/SnowWaterMainGlacierMod.F90 @@ -11,6 +11,7 @@ module SnowWaterMainGlacierMod use SnowLayerCombineMod, only : SnowLayerCombine use SnowLayerDivideMod, only : SnowLayerDivide use SnowpackHydrologyGlacierMod, only : SnowpackHydrologyGlacier + use SnowAerosolSnicarMod implicit none @@ -29,14 +30,16 @@ subroutine SnowWaterMainGlacier(noahmp) type(noahmp_type), intent(inout) :: noahmp ! local variables - integer :: LoopInd ! do loop/array indices - real(kind=kind_noahmp) :: SnowDensBulk ! bulk density of snow [kg/m3] + integer :: LoopInd ! do loop/array indices + real(kind=kind_noahmp) :: SnowDensBulk ! bulk density of snow [kg/m3] + real(kind=kind_noahmp) :: GlacierExcessRemainFrac ! fraction of mass remaining after glacier excess flow ! -------------------------------------------------------------------- associate( & NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface SnoWatEqvMaxGlacier => noahmp%water%param%SnoWatEqvMaxGlacier ,& ! in, Maximum SWE allowed at glaciers [mm] ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] @@ -47,6 +50,15 @@ subroutine SnowWaterMainGlacier(noahmp) SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + MassBChydropho => noahmp%water%state%MassBChydropho ,& ! inout, mass of hydrophobic Black Carbon in snow [kg m-2] + MassBChydrophi => noahmp%water%state%MassBChydrophi ,& ! inout, mass of hydrophillic Black Carbon in snow [kg m-2] + MassOChydropho => noahmp%water%state%MassOChydropho ,& ! inout, mass of hydrophobic Organic Carbon in snow [kg m-2] + MassOChydrophi => noahmp%water%state%MassOChydrophi ,& ! inout, mass of hydrophillic Organic Carbon in snow [kg m-2] + MassDust1 => noahmp%water%state%MassDust1 ,& ! inout, mass of dust species 1 in snow [kg m-2] + MassDust2 => noahmp%water%state%MassDust2 ,& ! inout, mass of dust species 2 in snow [kg m-2] + MassDust3 => noahmp%water%state%MassDust3 ,& ! inout, mass of dust species 3 in snow [kg m-2] + MassDust4 => noahmp%water%state%MassDust4 ,& ! inout, mass of dust species 4 in snow [kg m-2] + MassDust5 => noahmp%water%state%MassDust5 ,& ! inout, mass of dust species 5 in snow [kg m-2] GlacierExcessFlow => noahmp%water%flux%GlacierExcessFlow ,& ! out, glacier excess flow [mm/s] PondSfcThinSnwComb => noahmp%water%state%PondSfcThinSnwComb ,& ! out, surface ponding [mm] from liquid in thin snow layer combination PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow liquid during transition from multilayer to no layer @@ -54,9 +66,10 @@ subroutine SnowWaterMainGlacier(noahmp) ! ---------------------------------------------------------------------- ! initialize out-only variables - GlacierExcessFlow = 0.0 - PondSfcThinSnwComb = 0.0 - PondSfcThinSnwTrans = 0.0 + GlacierExcessFlow = 0.0 + PondSfcThinSnwComb = 0.0 + PondSfcThinSnwTrans = 0.0 + GlacierExcessRemainFrac = 1.0 ! snowfall call SnowfallAfterCanopyIntercept(noahmp) @@ -82,6 +95,19 @@ subroutine SnowWaterMainGlacier(noahmp) TemperatureSoilSnow(LoopInd) = 0.0 ThicknessSnowSoilLayer(LoopInd) = 0.0 DepthSnowSoilLayer(LoopInd) = 0.0 + + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(LoopInd) = 0.0 + MassBChydrophi(LoopInd) = 0.0 + MassOChydropho(LoopInd) = 0.0 + MassOChydrophi(LoopInd) = 0.0 + MassDust1(LoopInd) = 0.0 + MassDust2(LoopInd) = 0.0 + MassDust3(LoopInd) = 0.0 + MassDust4(LoopInd) = 0.0 + MassDust5(LoopInd) = 0.0 + endif + enddo ! to obtain equilibrium state of snow in glacier region @@ -91,8 +117,25 @@ subroutine SnowWaterMainGlacier(noahmp) SnowIce(0) = SnowIce(0) - GlacierExcessFlow ThicknessSnowSoilLayer(0) = ThicknessSnowSoilLayer(0) - GlacierExcessFlow / SnowDensBulk GlacierExcessFlow = GlacierExcessFlow / MainTimeStep + + if ( OptSnowAlbedo == 3 ) then + GlacierExcessRemainFrac = SnowIce(0) / (SnowIce(0) + GlacierExcessFlow) + MassBChydropho(0) = MassBChydropho(0) * GlacierExcessRemainFrac + MassBChydrophi(0) = MassBChydrophi(0) * GlacierExcessRemainFrac + MassOChydropho(0) = MassOChydropho(0) * GlacierExcessRemainFrac + MassOChydrophi(0) = MassOChydrophi(0) * GlacierExcessRemainFrac + MassDust1(0) = MassDust1(0) * GlacierExcessRemainFrac + MassDust2(0) = MassDust2(0) * GlacierExcessRemainFrac + MassDust3(0) = MassDust3(0) * GlacierExcessRemainFrac + MassDust4(0) = MassDust4(0) * GlacierExcessRemainFrac + MassDust5(0) = MassDust5(0) * GlacierExcessRemainFrac + endif + endif + !SNICAR + if ( OptSnowAlbedo == 3 ) call SnowAerosolSnicar(noahmp) + ! sum up snow mass for layered snow if ( NumSnowLayerNeg < 0 ) then ! MB: only do for multi-layer SnowWaterEquiv = 0.0 diff --git a/src/SnowWaterMainMod.F90 b/src/SnowWaterMainMod.F90 index 2e3e7f00..661d7ec2 100644 --- a/src/SnowWaterMainMod.F90 +++ b/src/SnowWaterMainMod.F90 @@ -11,6 +11,7 @@ module SnowWaterMainMod use SnowLayerCombineMod, only : SnowLayerCombine use SnowLayerDivideMod, only : SnowLayerDivide use SnowpackHydrologyMod, only : SnowpackHydrology + use SnowAerosolSnicarMod implicit none @@ -29,14 +30,16 @@ subroutine SnowWaterMain(noahmp) type(noahmp_type), intent(inout) :: noahmp ! local variable - integer :: LoopInd ! do loop/array indices - real(kind=kind_noahmp) :: SnowDensBulk ! bulk density of snow [kg/m3] + integer :: LoopInd ! do loop/array indices + real(kind=kind_noahmp) :: SnowDensBulk ! bulk density of snow [kg/m3] + real(kind=kind_noahmp) :: GlacierExcessRemainFrac ! fraction of mass remaining after glacier excess flow ! -------------------------------------------------------------------- associate( & NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface SnoWatEqvMaxGlacier => noahmp%water%param%SnoWatEqvMaxGlacier ,& ! in, Maximum SWE allowed at glaciers [mm] ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] @@ -47,6 +50,15 @@ subroutine SnowWaterMain(noahmp) SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + MassBChydropho => noahmp%water%state%MassBChydropho ,& ! inout, mass of hydrophobic Black Carbon in snow [kg m-2] + MassBChydrophi => noahmp%water%state%MassBChydrophi ,& ! inout, mass of hydrophillic Black Carbon in snow [kg m-2] + MassOChydropho => noahmp%water%state%MassOChydropho ,& ! inout, mass of hydrophobic Organic Carbon in snow [kg m-2] + MassOChydrophi => noahmp%water%state%MassOChydrophi ,& ! inout, mass of hydrophillic Organic Carbon in snow [kg m-2] + MassDust1 => noahmp%water%state%MassDust1 ,& ! inout, mass of dust species 1 in snow [kg m-2] + MassDust2 => noahmp%water%state%MassDust2 ,& ! inout, mass of dust species 2 in snow [kg m-2] + MassDust3 => noahmp%water%state%MassDust3 ,& ! inout, mass of dust species 3 in snow [kg m-2] + MassDust4 => noahmp%water%state%MassDust4 ,& ! inout, mass of dust species 4 in snow [kg m-2] + MassDust5 => noahmp%water%state%MassDust5 ,& ! inout, mass of dust species 5 in snow [kg m-2] GlacierExcessFlow => noahmp%water%flux%GlacierExcessFlow ,& ! out, glacier snow excess flow [mm/s] PondSfcThinSnwComb => noahmp%water%state%PondSfcThinSnwComb ,& ! out, surface ponding [mm] from liquid in thin snow layer combination PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow liquid during transition from multilayer to no layer @@ -54,9 +66,10 @@ subroutine SnowWaterMain(noahmp) ! ---------------------------------------------------------------------- ! initialize out-only variables - GlacierExcessFlow = 0.0 - PondSfcThinSnwComb = 0.0 - PondSfcThinSnwTrans = 0.0 + GlacierExcessFlow = 0.0 + PondSfcThinSnwComb = 0.0 + PondSfcThinSnwTrans = 0.0 + GlacierExcessRemainFrac = 1.0 ! snowfall after canopy interception call SnowfallAfterCanopyIntercept(noahmp) @@ -82,6 +95,19 @@ subroutine SnowWaterMain(noahmp) TemperatureSoilSnow(LoopInd) = 0.0 ThicknessSnowSoilLayer(LoopInd) = 0.0 DepthSnowSoilLayer(LoopInd) = 0.0 + + if ( OptSnowAlbedo == 3 ) then + MassBChydropho(LoopInd) = 0.0 + MassBChydrophi(LoopInd) = 0.0 + MassOChydropho(LoopInd) = 0.0 + MassOChydrophi(LoopInd) = 0.0 + MassDust1(LoopInd) = 0.0 + MassDust2(LoopInd) = 0.0 + MassDust3(LoopInd) = 0.0 + MassDust4(LoopInd) = 0.0 + MassDust5(LoopInd) = 0.0 + endif + enddo ! to obtain equilibrium state of snow in glacier region @@ -91,8 +117,25 @@ subroutine SnowWaterMain(noahmp) SnowIce(0) = SnowIce(0) - GlacierExcessFlow ThicknessSnowSoilLayer(0) = ThicknessSnowSoilLayer(0) - GlacierExcessFlow / SnowDensBulk GlacierExcessFlow = GlacierExcessFlow / MainTimeStep + + if ( OptSnowAlbedo == 3 ) then + GlacierExcessRemainFrac = SnowIce(0) / (SnowIce(0) + GlacierExcessFlow) + MassBChydropho(0) = MassBChydropho(0) * GlacierExcessRemainFrac + MassBChydrophi(0) = MassBChydrophi(0) * GlacierExcessRemainFrac + MassOChydropho(0) = MassOChydropho(0) * GlacierExcessRemainFrac + MassOChydrophi(0) = MassOChydrophi(0) * GlacierExcessRemainFrac + MassDust1(0) = MassDust1(0) * GlacierExcessRemainFrac + MassDust2(0) = MassDust2(0) * GlacierExcessRemainFrac + MassDust3(0) = MassDust3(0) * GlacierExcessRemainFrac + MassDust4(0) = MassDust4(0) * GlacierExcessRemainFrac + MassDust5(0) = MassDust5(0) * GlacierExcessRemainFrac + endif + endif + !SNICAR + if ( OptSnowAlbedo == 3 ) call SnowAerosolSnicar(noahmp) + ! sum up snow mass for layered snow if ( NumSnowLayerNeg < 0 ) then ! MB: only do for multi-layer SnowWaterEquiv = 0.0 @@ -100,7 +143,6 @@ subroutine SnowWaterMain(noahmp) SnowWaterEquiv = SnowWaterEquiv + SnowIce(LoopInd) + SnowLiqWater(LoopInd) enddo endif - ! Reset DepthSnowSoilLayer and ThicknessSnowSoilLayer do LoopInd = NumSnowLayerNeg+1, 0 ThicknessSnowSoilLayer(LoopInd) = -ThicknessSnowSoilLayer(LoopInd) diff --git a/src/SnowpackHydrologyGlacierMod.F90 b/src/SnowpackHydrologyGlacierMod.F90 index dc702cea..4fd2742b 100644 --- a/src/SnowpackHydrologyGlacierMod.F90 +++ b/src/SnowpackHydrologyGlacierMod.F90 @@ -27,7 +27,6 @@ subroutine SnowpackHydrologyGlacier(noahmp) ! local variables integer :: LoopInd ! do loop/array indices real(kind=kind_noahmp) :: InflowSnowLayer ! water flow into each snow layer (mm/s) - real(kind=kind_noahmp) :: OutflowSnowLayer ! water flow out of each snow layer (mm/s) real(kind=kind_noahmp) :: SnowIceTmp ! ice mass after minus sublimation real(kind=kind_noahmp) :: SnowWaterRatio ! ratio of SWE after frost & sublimation to original SWE real(kind=kind_noahmp) :: SnowWaterTmp ! temporary SWE @@ -55,7 +54,8 @@ subroutine SnowpackHydrologyGlacier(noahmp) SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil liquid moisture [m3/m3] SoilIce => noahmp%water%state%SoilIce ,& ! inout, soil ice moisture [m3/m3] SnowEffPorosity => noahmp%water%state%SnowEffPorosity ,& ! out, snow effective porosity [m3/m3] - SnowBotOutflow => noahmp%water%flux%SnowBotOutflow & ! out, total water (snowmelt + rain through pack) out of snowpack bottom [mm/s] + SnowBotOutflow => noahmp%water%flux%SnowBotOutflow ,& ! out, total water (snowmelt + rain through pack) out of snowpack bottom [mm/s] + OutflowSnowLayer => noahmp%water%flux%OutflowSnowLayer & ! out, water flow out of each snow layer [mm/s] ) ! ---------------------------------------------------------------------- @@ -67,7 +67,7 @@ subroutine SnowpackHydrologyGlacier(noahmp) SnowEffPorosity(:) = 0.0 SnowBotOutflow = 0.0 InflowSnowLayer = 0.0 - OutflowSnowLayer = 0.0 + OutflowSnowLayer(:)= 0.0 ! for the case when SnowWaterEquiv becomes '0' after 'COMBINE' if ( SnowWaterEquiv == 0.0 ) then @@ -131,22 +131,22 @@ subroutine SnowpackHydrologyGlacier(noahmp) ! compute inter-layer snow water flow do LoopInd = NumSnowLayerNeg+1, 0 - SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) + InflowSnowLayer - SnowLiqVol(LoopInd) = SnowLiqWater(LoopInd) / (ThicknessSnowSoilLayer(LoopInd)*ConstDensityWater) - OutflowSnowLayer = max(0.0, (SnowLiqVol(LoopInd) - SnowLiqHoldCap*SnowEffPorosity(LoopInd)) * & - ThicknessSnowSoilLayer(LoopInd)) + SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) + InflowSnowLayer + SnowLiqVol(LoopInd) = SnowLiqWater(LoopInd) / (ThicknessSnowSoilLayer(LoopInd)*ConstDensityWater) + OutflowSnowLayer(LoopInd) = max(0.0, (SnowLiqVol(LoopInd) - SnowLiqHoldCap*SnowEffPorosity(LoopInd)) * & + ThicknessSnowSoilLayer(LoopInd)) if ( LoopInd == 0 ) then - OutflowSnowLayer = max((SnowLiqVol(LoopInd)-SnowEffPorosity(LoopInd)) * ThicknessSnowSoilLayer(LoopInd), & - SnowLiqReleaseFac * MainTimeStep * OutflowSnowLayer) + OutflowSnowLayer(LoopInd) = max((SnowLiqVol(LoopInd)-SnowEffPorosity(LoopInd)) * ThicknessSnowSoilLayer(LoopInd), & + SnowLiqReleaseFac * MainTimeStep * OutflowSnowLayer(LoopInd)) endif - OutflowSnowLayer = OutflowSnowLayer * ConstDensityWater - SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) - OutflowSnowLayer + OutflowSnowLayer(LoopInd) = OutflowSnowLayer(LoopInd) * ConstDensityWater + SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) - OutflowSnowLayer(LoopInd) if ( ( SnowLiqWater(LoopInd) / (SnowIce(LoopInd)+SnowLiqWater(LoopInd)) ) > SnowLiqFracMax ) then - OutflowSnowLayer = OutflowSnowLayer + & - (SnowLiqWater(LoopInd) - SnowLiqFracMax/(1.0-SnowLiqFracMax) * SnowIce(LoopInd)) + OutflowSnowLayer(LoopInd) = OutflowSnowLayer(LoopInd) + & + (SnowLiqWater(LoopInd) - SnowLiqFracMax/(1.0-SnowLiqFracMax) * SnowIce(LoopInd)) SnowLiqWater(LoopInd) = SnowLiqFracMax / (1.0 - SnowLiqFracMax) * SnowIce(LoopInd) endif - InflowSnowLayer = OutflowSnowLayer + InflowSnowLayer = OutflowSnowLayer(LoopInd) enddo ! update snow depth @@ -156,7 +156,8 @@ subroutine SnowpackHydrologyGlacier(noahmp) enddo ! Liquid water from snow bottom to soil (mm/s) - SnowBotOutflow = OutflowSnowLayer / MainTimeStep + SnowBotOutflow = OutflowSnowLayer(0) / MainTimeStep + OutflowSnowLayer(:) = OutflowSnowLayer(:) / MainTimeStep ! deallocate local arrays to avoid memory leaks deallocate(SnowLiqVol) diff --git a/src/SnowpackHydrologyMod.F90 b/src/SnowpackHydrologyMod.F90 index 8b3638d4..288a3f26 100644 --- a/src/SnowpackHydrologyMod.F90 +++ b/src/SnowpackHydrologyMod.F90 @@ -27,7 +27,6 @@ subroutine SnowpackHydrology(noahmp) ! local variable integer :: LoopInd ! do loop/array indices real(kind=kind_noahmp) :: InflowSnowLayer ! water flow into each snow layer [mm/s] - real(kind=kind_noahmp) :: OutflowSnowLayer ! water flow out of each snow layer [mm/s] real(kind=kind_noahmp) :: SnowIceTmp ! ice mass after minus sublimation real(kind=kind_noahmp) :: SnowWaterRatio ! ratio of SWE after frost & sublimation to original SWE real(kind=kind_noahmp) :: SnowWaterTmp ! temporary SWE @@ -53,7 +52,8 @@ subroutine SnowpackHydrology(noahmp) SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil liquid moisture [m3/m3] SoilIce => noahmp%water%state%SoilIce ,& ! inout, soil ice moisture [m3/m3] SnowEffPorosity => noahmp%water%state%SnowEffPorosity ,& ! out, snow effective porosity [m3/m3] - SnowBotOutflow => noahmp%water%flux%SnowBotOutflow & ! out, total water (snowmelt + rain through pack) out of snowpack bottom [mm/s] + SnowBotOutflow => noahmp%water%flux%SnowBotOutflow ,& ! out, total water (snowmelt + rain through pack) out of snowpack bottom [mm/s] + OutflowSnowLayer => noahmp%water%flux%OutflowSnowLayer & ! out, water flow out of each snow layer [mm/s] ) ! ---------------------------------------------------------------------- @@ -65,7 +65,7 @@ subroutine SnowpackHydrology(noahmp) SnowEffPorosity(:) = 0.0 SnowBotOutflow = 0.0 InflowSnowLayer = 0.0 - OutflowSnowLayer = 0.0 + OutflowSnowLayer(:)= 0.0 ! for the case when SnowWaterEquiv becomes '0' after 'COMBINE' if ( SnowWaterEquiv == 0.0 ) then @@ -121,22 +121,22 @@ subroutine SnowpackHydrology(noahmp) ! compute inter-layer snow water flow do LoopInd = NumSnowLayerNeg+1, 0 - SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) + InflowSnowLayer - SnowLiqVol(LoopInd) = SnowLiqWater(LoopInd) / (ThicknessSnowSoilLayer(LoopInd)*ConstDensityWater) - OutflowSnowLayer = max(0.0, (SnowLiqVol(LoopInd)-SnowLiqHoldCap*SnowEffPorosity(LoopInd)) * & - ThicknessSnowSoilLayer(LoopInd)) + SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) + InflowSnowLayer + SnowLiqVol(LoopInd) = SnowLiqWater(LoopInd) / (ThicknessSnowSoilLayer(LoopInd)*ConstDensityWater) + OutflowSnowLayer(LoopInd) = max(0.0, (SnowLiqVol(LoopInd)-SnowLiqHoldCap*SnowEffPorosity(LoopInd)) * & + ThicknessSnowSoilLayer(LoopInd)) if ( LoopInd == 0 ) then - OutflowSnowLayer = max((SnowLiqVol(LoopInd)-SnowEffPorosity(LoopInd)) * ThicknessSnowSoilLayer(LoopInd), & - SnowLiqReleaseFac * MainTimeStep * OutflowSnowLayer) + OutflowSnowLayer(LoopInd) = max((SnowLiqVol(LoopInd)-SnowEffPorosity(LoopInd)) * ThicknessSnowSoilLayer(LoopInd), & + SnowLiqReleaseFac * MainTimeStep * OutflowSnowLayer(LoopInd)) endif - OutflowSnowLayer = OutflowSnowLayer * ConstDensityWater - SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) - OutflowSnowLayer + OutflowSnowLayer(LoopInd) = OutflowSnowLayer(LoopInd) * ConstDensityWater + SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) - OutflowSnowLayer(LoopInd) if ( (SnowLiqWater(LoopInd)/(SnowIce(LoopInd)+SnowLiqWater(LoopInd))) > SnowLiqFracMax ) then - OutflowSnowLayer = OutflowSnowLayer + (SnowLiqWater(LoopInd) - & - SnowLiqFracMax / (1.0-SnowLiqFracMax) * SnowIce(LoopInd)) + OutflowSnowLayer(LoopInd) = OutflowSnowLayer(LoopInd) + (SnowLiqWater(LoopInd) - & + SnowLiqFracMax / (1.0-SnowLiqFracMax) * SnowIce(LoopInd)) SnowLiqWater(LoopInd) = SnowLiqFracMax / (1.0 - SnowLiqFracMax) * SnowIce(LoopInd) endif - InflowSnowLayer = OutflowSnowLayer + InflowSnowLayer = OutflowSnowLayer(LoopInd) enddo ! update snow depth @@ -146,7 +146,8 @@ subroutine SnowpackHydrology(noahmp) enddo ! Liquid water from snow bottom to soil [mm/s] - SnowBotOutflow = OutflowSnowLayer / MainTimeStep + SnowBotOutflow = OutflowSnowLayer(0) / MainTimeStep + OutflowSnowLayer (:) = OutflowSnowLayer (:) / MainTimeStep ! deallocate local arrays to avoid memory leaks deallocate(SnowLiqVol) diff --git a/src/SoilSnowTemperatureMainMod.F90 b/src/SoilSnowTemperatureMainMod.F90 index cf4a906b..aee56bcf 100644 --- a/src/SoilSnowTemperatureMainMod.F90 +++ b/src/SoilSnowTemperatureMainMod.F90 @@ -21,6 +21,7 @@ subroutine SoilSnowTemperatureMain(noahmp) ! Original Noah-MP subroutine: TSNOSOI ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding snicar solar fluxes redistribution in snow layer (T.-S. Lin, C. He et al. 2023) ! ---------------------------------------------------------------------------------------- implicit none @@ -29,6 +30,7 @@ subroutine SoilSnowTemperatureMain(noahmp) type(noahmp_type) , intent(inout) :: noahmp ! local variable + integer :: IndLoop ! snow and soil layer loop real(kind=kind_noahmp), allocatable, dimension(:) :: MatRight ! right-hand side term of the matrix real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft1 ! left-hand side term real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft2 ! left-hand side term @@ -38,10 +40,13 @@ subroutine SoilSnowTemperatureMain(noahmp) associate( & NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil process timestep [s] DepthSoilTempBottom => noahmp%config%domain%DepthSoilTempBottom ,& ! in, depth [m] from soil surface for soil temp. lower boundary SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + RadSwAbsSnowSoilLayer => noahmp%energy%flux%RadSwAbsSnowSoilLayer ,& ! in, total absorbed solar radiation by snow for each layer [W/m2] + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] DepthSoilTempBotToSno => noahmp%energy%state%DepthSoilTempBotToSno ,& ! out, depth [m] of soil temp. lower boundary from snow surface HeatFromSoilBot => noahmp%energy%flux%HeatFromSoilBot ,& ! out, energy influx from soil bottom during soil timestep [J/m2] RadSwPenetrateGrd => noahmp%energy%flux%RadSwPenetrateGrd & ! out, light penetrating through soil/snow water [W/m2] @@ -59,7 +64,17 @@ subroutine SoilSnowTemperatureMain(noahmp) MatLeft3(:) = 0.0 ! compute solar penetration through water, needs more work - RadSwPenetrateGrd(NumSnowLayerNeg+1:NumSoilLayer) = 0.0 + RadSwPenetrateGrd(-NumSnowLayerMax+1:NumSoilLayer) = 0.0 + + if (NumSnowLayerNeg < 0 .and. sum(RadSwAbsSnowSoilLayer) > 0.0 .and. OptSnowAlbedo == 3) then + do IndLoop = NumSnowLayerNeg+1, 1, 1 + if (IndLoop == NumSnowLayerNeg+1) then + RadSwPenetrateGrd (IndLoop) = RadSwAbsSnowSoilLayer (IndLoop) - RadSwAbsGrd + else + RadSwPenetrateGrd (IndLoop) = RadSwAbsSnowSoilLayer (IndLoop) + endif + enddo + endif ! adjust DepthSoilTempBottom from soil surface to DepthSoilTempBotToSno from snow surface DepthSoilTempBotToSno = DepthSoilTempBottom - SnowDepth diff --git a/src/SoilSnowWaterPhaseChangeMod.F90 b/src/SoilSnowWaterPhaseChangeMod.F90 index fb8a202b..6bffbc38 100644 --- a/src/SoilSnowWaterPhaseChangeMod.F90 +++ b/src/SoilSnowWaterPhaseChangeMod.F90 @@ -41,6 +41,7 @@ subroutine SoilSnowWaterPhaseChange(noahmp) ! -------------------------------------------------------------------- associate( & + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo OptSoilSupercoolWater => noahmp%config%nmlist%OptSoilSupercoolWater ,& ! in, options for soil supercooled liquid water NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers @@ -62,7 +63,8 @@ subroutine SoilSnowWaterPhaseChange(noahmp) IndexPhaseChange => noahmp%water%state%IndexPhaseChange ,& ! out, phase change index [0-none;1-melt;2-refreeze] SoilSupercoolWater => noahmp%water%state%SoilSupercoolWater ,& ! out, supercooled water in soil [kg/m2] PondSfcThinSnwMelt => noahmp%water%state%PondSfcThinSnwMelt ,& ! out, surface ponding [mm] from melt when thin snow w/o layer - MeltGroundSnow => noahmp%water%flux%MeltGroundSnow & ! out, ground snowmelt rate [mm/s] + MeltGroundSnow => noahmp%water%flux%MeltGroundSnow ,& ! out, ground snowmelt rate [mm/s] + SnowFreezeRate => noahmp%water%flux%SnowFreezeRate & ! out, rate of snow freezing [mm/s] ) ! ---------------------------------------------------------------------- @@ -84,6 +86,7 @@ subroutine SoilSnowWaterPhaseChange(noahmp) MeltGroundSnow = 0.0 PondSfcThinSnwMelt = 0.0 HeatLhTotPhsChg = 0.0 + if (OptSnowAlbedo == 3) SnowFreezeRate(:) = 0.0 ! supercooled water content do LoopInd = -NumSnowLayerMax+1, NumSoilLayer @@ -228,6 +231,9 @@ subroutine SoilSnowWaterPhaseChange(noahmp) ! snow melting rate if ( LoopInd < 1 ) then MeltGroundSnow = MeltGroundSnow + max(0.0, (MassWatIceInit(LoopInd)-MassWatIceTmp(LoopInd))) / MainTimeStep + if (OptSnowAlbedo == 3) then + SnowFreezeRate(LoopInd) = max(0.0, (MassWatIceTmp(LoopInd)-MassWatIceInit(LoopInd))) / MainTimeStep + endif endif endif enddo diff --git a/src/SoilWaterInfilGreenAmptMod.F90 b/src/SoilWaterInfilGreenAmptMod.F90 index c6179345..d4c706fe 100644 --- a/src/SoilWaterInfilGreenAmptMod.F90 +++ b/src/SoilWaterInfilGreenAmptMod.F90 @@ -34,6 +34,7 @@ subroutine SoilWaterInfilGreenAmpt(noahmp, IndInfilMax, InfilSfcAcc, InfilSfcTmp real(kind=kind_noahmp) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] real(kind=kind_noahmp) :: SoilWatConductivity ! soil water conductivity[m/s] real(kind=kind_noahmp) :: InfilFacTmp ! temporary infiltrability variable + real(kind=kind_noahmp) :: IniSoilIce ! zero soil ice ! -------------------------------------------------------------------- associate( & @@ -48,12 +49,13 @@ subroutine SoilWaterInfilGreenAmpt(noahmp, IndInfilMax, InfilSfcAcc, InfilSfcTmp ) ! ---------------------------------------------------------------------- + IniSoilIce = 0.0 IndSoil = 1 if ( IndInfilMax == 1 ) then ! estimate initial soil hydraulic conductivty (Ki in the equation) (m/s) call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & - SoilMoistureWilt(IndSoil), 0.0, IndSoil) + SoilMoistureWilt(IndSoil), IniSoilIce, IndSoil) ! Maximum infiltrability based on the Eq. 6.25. (m/s) InfilFacTmp = InfilCapillaryDynVic * (SoilMoistureSat(IndSoil) - SoilMoistureWilt(IndSoil)) * & diff --git a/src/SoilWaterInfilPhilipMod.F90 b/src/SoilWaterInfilPhilipMod.F90 index 9008f1ca..09940b83 100644 --- a/src/SoilWaterInfilPhilipMod.F90 +++ b/src/SoilWaterInfilPhilipMod.F90 @@ -36,6 +36,7 @@ subroutine SoilWaterInfilPhilip(noahmp, TimeStep, IndInfilMax, InfilSfcAcc, Infi real(kind=kind_noahmp) :: SoilWatConductivity ! soil water conductivity [m/s] real(kind=kind_noahmp) :: SoilSorptivity ! sorptivity [m s^-1/2] real(kind=kind_noahmp) :: SoilWatConductTmp ! intial hydraulic conductivity [m/s] + real(kind=kind_noahmp) :: IniSoilIce ! zero soil ice ! -------------------------------------------------------------------- associate( & @@ -49,12 +50,13 @@ subroutine SoilWaterInfilPhilip(noahmp, TimeStep, IndInfilMax, InfilSfcAcc, Infi ) ! ---------------------------------------------------------------------- + IniSoilIce = 0.0 IndSoil = 1 if ( IndInfilMax == 1) then ! estimate initial soil hydraulic conductivty and diffusivity (Ki, D(theta) in the equation) call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & - SoilMoistureWilt(IndSoil), 0.0, IndSoil) + SoilMoistureWilt(IndSoil), IniSoilIce, IndSoil) ! Sorptivity based on Eq. 10b from Kutílek, Miroslav, and Jana Valentová (1986) ! Sorptivity approximations. Transport in Porous Media 1.1, 57-62. diff --git a/src/SoilWaterInfilSmithParlangeMod.F90 b/src/SoilWaterInfilSmithParlangeMod.F90 index 5d87dfe9..f9f3fa2e 100644 --- a/src/SoilWaterInfilSmithParlangeMod.F90 +++ b/src/SoilWaterInfilSmithParlangeMod.F90 @@ -34,6 +34,7 @@ subroutine SoilWaterInfilSmithParlange(noahmp, IndInfilMax, InfilSfcAcc, InfilSf real(kind=kind_noahmp) :: SoilWatConductivity ! soil water conductivity [m/s] real(kind=kind_noahmp) :: InfilFacTmp ! temporary infiltrability variable real(kind=kind_noahmp) :: WeighFac ! smith-parlang weighing parameter + real(kind=kind_noahmp) :: IniSoilIce ! zero soil ice ! -------------------------------------------------------------------- associate( & @@ -50,6 +51,7 @@ subroutine SoilWaterInfilSmithParlange(noahmp, IndInfilMax, InfilSfcAcc, InfilSf ! smith-parlang weighing parameter, Gamma WeighFac = 0.82 + IniSoilIce = 0.0 IndSoil = 1 ! check whether we are estimating infiltration for current SoilMoisture or SoilMoistureWilt @@ -57,7 +59,7 @@ subroutine SoilWaterInfilSmithParlange(noahmp, IndInfilMax, InfilSfcAcc, InfilSf ! estimate initial soil hydraulic conductivty (Ki in the equation) (m/s) call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & - SoilMoistureWilt(IndSoil), 0.0, IndSoil) + SoilMoistureWilt(IndSoil), IniSoilIce, IndSoil) ! Maximum infiltrability based on the Eq. 6.25. (m/s) InfilFacTmp = InfilCapillaryDynVic * (SoilMoistureSat(IndSoil) - SoilMoistureWilt(IndSoil)) * & diff --git a/src/SoilWaterSupercoolKoren99Mod.F90 b/src/SoilWaterSupercoolKoren99Mod.F90 index 49f3dedb..5cafb3c0 100644 --- a/src/SoilWaterSupercoolKoren99Mod.F90 +++ b/src/SoilWaterSupercoolKoren99Mod.F90 @@ -83,9 +83,17 @@ subroutine SoilWaterSupercoolKoren99(noahmp, IndSoil, SoilWatSupercool, & 1001 Continue if ( .not. ((NumIter < 10) .and. (IndCnt == 0)) ) goto 1002 NumIter = NumIter +1 +#ifdef DOUBLE_PREC + + DF = dlog((SoilMatPotentialSat(IndSoil)*ConstGravityAcc/ConstLatHeatFusion) * & + ((1.0 + CK*SoilIce)**2.0) * (SoilMoistureSat(IndSoil)/(SoilMoisture - SoilIce))**SoilExpB) - & + dlog(-(SoilTemperature - ConstFreezePoint) / SoilTemperature) +#else DF = alog((SoilMatPotentialSat(IndSoil)*ConstGravityAcc/ConstLatHeatFusion) * & ((1.0 + CK*SoilIce)**2.0) * (SoilMoistureSat(IndSoil)/(SoilMoisture - SoilIce))**SoilExpB) - & alog(-(SoilTemperature - ConstFreezePoint) / SoilTemperature) + +#endif Denom = 2.0 * CK / (1.0 + CK * SoilIce) + SoilExpB / (SoilMoisture - SoilIce) SoilIceTmp = SoilIce - DF / Denom ! bounds useful for mathematical solution diff --git a/src/SurfaceAlbedoGlacierMod.F90 b/src/SurfaceAlbedoGlacierMod.F90 index 515a2235..a7be323e 100644 --- a/src/SurfaceAlbedoGlacierMod.F90 +++ b/src/SurfaceAlbedoGlacierMod.F90 @@ -5,10 +5,13 @@ module SurfaceAlbedoGlacierMod use Machine use NoahmpVarType use ConstantDefineMod - use SnowAgingBatsMod, only : SnowAgingBats - use SnowAlbedoBatsMod, only : SnowAlbedoBats - use SnowAlbedoClassMod, only : SnowAlbedoClass - use GroundAlbedoGlacierMod, only : GroundAlbedoGlacier + use SnowAgingBatsMod, only : SnowAgingBats + use SnowAlbedoBatsMod, only : SnowAlbedoBats + use SnowAlbedoClassMod, only : SnowAlbedoClass + use GroundAlbedoGlacierMod, only : GroundAlbedoGlacier + use SnowAlbedoSnicarMod, only : SnowAlbedoSnicar + use SnowFreshRadiusMod, only : SnowFreshRadius + use SnowAgingSnicarMod, only : SnowAgingSnicar implicit none @@ -20,6 +23,7 @@ subroutine SurfaceAlbedoGlacier(noahmp) ! Original Noah-MP subroutine: RADIATION_GLACIER ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding snicar snow albedo (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- implicit none @@ -39,7 +43,10 @@ subroutine SurfaceAlbedoGlacier(noahmp) AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! out, snow albedo for direct(1=vis, 2=nir) AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif ,& ! out, snow albedo for diffuse(1=vis, 2=nir) AlbedoSfcDir => noahmp%energy%state%AlbedoSfcDir ,& ! out, surface albedo (direct) - AlbedoSfcDif => noahmp%energy%state%AlbedoSfcDif & ! out, surface albedo (diffuse) + AlbedoSfcDif => noahmp%energy%state%AlbedoSfcDif ,& ! out, surface albedo (diffuse) + FracRadSwAbsSnowDir => noahmp%energy%flux%FracRadSwAbsSnowDir ,& ! out, direct solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif & ! out, diffuse solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) + ) ! ---------------------------------------------------------------------- @@ -51,8 +58,16 @@ subroutine SurfaceAlbedoGlacier(noahmp) AlbedoGrdDif (IndBand) = 0.0 AlbedoSnowDir(IndBand) = 0.0 AlbedoSnowDif(IndBand) = 0.0 + FracRadSwAbsSnowDir(:,IndBand) = 0.0 + FracRadSwAbsSnowDif(:,IndBand) = 0.0 enddo + if ( OptSnowAlbedo == 3 ) then + ! snow radius + call SnowFreshRadius(noahmp) + call SnowAgingSnicar(noahmp) + endif + ! solar radiation process is only done if there is light if ( CosSolarZenithAngle > 0 ) then @@ -62,6 +77,7 @@ subroutine SurfaceAlbedoGlacier(noahmp) ! snow albedo if ( OptSnowAlbedo == 1 ) call SnowAlbedoBats(noahmp) if ( OptSnowAlbedo == 2 ) call SnowAlbedoClass(noahmp) + if ( OptSnowAlbedo == 3 ) call SnowAlbedoSnicar(noahmp) ! ground albedo call GroundAlbedoGlacier(noahmp) diff --git a/src/SurfaceAlbedoMod.F90 b/src/SurfaceAlbedoMod.F90 index d8e4bf10..a5774fe8 100644 --- a/src/SurfaceAlbedoMod.F90 +++ b/src/SurfaceAlbedoMod.F90 @@ -9,8 +9,11 @@ module SurfaceAlbedoMod use SnowAgingBatsMod, only : SnowAgingBats use SnowAlbedoBatsMod, only : SnowAlbedoBats use SnowAlbedoClassMod, only : SnowAlbedoClass + use SnowAlbedoSnicarMod, only : SnowAlbedoSnicar use GroundAlbedoMod, only : GroundAlbedo use CanopyRadiationTwoStreamMod, only : CanopyRadiationTwoStream + use SnowFreshRadiusMod, only : SnowFreshRadius + use SnowAgingSnicarMod, only : SnowAgingSnicar implicit none @@ -22,6 +25,7 @@ subroutine SurfaceAlbedo(noahmp) ! Original Noah-MP subroutine: ALBEDO ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding snicar snow albedo (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- implicit none @@ -51,6 +55,8 @@ subroutine SurfaceAlbedo(noahmp) AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! out, ground albedo (diffuse: vis, nir) AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! out, snow albedo for direct(1=vis, 2=nir) AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif ,& ! out, snow albedo for diffuse(1=vis, 2=nir) + FracRadSwAbsSnowDir => noahmp%energy%flux%FracRadSwAbsSnowDir ,& ! out, direct solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif ,& ! out, diffuse solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) AlbedoSfcDir => noahmp%energy%state%AlbedoSfcDir ,& ! out, surface albedo (direct) AlbedoSfcDif => noahmp%energy%state%AlbedoSfcDif ,& ! out, surface albedo (diffuse) CanopySunlitFrac => noahmp%energy%state%CanopySunlitFrac ,& ! out, sunlit fraction of canopy @@ -101,9 +107,17 @@ subroutine SurfaceAlbedo(noahmp) RadSwReflVegDif (IndBand) = 0.0 RadSwReflGrdDir (IndBand) = 0.0 RadSwReflGrdDif (IndBand) = 0.0 + FracRadSwAbsSnowDir(:,IndBand) = 0.0 + FracRadSwAbsSnowDif(:,IndBand) = 0.0 enddo VegAreaIndEff = LeafAreaIndEff + StemAreaIndEff + if ( OptSnowAlbedo == 3 ) then + ! snow radius + call SnowFreshRadius(noahmp) + call SnowAgingSnicar(noahmp) + endif + ! solar radiation process is only done if there is light if ( CosSolarZenithAngle > 0 ) then @@ -121,6 +135,7 @@ subroutine SurfaceAlbedo(noahmp) ! snow albedos if ( OptSnowAlbedo == 1 ) call SnowAlbedoBats(noahmp) if ( OptSnowAlbedo == 2 ) call SnowAlbedoClass(noahmp) + if ( OptSnowAlbedo == 3 ) call SnowAlbedoSnicar(noahmp) ! ground surface albedo call GroundAlbedo(noahmp) diff --git a/src/SurfaceRadiationGlacierMod.F90 b/src/SurfaceRadiationGlacierMod.F90 index 0d8e2bac..5bafd43b 100644 --- a/src/SurfaceRadiationGlacierMod.F90 +++ b/src/SurfaceRadiationGlacierMod.F90 @@ -16,6 +16,7 @@ subroutine SurfaceRadiationGlacier(noahmp) ! Original Noah-MP subroutine: RADIATION_GLACIER ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding snicar solar absorbed by snow layer (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- implicit none @@ -24,26 +25,49 @@ subroutine SurfaceRadiationGlacier(noahmp) ! local variable integer :: IndBand ! waveband indices (1=vis, 2=nir) + integer :: IndLoop ! snow and soil layer loop real(kind=kind_noahmp) :: RadSwAbsGrdTmp ! ground absorbed solar radiation [W/m2] real(kind=kind_noahmp) :: RadSwReflGrdTmp ! ground reflected solar radiation [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDirMean !direct solar flux factor absorbed by snow [frc] scaling (-NumSnowLayerMax+1:1,NumSwRadBand) + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDifMean !diffuse solar flux factor absorbed by snow [frc] scaling (-NumSnowLayerMax+1:1,NumSwRadBand) ! ----------------------------------------------------------------- associate( & NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + RadSwDownDir => noahmp%energy%flux%RadSwDownDir ,& ! in, incoming direct solar radiation [W/m2] RadSwDownDif => noahmp%energy%flux%RadSwDownDif ,& ! in, incoming diffuse solar radiation [W/m2] AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! in, ground albedo (direct beam: vis, nir) AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! in, ground albedo (diffuse: vis, nir) + SnowCoverFrac=> noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + FracRadSwAbsSnowDir => noahmp%energy%flux%FracRadSwAbsSnowDir ,& ! in, direct solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif ,& ! in, diffuse solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir,& ! in, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif,& ! in, snow albedo for diffuse(1=vis, 2=nir) + SnowWaterEquiv=> noahmp%water%state%SnowWaterEquiv,& ! in, snow water equivalent [mm] + + AlbedoLandIce => noahmp%energy%param%AlbedoLandIce,& ! in, albedo land ice: 1=vis, 2=nir RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! out, solar radiation absorbed by ground [W/m2] RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! out, total absorbed solar radiation [W/m2] - RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc & ! out, total reflected solar radiation [W/m2] + RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! out, total reflected solar radiation [W/m2] + RadSwAbsSnowSoilLayer=> noahmp%energy%flux%RadSwAbsSnowSoilLayer & ! out, total absorbed solar radiation by snow for each layer [W/m2] + ) ! ---------------------------------------------------------------------- + if (OptSnowAlbedo == 3) then + if (.not. allocated(FracRadSwAbsSnowDirMean)) allocate(FracRadSwAbsSnowDirMean(-NumSnowLayerMax+1:1,1:NumSwRadBand)) + if (.not. allocated(FracRadSwAbsSnowDifMean)) allocate(FracRadSwAbsSnowDifMean(-NumSnowLayerMax+1:1,1:NumSwRadBand)) + RadSwAbsSnowSoilLayer(:) = 0.0 + endif ! initialization RadSwAbsGrd = 0.0 RadSwAbsSfc = 0.0 RadSwReflSfc = 0.0 + RadSwAbsSnowSoilLayer(:) = 0.0 do IndBand = 1, NumSwRadBand ! solar radiation absorbed by glacier surface @@ -56,8 +80,38 @@ subroutine SurfaceRadiationGlacier(noahmp) RadSwReflGrdTmp = RadSwDownDir(IndBand) * AlbedoGrdDir(IndBand) + & RadSwDownDif(IndBand) * AlbedoGrdDif(IndBand) RadSwReflSfc = RadSwReflSfc + RadSwReflGrdTmp + + + if (OptSnowAlbedo == 3) then + do IndLoop = -NumSnowLayerMax+1, 1, 1 + + FracRadSwAbsSnowDirMean(IndLoop,IndBand)=FracRadSwAbsSnowDir(IndLoop,IndBand)*SnowCoverFrac+& + ((1.0 - SnowCoverFrac)*(1.0 - AlbedoLandIce(IndBand))* & + (FracRadSwAbsSnowDir(IndLoop,IndBand)/(1.0 - AlbedoSnowDir(IndBand)))) + FracRadSwAbsSnowDifMean(IndLoop,IndBand)=FracRadSwAbsSnowDif(IndLoop,IndBand)*SnowCoverFrac+& + ((1.0 - SnowCoverFrac)*(1.0 - AlbedoLandIce(IndBand))* & + (FracRadSwAbsSnowDif(IndLoop,IndBand)/(1.0 - AlbedoSnowDif(IndBand)))) + + RadSwAbsSnowSoilLayer(IndLoop)=RadSwAbsSnowSoilLayer(IndLoop)+ & + RadSwDownDir(IndBand) * & + FracRadSwAbsSnowDirMean(IndLoop,IndBand) + & + RadSwDownDif(IndBand) * & + FracRadSwAbsSnowDifMean(IndLoop,IndBand) + enddo + endif + enddo + if (OptSnowAlbedo == 3 .and. NumSnowLayerNeg == 0) then + RadSwAbsSnowSoilLayer(:)=0.0 + RadSwAbsSnowSoilLayer(1)=RadSwAbsGrd + endif + + if (OptSnowAlbedo == 3) then + deallocate(FracRadSwAbsSnowDirMean) + deallocate(FracRadSwAbsSnowDifMean) + endif + end associate end subroutine SurfaceRadiationGlacier diff --git a/src/SurfaceRadiationMod.F90 b/src/SurfaceRadiationMod.F90 index bd9bbb41..238a3d8f 100644 --- a/src/SurfaceRadiationMod.F90 +++ b/src/SurfaceRadiationMod.F90 @@ -16,6 +16,7 @@ subroutine SurfaceRadiation(noahmp) ! Original Noah-MP subroutine: SURRAD ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding snicar solar absorbed by snow layer (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- implicit none @@ -24,6 +25,7 @@ subroutine SurfaceRadiation(noahmp) ! local variable integer :: IndBand ! waveband indices (1=vis, 2=nir) + integer :: IndLoop ! snow and soil layer loop real(kind=kind_noahmp) :: MinThr ! prevents overflow for division by zero real(kind=kind_noahmp) :: RadSwAbsGrdTmp ! ground absorbed solar radiation [W/m2] real(kind=kind_noahmp) :: RadSwReflSfcNir ! surface reflected solar radiation NIR [W/m2] @@ -33,10 +35,15 @@ subroutine SurfaceRadiation(noahmp) real(kind=kind_noahmp) :: RadSwTranGrdDif ! transmitted solar radiation at ground: diffuse [W/m2] real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsCanDir ! direct beam absorbed by canopy [W/m2] real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsCanDif ! diffuse radiation absorbed by canopy [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDirMean !direct solar flux factor absorbed by snow [frc] scaling (-NumSnowLayerMax+1:1,NumSwRadBand) + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDifMean !diffuse solar flux factor absorbed by snow [frc] scaling (-NumSnowLayerMax+1:1,NumSwRadBand) ! -------------------------------------------------------------------- associate( & NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) LeafAreaIndEff => noahmp%energy%state%LeafAreaIndEff ,& ! in, leaf area index, after burying by snow VegAreaIndEff => noahmp%energy%state%VegAreaIndEff ,& ! in, one-sided leaf+stem area index [m2/m2] CanopySunlitFrac => noahmp%energy%state%CanopySunlitFrac ,& ! in, sunlit fraction of canopy @@ -54,15 +61,24 @@ subroutine SurfaceRadiation(noahmp) AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! in, ground albedo (diffuse: vis, nir) AlbedoSfcDir => noahmp%energy%state%AlbedoSfcDir ,& ! in, surface albedo (direct) AlbedoSfcDif => noahmp%energy%state%AlbedoSfcDif ,& ! in, surface albedo (diffuse) + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! in, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif ,& ! in, snow albedo for diffuse(1=vis, 2=nir) + AlbedoSoilDir => noahmp%energy%state%AlbedoSoilDir ,& ! in, soil albedo (direct) + AlbedoSoilDif => noahmp%energy%state%AlbedoSoilDif ,& ! in, soil albedo (diffuse) + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction RadSwReflVegDir => noahmp%energy%flux%RadSwReflVegDir ,& ! in, flux reflected by veg layer (per unit direct flux) RadSwReflVegDif => noahmp%energy%flux%RadSwReflVegDif ,& ! in, flux reflected by veg layer (per unit diffuse flux) RadSwReflGrdDir => noahmp%energy%flux%RadSwReflGrdDir ,& ! in, flux reflected by ground (per unit direct flux) RadSwReflGrdDif => noahmp%energy%flux%RadSwReflGrdDif ,& ! in, flux reflected by ground (per unit diffuse flux) + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + FracRadSwAbsSnowDir => noahmp%energy%flux%FracRadSwAbsSnowDir ,& ! in, direct solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif ,& ! in, diffuse solar flux factor absorbed by snow [frc] (-NumSnowLayerMax+1:1,NumSwRadBand) RadPhotoActAbsSunlit => noahmp%energy%flux%RadPhotoActAbsSunlit ,& ! out, average absorbed par for sunlit leaves [W/m2] RadPhotoActAbsShade => noahmp%energy%flux%RadPhotoActAbsShade ,& ! out, average absorbed par for shaded leaves [W/m2] RadSwAbsVeg => noahmp%energy%flux%RadSwAbsVeg ,& ! out, solar radiation absorbed by vegetation [W/m2] RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! out, solar radiation absorbed by ground [W/m2] RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! out, total absorbed solar radiation [W/m2] + RadSwAbsSnowSoilLayer=> noahmp%energy%flux%RadSwAbsSnowSoilLayer,& ! out, total absorbed solar radiation by snow for each layer [W/m2] RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! out, total reflected solar radiation [W/m2] RadSwReflVeg => noahmp%energy%flux%RadSwReflVeg ,& ! out, reflected solar radiation by vegetation [W/m2] RadSwReflGrd => noahmp%energy%flux%RadSwReflGrd & ! out, reflected solar radiation by ground [W/m2] @@ -70,8 +86,14 @@ subroutine SurfaceRadiation(noahmp) ! ---------------------------------------------------------------------- ! initialization - if (.not. allocated(RadSwAbsCanDir)) allocate(RadSwAbsCanDir(1:NumSwRadBand)) - if (.not. allocated(RadSwAbsCanDif)) allocate(RadSwAbsCanDif(1:NumSwRadBand)) + if (.not. allocated(RadSwAbsCanDir)) allocate(RadSwAbsCanDir(1:NumSwRadBand)) + if (.not. allocated(RadSwAbsCanDif)) allocate(RadSwAbsCanDif(1:NumSwRadBand)) + if (OptSnowAlbedo == 3) then + if (.not. allocated(FracRadSwAbsSnowDirMean)) allocate(FracRadSwAbsSnowDirMean(-NumSnowLayerMax+1:1,1:NumSwRadBand)) + if (.not. allocated(FracRadSwAbsSnowDifMean)) allocate(FracRadSwAbsSnowDifMean(-NumSnowLayerMax+1:1,1:NumSwRadBand)) + RadSwAbsSnowSoilLayer(:) = 0.0 + endif + MinThr = 1.0e-6 RadSwAbsCanDir = 0.0 RadSwAbsCanDif = 0.0 @@ -94,13 +116,39 @@ subroutine SurfaceRadiation(noahmp) RadSwTranGrdDir = RadSwDownDir(IndBand) * RadSwDirTranGrdDir(IndBand) RadSwTranGrdDif = RadSwDownDir(IndBand) * RadSwDifTranGrdDir(IndBand) + & RadSwDownDif(IndBand) * RadSwDifTranGrdDif(IndBand) + ! solar radiation absorbed by ground surface RadSwAbsGrdTmp = RadSwTranGrdDir * (1.0 - AlbedoGrdDir(IndBand)) + & RadSwTranGrdDif * (1.0 - AlbedoGrdDif(IndBand)) RadSwAbsGrd = RadSwAbsGrd + RadSwAbsGrdTmp RadSwAbsSfc = RadSwAbsSfc + RadSwAbsGrdTmp + + + if (OptSnowAlbedo == 3) then + do IndLoop = -NumSnowLayerMax+1, 1, 1 + + FracRadSwAbsSnowDirMean(IndLoop,IndBand)=FracRadSwAbsSnowDir(IndLoop,IndBand)*SnowCoverFrac+& + ((1.0 - SnowCoverFrac)*(1.0 - AlbedoSoilDir(IndBand))* & + (FracRadSwAbsSnowDir(IndLoop,IndBand)/(1.0 - AlbedoSnowDir(IndBand)))) + FracRadSwAbsSnowDifMean(IndLoop,IndBand)=FracRadSwAbsSnowDif(IndLoop,IndBand)*SnowCoverFrac+& + ((1.0 - SnowCoverFrac)*(1.0 - AlbedoSoilDif(IndBand))* & + (FracRadSwAbsSnowDif(IndLoop,IndBand)/(1.0 - AlbedoSnowDif(IndBand)))) + RadSwAbsSnowSoilLayer(IndLoop)=RadSwAbsSnowSoilLayer(IndLoop)+ & + RadSwTranGrdDir * & + FracRadSwAbsSnowDirMean(IndLoop,IndBand) + & + RadSwTranGrdDif * & + FracRadSwAbsSnowDifMean(IndLoop,IndBand) + enddo + endif enddo + if (OptSnowAlbedo == 3 .and. NumSnowLayerNeg == 0) then + RadSwAbsSnowSoilLayer(:)=0.0 + RadSwAbsSnowSoilLayer(1)=RadSwAbsGrd + endif + + + ! partition visible canopy absorption to sunlit and shaded fractions ! to get average absorbed par for sunlit and shaded leaves LeafAreaIndFrac = LeafAreaIndEff / max(VegAreaIndEff, MinThr) @@ -130,6 +178,11 @@ subroutine SurfaceRadiation(noahmp) deallocate(RadSwAbsCanDir) deallocate(RadSwAbsCanDif) + if (OptSnowAlbedo == 3) then + deallocate(FracRadSwAbsSnowDirMean) + deallocate(FracRadSwAbsSnowDifMean) + endif + end associate end subroutine SurfaceRadiation diff --git a/src/WaterVarInitMod.F90 b/src/WaterVarInitMod.F90 index a03d8b4f..6b4c9b21 100644 --- a/src/WaterVarInitMod.F90 +++ b/src/WaterVarInitMod.F90 @@ -24,7 +24,10 @@ subroutine WaterVarInitDefault(noahmp) associate( & NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& - NumSoilLayer => noahmp%config%domain%NumSoilLayer & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + idx_rhos_max => noahmp%config%domain%idx_rhos_max ,& + idx_Tgrd_max => noahmp%config%domain%idx_Tgrd_max ,& + idx_T_max => noahmp%config%domain%idx_T_max & ) ! water state variables @@ -207,8 +210,10 @@ subroutine WaterVarInitDefault(noahmp) allocate( noahmp%water%flux%TranspWatLossSoil(1:NumSoilLayer) ) if ( .not. allocated(noahmp%water%flux%TranspWatLossSoilAcc) ) & allocate( noahmp%water%flux%TranspWatLossSoilAcc(1:NumSoilLayer) ) - if ( .not. allocated(noahmp%water%flux%TranspWatLossSoilMean) ) & + if ( .not. allocated(noahmp%water%flux%TranspWatLossSoilMean) ) & allocate( noahmp%water%flux%TranspWatLossSoilMean(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%flux%OutflowSnowLayer) ) & + allocate( noahmp%water%flux%OutflowSnowLayer(-NumSnowLayerMax+1:0) ) noahmp%water%flux%CompactionSnowAging (:) = undefined_real noahmp%water%flux%CompactionSnowBurden (:) = undefined_real @@ -217,6 +222,7 @@ subroutine WaterVarInitDefault(noahmp) noahmp%water%flux%TranspWatLossSoil (:) = undefined_real noahmp%water%flux%TranspWatLossSoilAcc (:) = undefined_real noahmp%water%flux%TranspWatLossSoilMean(:) = undefined_real + noahmp%water%flux%OutflowSnowLayer (:) = undefined_real ! water parameter variables noahmp%water%param%DrainSoilLayerInd = undefined_int @@ -303,6 +309,92 @@ subroutine WaterVarInitDefault(noahmp) noahmp%water%param%SoilExpCoeffB (:) = undefined_real noahmp%water%param%SoilMatPotentialSat (:) = undefined_real + !SNICAR + if (noahmp%config%nmlist%OptSnowAlbedo == 3 )then + + if ( .not. allocated(noahmp%water%state%SnowRadius) ) & + allocate( noahmp%water%state%SnowRadius(-NumSnowLayerMax+1:0) ) + + if ( .not. allocated(noahmp%water%state%MassBChydropho) ) & + allocate( noahmp%water%state%MassBChydropho(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassBChydrophi) ) & + allocate( noahmp%water%state%MassBChydrophi(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassOChydropho) ) & + allocate( noahmp%water%state%MassOChydropho(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassOChydrophi) ) & + allocate( noahmp%water%state%MassOChydrophi(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassDust1) ) & + allocate( noahmp%water%state%MassDust1(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassDust2) ) & + allocate( noahmp%water%state%MassDust2(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassDust3) ) & + allocate( noahmp%water%state%MassDust3(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassDust4) ) & + allocate( noahmp%water%state%MassDust4(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassDust5) ) & + allocate( noahmp%water%state%MassDust5(-NumSnowLayerMax+1:0) ) + + if ( .not. allocated(noahmp%water%state%MassConcBChydropho) ) & + allocate( noahmp%water%state%MassConcBChydropho(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassConcBChydrophi) ) & + allocate( noahmp%water%state%MassConcBChydrophi(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassConcOChydropho) ) & + allocate( noahmp%water%state%MassConcOChydropho(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassConcOChydrophi) ) & + allocate( noahmp%water%state%MassConcOChydrophi(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassConcDust1) ) & + allocate( noahmp%water%state%MassConcDust1(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassConcDust2) ) & + allocate( noahmp%water%state%MassConcDust2(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassConcDust3) ) & + allocate( noahmp%water%state%MassConcDust3(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassConcDust4) ) & + allocate( noahmp%water%state%MassConcDust4(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%MassConcDust5) ) & + allocate( noahmp%water%state%MassConcDust5(-NumSnowLayerMax+1:0) ) + + noahmp%water%state%SnowRadiusFresh = undefined_real + noahmp%water%state%SnowRadius (:) = undefined_real + noahmp%water%state%MassBChydropho (:) = undefined_real + noahmp%water%state%MassBChydrophi (:) = undefined_real + noahmp%water%state%MassOChydropho (:) = undefined_real + noahmp%water%state%MassOChydrophi (:) = undefined_real + noahmp%water%state%MassDust1 (:) = undefined_real + noahmp%water%state%MassDust2 (:) = undefined_real + noahmp%water%state%MassDust3 (:) = undefined_real + noahmp%water%state%MassDust4 (:) = undefined_real + noahmp%water%state%MassDust5 (:) = undefined_real + noahmp%water%state%MassConcBChydropho(:) = undefined_real + noahmp%water%state%MassConcBChydrophi(:) = undefined_real + noahmp%water%state%MassConcOChydropho(:) = undefined_real + noahmp%water%state%MassConcOChydrophi(:) = undefined_real + noahmp%water%state%MassConcDust1 (:) = undefined_real + noahmp%water%state%MassConcDust2 (:) = undefined_real + noahmp%water%state%MassConcDust3 (:) = undefined_real + noahmp%water%state%MassConcDust4 (:) = undefined_real + noahmp%water%state%MassConcDust5 (:) = undefined_real + + if ( .not. allocated(noahmp%water%flux%SnowFreezeRate) ) & + allocate( noahmp%water%flux%SnowFreezeRate(-NumSnowLayerMax+1:0) ) + + noahmp%water%flux%SnowFreezeRate (:) = undefined_real + + if ( .not. allocated(noahmp%water%param%snowage_tau) ) & + allocate( noahmp%water%param%snowage_tau(idx_rhos_max,idx_Tgrd_max,idx_T_max) ) + if ( .not. allocated(noahmp%water%param%snowage_kappa) ) & + allocate( noahmp%water%param%snowage_kappa(idx_rhos_max,idx_Tgrd_max,idx_T_max) ) + if ( .not. allocated(noahmp%water%param%snowage_drdt0) ) & + allocate( noahmp%water%param%snowage_drdt0(idx_rhos_max,idx_Tgrd_max,idx_T_max) ) + + noahmp%water%param%snowage_tau (:,:,:) = undefined_real + noahmp%water%param%snowage_kappa (:,:,:) = undefined_real + noahmp%water%param%snowage_drdt0 (:,:,:) = undefined_real + noahmp%water%param%SnowRadiusMin = undefined_real + noahmp%water%param%FreshSnowRadiusMax = undefined_real + noahmp%water%param%SnowRadiusRefrz = undefined_real + + endif + end associate end subroutine WaterVarInitDefault diff --git a/src/WaterVarType.F90 b/src/WaterVarType.F90 index 2d2f9132..324bb91b 100644 --- a/src/WaterVarType.F90 +++ b/src/WaterVarType.F90 @@ -6,6 +6,7 @@ module WaterVarType ! ------------------------ Code history ----------------------------------- ! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) ! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! SNICAR: Adding related variables (T.-S. Lin, C. He et al. 2023) ! ------------------------------------------------------------------------- use Machine @@ -80,6 +81,8 @@ module WaterVarType real(kind=kind_noahmp), allocatable, dimension(:) :: CompactionSnowBurden ! rate of snow compaction due to overburden [1/s] real(kind=kind_noahmp), allocatable, dimension(:) :: CompactionSnowMelt ! rate of snow compaction due to melt [1/s] real(kind=kind_noahmp), allocatable, dimension(:) :: CompactionSnowTot ! rate of total snow compaction [fraction/timestep] + real(kind=kind_noahmp), allocatable, dimension(:) :: OutflowSnowLayer ! water flow out of each snow layer [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowFreezeRate ! rate of snow freezing [mm/s] end type flux_type @@ -134,6 +137,7 @@ module WaterVarType real(kind=kind_noahmp) :: WaterStorageTotBeg ! total water storage [mm] at the begining before NoahMP process real(kind=kind_noahmp) :: WaterBalanceError ! water balance error [mm] real(kind=kind_noahmp) :: WaterStorageTotEnd ! total water storage [mm] at the end of NoahMP process + real(kind=kind_noahmp) :: SnowRadiusFresh ! fresh snow radius [microns integer , allocatable, dimension(:) :: IndexPhaseChange ! phase change index (0-none;1-melt;2-refreeze) real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIce ! snow layer ice [mm] @@ -155,6 +159,25 @@ module WaterVarType real(kind=kind_noahmp), allocatable, dimension(:) :: SnowLiqWaterVol ! partial volume of snow liquid water [m3/m3] real(kind=kind_noahmp), allocatable, dimension(:) :: SoilSupercoolWater ! supercooled water in soil [kg/m2] real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMatPotential ! soil matric potential [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowRadius ! snow effective grain radius [microns, m-6] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassBChydropho ! mass of hydrophobic Black Carbon in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassBChydrophi ! mass of hydrophillic Black Carbon in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassOChydropho ! mass of hydrophobic Organic Carbon in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassOChydrophi ! mass of hydrophillic Organic Carbon in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust1 ! mass of dust species 1 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust2 ! mass of dust species 2 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust3 ! mass of dust species 3 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust4 ! mass of dust species 4 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassDust5 ! mass of dust species 5 in snow [kg m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcBChydropho ! mass concentration of hydrophobic Black Carbon in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcBChydrophi ! mass concentration of hydrophillic Black Carbon in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcOChydropho ! mass concentration of hydrophobic Organic Carbon in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcOChydrophi ! mass concentration of hydrophillic Organic Carbon in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcDust1 ! mass concentration of dust species 1 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcDust2 ! mass concentration of dust species 2 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcDust3 ! mass concentration of dust species 3 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcDust4 ! mass concentration of dust species 4 in snow [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassConcDust5 ! mass concentration of dust species 5 in snow [kg/kg] end type state_type @@ -219,16 +242,21 @@ module WaterVarType real(kind=kind_noahmp) :: SoilMatPotentialWilt ! soil metric potential for wilting point [m] real(kind=kind_noahmp) :: SnowMeltFac ! snowmelt m parameter in snow cover fraction calculation real(kind=kind_noahmp) :: SnowCoverFac ! snow cover factor [m] (originally hard-coded 2.5*z0 in SCF formulation) + real(kind=kind_noahmp) :: SnowRadiusMin ! minimum allowed snow effective radius for SNICAR (also cold "fresh snow" value) [microns] + real(kind=kind_noahmp) :: FreshSnowRadiusMax ! maximum warm fresh snow effective radius [microns] + real(kind=kind_noahmp) :: SnowRadiusRefrz ! Effective radius of re-frozen snow [microns] - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureSat ! saturated value of soil moisture [m3/m3] - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureWilt ! wilting point soil moisture [m3/m3] - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureFieldCap ! reference soil moisture (field capacity) [m3/m3] - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureDry ! dry soil moisture threshold [m3/m3] - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatDiffusivitySat ! saturated soil hydraulic diffusivity [m2/s] - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatConductivitySat ! saturated soil hydraulic conductivity [m/s] - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilExpCoeffB ! soil exponent B paramete - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMatPotentialSat ! saturated soil matric potential [m] - + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureSat ! saturated value of soil moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureWilt ! wilting point soil moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureFieldCap ! reference soil moisture (field capacity) [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureDry ! dry soil moisture threshold [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatDiffusivitySat ! saturated soil hydraulic diffusivity [m2/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatConductivitySat ! saturated soil hydraulic conductivity [m/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilExpCoeffB ! soil exponent B paramete + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMatPotentialSat ! saturated soil matric potential [m] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: snowage_tau ! snowage tau from table [hours] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: snowage_kappa ! snowage kappa from table [unitless] + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: snowage_drdt0 ! snowage dr/dt_0 from table [m2/kg/hr] end type parameter_type diff --git a/utility/Makefile b/utility/Makefile index dc3130fd..5205a702 100644 --- a/utility/Makefile +++ b/utility/Makefile @@ -6,7 +6,8 @@ include ../../hrldas/user_build_options OBJS = Machine.o \ - CheckNanMod.o + CheckNanMod.o \ + PiecewiseLinearInterp1dMod.o # ErrorHandleMod.o all: $(OBJS) diff --git a/utility/PiecewiseLinearInterp1dMod.F90 b/utility/PiecewiseLinearInterp1dMod.F90 new file mode 100644 index 00000000..52f6e883 --- /dev/null +++ b/utility/PiecewiseLinearInterp1dMod.F90 @@ -0,0 +1,62 @@ +module PiecewiseLinearInterp1dMod + +!!! Piecewise linear interpolation method for 1-dimensional data + + use Machine + + implicit none + +contains + + subroutine PiecewiseLinearInterp1d(ND, XD, YD, XI, YI) + +! ------------------------ Code history -------------------------------------------------- +! Piecewise linear interpolation method for 1-dimensional data +! Original author: John Burkardt, Florida State University, 09/22/2012 +! Added and modified by Cenlin He (NCAR) in CTSM, 01/27/2022 +! Added in Noah-MP by T.-S. Lin +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + integer , intent(in) :: ND ! number of data points of (XD) + real(kind=kind_noahmp), dimension(1:ND), intent(in) :: XD ! x-value of data points + real(kind=kind_noahmp), dimension(1:ND), intent(in) :: YD ! y-value of data points + real(kind=kind_noahmp), intent(in) :: XI ! x-value for to-be-interpolated point + real(kind=kind_noahmp), intent(out) :: YI ! the interpolated value at xi + +! local variables + integer :: K ! loop index + real(kind=kind_noahmp) :: T +! ------------------------------------------------------------ + + YI = 0. + + ! if only one data point + if ( ND == 1 ) then + YI = YD(1) + return + endif + + ! if multiple data points + if ( XI < XD(1) ) then ! extrapolate + T = ( XI - XD(1) ) / ( XD(2) - XD(1) ) + YI = (1. - T) * YD(1) + T * YD(2) + elseif ( XI > XD(ND) ) then ! extrapolate + T = ( XI - XD(ND-1) ) / ( XD(ND) - XD(ND-1) ) + YI = (1. - T) * YD(ND-1) + T * YD(ND) + else ! piecsewise interpolate + do K = 2, ND + if ( (XD(K-1) <= XI) .and. (XI <= XD(K)) ) then + T = ( XI - XD(K-1) ) / ( XD(K) - XD(K-1) ) + YI = (1. - T) * YD(K-1) + T * YD(K) + exit + endif + enddo + endif + + + end subroutine PiecewiseLinearInterp1d + +end module PiecewiseLinearInterp1dMod