diff --git a/drivers/hrldas/ConfigVarInTransferMod.F90 b/drivers/hrldas/ConfigVarInTransferMod.F90 index 8ea389e1..fcb79b0c 100644 --- a/drivers/hrldas/ConfigVarInTransferMod.F90 +++ b/drivers/hrldas/ConfigVarInTransferMod.F90 @@ -62,9 +62,23 @@ subroutine ConfigVarInTransfer(noahmp, NoahmpIO) noahmp%config%nmlist%OptSnowCompaction = NoahmpIO%IOPT_COMPACT noahmp%config%nmlist%OptWetlandModel = NoahmpIO%IOPT_WETLAND + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then ! SNICAR namelist + noahmp%config%nmlist%OptSnicarSnowShape = NoahmpIO%SNICAR_SNOWSHAPE_OPT + noahmp%config%nmlist%OptSnicarRTSolver = NoahmpIO%SNICAR_RTSOLVER_OPT + noahmp%config%nmlist%OptSnicarBandNum = NoahmpIO%SNICAR_BANDNUMBER_OPT + noahmp%config%nmlist%OptSnicarSolarSpec = NoahmpIO%SNICAR_SOLARSPEC_OPT + noahmp%config%nmlist%OptSnicarSnwOptic = NoahmpIO%SNICAR_SNOWOPTICS_OPT + noahmp%config%nmlist%OptSnicarDustOptic = NoahmpIO%SNICAR_DUSTOPTICS_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 + endif + ! config domain variable noahmp%config%domain%SurfaceType = 1 - noahmp%config%domain%NumSwRadBand = 2 + noahmp%config%domain%NumSwRadBand = NoahmpIO%NUMRAD noahmp%config%domain%SoilColor = 4 noahmp%config%domain%NumCropGrowStage = 8 noahmp%config%domain%FlagSoilProcess = NoahmpIO%calculate_soil @@ -95,6 +109,14 @@ subroutine ConfigVarInTransfer(noahmp, NoahmpIO) noahmp%config%domain%RunoffSlopeType = NoahmpIO%SLOPETYP noahmp%config%domain%DepthSoilTempBottom = NoahmpIO%ZBOT_TABLE + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then ! SNICAR variables + noahmp%config%domain%NumTempSnwAgeSnicar = NoahmpIO%idx_T_max + noahmp%config%domain%NumTempGradSnwAgeSnicar = NoahmpIO%idx_Tgrd_max + noahmp%config%domain%NumDensitySnwAgeSnicar = NoahmpIO%idx_rhos_max + noahmp%config%domain%NumSnicarRadBand = NoahmpIO%snicar_numrad_snw + noahmp%config%domain%NumRadiusSnwMieSnicar = 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..585cc276 100644 --- a/drivers/hrldas/EnergyVarInTransferMod.F90 +++ b/drivers/hrldas/EnergyVarInTransferMod.F90 @@ -30,17 +30,19 @@ subroutine EnergyVarInTransfer(noahmp, NoahmpIO) integer :: SoilLayerIndex ! ------------------------------------------------------------------------- - associate( & - I => noahmp%config%domain%GridIndexI ,& - J => noahmp%config%domain%GridIndexJ ,& - VegType => noahmp%config%domain%VegType ,& - SoilType => noahmp%config%domain%SoilType ,& - CropType => noahmp%config%domain%CropType ,& - SoilColor => noahmp%config%domain%SoilColor ,& - FlagUrban => noahmp%config%domain%FlagUrban ,& - NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& - NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& - NumSwRadBand => noahmp%config%domain%NumSwRadBand & + associate( & + I => noahmp%config%domain%GridIndexI ,& + J => noahmp%config%domain%GridIndexJ ,& + VegType => noahmp%config%domain%VegType ,& + SoilType => noahmp%config%domain%SoilType ,& + CropType => noahmp%config%domain%CropType ,& + SoilColor => noahmp%config%domain%SoilColor ,& + FlagUrban => noahmp%config%domain%FlagUrban ,& + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& + NumSnicarRadBand => noahmp%config%domain%NumSnicarRadBand ,& + NumRadiusSnwMieSnicar => noahmp%config%domain%NumRadiusSnwMieSnicar & ) ! ------------------------------------------------------------------------- @@ -60,6 +62,8 @@ subroutine EnergyVarInTransfer(noahmp, NoahmpIO) noahmp%energy%state%TemperatureSoilSnow(1:NumSoilLayer) = NoahmpIO%TSLB (I,1:NumSoilLayer,J) noahmp%energy%state%PressureAtmosCO2 = NoahmpIO%CO2_TABLE * noahmp%forcing%PressureAirRefHeight noahmp%energy%state%PressureAtmosO2 = NoahmpIO%O2_TABLE * noahmp%forcing%PressureAirRefHeight + noahmp%energy%state%AlbedoSoilDir(1:NumSwRadBand) = NoahmpIO%ALBSOILDIRXY(I,1:NumSwRadBand,J) + noahmp%energy%state%AlbedoSoilDif(1:NumSwRadBand) = NoahmpIO%ALBSOILDIFXY(I,1:NumSwRadBand,J) ! vegetation treatment for USGS land types (playa, lava, sand to bare) if ( (VegType == 25) .or. (VegType == 26) .or. (VegType == 27) ) then noahmp%energy%state%VegFrac = 0.0 @@ -129,23 +133,67 @@ subroutine EnergyVarInTransfer(noahmp, NoahmpIO) noahmp%energy%param%AlbedoLakeFrz (1:NumSwRadBand) = NoahmpIO%ALBLAK_TABLE(1:NumSwRadBand) noahmp%energy%param%ScatterCoeffSnow (1:NumSwRadBand) = NoahmpIO%OMEGAS_TABLE(1:NumSwRadBand) + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then ! SNICAR variables + noahmp%energy%param%RadSwWgtDif (1:NumSnicarRadBand) = NoahmpIO%flx_wgt_dif(1:NumSnicarRadBand) + noahmp%energy%param%RadSwWgtDir (1:NumSnicarRadBand) = NoahmpIO%flx_wgt_dir(1:NumSnicarRadBand) + noahmp%energy%param%SsAlbBCphi (1:NumSnicarRadBand) = NoahmpIO%ss_alb_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmBCphi (1:NumSnicarRadBand) = NoahmpIO%asm_prm_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassBCphi (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbBCpho (1:NumSnicarRadBand) = NoahmpIO%ss_alb_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmBCpho (1:NumSnicarRadBand) = NoahmpIO%asm_prm_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassBCpho (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbOCphi (1:NumSnicarRadBand) = NoahmpIO%ss_alb_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmOCphi (1:NumSnicarRadBand) = NoahmpIO%asm_prm_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassOCphi (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbOCpho (1:NumSnicarRadBand) = NoahmpIO%ss_alb_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmOCpho (1:NumSnicarRadBand) = NoahmpIO%asm_prm_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassOCpho (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB1 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB1 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB1 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB2 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB2 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB2 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB3 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB3 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB3 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB4 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst4 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB4 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst4 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB4 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst4 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB5 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst5 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB5 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst5 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB5 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst5 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbSnwRadDir (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%ss_alb_snw_drc (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmSnwRadDir (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%asm_prm_snw_drc (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassSnwRadDir(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%ext_cff_mss_snw_drc(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%SsAlbSnwRadDif (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%ss_alb_snw_dfs (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmSnwRadDif (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%asm_prm_snw_dfs (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassSnwRadDif(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%ext_cff_mss_snw_dfs(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + endif + do SoilLayerIndex = 1, size(SoilType) - noahmp%energy%param%SoilQuartzFrac(SoilLayerIndex) = NoahmpIO%QUARTZ_TABLE(SoilType(SoilLayerIndex)) + noahmp%energy%param%SoilQuartzFrac(SoilLayerIndex) = NoahmpIO%QUARTZ_TABLE(SoilType(SoilLayerIndex)) enddo ! spatial varying soil input if ( noahmp%config%nmlist%OptSoilProperty == 4 ) then - noahmp%energy%param%SoilQuartzFrac(1:NumSoilLayer) = NoahmpIO%QUARTZ_3D(I,1:NumSoilLayer,J) + noahmp%energy%param%SoilQuartzFrac(1:NumSoilLayer) = NoahmpIO%QUARTZ_3D(I,1:NumSoilLayer,J) endif if ( FlagUrban .eqv. .true. ) noahmp%energy%param%SoilHeatCapacity = 3.0e6 if ( CropType > 0 ) then - noahmp%energy%param%ConductanceLeafMin = NoahmpIO%BPI_TABLE (CropType) - noahmp%energy%param%Co2MmConst25C = NoahmpIO%KC25I_TABLE(CropType) - noahmp%energy%param%O2MmConst25C = NoahmpIO%KO25I_TABLE(CropType) - noahmp%energy%param%Co2MmConstQ10 = NoahmpIO%AKCI_TABLE (CropType) - noahmp%energy%param%O2MmConstQ10 = NoahmpIO%AKOI_TABLE (CropType) + noahmp%energy%param%ConductanceLeafMin = NoahmpIO%BPI_TABLE (CropType) + noahmp%energy%param%Co2MmConst25C = NoahmpIO%KC25I_TABLE(CropType) + noahmp%energy%param%O2MmConst25C = NoahmpIO%KO25I_TABLE(CropType) + noahmp%energy%param%Co2MmConstQ10 = NoahmpIO%AKCI_TABLE (CropType) + noahmp%energy%param%O2MmConstQ10 = NoahmpIO%AKOI_TABLE (CropType) endif end associate diff --git a/drivers/hrldas/EnergyVarOutTransferMod.F90 b/drivers/hrldas/EnergyVarOutTransferMod.F90 index 00658527..23311629 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,13 @@ 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) + NoahmpIO%ALBSOILDIRXY(I,1:NumSwRadBand,J) = noahmp%energy%state%AlbedoSoilDir(1:NumSwRadBand) + NoahmpIO%ALBSOILDIFXY(I,1:NumSwRadBand,J) = noahmp%energy%state%AlbedoSoilDif(1:NumSwRadBand) + 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..98cb90f6 100644 --- a/drivers/hrldas/ForcingVarInTransferMod.F90 +++ b/drivers/hrldas/ForcingVarInTransferMod.F90 @@ -62,6 +62,35 @@ subroutine ForcingVarInTransfer(noahmp, NoahmpIO) noahmp%forcing%PrecipNonConvRefHeight = noahmp%forcing%PrecipNonConvRefHeight + PrecipOtherRefHeight noahmp%forcing%PrecipSnowRefHeight = noahmp%forcing%PrecipSnowRefHeight + PrecipOtherRefHeight * NoahmpIO%SR(I,J) + ! downward solar radiation direct/diffuse and visible/NIR partition + noahmp%forcing%RadSwDirFrac = NoahmpIO%RadSwDirFrac(I,J) + noahmp%forcing%RadSwVisFrac = NoahmpIO%RadSwVisFrac(I,J) + + ! SNICAR aerosol deposition flux forcing + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then + if ( noahmp%config%nmlist%FlagSnicarAerosolReadTable .eqv. .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..f1d51889 100644 --- a/drivers/hrldas/ForcingVarOutTransferMod.F90 +++ b/drivers/hrldas/ForcingVarOutTransferMod.F90 @@ -25,9 +25,9 @@ subroutine ForcingVarOutTransfer(noahmp, NoahmpIO) type(NoahmpIO_type), intent(inout) :: NoahmpIO ! ------------------------------------------------------------------------- - associate( & - I => noahmp%config%domain%GridIndexI ,& - J => noahmp%config%domain%GridIndexJ & + associate( & + I => noahmp%config%domain%GridIndexI ,& + J => noahmp%config%domain%GridIndexJ & ) ! ------------------------------------------------------------------------- @@ -36,6 +36,8 @@ subroutine ForcingVarOutTransfer(noahmp, NoahmpIO) NoahmpIO%FORCPLSM (I,J) = noahmp%forcing%PressureAirRefHeight NoahmpIO%FORCWLSM (I,J) = sqrt(noahmp%forcing%WindEastwardRefHeight**2 + & noahmp%forcing%WindNorthwardRefHeight**2) + NoahmpIO%RadSwDirFrac(I,J) = noahmp%forcing%RadSwDirFrac + NoahmpIO%RadSwVisFrac(I,J) = noahmp%forcing%RadSwVisFrac end associate diff --git a/drivers/hrldas/NoahmpDriverMainMod.F90 b/drivers/hrldas/NoahmpDriverMainMod.F90 index dd593a8b..c3f62825 100644 --- a/drivers/hrldas/NoahmpDriverMainMod.F90 +++ b/drivers/hrldas/NoahmpDriverMainMod.F90 @@ -198,8 +198,8 @@ subroutine NoahmpDriverMain(NoahmpIO) else noahmp%config%domain%IndicatorIceSfc = 0 ! land soil point. call NoahmpMain(noahmp) - endif ! glacial split ends - + 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 640a599f..1f19d86e 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 & ) ! ------------------------------------------------- @@ -318,6 +319,93 @@ 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%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%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%RadSwVisFrac) ) allocate ( NoahmpIO%RadSwVisFrac (XSTART:XEND,YSTART:YEND) ) ! downward solar radation visible fraction + if ( .not. allocated (NoahmpIO%RadSwDirFrac) ) allocate ( NoahmpIO%RadSwDirFrac (XSTART:XEND,YSTART:YEND) ) ! downward solar radation direct fraction + ! 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) ) @@ -605,6 +693,14 @@ subroutine NoahmpIOVarInitDefault(NoahmpIO) NoahmpIO%CANHSXY = undefined_real NoahmpIO%Z0 = undefined_real NoahmpIO%ZNT = undefined_real + NoahmpIO%ALBSNOWDIRXY = undefined_real + NoahmpIO%ALBSNOWDIFXY = undefined_real + NoahmpIO%ALBSFCDIRXY = undefined_real + NoahmpIO%ALBSFCDIFXY = undefined_real + NoahmpIO%ALBSOILDIRXY = 0.0 + NoahmpIO%ALBSOILDIFXY = 0.0 + NoahmpIO%RadSwVisFrac = undefined_real + NoahmpIO%RadSwDirFrac = undefined_real NoahmpIO%TAUSSXY = 0.0 NoahmpIO%DEEPRECHXY = 0.0 NoahmpIO%RECHXY = 0.0 @@ -682,6 +778,77 @@ 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%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 12581dbf..536fb4d6 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) @@ -111,11 +111,11 @@ module NoahmpIOVarType real(kind=kind_noahmp), allocatable, dimension(:,:) :: MP_HAIL ! hail precipitation entering land model [mm] ! MB/AN : v3.7 #ifdef WRF_HYDRO - real(kind=kind_noahmp), allocatable, dimension(:,:) :: infxsrt ! surface infiltration - real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfcheadrt ! surface water head - real(kind=kind_noahmp), allocatable, dimension(:,:) :: soldrain ! soil drainage - real(kind=kind_noahmp), allocatable, dimension(:,:) :: qtiledrain ! tile drainage - real(kind=kind_noahmp), allocatable, dimension(:,:) :: ZWATBLE2D ! water table depth + real(kind=kind_noahmp), allocatable, dimension(:,:) :: infxsrt ! surface infiltration + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfcheadrt ! surface water head + real(kind=kind_noahmp), allocatable, dimension(:,:) :: soldrain ! soil drainage + real(kind=kind_noahmp), allocatable, dimension(:,:) :: qtiledrain ! tile drainage + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ZWATBLE2D ! water table depth #endif ! Spatially varying fields (for now it is de-activated) @@ -357,6 +357,124 @@ 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] + character(len=256) :: forcing_name_BCPHI ! forcing variable for hydrophilic black carbon deposition flux [kg/m2/s] + character(len=256) :: forcing_name_BCPHO ! forcing variable for hydrophobic black carbon deposition flux [kg/m2/s] + character(len=256) :: forcing_name_OCPHI ! forcing variable for hydrophilic organic carbon deposition flux [kg/m2/s] + character(len=256) :: forcing_name_OCPHO ! forcing variable for hydrophobic organic carbon deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST1 ! forcing variable for dust size bin 1 deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST2 ! forcing variable for dust size bin 2 deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST3 ! forcing variable for dust size bin 3 deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST4 ! forcing variable for dust size bin 4 deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST5 ! forcing variable for dust size bin 5 deposition flux [kg/m2/s] + 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(:,:,:) :: 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), allocatable, dimension(:,:,:) :: ALBSOILDIRXY ! soil albedo (direct) + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: ALBSOILDIFXY ! soil albedo (diffuse) + 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(:,:) :: RadSwVisFrac ! fraction of downward solar visible band + real(kind=kind_noahmp), allocatable, dimension(:,:) :: RadSwDirFrac ! fraction of downward solar direct band !------------------------------------------------------------------------ ! Needed for TILE DRAINAGE IF IOPT_TDRN = 1 OR 2 @@ -556,6 +674,7 @@ module NoahmpIOVarType logical :: update_lai, update_veg integer :: spinup_loop logical :: reset_spinup_date + logical :: reset_spinup_datea !--------------------------------------------------------------------- ! File naming, parallel @@ -650,6 +769,8 @@ module NoahmpIOVarType character(len=256) :: forcing_name_SW character(len=256) :: forcing_name_PR character(len=256) :: forcing_name_SN + character(len=256) :: forcing_name_DirFrac + character(len=256) :: forcing_name_VisFrac integer :: noahmp_output ! =0: default output; >0 include additional output integer :: split_output_count @@ -663,6 +784,8 @@ module NoahmpIOVarType character(len=256) :: external_lai_filename_template character(len=256) :: agdata_flnm character(len=256) :: tdinput_flnm + character(len=256) :: snicar_optic_flnm ! SNICAR filename for optics parameters + character(len=256) :: snicar_age_flnm ! SNICAR filename for snow aging parameters integer :: xstart integer :: ystart integer :: xend @@ -811,6 +934,34 @@ module NoahmpIOVarType real(kind=kind_noahmp) :: Z0SOIL_TABLE ! Bare-soil roughness length (m) (i.e., under the canopy) real(kind=kind_noahmp) :: Z0LAKE_TABLE ! Lake surface roughness length (m) + ! SNICAR scheme parameters + 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] + real(kind=kind_noahmp) :: ScavEffMeltScale_TABLE ! Scaling factor modifying scavenging factors for aerosol in meltwater (-) + real(kind=kind_noahmp) :: ScavEffMeltBCphi_TABLE ! scavenging factor for hydrophillic BC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltBCpho_TABLE ! scavenging factor for hydrophobic BC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltOCphi_TABLE ! scavenging factor for hydrophillic OC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltOCpho_TABLE ! scavenging factor for hydrophobic OC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust1_TABLE ! scavenging factor for dust species 1 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust2_TABLE ! scavenging factor for dust species 2 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust3_TABLE ! scavenging factor for dust species 3 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust4_TABLE ! scavenging factor for dust species 4 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust5_TABLE ! scavenging factor for dust species 5 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: SnowRadiusMax_TABLE ! maximum allowed snow effective radius [microns] + real(kind=kind_noahmp) :: SnowWetAgeC1Brun89_TABLE ! constant for liquid water grain growth [m3 s-1], from Brun89 + real(kind=kind_noahmp) :: SnowWetAgeC2Brun89_TABLE ! Constant for liquid water grain growth [m3 s-1], from Brun89: corrected for LWC + real(kind=kind_noahmp) :: SnowAgeScaleFac_TABLE ! Arbitrary scaling factor applied to snow aging rate (-) + ! irrigation parameters integer :: IRR_HAR_TABLE ! number of days before harvest date to stop irrigation real(kind=kind_noahmp) :: IRR_FRAC_TABLE ! irrigation Fraction diff --git a/drivers/hrldas/NoahmpInitMainMod.F90 b/drivers/hrldas/NoahmpInitMainMod.F90 index a1ab2fe1..ffea0a2a 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 @@ -38,13 +38,12 @@ subroutine NoahmpInitMain(NoahmpIO) jde = NoahmpIO%jde+1 its = NoahmpIO%its jts = NoahmpIO%jts + itf = min0(NoahmpIO%ite, ide-1) + jtf = min0(NoahmpIO%jte, jde-1) ! only initialize for non-restart case if ( .not. NoahmpIO%restart_flag ) then - itf = min0(NoahmpIO%ite, ide-1) - jtf = min0(NoahmpIO%jte, jde-1) - ! initialize physical snow height SNOWH if ( .not. NoahmpIO%FNDSNOWH ) then ! If no SNOWH do the following @@ -270,7 +269,37 @@ subroutine NoahmpInitMain(NoahmpIO) endif endif ! NoahmpIO%restart_flag - + + if ( NoahmpIO%IOPT_ALB == 3 ) then ! initialize SNICAR aerosol content in snow + 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 + end subroutine NoahmpInitMain end module NoahmpInitMainMod diff --git a/drivers/hrldas/NoahmpReadNamelistMod.F90 b/drivers/hrldas/NoahmpReadNamelistMod.F90 index 34701629..aaf14b79 100644 --- a/drivers/hrldas/NoahmpReadNamelistMod.F90 +++ b/drivers/hrldas/NoahmpReadNamelistMod.F90 @@ -59,7 +59,6 @@ subroutine NoahmpReadNamelist(NoahmpIO) real(kind=kind_noahmp) :: urban_atmosphere_thickness = 2.0 real(kind=kind_noahmp) :: soil_timestep = 0.0 ! soil timestep (default=0: same as main noahmp timestep) - ! derived urban dimensions character(len=256) :: forcing_name_T = "T2D" character(len=256) :: forcing_name_Q = "Q2D" character(len=256) :: forcing_name_U = "U2D" @@ -69,6 +68,8 @@ subroutine NoahmpReadNamelist(NoahmpIO) character(len=256) :: forcing_name_SW = "SWDOWN" character(len=256) :: forcing_name_PR = "RAINRATE" character(len=256) :: forcing_name_SN = "" + character(len=256) :: forcing_name_DirFrac = "" + character(len=256) :: forcing_name_VisFrac = "" integer :: dynamic_veg_option = 4 integer :: canopy_stomatal_resistance_option = 1 integer :: btr_option = 1 @@ -105,13 +106,37 @@ subroutine NoahmpReadNamelist(NoahmpIO) character(len=256) :: external_lai_filename_template = " " character(len=256) :: agdata_flnm = " " character(len=256) :: tdinput_flnm = " " + character(len=256) :: snicar_optic_flnm = "snicar_optics_5bnd_c013122.nc" + character(len=256) :: snicar_age_flnm = "snicar_drdt_bst_fit_60_c070416.nc" integer :: xstart = 1 integer :: ystart = 1 integer :: xend = 0 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 = .false. + logical :: snicar_use_oc = .false. + 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, & @@ -123,6 +148,7 @@ subroutine NoahmpReadNamelist(NoahmpIO) spinup_loops, & forcing_name_T,forcing_name_Q,forcing_name_U,forcing_name_V,forcing_name_P, & forcing_name_LW,forcing_name_SW,forcing_name_PR,forcing_name_SN, & + forcing_name_DirFrac, forcing_name_VisFrac, & dynamic_veg_option, canopy_stomatal_resistance_option, & btr_option, surface_drag_option, supercooled_water_option, & frozen_soil_option, radiative_transfer_option, snow_albedo_option, & @@ -136,10 +162,15 @@ subroutine NoahmpReadNamelist(NoahmpIO) num_urban_nf ,num_urban_nz,num_urban_nbui,num_urban_ngr , & split_output_count, & khour, kday, zlvl, hrldas_setup_file, & - spatial_filename, agdata_flnm, tdinput_flnm, & + spatial_filename, agdata_flnm, tdinput_flnm, snicar_optic_flnm, snicar_age_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 @@ -383,6 +414,8 @@ subroutine NoahmpReadNamelist(NoahmpIO) NoahmpIO%forcing_name_SW = forcing_name_SW NoahmpIO%forcing_name_PR = forcing_name_PR NoahmpIO%forcing_name_SN = forcing_name_SN + NoahmpIO%forcing_name_DirFrac = forcing_name_DirFrac + NoahmpIO%forcing_name_VisFrac = forcing_name_VisFrac NoahmpIO%split_output_count = split_output_count NoahmpIO%skip_first_output = skip_first_output NoahmpIO%khour = khour @@ -400,7 +433,30 @@ subroutine NoahmpReadNamelist(NoahmpIO) NoahmpIO%yend = yend NoahmpIO%MAX_SOIL_LEVELS = MAX_SOIL_LEVELS NoahmpIO%soil_thick_input = soil_thick_input - + ! SNICAR + NoahmpIO%snicar_optic_flnm = snicar_optic_flnm + NoahmpIO%snicar_age_flnm = snicar_age_flnm + 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 b9f9a694..8be41bb4 100644 --- a/drivers/hrldas/NoahmpReadTableMod.F90 +++ b/drivers/hrldas/NoahmpReadTableMod.F90 @@ -180,7 +180,7 @@ subroutine NoahmpReadTable(NoahmpIO) namelist / noahmp_tiledrain_parameters / NSOILTYPE, DRAIN_LAYER_OPT, TDSMC_FAC, TD_DEPTH, TD_DC, TD_DCOEF, TD_D,& TD_ADEPTH, TD_RADI, TD_SPAC, TD_DDRAIN, KLAT_FAC - ! optional parameters + ! pedotransfer soil function parameters real(kind=kind_noahmp) :: sr2006_theta_1500t_a, sr2006_theta_1500t_b, sr2006_theta_1500t_c, & sr2006_theta_1500t_d, sr2006_theta_1500t_e, sr2006_theta_1500t_f, & sr2006_theta_1500t_g, sr2006_theta_1500_a , sr2006_theta_1500_b, & @@ -208,6 +208,22 @@ subroutine NoahmpReadTable(NoahmpIO) sr2006_psi_e_a, sr2006_psi_e_b, sr2006_psi_e_c, sr2006_smcmax_a, & sr2006_smcmax_b + ! SNICAR parameters + real(kind=kind_noahmp) :: DepBChydropho, DepBChydrophi, DepOChydropho, DepOChydrophi, & + DepDust1, DepDust2, DepDust3, DepDust4, DepDust5, & + SnowRadiusMin, FreshSnowRadiusMax, SnowRadiusRefrz, ScavEffMeltScale, & + ScavEffMeltBCphi, ScavEffMeltBCpho, ScavEffMeltOCphi, ScavEffMeltOCpho,& + ScavEffMeltDust1, ScavEffMeltDust2, ScavEffMeltDust3, ScavEffMeltDust4,& + ScavEffMeltDust5, SnowRadiusMax, SnowWetAgeC1Brun89, SnowAgeScaleFac, & + SnowWetAgeC2Brun89 + namelist / noahmp_snicar_parameters / DepBChydropho, DepBChydrophi, DepOChydropho, DepOChydrophi, & + DepDust1, DepDust2, DepDust3, DepDust4, DepDust5, & + SnowRadiusMin, FreshSnowRadiusMax, SnowRadiusRefrz, ScavEffMeltScale, & + ScavEffMeltBCphi, ScavEffMeltBCpho, ScavEffMeltOCphi, ScavEffMeltOCpho,& + ScavEffMeltDust1, ScavEffMeltDust2, ScavEffMeltDust3, ScavEffMeltDust4,& + ScavEffMeltDust5, SnowRadiusMax, SnowWetAgeC1Brun89, SnowAgeScaleFac, & + SnowWetAgeC2Brun89 + !-------------------------------------------------- !=== allocate multi-dim input table variables !-------------------------------------------------- @@ -610,7 +626,7 @@ subroutine NoahmpReadTable(NoahmpIO) NoahmpIO%TD_DDRAIN_TABLE = undefined_real NoahmpIO%KLAT_FAC_TABLE = undefined_real - ! optional parameters + ! pedotransfer soil function parameters NoahmpIO%sr2006_theta_1500t_a_TABLE = undefined_real NoahmpIO%sr2006_theta_1500t_b_TABLE = undefined_real NoahmpIO%sr2006_theta_1500t_c_TABLE = undefined_real @@ -651,6 +667,34 @@ 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 + NoahmpIO%ScavEffMeltScale_TABLE = undefined_real + NoahmpIO%ScavEffMeltBCphi_TABLE = undefined_real + NoahmpIO%ScavEffMeltBCpho_TABLE = undefined_real + NoahmpIO%ScavEffMeltOCphi_TABLE = undefined_real + NoahmpIO%ScavEffMeltOCpho_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust1_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust2_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust3_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust4_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust5_TABLE = undefined_real + NoahmpIO%SnowRadiusMax_TABLE = undefined_real + NoahmpIO%SnowWetAgeC1Brun89_TABLE = undefined_real + NoahmpIO%SnowWetAgeC2Brun89_TABLE = undefined_real + NoahmpIO%SnowAgeScaleFac_TABLE = undefined_real !--------------------------------------------------------------- ! transfer values from table to input variables @@ -1140,7 +1184,7 @@ subroutine NoahmpReadTable(NoahmpIO) NoahmpIO%TD_DDRAIN_TABLE(1:NSOILTYPE) = TD_DDRAIN(1:NSOILTYPE) NoahmpIO%KLAT_FAC_TABLE (1:NSOILTYPE) = KLAT_FAC (1:NSOILTYPE) - !---------------- NoahmpTable.TBL optional parameters + !---------------- NoahmpTable.TBL pedotransfer soil function 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) @@ -1195,6 +1239,47 @@ 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 + NoahmpIO%ScavEffMeltScale_TABLE = ScavEffMeltScale + NoahmpIO%ScavEffMeltBCphi_TABLE = ScavEffMeltBCphi + NoahmpIO%ScavEffMeltBCpho_TABLE = ScavEffMeltBCpho + NoahmpIO%ScavEffMeltOCphi_TABLE = ScavEffMeltOCphi + NoahmpIO%ScavEffMeltOCpho_TABLE = ScavEffMeltOCpho + NoahmpIO%ScavEffMeltDust1_TABLE = ScavEffMeltDust1 + NoahmpIO%ScavEffMeltDust2_TABLE = ScavEffMeltDust2 + NoahmpIO%ScavEffMeltDust3_TABLE = ScavEffMeltDust3 + NoahmpIO%ScavEffMeltDust4_TABLE = ScavEffMeltDust4 + NoahmpIO%ScavEffMeltDust5_TABLE = ScavEffMeltDust5 + NoahmpIO%SnowRadiusMax_TABLE = SnowRadiusMax + NoahmpIO%SnowWetAgeC1Brun89_TABLE = SnowWetAgeC1Brun89 + NoahmpIO%SnowWetAgeC2Brun89_TABLE = SnowWetAgeC2Brun89 + NoahmpIO%SnowAgeScaleFac_TABLE = SnowAgeScaleFac + end subroutine NoahmpReadTable end module NoahmpReadTableMod diff --git a/drivers/hrldas/NoahmpSnowInitMod.F90 b/drivers/hrldas/NoahmpSnowInitMod.F90 index 6c5dd3c8..cc5d5a46 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,21 @@ subroutine NoahmpSnowInitMain(NoahmpIO) NoahmpIO%ZSNSOXY(I,IZ,J) = NoahmpIO%ZSNSOXY(I,IZ-1,J) + DZSNSO(IZ) enddo + ! SNICAR + if ( NoahmpIO%IOPT_ALB == 3 )then + 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 f604da63..9875a248 100644 --- a/drivers/hrldas/WaterVarInTransferMod.F90 +++ b/drivers/hrldas/WaterVarInTransferMod.F90 @@ -85,6 +85,29 @@ subroutine WaterVarInTransfer(noahmp, NoahmpIO) noahmp%water%state%WaterTableHydro = NoahmpIO%ZWATBLE2D (I,J) noahmp%water%state%WaterHeadSfc = NoahmpIO%sfcheadrt (I,J) #endif + ! SNICAR + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then + noahmp%water%state%SnowRadius (-NumSnowLayerMax+1:0) = NoahmpIO%SNRDSXY (I,-NumSnowLayerMax+1:0,J) + 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) + endif + ! water flux variables noahmp%water%flux%EvapSoilSfcLiqAcc = NoahmpIO%ACC_QSEVAXY (I,J) @@ -96,6 +119,11 @@ subroutine WaterVarInTransfer(noahmp, NoahmpIO) noahmp%water%flux%EvapGroundNetAcc = NoahmpIO%ACC_EDIRXY (I,J) noahmp%water%flux%TranspWatLossSoilAcc(1:NumSoilLayer)= NoahmpIO%ACC_ETRANIXY(I,1:NumSoilLayer,J) noahmp%water%flux%GlacierExcessFlowAcc = NoahmpIO%ACC_GLAFLWXY(I,J) + ! SNICAR + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then + noahmp%water%flux%SnowFreezeRate(-NumSnowLayerMax+1:0) = NoahmpIO%SNFRXY(I,-NumSnowLayerMax+1:0,J) + endif + ! water parameter variables noahmp%water%param%DrainSoilLayerInd = NoahmpIO%DRAIN_LAYER_OPT_TABLE @@ -159,6 +187,31 @@ subroutine WaterVarInTransfer(noahmp, NoahmpIO) noahmp%water%param%SoilDrainSlope = NoahmpIO%SLOPE_TABLE(RunoffSlopeType) noahmp%water%param%WetlandCapMax = NoahmpIO%WCAP_TABLE + ! SNICAR + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 )then + 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%param%SnowRadiusMin = NoahmpIO%SnowRadiusMin_TABLE + noahmp%water%param%FreshSnowRadiusMax = NoahmpIO%FreshSnowRadiusMax_TABLE + noahmp%water%param%SnowRadiusRefrz = NoahmpIO%SnowRadiusRefrz_TABLE + noahmp%water%param%ScavEffMeltScale = NoahmpIO%ScavEffMeltScale_TABLE + noahmp%water%param%ScavEffMeltBCphi = NoahmpIO%ScavEffMeltBCphi_TABLE + noahmp%water%param%ScavEffMeltBCpho = NoahmpIO%ScavEffMeltBCpho_TABLE + noahmp%water%param%ScavEffMeltOCphi = NoahmpIO%ScavEffMeltOCphi_TABLE + noahmp%water%param%ScavEffMeltOCpho = NoahmpIO%ScavEffMeltOCpho_TABLE + noahmp%water%param%ScavEffMeltDust1 = NoahmpIO%ScavEffMeltDust1_TABLE + noahmp%water%param%ScavEffMeltDust2 = NoahmpIO%ScavEffMeltDust2_TABLE + noahmp%water%param%ScavEffMeltDust3 = NoahmpIO%ScavEffMeltDust3_TABLE + noahmp%water%param%ScavEffMeltDust4 = NoahmpIO%ScavEffMeltDust4_TABLE + noahmp%water%param%ScavEffMeltDust5 = NoahmpIO%ScavEffMeltDust5_TABLE + noahmp%water%param%SnowRadiusMax = NoahmpIO%SnowRadiusMax_TABLE + noahmp%water%param%SnowWetAgeC1Brun89 = NoahmpIO%SnowWetAgeC1Brun89_TABLE + noahmp%water%param%SnowWetAgeC2Brun89 = NoahmpIO%SnowWetAgeC2Brun89_TABLE + noahmp%water%param%SnowAgeScaleFac = NoahmpIO%SnowAgeScaleFac_TABLE + endif + + ! soil properties 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)) diff --git a/drivers/hrldas/WaterVarOutTransferMod.F90 b/drivers/hrldas/WaterVarOutTransferMod.F90 index 94c75c22..b404bd31 100644 --- a/drivers/hrldas/WaterVarOutTransferMod.F90 +++ b/drivers/hrldas/WaterVarOutTransferMod.F90 @@ -56,7 +56,7 @@ subroutine WaterVarOutTransfer(noahmp, NoahmpIO) noahmp%water%flux%TileDrain = 0.0 noahmp%water%flux%RunoffSurface = noahmp%water%flux%RunoffSurface * noahmp%config%domain%MainTimeStep noahmp%water%flux%RunoffSubsurface = noahmp%water%flux%RunoffSubsurface * noahmp%config%domain%MainTimeStep - NoahmpIO%QFX(I,J) = noahmp%water%flux%EvapGroundNet + NoahmpIO%QFX(I,J) = noahmp%water%flux%EvapGroundNet endif if ( IndicatorIceSfc == 0 ) then ! land soil point @@ -73,10 +73,8 @@ subroutine WaterVarOutTransfer(noahmp, NoahmpIO) NoahmpIO%SNOW (I,J) = noahmp%water%state%SnowWaterEquiv NoahmpIO%SNOWH (I,J) = noahmp%water%state%SnowDepth NoahmpIO%CANWAT (I,J) = noahmp%water%state%CanopyLiqWater + noahmp%water%state%CanopyIce - NoahmpIO%ACSNOW (I,J) = NoahmpIO%ACSNOW(I,J) + (NoahmpIO%RAINBL (I,J) * noahmp%water%state%FrozenPrecipFrac) - NoahmpIO%ACSNOM (I,J) = NoahmpIO%ACSNOM(I,J) + (noahmp%water%flux%MeltGroundSnow * NoahmpIO%DTBL) + & - noahmp%water%state%PondSfcThinSnwMelt + noahmp%water%state%PondSfcThinSnwComb + & - noahmp%water%state%PondSfcThinSnwTrans + NoahmpIO%ACSNOW (I,J) = NoahmpIO%ACSNOW(I,J) + NoahmpIO%RAINBL (I,J) * noahmp%water%state%FrozenPrecipFrac + NoahmpIO%ACSNOM (I,J) = NoahmpIO%ACSNOM(I,J) + noahmp%water%flux%MeltGroundSnow * NoahmpIO%DTBL NoahmpIO%CANLIQXY (I,J) = noahmp%water%state%CanopyLiqWater NoahmpIO%CANICEXY (I,J) = noahmp%water%state%CanopyIce NoahmpIO%FWETXY (I,J) = noahmp%water%state%CanopyWetFrac @@ -130,17 +128,41 @@ 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 - NoahmpIO%IRNUMFI (I,J) = noahmp%water%state%IrrigationCntFlood - NoahmpIO%IRWATSI (I,J) = noahmp%water%state%IrrigationAmtSprinkler - NoahmpIO%IRWATMI (I,J) = noahmp%water%state%IrrigationAmtMicro - NoahmpIO%IRWATFI (I,J) = noahmp%water%state%IrrigationAmtFlood - NoahmpIO%IRSIVOL (I,J) = NoahmpIO%IRSIVOL(I,J)+(noahmp%water%flux%IrrigationRateSprinkler*1000.0) - NoahmpIO%IRMIVOL (I,J) = NoahmpIO%IRMIVOL(I,J)+(noahmp%water%flux%IrrigationRateMicro*1000.0) - NoahmpIO%IRFIVOL (I,J) = NoahmpIO%IRFIVOL(I,J)+(noahmp%water%flux%IrrigationRateFlood*1000.0) - NoahmpIO%IRELOSS (I,J) = NoahmpIO%IRELOSS(I,J)+(noahmp%water%flux%EvapIrriSprinkler*NoahmpIO%DTBL) + NoahmpIO%IRNUMSI(I,J) = noahmp%water%state%IrrigationCntSprinkler + NoahmpIO%IRNUMMI(I,J) = noahmp%water%state%IrrigationCntMicro + NoahmpIO%IRNUMFI(I,J) = noahmp%water%state%IrrigationCntFlood + NoahmpIO%IRWATSI(I,J) = noahmp%water%state%IrrigationAmtSprinkler + NoahmpIO%IRWATMI(I,J) = noahmp%water%state%IrrigationAmtMicro + NoahmpIO%IRWATFI(I,J) = noahmp%water%state%IrrigationAmtFlood + NoahmpIO%IRSIVOL(I,J) = NoahmpIO%IRSIVOL(I,J) + (noahmp%water%flux%IrrigationRateSprinkler*1000.0) + NoahmpIO%IRMIVOL(I,J) = NoahmpIO%IRMIVOL(I,J) + (noahmp%water%flux%IrrigationRateMicro*1000.0) + NoahmpIO%IRFIVOL(I,J) = NoahmpIO%IRFIVOL(I,J) + (noahmp%water%flux%IrrigationRateFlood*1000.0) + NoahmpIO%IRELOSS(I,J) = NoahmpIO%IRELOSS(I,J) + (noahmp%water%flux%EvapIrriSprinkler*NoahmpIO%DTBL) ! wetland (Zhang2022) if ( noahmp%config%nmlist%OptWetlandModel > 0 ) then diff --git a/drivers/lis/ConfigVarInTransferMod.F90 b/drivers/lis/ConfigVarInTransferMod.F90 index b0cde6a5..877a99b7 100644 --- a/drivers/lis/ConfigVarInTransferMod.F90 +++ b/drivers/lis/ConfigVarInTransferMod.F90 @@ -62,9 +62,23 @@ subroutine ConfigVarInTransfer(noahmp, NoahmpIO) noahmp%config%nmlist%OptSnowCompaction = NoahmpIO%IOPT_COMPACT noahmp%config%nmlist%OptWetlandModel = NoahmpIO%IOPT_WETLAND + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then ! SNICAR namelist + noahmp%config%nmlist%OptSnicarSnowShape = NoahmpIO%SNICAR_SNOWSHAPE_OPT + noahmp%config%nmlist%OptSnicarRTSolver = NoahmpIO%SNICAR_RTSOLVER_OPT + noahmp%config%nmlist%OptSnicarBandNum = NoahmpIO%SNICAR_BANDNUMBER_OPT + noahmp%config%nmlist%OptSnicarSolarSpec = NoahmpIO%SNICAR_SOLARSPEC_OPT + noahmp%config%nmlist%OptSnicarSnwOptic = NoahmpIO%SNICAR_SNOWOPTICS_OPT + noahmp%config%nmlist%OptSnicarDustOptic = NoahmpIO%SNICAR_DUSTOPTICS_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 + endif + ! config domain variable noahmp%config%domain%SurfaceType = 1 - noahmp%config%domain%NumSwRadBand = 2 + noahmp%config%domain%NumSwRadBand = NoahmpIO%NUMRAD noahmp%config%domain%SoilColor = 4 noahmp%config%domain%NumCropGrowStage = 8 noahmp%config%domain%FlagSoilProcess = NoahmpIO%calculate_soil @@ -95,6 +109,14 @@ subroutine ConfigVarInTransfer(noahmp, NoahmpIO) noahmp%config%domain%RunoffSlopeType = NoahmpIO%SLOPETYP noahmp%config%domain%DepthSoilTempBottom = NoahmpIO%ZBOT_TABLE + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then ! SNICAR variables + noahmp%config%domain%NumTempSnwAgeSnicar = NoahmpIO%idx_T_max + noahmp%config%domain%NumTempGradSnwAgeSnicar = NoahmpIO%idx_Tgrd_max + noahmp%config%domain%NumDensitySnwAgeSnicar = NoahmpIO%idx_rhos_max + noahmp%config%domain%NumSnicarRadBand = NoahmpIO%snicar_numrad_snw + noahmp%config%domain%NumRadiusSnwMieSnicar = 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/lis/EnergyVarInTransferMod.F90 b/drivers/lis/EnergyVarInTransferMod.F90 index 1525f5bf..3829e831 100644 --- a/drivers/lis/EnergyVarInTransferMod.F90 +++ b/drivers/lis/EnergyVarInTransferMod.F90 @@ -29,21 +29,23 @@ subroutine EnergyVarInTransfer(noahmp, NoahmpIO, LISparam) type(LisNoahmpParam_type), intent(in) :: LISparam ! lis/noahmp parameter ! local loop index - integer :: SoilLayerIndex + integer :: SoilLayerIndex ! ------------------------------------------------------------------------- - associate( & - I => noahmp%config%domain%GridIndexI ,& - J => noahmp%config%domain%GridIndexJ ,& - VegType => noahmp%config%domain%VegType ,& - SoilType => noahmp%config%domain%SoilType ,& - CropType => noahmp%config%domain%CropType ,& - SoilColor => noahmp%config%domain%SoilColor ,& - FlagUrban => noahmp%config%domain%FlagUrban ,& - NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& - NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& - NumSwRadBand => noahmp%config%domain%NumSwRadBand & - ) + associate( & + I => noahmp%config%domain%GridIndexI ,& + J => noahmp%config%domain%GridIndexJ ,& + VegType => noahmp%config%domain%VegType ,& + SoilType => noahmp%config%domain%SoilType ,& + CropType => noahmp%config%domain%CropType ,& + SoilColor => noahmp%config%domain%SoilColor ,& + FlagUrban => noahmp%config%domain%FlagUrban ,& + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& + NumSnicarRadBand => noahmp%config%domain%NumSnicarRadBand ,& + NumRadiusSnwMieSnicar => noahmp%config%domain%NumRadiusSnwMieSnicar & + ) ! ------------------------------------------------------------------------- ! energy state variables @@ -62,6 +64,8 @@ subroutine EnergyVarInTransfer(noahmp, NoahmpIO, LISparam) noahmp%energy%state%TemperatureSoilSnow(1:NumSoilLayer) = NoahmpIO%TSLB (I,1:NumSoilLayer,J) noahmp%energy%state%PressureAtmosCO2 = LISparam%CO2 * noahmp%forcing%PressureAirRefHeight noahmp%energy%state%PressureAtmosO2 = LISparam%O2 * noahmp%forcing%PressureAirRefHeight + noahmp%energy%state%AlbedoSoilDir(1:NumSwRadBand) = NoahmpIO%ALBSOILDIRXY(I,1:NumSwRadBand,J) + noahmp%energy%state%AlbedoSoilDif(1:NumSwRadBand) = NoahmpIO%ALBSOILDIFXY(I,1:NumSwRadBand,J) ! vegetation treatment for USGS land types (playa, lava, sand to bare) if ( (VegType == 25) .or. (VegType == 26) .or. (VegType == 27) ) then noahmp%energy%state%VegFrac = 0.0 @@ -131,23 +135,67 @@ subroutine EnergyVarInTransfer(noahmp, NoahmpIO, LISparam) noahmp%energy%param%AlbedoLakeFrz = LISparam%ALBLAK noahmp%energy%param%ScatterCoeffSnow = LISparam%OMEGAS + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then ! SNICAR variables + noahmp%energy%param%RadSwWgtDif (1:NumSnicarRadBand) = NoahmpIO%flx_wgt_dif(1:NumSnicarRadBand) + noahmp%energy%param%RadSwWgtDir (1:NumSnicarRadBand) = NoahmpIO%flx_wgt_dir(1:NumSnicarRadBand) + noahmp%energy%param%SsAlbBCphi (1:NumSnicarRadBand) = NoahmpIO%ss_alb_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmBCphi (1:NumSnicarRadBand) = NoahmpIO%asm_prm_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassBCphi (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_bc1 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbBCpho (1:NumSnicarRadBand) = NoahmpIO%ss_alb_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmBCpho (1:NumSnicarRadBand) = NoahmpIO%asm_prm_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassBCpho (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_bc2 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbOCphi (1:NumSnicarRadBand) = NoahmpIO%ss_alb_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmOCphi (1:NumSnicarRadBand) = NoahmpIO%asm_prm_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassOCphi (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_oc1 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbOCpho (1:NumSnicarRadBand) = NoahmpIO%ss_alb_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmOCpho (1:NumSnicarRadBand) = NoahmpIO%asm_prm_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassOCpho (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_oc2 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB1 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB1 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB1 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst1 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB2 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB2 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB2 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst2 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB3 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB3 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB3 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst3 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB4 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst4 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB4 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst4 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB4 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst4 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbDustB5 (1:NumSnicarRadBand) = NoahmpIO%ss_alb_dst5 (1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmDustB5 (1:NumSnicarRadBand) = NoahmpIO%asm_prm_dst5 (1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassDustB5 (1:NumSnicarRadBand) = NoahmpIO%ext_cff_mss_dst5 (1:NumSnicarRadBand) + noahmp%energy%param%SsAlbSnwRadDir (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%ss_alb_snw_drc (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmSnwRadDir (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%asm_prm_snw_drc (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassSnwRadDir(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%ext_cff_mss_snw_drc(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%SsAlbSnwRadDif (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%ss_alb_snw_dfs (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%AsyPrmSnwRadDif (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%asm_prm_snw_dfs (1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + noahmp%energy%param%ExtCffMassSnwRadDif(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) = & + NoahmpIO%ext_cff_mss_snw_dfs(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) + endif + do SoilLayerIndex = 1, size(SoilType) - noahmp%energy%param%SoilQuartzFrac(SoilLayerIndex) = LISparam%QUARTZ(SoilLayerIndex) + noahmp%energy%param%SoilQuartzFrac(SoilLayerIndex) = LISparam%QUARTZ(SoilLayerIndex) enddo ! spatial varying soil input if ( noahmp%config%nmlist%OptSoilProperty == 4 ) then - noahmp%energy%param%SoilQuartzFrac(1:NumSoilLayer) = NoahmpIO%QUARTZ_3D(I,1:NumSoilLayer,J) + noahmp%energy%param%SoilQuartzFrac(1:NumSoilLayer) = NoahmpIO%QUARTZ_3D(I,1:NumSoilLayer,J) endif if ( FlagUrban .eqv. .true. ) noahmp%energy%param%SoilHeatCapacity = 3.0e6 if ( CropType > 0 ) then - noahmp%energy%param%ConductanceLeafMin = LISparam%BP - noahmp%energy%param%Co2MmConst25C = LISparam%KC25 - noahmp%energy%param%O2MmConst25C = LISparam%KO25 - noahmp%energy%param%Co2MmConstQ10 = LISparam%AKC - noahmp%energy%param%O2MmConstQ10 = LISparam%AKO + noahmp%energy%param%ConductanceLeafMin = LISparam%BP + noahmp%energy%param%Co2MmConst25C = LISparam%KC25 + noahmp%energy%param%O2MmConst25C = LISparam%KO25 + noahmp%energy%param%Co2MmConstQ10 = LISparam%AKC + noahmp%energy%param%O2MmConstQ10 = LISparam%AKO endif end associate diff --git a/drivers/lis/EnergyVarOutTransferMod.F90 b/drivers/lis/EnergyVarOutTransferMod.F90 index f51af1cf..9d4cfc88 100644 --- a/drivers/lis/EnergyVarOutTransferMod.F90 +++ b/drivers/lis/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 & ) !----------------------------------------------------------------------- @@ -139,8 +140,15 @@ subroutine EnergyVarOutTransfer(noahmp, NoahmpIO) NoahmpIO%ALBEDO (I,J) = noahmp%energy%state%AlbedoSfc NoahmpIO%IRRSPLH (I,J) = NoahmpIO%IRRSPLH(I,J) + & (noahmp%energy%flux%HeatLatentIrriEvap * noahmp%config%domain%MainTimeStep) - 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) + 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) + + NoahmpIO%ALBSOILDIRXY(I,1:NumSwRadBand,J) = noahmp%energy%state%AlbedoSoilDir(1:NumSwRadBand) + NoahmpIO%ALBSOILDIFXY(I,1:NumSwRadBand,J) = noahmp%energy%state%AlbedoSoilDif(1:NumSwRadBand) + 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) diff --git a/drivers/lis/ForcingVarInTransferMod.F90 b/drivers/lis/ForcingVarInTransferMod.F90 index 5cef99c5..41833d05 100644 --- a/drivers/lis/ForcingVarInTransferMod.F90 +++ b/drivers/lis/ForcingVarInTransferMod.F90 @@ -12,6 +12,7 @@ module ForcingVarInTransferMod use Machine use NoahmpIOVarType use NoahmpVarType + use LisNoahmpParamType implicit none @@ -19,16 +20,17 @@ module ForcingVarInTransferMod !=== initialize with input data or table values - subroutine ForcingVarInTransfer(noahmp, NoahmpIO) + subroutine ForcingVarInTransfer(noahmp, NoahmpIO, LISparam) implicit none - type(NoahmpIO_type), intent(inout) :: NoahmpIO - type(noahmp_type), intent(inout) :: noahmp + type(NoahmpIO_type), intent(inout) :: NoahmpIO + type(noahmp_type), intent(inout) :: noahmp + type(LisNoahmpParam_type), intent(in) :: LISparam ! lis/noahmp parameter ! local variables - real(kind=kind_noahmp) :: PrecipOtherRefHeight ! other precipitation, e.g. fog [mm/s] at reference height - real(kind=kind_noahmp) :: PrecipTotalRefHeight ! total precipitation [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipOtherRefHeight ! other precipitation, e.g. fog [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipTotalRefHeight ! total precipitation [mm/s] at reference height ! --------------------------------------------------------------- associate( & @@ -62,6 +64,35 @@ subroutine ForcingVarInTransfer(noahmp, NoahmpIO) noahmp%forcing%PrecipNonConvRefHeight = noahmp%forcing%PrecipNonConvRefHeight + PrecipOtherRefHeight noahmp%forcing%PrecipSnowRefHeight = noahmp%forcing%PrecipSnowRefHeight + PrecipOtherRefHeight * NoahmpIO%SR(I,J) + ! downward solar radiation direct/diffuse and visible/NIR partition + noahmp%forcing%RadSwDirFrac = NoahmpIO%RadSwDirFrac(I,J) + noahmp%forcing%RadSwVisFrac = NoahmpIO%RadSwVisFrac(I,J) + + ! SNICAR aerosol deposition flux forcing + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then + if ( noahmp%config%nmlist%FlagSnicarAerosolReadTable .eqv. .true. ) then + noahmp%forcing%DepBChydropho = LISparam%DepBChydropho + noahmp%forcing%DepBChydrophi = LISparam%DepBChydrophi + noahmp%forcing%DepOChydropho = LISparam%DepOChydropho + noahmp%forcing%DepOChydrophi = LISparam%DepOChydrophi + noahmp%forcing%DepDust1 = LISparam%DepDust1 + noahmp%forcing%DepDust2 = LISparam%DepDust2 + noahmp%forcing%DepDust3 = LISparam%DepDust3 + noahmp%forcing%DepDust4 = LISparam%DepDust4 + noahmp%forcing%DepDust5 = LISparam%DepDust5 + 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/lis/ForcingVarOutTransferMod.F90 b/drivers/lis/ForcingVarOutTransferMod.F90 index 87e6da36..f1d51889 100644 --- a/drivers/lis/ForcingVarOutTransferMod.F90 +++ b/drivers/lis/ForcingVarOutTransferMod.F90 @@ -25,9 +25,9 @@ subroutine ForcingVarOutTransfer(noahmp, NoahmpIO) type(NoahmpIO_type), intent(inout) :: NoahmpIO ! ------------------------------------------------------------------------- - associate( & - I => noahmp%config%domain%GridIndexI ,& - J => noahmp%config%domain%GridIndexJ & + associate( & + I => noahmp%config%domain%GridIndexI ,& + J => noahmp%config%domain%GridIndexJ & ) ! ------------------------------------------------------------------------- @@ -36,6 +36,8 @@ subroutine ForcingVarOutTransfer(noahmp, NoahmpIO) NoahmpIO%FORCPLSM (I,J) = noahmp%forcing%PressureAirRefHeight NoahmpIO%FORCWLSM (I,J) = sqrt(noahmp%forcing%WindEastwardRefHeight**2 + & noahmp%forcing%WindNorthwardRefHeight**2) + NoahmpIO%RadSwDirFrac(I,J) = noahmp%forcing%RadSwDirFrac + NoahmpIO%RadSwVisFrac(I,J) = noahmp%forcing%RadSwVisFrac end associate diff --git a/drivers/lis/LisNoahmpParamType.F90 b/drivers/lis/LisNoahmpParamType.F90 index 9f834401..fad3af1c 100644 --- a/drivers/lis/LisNoahmpParamType.F90 +++ b/drivers/lis/LisNoahmpParamType.F90 @@ -249,6 +249,34 @@ module LisNoahmpParamType real(kind=kind_noahmp) :: t_llimit ! LIS specific: real(kind=kind_noahmp) :: snowf_scalef ! LIS specific: snow cover scaling factor + ! SNICAR parameter + real(kind=kind_noahmp) :: DepBChydropho ! hydrophobic Black Carbon deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepBChydrophi ! hydrophillic Black Carbon deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepOChydropho ! hydrophobic Organic Carbon deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepOChydrophi ! hydrophillic Organic Carbon deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust1 ! dust species 1 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust2 ! dust species 2 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust3 ! dust species 3 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust4 ! dust species 4 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: DepDust5 ! dust species 5 deposition [kg m-2 s-1], assume constant read from table + real(kind=kind_noahmp) :: SnowRadiusMin ! minimum allowed snow effective radius (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) :: ScavEffMeltScale ! Scaling factor modifying scavenging factors for aerosol in meltwater (-) + real(kind=kind_noahmp) :: ScavEffMeltBCphi ! scavenging factor for hydrophillic BC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltBCpho ! scavenging factor for hydrophobic BC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltOCphi ! scavenging factor for hydrophillic OC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltOCpho ! scavenging factor for hydrophobic OC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust1 ! scavenging factor for dust species 1 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust2 ! scavenging factor for dust species 2 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust3 ! scavenging factor for dust species 3 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust4 ! scavenging factor for dust species 4 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust5 ! scavenging factor for dust species 5 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: SnowRadiusMax ! maximum allowed snow effective radius [microns] + real(kind=kind_noahmp) :: SnowWetAgeC1Brun89 ! constant for liquid water grain growth [m3 s-1], from Brun89 + real(kind=kind_noahmp) :: SnowWetAgeC2Brun89 ! Constant for liquid water grain growth [m3 s-1], from Brun89: corrected for LWC + real(kind=kind_noahmp) :: SnowAgeScaleFac ! Arbitrary scaling factor applied to snow aging rate (-) + end type LisNoahmpParam_type end module LisNoahmpParamType diff --git a/drivers/lis/NoahmpDriverMainMod.F90 b/drivers/lis/NoahmpDriverMainMod.F90 index 7ede99fc..9a5e2612 100644 --- a/drivers/lis/NoahmpDriverMainMod.F90 +++ b/drivers/lis/NoahmpDriverMainMod.F90 @@ -148,7 +148,7 @@ subroutine NoahmpDriverMain(NoahmpIO, LISparam) call ConfigVarInitDefault (noahmp) call ConfigVarInTransfer (noahmp, NoahmpIO) call ForcingVarInitDefault (noahmp) - call ForcingVarInTransfer (noahmp, NoahmpIO) + call ForcingVarInTransfer (noahmp, NoahmpIO, LISparam) call EnergyVarInitDefault (noahmp) call EnergyVarInTransfer (noahmp, NoahmpIO, LISparam) call WaterVarInitDefault (noahmp) diff --git a/drivers/lis/NoahmpIOVarInitMod.F90 b/drivers/lis/NoahmpIOVarInitMod.F90 index 1bec48c2..e64c6ad5 100644 --- a/drivers/lis/NoahmpIOVarInitMod.F90 +++ b/drivers/lis/NoahmpIOVarInitMod.F90 @@ -31,7 +31,8 @@ subroutine NoahmpIOVarInitDefault(NoahmpIO) KDS => NoahmpIO%KDS ,& KDE => NoahmpIO%KDE ,& NSOIL => NoahmpIO%NSOIL ,& - NSNOW => NoahmpIO%NSNOW & + NSNOW => NoahmpIO%NSNOW ,& + NUMRAD => NoahmpIO%NUMRAD & ) ! ------------------------------------------------- @@ -324,6 +325,93 @@ 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%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%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%RadSwVisFrac) ) allocate ( NoahmpIO%RadSwVisFrac (XSTART:XEND,YSTART:YEND) ) ! downward solar radation visible fraction + if ( .not. allocated (NoahmpIO%RadSwDirFrac) ) allocate ( NoahmpIO%RadSwDirFrac (XSTART:XEND,YSTART:YEND) ) ! downward solar radation direct fraction + ! 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) ) @@ -608,6 +696,14 @@ subroutine NoahmpIOVarInitDefault(NoahmpIO) NoahmpIO%CANHSXY = undefined_real NoahmpIO%Z0 = undefined_real NoahmpIO%ZNT = undefined_real + NoahmpIO%ALBSNOWDIRXY = undefined_real + NoahmpIO%ALBSNOWDIFXY = undefined_real + NoahmpIO%ALBSFCDIRXY = undefined_real + NoahmpIO%ALBSFCDIFXY = undefined_real + NoahmpIO%ALBSOILDIRXY = 0.0 + NoahmpIO%ALBSOILDIFXY = 0.0 + NoahmpIO%RadSwVisFrac = undefined_real + NoahmpIO%RadSwDirFrac = undefined_real NoahmpIO%rivsto = undefined_real NoahmpIO%fldsto = undefined_real NoahmpIO%fldfrc = undefined_real @@ -691,6 +787,77 @@ 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%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/lis/NoahmpIOVarType.F90 b/drivers/lis/NoahmpIOVarType.F90 index 81ee9ab4..3aab6a6d 100644 --- a/drivers/lis/NoahmpIOVarType.F90 +++ b/drivers/lis/NoahmpIOVarType.F90 @@ -42,7 +42,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) @@ -346,6 +346,124 @@ 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] + character(len=256) :: forcing_name_BCPHI ! forcing variable for hydrophilic black carbon deposition flux [kg/m2/s] + character(len=256) :: forcing_name_BCPHO ! forcing variable for hydrophobic black carbon deposition flux [kg/m2/s] + character(len=256) :: forcing_name_OCPHI ! forcing variable for hydrophilic organic carbon deposition flux [kg/m2/s] + character(len=256) :: forcing_name_OCPHO ! forcing variable for hydrophobic organic carbon deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST1 ! forcing variable for dust size bin 1 deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST2 ! forcing variable for dust size bin 2 deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST3 ! forcing variable for dust size bin 3 deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST4 ! forcing variable for dust size bin 4 deposition flux [kg/m2/s] + character(len=256) :: forcing_name_DUST5 ! forcing variable for dust size bin 5 deposition flux [kg/m2/s] + 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(:,:,:) :: 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), allocatable, dimension(:,:,:) :: ALBSOILDIRXY ! soil albedo (direct) + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: ALBSOILDIFXY ! soil albedo (diffuse) + 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(:,:) :: RadSwVisFrac ! fraction of downward solar visible band + real(kind=kind_noahmp), allocatable, dimension(:,:) :: RadSwDirFrac ! fraction of downward solar direct band !------------------------------------------------------------------------ ! Needed for wetland model (OPT_WETLAND = 1 or 2) @@ -622,6 +740,8 @@ module NoahmpIOVarType character(len=256) :: forcing_name_SW character(len=256) :: forcing_name_PR character(len=256) :: forcing_name_SN + character(len=256) :: forcing_name_DirFrac + character(len=256) :: forcing_name_VisFrac integer :: noahmp_output ! =0: default output; >0 include additional output integer :: split_output_count @@ -635,6 +755,8 @@ module NoahmpIOVarType character(len=256) :: external_lai_filename_template character(len=256) :: agdata_flnm character(len=256) :: tdinput_flnm + character(len=256) :: snicar_optic_flnm ! SNICAR filename for optics parameters + character(len=256) :: snicar_age_flnm ! SNICAR filename for snow aging parameters integer :: xstart integer :: ystart integer :: xend @@ -785,6 +907,34 @@ module NoahmpIOVarType real(kind=kind_noahmp) :: Z0SOIL_TABLE ! Bare-soil roughness length (m) (i.e., under the canopy) real(kind=kind_noahmp) :: Z0LAKE_TABLE ! Lake surface roughness length (m) + ! SNICAR scheme parameters + 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] + real(kind=kind_noahmp) :: ScavEffMeltScale_TABLE ! Scaling factor modifying scavenging factors for aerosol in meltwater (-) + real(kind=kind_noahmp) :: ScavEffMeltBCphi_TABLE ! scavenging factor for hydrophillic BC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltBCpho_TABLE ! scavenging factor for hydrophobic BC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltOCphi_TABLE ! scavenging factor for hydrophillic OC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltOCpho_TABLE ! scavenging factor for hydrophobic OC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust1_TABLE ! scavenging factor for dust species 1 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust2_TABLE ! scavenging factor for dust species 2 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust3_TABLE ! scavenging factor for dust species 3 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust4_TABLE ! scavenging factor for dust species 4 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust5_TABLE ! scavenging factor for dust species 5 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: SnowRadiusMax_TABLE ! maximum allowed snow effective radius [microns] + real(kind=kind_noahmp) :: SnowWetAgeC1Brun89_TABLE ! constant for liquid water grain growth [m3 s-1], from Brun89 + real(kind=kind_noahmp) :: SnowWetAgeC2Brun89_TABLE ! Constant for liquid water grain growth [m3 s-1], from Brun89: corrected for LWC + real(kind=kind_noahmp) :: SnowAgeScaleFac_TABLE ! Arbitrary scaling factor applied to snow aging rate (-) + ! irrigation parameters integer :: IRR_HAR_TABLE ! number of days before harvest date to stop irrigation real(kind=kind_noahmp) :: IRR_FRAC_TABLE ! irrigation Fraction diff --git a/drivers/lis/NoahmpInitMainMod.F90 b/drivers/lis/NoahmpInitMainMod.F90 index a1ab2fe1..94b88b6a 100644 --- a/drivers/lis/NoahmpInitMainMod.F90 +++ b/drivers/lis/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 @@ -38,13 +38,12 @@ subroutine NoahmpInitMain(NoahmpIO) jde = NoahmpIO%jde+1 its = NoahmpIO%its jts = NoahmpIO%jts + itf = min0(NoahmpIO%ite, ide-1) + jtf = min0(NoahmpIO%jte, jde-1) ! only initialize for non-restart case if ( .not. NoahmpIO%restart_flag ) then - itf = min0(NoahmpIO%ite, ide-1) - jtf = min0(NoahmpIO%jte, jde-1) - ! initialize physical snow height SNOWH if ( .not. NoahmpIO%FNDSNOWH ) then ! If no SNOWH do the following @@ -270,7 +269,38 @@ subroutine NoahmpInitMain(NoahmpIO) endif endif ! NoahmpIO%restart_flag - + + + if ( NoahmpIO%IOPT_ALB == 3 ) then ! initialize SNICAR aerosol content in snow + 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 + end subroutine NoahmpInitMain end module NoahmpInitMainMod diff --git a/drivers/lis/NoahmpReadTableMod.F90 b/drivers/lis/NoahmpReadTableMod.F90 index aff96124..eab659c6 100644 --- a/drivers/lis/NoahmpReadTableMod.F90 +++ b/drivers/lis/NoahmpReadTableMod.F90 @@ -180,7 +180,7 @@ subroutine NoahmpReadTable(LANDDATA_name,MPTABLE_file) namelist / noahmp_tiledrain_parameters / NSOILTYPE, DRAIN_LAYER_OPT, TDSMC_FAC, TD_DEPTH, TD_DC, TD_DCOEF, TD_D,& TD_ADEPTH, TD_RADI, TD_SPAC, TD_DDRAIN, KLAT_FAC - ! optional parameters + ! pedotransfer soil function parameters real(kind=kind_noahmp) :: sr2006_theta_1500t_a, sr2006_theta_1500t_b, sr2006_theta_1500t_c, & sr2006_theta_1500t_d, sr2006_theta_1500t_e, sr2006_theta_1500t_f, & sr2006_theta_1500t_g, sr2006_theta_1500_a , sr2006_theta_1500_b, & @@ -208,6 +208,22 @@ subroutine NoahmpReadTable(LANDDATA_name,MPTABLE_file) sr2006_psi_e_a, sr2006_psi_e_b, sr2006_psi_e_c, sr2006_smcmax_a, & sr2006_smcmax_b + ! SNICAR parameters + real(kind=kind_noahmp) :: DepBChydropho, DepBChydrophi, DepOChydropho, DepOChydrophi, & + DepDust1, DepDust2, DepDust3, DepDust4, DepDust5, & + SnowRadiusMin, FreshSnowRadiusMax, SnowRadiusRefrz, ScavEffMeltScale, & + ScavEffMeltBCphi, ScavEffMeltBCpho, ScavEffMeltOCphi, ScavEffMeltOCpho,& + ScavEffMeltDust1, ScavEffMeltDust2, ScavEffMeltDust3, ScavEffMeltDust4,& + ScavEffMeltDust5, SnowRadiusMax, SnowWetAgeC1Brun89, SnowAgeScaleFac, & + SnowWetAgeC2Brun89 + namelist / noahmp_snicar_parameters / DepBChydropho, DepBChydrophi, DepOChydropho, DepOChydrophi, & + DepDust1, DepDust2, DepDust3, DepDust4, DepDust5, & + SnowRadiusMin, FreshSnowRadiusMax, SnowRadiusRefrz, ScavEffMeltScale, & + ScavEffMeltBCphi, ScavEffMeltBCpho, ScavEffMeltOCphi, ScavEffMeltOCpho,& + ScavEffMeltDust1, ScavEffMeltDust2, ScavEffMeltDust3, ScavEffMeltDust4,& + ScavEffMeltDust5, SnowRadiusMax, SnowWetAgeC1Brun89, SnowAgeScaleFac, & + SnowWetAgeC2Brun89 + !-------------------------------------------------- !=== allocate multi-dim input table variables !-------------------------------------------------- @@ -610,7 +626,7 @@ subroutine NoahmpReadTable(LANDDATA_name,MPTABLE_file) NoahmpIO%TD_DDRAIN_TABLE = undefined_real NoahmpIO%KLAT_FAC_TABLE = undefined_real - ! optional parameters + ! pedotransfer soil function parameters NoahmpIO%sr2006_theta_1500t_a_TABLE = undefined_real NoahmpIO%sr2006_theta_1500t_b_TABLE = undefined_real NoahmpIO%sr2006_theta_1500t_c_TABLE = undefined_real @@ -652,6 +668,34 @@ subroutine NoahmpReadTable(LANDDATA_name,MPTABLE_file) 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 + NoahmpIO%ScavEffMeltScale_TABLE = undefined_real + NoahmpIO%ScavEffMeltBCphi_TABLE = undefined_real + NoahmpIO%ScavEffMeltBCpho_TABLE = undefined_real + NoahmpIO%ScavEffMeltOCphi_TABLE = undefined_real + NoahmpIO%ScavEffMeltOCpho_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust1_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust2_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust3_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust4_TABLE = undefined_real + NoahmpIO%ScavEffMeltDust5_TABLE = undefined_real + NoahmpIO%SnowRadiusMax_TABLE = undefined_real + NoahmpIO%SnowWetAgeC1Brun89_TABLE = undefined_real + NoahmpIO%SnowWetAgeC2Brun89_TABLE = undefined_real + NoahmpIO%SnowAgeScaleFac_TABLE = undefined_real + !--------------------------------------------------------------- ! transfer values from table to input variables !--------------------------------------------------------------- @@ -1149,7 +1193,7 @@ subroutine NoahmpReadTable(LANDDATA_name,MPTABLE_file) NoahmpIO%TD_DDRAIN_TABLE(1:NSOILTYPE) = TD_DDRAIN(1:NSOILTYPE) NoahmpIO%KLAT_FAC_TABLE (1:NSOILTYPE) = KLAT_FAC (1:NSOILTYPE) - !---------------- NoahmpTable.TBL optional parameters + !---------------- NoahmpTable.TBL pedotransfer soil function parameters inquire( file=trim(MPTABLE_file), exist=file_named ) if ( file_named ) then open(15, file=trim(MPTABLE_file), status='old', form='formatted', action='read', iostat=ierr) @@ -1205,6 +1249,47 @@ subroutine NoahmpReadTable(LANDDATA_name,MPTABLE_file) NoahmpIO%sr2006_smcmax_a_TABLE = sr2006_smcmax_a NoahmpIO%sr2006_smcmax_b_TABLE = sr2006_smcmax_b + !---------------- NoahmpTable.TBL SNICAR parameters + inquire( file=trim(MPTABLE_file), exist=file_named ) + if ( file_named ) then + open(15, file=trim(MPTABLE_file), 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 + NoahmpIO%ScavEffMeltScale_TABLE = ScavEffMeltScale + NoahmpIO%ScavEffMeltBCphi_TABLE = ScavEffMeltBCphi + NoahmpIO%ScavEffMeltBCpho_TABLE = ScavEffMeltBCpho + NoahmpIO%ScavEffMeltOCphi_TABLE = ScavEffMeltOCphi + NoahmpIO%ScavEffMeltOCpho_TABLE = ScavEffMeltOCpho + NoahmpIO%ScavEffMeltDust1_TABLE = ScavEffMeltDust1 + NoahmpIO%ScavEffMeltDust2_TABLE = ScavEffMeltDust2 + NoahmpIO%ScavEffMeltDust3_TABLE = ScavEffMeltDust3 + NoahmpIO%ScavEffMeltDust4_TABLE = ScavEffMeltDust4 + NoahmpIO%ScavEffMeltDust5_TABLE = ScavEffMeltDust5 + NoahmpIO%SnowRadiusMax_TABLE = SnowRadiusMax + NoahmpIO%SnowWetAgeC1Brun89_TABLE = SnowWetAgeC1Brun89 + NoahmpIO%SnowWetAgeC2Brun89_TABLE = SnowWetAgeC2Brun89 + NoahmpIO%SnowAgeScaleFac_TABLE = SnowAgeScaleFac + end subroutine NoahmpReadTable end module NoahmpReadTableMod diff --git a/drivers/lis/NoahmpSnowInitMod.F90 b/drivers/lis/NoahmpSnowInitMod.F90 index 6c5dd3c8..cc5d5a46 100644 --- a/drivers/lis/NoahmpSnowInitMod.F90 +++ b/drivers/lis/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,21 @@ subroutine NoahmpSnowInitMain(NoahmpIO) NoahmpIO%ZSNSOXY(I,IZ,J) = NoahmpIO%ZSNSOXY(I,IZ-1,J) + DZSNSO(IZ) enddo + ! SNICAR + if ( NoahmpIO%IOPT_ALB == 3 )then + 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/lis/WaterVarInTransferMod.F90 b/drivers/lis/WaterVarInTransferMod.F90 index 96415601..43fb30b2 100644 --- a/drivers/lis/WaterVarInTransferMod.F90 +++ b/drivers/lis/WaterVarInTransferMod.F90 @@ -87,6 +87,28 @@ subroutine WaterVarInTransfer(noahmp, NoahmpIO, LISparam) noahmp%water%state%WaterTableHydro = NoahmpIO%ZWATBLE2D (I,J) noahmp%water%state%WaterHeadSfc = NoahmpIO%sfcheadrt (I,J) #endif + ! SNICAR + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then + noahmp%water%state%SnowRadius (-NumSnowLayerMax+1:0) = NoahmpIO%SNRDSXY (I,-NumSnowLayerMax+1:0,J) + 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) + endif ! water flux variables noahmp%water%flux%EvapSoilSfcLiqAcc = NoahmpIO%ACC_QSEVAXY (I,J) @@ -98,6 +120,10 @@ subroutine WaterVarInTransfer(noahmp, NoahmpIO, LISparam) noahmp%water%flux%EvapGroundNetAcc = NoahmpIO%ACC_EDIRXY (I,J) noahmp%water%flux%TranspWatLossSoilAcc(1:NumSoilLayer)= NoahmpIO%ACC_ETRANIXY(I,1:NumSoilLayer,J) noahmp%water%flux%GlacierExcessFlowAcc = NoahmpIO%ACC_GLAFLWXY(I,J) + ! SNICAR + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 ) then + noahmp%water%flux%SnowFreezeRate(-NumSnowLayerMax+1:0) = NoahmpIO%SNFRXY(I,-NumSnowLayerMax+1:0,J) + endif ! water parameter variables noahmp%water%param%DrainSoilLayerInd = LISparam%DRAIN_LAYER_OPT @@ -161,6 +187,31 @@ subroutine WaterVarInTransfer(noahmp, NoahmpIO, LISparam) noahmp%water%param%SoilDrainSlope = LISparam%SLOPE noahmp%water%param%WetlandCapMax = LISparam%WCAP + ! SNICAR + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 )then + 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%param%SnowRadiusMin = LISparam%SnowRadiusMin + noahmp%water%param%FreshSnowRadiusMax = LISparam%FreshSnowRadiusMax + noahmp%water%param%SnowRadiusRefrz = LISparam%SnowRadiusRefrz + noahmp%water%param%ScavEffMeltScale = LISparam%ScavEffMeltScale + noahmp%water%param%ScavEffMeltBCphi = LISparam%ScavEffMeltBCphi + noahmp%water%param%ScavEffMeltBCpho = LISparam%ScavEffMeltBCpho + noahmp%water%param%ScavEffMeltOCphi = LISparam%ScavEffMeltOCphi + noahmp%water%param%ScavEffMeltOCpho = LISparam%ScavEffMeltOCpho + noahmp%water%param%ScavEffMeltDust1 = LISparam%ScavEffMeltDust1 + noahmp%water%param%ScavEffMeltDust2 = LISparam%ScavEffMeltDust2 + noahmp%water%param%ScavEffMeltDust3 = LISparam%ScavEffMeltDust3 + noahmp%water%param%ScavEffMeltDust4 = LISparam%ScavEffMeltDust4 + noahmp%water%param%ScavEffMeltDust5 = LISparam%ScavEffMeltDust5 + noahmp%water%param%SnowRadiusMax = LISparam%SnowRadiusMax + noahmp%water%param%SnowWetAgeC1Brun89 = LISparam%SnowWetAgeC1Brun89 + noahmp%water%param%SnowWetAgeC2Brun89 = LISparam%SnowWetAgeC2Brun89 + noahmp%water%param%SnowAgeScaleFac = LISparam%SnowAgeScaleFac + endif + + ! soil properties do IndexSoilLayer = 1, size(SoilType) noahmp%water%param%SoilMoistureSat (IndexSoilLayer) = LISparam%SMCMAX(IndexSoilLayer) noahmp%water%param%SoilMoistureWilt (IndexSoilLayer) = LISparam%SMCWLT(IndexSoilLayer) diff --git a/drivers/lis/WaterVarOutTransferMod.F90 b/drivers/lis/WaterVarOutTransferMod.F90 index e14851b6..4a728c6b 100644 --- a/drivers/lis/WaterVarOutTransferMod.F90 +++ b/drivers/lis/WaterVarOutTransferMod.F90 @@ -56,7 +56,7 @@ subroutine WaterVarOutTransfer(noahmp, NoahmpIO) noahmp%water%flux%TileDrain = 0.0 noahmp%water%flux%RunoffSurface = noahmp%water%flux%RunoffSurface * noahmp%config%domain%MainTimeStep noahmp%water%flux%RunoffSubsurface = noahmp%water%flux%RunoffSubsurface * noahmp%config%domain%MainTimeStep - NoahmpIO%QFX(I,J) = noahmp%water%flux%EvapGroundNet + NoahmpIO%QFX(I,J) = noahmp%water%flux%EvapGroundNet endif if ( IndicatorIceSfc == 0 ) then ! land soil point @@ -71,10 +71,8 @@ subroutine WaterVarOutTransfer(noahmp, NoahmpIO) NoahmpIO%SNOW (I,J) = noahmp%water%state%SnowWaterEquiv NoahmpIO%SNOWH (I,J) = noahmp%water%state%SnowDepth NoahmpIO%CANWAT (I,J) = noahmp%water%state%CanopyLiqWater + noahmp%water%state%CanopyIce - NoahmpIO%ACSNOW (I,J) = NoahmpIO%ACSNOW(I,J) + (NoahmpIO%RAINBL (I,J) * noahmp%water%state%FrozenPrecipFrac) - NoahmpIO%ACSNOM (I,J) = NoahmpIO%ACSNOM(I,J) + (noahmp%water%flux%MeltGroundSnow * NoahmpIO%DTBL) + & - noahmp%water%state%PondSfcThinSnwMelt + noahmp%water%state%PondSfcThinSnwComb + & - noahmp%water%state%PondSfcThinSnwTrans + NoahmpIO%ACSNOW (I,J) = NoahmpIO%ACSNOW(I,J) + NoahmpIO%RAINBL (I,J) * noahmp%water%state%FrozenPrecipFrac + NoahmpIO%ACSNOM (I,J) = NoahmpIO%ACSNOM(I,J) + noahmp%water%flux%MeltGroundSnow * NoahmpIO%DTBL NoahmpIO%CANLIQXY (I,J) = noahmp%water%state%CanopyLiqWater NoahmpIO%CANICEXY (I,J) = noahmp%water%state%CanopyIce NoahmpIO%FWETXY (I,J) = noahmp%water%state%CanopyWetFrac @@ -131,17 +129,41 @@ subroutine WaterVarOutTransfer(noahmp, NoahmpIO) noahmp%water%param%SoilMoistureWilt(1:NumSoilLayer)) / & (noahmp%water%param%SoilMoistureSat(1:NumSoilLayer) - & noahmp%water%param%SoilMoistureWilt(1:NumSoilLayer)) + ! 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 - NoahmpIO%IRNUMFI (I,J) = noahmp%water%state%IrrigationCntFlood - NoahmpIO%IRWATSI (I,J) = noahmp%water%state%IrrigationAmtSprinkler - NoahmpIO%IRWATMI (I,J) = noahmp%water%state%IrrigationAmtMicro - NoahmpIO%IRWATFI (I,J) = noahmp%water%state%IrrigationAmtFlood - NoahmpIO%IRSIVOL (I,J) = NoahmpIO%IRSIVOL(I,J)+(noahmp%water%flux%IrrigationRateSprinkler*1000.0) - NoahmpIO%IRMIVOL (I,J) = NoahmpIO%IRMIVOL(I,J)+(noahmp%water%flux%IrrigationRateMicro*1000.0) - NoahmpIO%IRFIVOL (I,J) = NoahmpIO%IRFIVOL(I,J)+(noahmp%water%flux%IrrigationRateFlood*1000.0) - NoahmpIO%IRELOSS (I,J) = NoahmpIO%IRELOSS(I,J)+(noahmp%water%flux%EvapIrriSprinkler*NoahmpIO%DTBL) + NoahmpIO%IRNUMSI(I,J) = noahmp%water%state%IrrigationCntSprinkler + NoahmpIO%IRNUMMI(I,J) = noahmp%water%state%IrrigationCntMicro + NoahmpIO%IRNUMFI(I,J) = noahmp%water%state%IrrigationCntFlood + NoahmpIO%IRWATSI(I,J) = noahmp%water%state%IrrigationAmtSprinkler + NoahmpIO%IRWATMI(I,J) = noahmp%water%state%IrrigationAmtMicro + NoahmpIO%IRWATFI(I,J) = noahmp%water%state%IrrigationAmtFlood + NoahmpIO%IRSIVOL(I,J) = NoahmpIO%IRSIVOL(I,J) + (noahmp%water%flux%IrrigationRateSprinkler*1000.0) + NoahmpIO%IRMIVOL(I,J) = NoahmpIO%IRMIVOL(I,J) + (noahmp%water%flux%IrrigationRateMicro*1000.0) + NoahmpIO%IRFIVOL(I,J) = NoahmpIO%IRFIVOL(I,J) + (noahmp%water%flux%IrrigationRateFlood*1000.0) + NoahmpIO%IRELOSS(I,J) = NoahmpIO%IRELOSS(I,J) + (noahmp%water%flux%EvapIrriSprinkler*NoahmpIO%DTBL) ! wetland (Zhang2022) if ( noahmp%config%nmlist%OptWetlandModel > 0 ) then diff --git a/parameters/NoahmpTable.TBL b/parameters/NoahmpTable.TBL index cad98ba4..82d1cb2d 100644 --- a/parameters/NoahmpTable.TBL +++ b/parameters/NoahmpTable.TBL @@ -480,6 +480,35 @@ WCAP = 0.10 ! maximum wetland water holding capacity [m] (tunable) from Zhang et al. 2022 / +&noahmp_snicar_parameters + SnowRadiusMin = 54.526 ! minimum allowed snow effective radius (also cold "fresh snow" value), can't be lower than 30.0 [microns] + SnowRadiusMax = 1500 ! maximum allowed snow effective radius [microns], needs to be lower than that covered by SNICAR input database + 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 + ScavEffMeltScale = 1.0 ! Scaling factor modifying scavenging factors for aerosol in meltwater (-) + ScavEffMeltBCphi = 0.20 ! scavenging factor for hydrophillic BC inclusion in meltwater [frc] + ScavEffMeltBCpho = 0.03 ! scavenging factor for hydrophobic BC inclusion in meltwater [frc] + ScavEffMeltOCphi = 0.20 ! scavenging factor for hydrophillic OC inclusion in meltwater [frc] + ScavEffMeltOCpho = 0.03 ! scavenging factor for hydrophobic OC inclusion in meltwater [frc] + ScavEffMeltDust1 = 0.02 ! scavenging factor for dust species 1 inclusion in meltwater [frc] + ScavEffMeltDust2 = 0.02 ! scavenging factor for dust species 2 inclusion in meltwater [frc] + ScavEffMeltDust3 = 0.01 ! scavenging factor for dust species 3 inclusion in meltwater [frc] + ScavEffMeltDust4 = 0.01 ! scavenging factor for dust species 4 inclusion in meltwater [frc] + ScavEffMeltDust5 = 0.01 ! scavenging factor for dust species 5 inclusion in meltwater [frc] + SnowWetAgeC1Brun89 = 0.0 ! constant for liquid water grain growth [m3 s-1], from Brun89 + SnowWetAgeC2Brun89 = 4.22e-13 ! Constant for liquid water grain growth [m3 s-1], from Brun89: corrected for LWC [%] + SnowAgeScaleFac = 1.0 ! Arbitrary tuning/scaling factor applied to snow aging rate (-) +/ + &noahmp_irrigation_parameters IRR_FRAC = 0.10 ! irrigation Fraction IRR_HAR = 20 ! number of days before harvest date to stop irrigation @@ -866,3 +895,4 @@ ! 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 / + 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 9209a2dd..3ba87b89 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 + RadSwVisFrac => noahmp%forcing%RadSwVisFrac ,& ! in, downward solar radiation visible band fraction + RadSwDirFrac => noahmp%forcing%RadSwDirFrac ,& ! in, downward solar radiation direct beam fraction 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 ( RadSwDirFrac >= 0.0 .and. RadSwDirFrac <= 1.0 ) then + RadDirFrac = RadSwDirFrac + else + RadSwDirFrac = RadDirFrac + endif + + if ( RadSwVisFrac >= 0.0 .and. RadSwVisFrac <= 1.0 ) then + RadVisFrac = RadSwVisFrac + else + RadSwVisFrac = 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..a1beb7ea 100644 --- a/src/BalanceErrorCheckGlacierMod.F90 +++ b/src/BalanceErrorCheckGlacierMod.F90 @@ -112,25 +112,28 @@ 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/soil 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] ) ! ---------------------------------------------------------------------- ! error in shortwave radiation balance should be <0.01 W/m2 RadSwBalanceError = RadSwDownRefHeight - (RadSwAbsSfc + RadSwReflSfc) + ! print out diagnostics when error is large if ( abs(RadSwBalanceError) > 0.01 ) then write(*,*) "GridIndexI, GridIndexJ = ", GridIndexI, GridIndexJ @@ -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 "Error: SNICAR snow albedo radiation budget problem in NoahMP LSM" + 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 f698821e..40160386 100644 --- a/src/BalanceErrorCheckMod.F90 +++ b/src/BalanceErrorCheckMod.F90 @@ -181,9 +181,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/soil 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] @@ -193,6 +195,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] @@ -201,6 +204,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 ,& ! in, light penetrating through soil and snowpack [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] ) @@ -208,6 +212,7 @@ subroutine BalanceEnergyCheck(noahmp) ! error in shortwave radiation balance should be <0.01 W/m2 RadSwBalanceError = RadSwDownRefHeight - (RadSwAbsSfc + RadSwReflSfc) + ! print out diagnostics when error is large if ( abs(RadSwBalanceError) > 0.01 ) then write(*,*) "GridIndexI, GridIndexJ = ", GridIndexI, GridIndexJ @@ -229,10 +234,20 @@ 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 "Error: SNICAR snow albedo radiation budget problem in NoahMP LSM" + endif + ! error in surface energy balance should be <0.01 W/m2 EnergyBalanceError = RadSwAbsVeg + RadSwAbsGrd + HeatPrecipAdvSfc - & (RadLwNetSfc + HeatSensibleSfc + HeatLatentCanopy + HeatLatentGrd + & HeatLatentTransp + HeatGroundTot + HeatLatentIrriEvap + HeatCanStorageChg) + ! print out diagnostics when error is large if ( abs(EnergyBalanceError) > 0.01 ) then write(*,*) 'EnergyBalanceError = ', EnergyBalanceError, ' at GridIndexI,GridIndexJ: ', GridIndexI, GridIndexJ @@ -247,6 +262,8 @@ subroutine BalanceEnergyCheck(noahmp) write(*,'(a17,F10.4)' ) "Canopy heat storage change: ", HeatCanStorageChg write(*,'(a17,4F10.4)') "Precip advected: ", HeatPrecipAdvSfc,HeatPrecipAdvCanopy,HeatPrecipAdvVegGrd,HeatPrecipAdvBareGrd write(*,'(a17,F10.4)' ) "Veg fraction: ", VegFrac + write(*,'(a17,F10.4)' ) "Light through soil/snow layer total: ", sum(RadSwPenetrateGrd) + write(*,'(a17,4F10.4)') "Light through soil/snow layer: ", RadSwPenetrateGrd stop "Error: Energy budget problem in NoahMP LSM" endif diff --git a/src/ConfigVarInitMod.F90 b/src/ConfigVarInitMod.F90 index af9ec5b3..0fea62bc 100644 --- a/src/ConfigVarInitMod.F90 +++ b/src/ConfigVarInitMod.F90 @@ -48,6 +48,17 @@ subroutine ConfigVarInitDefault(noahmp) noahmp%config%nmlist%OptGlacierTreatment = undefined_int noahmp%config%nmlist%OptSnowCompaction = undefined_int noahmp%config%nmlist%OptWetlandModel = undefined_int + noahmp%config%nmlist%OptSnicarSnowShape = undefined_int + noahmp%config%nmlist%OptSnicarRTSolver = undefined_int + noahmp%config%nmlist%OptSnicarBandNum = undefined_int + noahmp%config%nmlist%OptSnicarSolarSpec = undefined_int + noahmp%config%nmlist%OptSnicarSnwOptic = undefined_int + noahmp%config%nmlist%OptSnicarDustOptic = undefined_int + noahmp%config%nmlist%FlagSnicarSnowBCIntmix = .false. + noahmp%config%nmlist%FlagSnicarSnowDustIntmix = .false. + noahmp%config%nmlist%FlagSnicarUseAerosol = .false. + noahmp%config%nmlist%FlagSnicarUseOC = .false. + noahmp%config%nmlist%FlagSnicarAerosolReadTable = .false. ! config domain variable noahmp%config%domain%LandUseDataName = "MODIFIED_IGBP_MODIS_NOAH" @@ -86,6 +97,11 @@ subroutine ConfigVarInitDefault(noahmp) noahmp%config%domain%ThicknessAtmosBotLayer = undefined_real noahmp%config%domain%Latitude = undefined_real noahmp%config%domain%DepthSoilTempBottom = undefined_real + noahmp%config%domain%NumTempSnwAgeSnicar = undefined_int + noahmp%config%domain%NumTempGradSnwAgeSnicar = undefined_int + noahmp%config%domain%NumDensitySnwAgeSnicar = undefined_int + noahmp%config%domain%NumSnicarRadBand = undefined_int + noahmp%config%domain%NumRadiusSnwMieSnicar = undefined_int end subroutine ConfigVarInitDefault diff --git a/src/ConfigVarType.F90 b/src/ConfigVarType.F90 index 31dbc861..54b26d76 100644 --- a/src/ConfigVarType.F90 +++ b/src/ConfigVarType.F90 @@ -21,60 +21,61 @@ module ConfigVarType ! 1 -> off (use table LeafAreaIndex; use VegFrac = VegFracGreen from input) ! 2 -> on (together with OptStomataResistance = 1) ! 3 -> off (use table LeafAreaIndex; calculate VegFrac) - ! 4 -> off (use table LeafAreaIndex; use maximum vegetation fraction) (default) + ! 4 -> off (use table LeafAreaIndex; use maximum vegetation fraction) ! 5 -> on (use maximum vegetation fraction) ! 6 -> on (use VegFrac = VegFracGreen from input) ! 7 -> off (use input LeafAreaIndex; use VegFrac = VegFracGreen from input) ! 8 -> off (use input LeafAreaIndex; calculate VegFrac) ! 9 -> off (use input LeafAreaIndex; use maximum vegetation fraction) integer :: OptRainSnowPartition ! options for partitioning precipitation into rainfall & snowfall - ! 1 -> Jordan (1991) scheme (default) + ! 1 -> Jordan (1991) scheme ! 2 -> BATS: when TemperatureAirRefHeight < freezing point+2.2 ! 3 -> TemperatureAirRefHeight < freezing point ! 4 -> Use WRF microphysics output ! 5 -> Use wetbulb temperature (Wang et al., 2019) integer :: OptSoilWaterTranspiration ! options for soil moisture factor for stomatal resistance & evapotranspiration - ! 1 -> Noah (soil moisture) (default) + ! 1 -> Noah (soil moisture) ! 2 -> CLM (matric potential) ! 3 -> SSiB (matric potential) integer :: OptGroundResistanceEvap ! options for ground resistent to evaporation/sublimation - ! 1 -> Sakaguchi and Zeng, 2009 (default) + ! 1 -> Sakaguchi and Zeng, 2009 ! 2 -> Sellers (1992) ! 3 -> adjusted Sellers to decrease ResistanceGrdEvap for wet soil ! 4 -> option 1 for non-snow; rsurf = rsurf_snow for snow (set in table) integer :: OptSurfaceDrag ! options for surface layer drag/exchange coefficient - ! 1 -> Monin-Obukhov (M-O) Similarity Theory (MOST) (default) + ! 1 -> Monin-Obukhov (M-O) Similarity Theory (MOST) ! 2 -> original Noah (Chen et al. 1997) integer :: OptStomataResistance ! options for canopy stomatal resistance - ! 1 -> Ball-Berry scheme (default) + ! 1 -> Ball-Berry scheme ! 2 -> Jarvis scheme integer :: OptSnowAlbedo ! options for ground snow surface albedo - ! 1 -> BATS snow albedo scheme (default) + ! 1 -> BATS snow albedo scheme ! 2 -> CLASS snow albedo scheme + ! 3 -> SNICAR snow albedo scheme (Lin et al., 2025 JHM) 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) - ! 3 -> two-stream applied to vegetated fraction (gap=1-VegFrac) (default) + ! 3 -> two-stream applied to vegetated fraction (gap=1-VegFrac) integer :: OptSnowSoilTempTime ! options for snow/soil temperature time scheme (only layer 1) - ! 1 -> semi-implicit; flux top boundary condition (default) + ! 1 -> semi-implicit; flux top boundary condition ! 2 -> full implicit (original Noah); temperature top boundary condition ! 3 -> same as 1, but snow cover for skin temperature calculation (generally improves snow) integer :: OptSnowThermConduct ! options for snow thermal conductivity - ! 1 -> Stieglitz(yen,1965) scheme (default) + ! 1 -> Stieglitz(yen,1965) scheme ! 2 -> Anderson, 1976 scheme ! 3 -> constant ! 4 -> Verseghy (1991) scheme ! 5 -> Douvill(Yen, 1981) scheme integer :: OptSoilTemperatureBottom ! options for lower boundary condition of soil temperature ! 1 -> zero heat flux from bottom (DepthSoilTempBottom & TemperatureSoilBottom not used) - ! 2 -> TemperatureSoilBottom at DepthSoilTempBottom (8m) read from a file (original Noah) (default) + ! 2 -> TemperatureSoilBottom at DepthSoilTempBottom (8m) read from a file (original Noah) integer :: OptSoilSupercoolWater ! options for soil supercooled liquid water - ! 1 -> no iteration (Niu and Yang, 2006 JHM) (default) + ! 1 -> no iteration (Niu and Yang, 2006 JHM) ! 2 -> Koren's iteration (Koren et al., 1999 JGR) integer :: OptRunoffSurface ! options for surface runoff ! 1 -> TOPMODEL with groundwater ! 2 -> TOPMODEL with an equilibrium water table - ! 3 -> original surface and subsurface runoff (free drainage) (default) + ! 3 -> original surface and subsurface runoff (free drainage) ! 4 -> BATS surface and subsurface runoff (free drainage) ! 5 -> Miguez-Macho&Fan groundwater scheme ! 6 -> Variable Infiltration Capacity Model surface runoff scheme @@ -82,52 +83,93 @@ module ConfigVarType ! 8 -> Dynamic VIC surface runoff scheme integer :: OptRunoffSubsurface ! options for drainage & subsurface runoff ! 1~8: similar to runoff option, separated from original NoahMP runoff option - ! currently tested & recommended the same option# as surface runoff (default) + ! currently tested & recommended the same option# as surface runoff integer :: OptSoilPermeabilityFrozen ! options for frozen soil permeability - ! 1 -> linear effects, more permeable (default) + ! 1 -> linear effects, more permeable ! 2 -> nonlinear effects, less permeable integer :: OptDynVicInfiltration ! options for infiltration in dynamic VIC runoff scheme - ! 1 -> Philip scheme (default) + ! 1 -> Philip scheme ! 2 -> Green-Ampt scheme ! 3 -> Smith-Parlange scheme integer :: OptTileDrainage ! options for tile drainage ! currently only tested & calibrated to work with runoff option=3 - ! 0 -> No tile drainage (default) + ! 0 -> No tile drainage ! 1 -> on (simple scheme) ! 2 -> on (Hooghoudt's scheme) integer :: OptIrrigation ! options for irrigation - ! 0 -> No irrigation (default) + ! 0 -> No irrigation ! 1 -> Irrigation ON ! 2 -> irrigation trigger based on crop season Planting and harvesting dates ! 3 -> irrigation trigger based on LeafAreaIndex threshold integer :: OptIrrigationMethod ! options for irrigation method ! only works when OptIrrigation > 0 - ! 0 -> method based on geo_em fractions (default) + ! 0 -> method based on geo_em fractions ! 1 -> sprinkler method ! 2 -> micro/drip irrigation ! 3 -> surface flooding integer :: OptCropModel ! options for crop model - ! 0 -> No crop model (default) + ! 0 -> No crop model ! 1 -> Liu, et al. 2016 crop scheme integer :: OptSoilProperty ! options for defining soil properties - ! 1 -> use input dominant soil texture (default) + ! 1 -> use input dominant soil texture ! 2 -> use input soil texture that varies with depth ! 3 -> use soil composition (sand, clay, orgm) and pedotransfer function ! 4 -> use input soil properties integer :: OptPedotransfer ! options for pedotransfer functions ! only works when OptSoilProperty = 3 - ! 1 -> Saxton and Rawls (2006) scheme (default) + ! 1 -> Saxton and Rawls (2006) scheme integer :: OptGlacierTreatment ! options for glacier treatment - ! 1 -> include phase change of ice (default) + ! 1 -> include phase change of ice ! 2 -> ice treatment more like original Noah integer :: OptSnowCompaction ! options for ground snow compaction ! 1 -> original scheme from Anderson (1976) ! 2 -> new scheme from Abolafia-Rosenzweig et al. (2024) integer :: OptWetlandModel ! option for wetland model - ! 0 -> No Wetland model (default) + ! 0 -> No Wetland model ! 1 -> Single-point/uniform parameter (Zhang, et al. 2022 WRR) ! 2 -> 2-D regional parameter input (Zhang, et al. 2022 WRR) - end type namelist_type + 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) + integer :: OptSnicarBandNum ! option for SNICAR number of solar bands in RT solver + ! 1 -> 5 bands + ! 2 -> 480 bands (10-nm spectral resolution) + integer :: OptSnicarSolarSpec ! option for SNICAR downward solar spectrum + ! 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 :: OptSnicarSnwOptic ! option for snow optics using different refractive index databases in SNICAR + ! 1 -> Warren (1984) + ! 2 -> Warren and Brandt (2008) + ! 3 -> Picard et al (2016) + integer :: OptSnicarDustOptic ! option for dust optics 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) + logical :: FlagSnicarSnowBCIntmix ! flag to determine SNICAR BC-snow mixing state + ! .false. -> external mixing for all BC + ! .true. -> internal mixing for hydrophilic BC + logical :: FlagSnicarSnowDustIntmix ! flag to determine SNICAR dust-snow mixing state + ! .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) @@ -160,6 +202,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 :: NumTempSnwAgeSnicar ! maxiumum temperature index used in aging lookup table [idx] + integer :: NumTempGradSnwAgeSnicar ! maxiumum temperature gradient index used in aging lookup table [idx] + integer :: NumDensitySnwAgeSnicar ! maxiumum snow density index used in aging lookup table [idx] + integer :: NumSnicarRadBand ! wavelength bands used in SNICAR snow albedo calculation + integer :: NumRadiusSnwMieSnicar ! 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/EnergyVarInitMod.F90 b/src/EnergyVarInitMod.F90 index 16484712..8e2cabd7 100644 --- a/src/EnergyVarInitMod.F90 +++ b/src/EnergyVarInitMod.F90 @@ -22,10 +22,12 @@ subroutine EnergyVarInitDefault(noahmp) type(noahmp_type), intent(inout) :: noahmp - associate( & - NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& - NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& - NumSwRadBand => noahmp%config%domain%NumSwRadBand & + associate( & + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& + NumSnicarRadBand => noahmp%config%domain%NumSnicarRadBand ,& + NumRadiusSnwMieSnicar => noahmp%config%domain%NumRadiusSnwMieSnicar & ) ! energy state variables @@ -213,8 +215,8 @@ subroutine EnergyVarInitDefault(noahmp) noahmp%energy%state%ThermConductGlaIce (:) = undefined_real noahmp%energy%state%AlbedoSnowDir (:) = undefined_real noahmp%energy%state%AlbedoSnowDif (:) = undefined_real - noahmp%energy%state%AlbedoSoilDir (:) = undefined_real - noahmp%energy%state%AlbedoSoilDif (:) = undefined_real + noahmp%energy%state%AlbedoSoilDir (:) = 0.0 + noahmp%energy%state%AlbedoSoilDif (:) = 0.0 noahmp%energy%state%AlbedoGrdDir (:) = undefined_real noahmp%energy%state%AlbedoGrdDif (:) = undefined_real noahmp%energy%state%ReflectanceVeg (:) = undefined_real @@ -222,6 +224,7 @@ subroutine EnergyVarInitDefault(noahmp) noahmp%energy%state%AlbedoSfcDir (:) = undefined_real noahmp%energy%state%AlbedoSfcDif (:) = undefined_real + ! energy flux variables noahmp%energy%flux%HeatLatentCanopy = undefined_real noahmp%energy%flux%HeatLatentTransp = undefined_real @@ -287,7 +290,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 +304,22 @@ subroutine EnergyVarInitDefault(noahmp) noahmp%energy%flux%RadSwDownDir (:) = undefined_real noahmp%energy%flux%RadSwDownDif (:) = undefined_real noahmp%energy%flux%RadSwPenetrateGrd (:) = 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 + endif + + ! energy parameter variables noahmp%energy%param%TreeCrownRadius = undefined_real noahmp%energy%param%HeightCanopyTop = undefined_real @@ -375,8 +393,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 +408,117 @@ 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%param%RadSwWgtDir) ) & + allocate( noahmp%energy%param%RadSwWgtDir(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%RadSwWgtDif) ) & + allocate( noahmp%energy%param%RadSwWgtDif(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbSnwRadDir) ) & + allocate( noahmp%energy%param%SsAlbSnwRadDir(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmSnwRadDir) ) & + allocate( noahmp%energy%param%AsyPrmSnwRadDir(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassSnwRadDir) ) & + allocate( noahmp%energy%param%ExtCffMassSnwRadDir(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbSnwRadDif) ) & + allocate( noahmp%energy%param%SsAlbSnwRadDif(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmSnwRadDif) ) & + allocate( noahmp%energy%param%AsyPrmSnwRadDif(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassSnwRadDif) ) & + allocate( noahmp%energy%param%ExtCffMassSnwRadDif(1:NumRadiusSnwMieSnicar,1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbBCphi) ) & + allocate( noahmp%energy%param%SsAlbBCphi(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmBCphi) ) & + allocate( noahmp%energy%param%AsyPrmBCphi(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassBCphi) ) & + allocate( noahmp%energy%param%ExtCffMassBCphi(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbBCpho) ) & + allocate( noahmp%energy%param%SsAlbBCpho(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmBCpho) ) & + allocate( noahmp%energy%param%AsyPrmBCpho(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassBCpho) ) & + allocate( noahmp%energy%param%ExtCffMassBCpho(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbOCphi) ) & + allocate( noahmp%energy%param%SsAlbOCphi(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmOCphi) ) & + allocate( noahmp%energy%param%AsyPrmOCphi(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassOCphi) ) & + allocate( noahmp%energy%param%ExtCffMassOCphi(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbOCpho) ) & + allocate( noahmp%energy%param%SsAlbOCpho(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmOCpho) ) & + allocate( noahmp%energy%param%AsyPrmOCpho(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassOCpho) ) & + allocate( noahmp%energy%param%ExtCffMassOCpho(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbDustB1) ) & + allocate( noahmp%energy%param%SsAlbDustB1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmDustB1) ) & + allocate( noahmp%energy%param%AsyPrmDustB1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassDustB1) ) & + allocate( noahmp%energy%param%ExtCffMassDustB1(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbDustB2) ) & + allocate( noahmp%energy%param%SsAlbDustB2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmDustB2) ) & + allocate( noahmp%energy%param%AsyPrmDustB2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassDustB2) ) & + allocate( noahmp%energy%param%ExtCffMassDustB2(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbDustB3) ) & + allocate( noahmp%energy%param%SsAlbDustB3(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmDustB3) ) & + allocate( noahmp%energy%param%AsyPrmDustB3(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassDustB3) ) & + allocate( noahmp%energy%param%ExtCffMassDustB3(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbDustB4) ) & + allocate( noahmp%energy%param%SsAlbDustB4(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmDustB4) ) & + allocate( noahmp%energy%param%AsyPrmDustB4(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassDustB4) ) & + allocate( noahmp%energy%param%ExtCffMassDustB4(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%SsAlbDustB5) ) & + allocate( noahmp%energy%param%SsAlbDustB5(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%AsyPrmDustB5) ) & + allocate( noahmp%energy%param%AsyPrmDustB5(1:NumSnicarRadBand) ) + if ( .not. allocated(noahmp%energy%param%ExtCffMassDustB5) ) & + allocate( noahmp%energy%param%ExtCffMassDustB5(1:NumSnicarRadBand) ) + + noahmp%energy%param%RadSwWgtDir (:) = undefined_real + noahmp%energy%param%RadSwWgtDif (:) = undefined_real + noahmp%energy%param%SsAlbSnwRadDir (:,:) = undefined_real + noahmp%energy%param%AsyPrmSnwRadDir (:,:) = undefined_real + noahmp%energy%param%ExtCffMassSnwRadDir (:,:) = undefined_real + noahmp%energy%param%SsAlbSnwRadDif (:,:) = undefined_real + noahmp%energy%param%AsyPrmSnwRadDif (:,:) = undefined_real + noahmp%energy%param%ExtCffMassSnwRadDif (:,:) = undefined_real + noahmp%energy%param%SsAlbBCphi (:) = undefined_real + noahmp%energy%param%AsyPrmBCphi (:) = undefined_real + noahmp%energy%param%ExtCffMassBCphi (:) = undefined_real + noahmp%energy%param%SsAlbBCpho (:) = undefined_real + noahmp%energy%param%AsyPrmBCpho (:) = undefined_real + noahmp%energy%param%ExtCffMassBCpho (:) = undefined_real + noahmp%energy%param%SsAlbOCphi (:) = undefined_real + noahmp%energy%param%AsyPrmOCphi (:) = undefined_real + noahmp%energy%param%ExtCffMassOCphi (:) = undefined_real + noahmp%energy%param%SsAlbOCpho (:) = undefined_real + noahmp%energy%param%AsyPrmOCpho (:) = undefined_real + noahmp%energy%param%ExtCffMassOCpho (:) = undefined_real + noahmp%energy%param%SsAlbDustB1 (:) = undefined_real + noahmp%energy%param%AsyPrmDustB1 (:) = undefined_real + noahmp%energy%param%ExtCffMassDustB1 (:) = undefined_real + noahmp%energy%param%SsAlbDustB2 (:) = undefined_real + noahmp%energy%param%AsyPrmDustB2 (:) = undefined_real + noahmp%energy%param%ExtCffMassDustB2 (:) = undefined_real + noahmp%energy%param%SsAlbDustB3 (:) = undefined_real + noahmp%energy%param%AsyPrmDustB3 (:) = undefined_real + noahmp%energy%param%ExtCffMassDustB3 (:) = undefined_real + noahmp%energy%param%SsAlbDustB4 (:) = undefined_real + noahmp%energy%param%AsyPrmDustB4 (:) = undefined_real + noahmp%energy%param%ExtCffMassDustB4 (:) = undefined_real + noahmp%energy%param%SsAlbDustB5 (:) = undefined_real + noahmp%energy%param%AsyPrmDustB5 (:) = undefined_real + noahmp%energy%param%ExtCffMassDustB5 (:) = undefined_real + endif + end associate end subroutine EnergyVarInitDefault diff --git a/src/EnergyVarType.F90 b/src/EnergyVarType.F90 index 0805d303..efb26168 100644 --- a/src/EnergyVarType.F90 +++ b/src/EnergyVarType.F90 @@ -55,19 +55,23 @@ module EnergyVarType real(kind=kind_noahmp) :: RadLwNetVegGrd ! vegetated ground net longwave radiation [W/m2] (+ to atm) real(kind=kind_noahmp) :: RadLwNetBareGrd ! bare ground net longwave rad [W/m2] (+ to atm) - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsVegDir ! solar flux absorbed by veg per unit direct flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsVegDif ! solar flux absorbed by veg per unit diffuse flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDirTranGrdDir ! transmitted direct flux below veg per unit direct flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDirTranGrdDif ! transmitted direct flux below veg per unit diffuse flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDifTranGrdDir ! transmitted diffuse flux below veg per unit direct flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDifTranGrdDif ! transmitted diffuse flux below veg per unit diffuse flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflVegDir ! solar flux reflected by veg layer per unit direct flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflVegDif ! solar flux reflected by veg layer per unit diffuse flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflGrdDir ! solar flux reflected by ground per unit direct flux - real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflGrdDif ! solar flux reflected by ground per unit diffuse flux - 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(:) :: RadSwAbsVegDir ! solar flux absorbed by veg per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsVegDif ! solar flux absorbed by veg per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDirTranGrdDir ! transmitted direct flux below veg per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDirTranGrdDif ! transmitted direct flux below veg per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDifTranGrdDir ! transmitted diffuse flux below veg per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDifTranGrdDif ! transmitted diffuse flux below veg per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflVegDir ! solar flux reflected by veg layer per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflVegDif ! solar flux reflected by veg layer per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflGrdDir ! solar flux reflected by ground per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflGrdDif ! solar flux reflected by ground per unit diffuse flux + 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 spectral solar flux absorbed by snow layer [frc] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDif ! diffuse spectral solar flux absorbed by snow layer [frc] + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsSnowSoilLayer ! solar flux absorbed by snow/soil for each layer [W/m2] + end type flux_type @@ -280,19 +284,54 @@ module EnergyVarType real(kind=kind_noahmp) :: VegFracAnnMax ! annual maximum vegetation fraction real(kind=kind_noahmp) :: HeatCapacCanFac ! canopy biomass heat capacity parameter [m] - real(kind=kind_noahmp), allocatable, dimension(:) :: LeafAreaIndexMon ! monthly leaf area index, one-sided - real(kind=kind_noahmp), allocatable, dimension(:) :: StemAreaIndexMon ! monthly stem area index, one-sided - real(kind=kind_noahmp), allocatable, dimension(:) :: SoilQuartzFrac ! soil quartz content - real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSoilSat ! saturated soil albedos: 1=vis, 2=nir - real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSoilDry ! dry soil albedos: 1=vis, 2=nir - real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoLakeFrz ! albedo frozen lakes: 1=vis, 2=nir - real(kind=kind_noahmp), allocatable, dimension(:) :: ScatterCoeffSnow ! Scattering coefficient for snow - real(kind=kind_noahmp), allocatable, dimension(:) :: ReflectanceLeaf ! leaf reflectance: 1=vis, 2=nir - real(kind=kind_noahmp), allocatable, dimension(:) :: ReflectanceStem ! stem reflectance: 1=vis, 2=nir - real(kind=kind_noahmp), allocatable, dimension(:) :: TransmittanceLeaf ! leaf transmittance: 1=vis, 2=nir - 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(:) :: LeafAreaIndexMon ! monthly leaf area index, one-sided + real(kind=kind_noahmp), allocatable, dimension(:) :: StemAreaIndexMon ! monthly stem area index, one-sided + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilQuartzFrac ! soil quartz content + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSoilSat ! saturated soil albedos: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSoilDry ! dry soil albedos: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoLakeFrz ! albedo frozen lakes: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: ScatterCoeffSnow ! Scattering coefficient for snow + real(kind=kind_noahmp), allocatable, dimension(:) :: ReflectanceLeaf ! leaf reflectance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: ReflectanceStem ! stem reflectance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: TransmittanceLeaf ! leaf transmittance: 1=vis, 2=nir + 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(:) :: RadSwWgtDir ! downward solar radiation spectral weights (direct) + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwWgtDif ! downward solar radiation spectral weights (diffuse) + real(kind=kind_noahmp), allocatable, dimension(:,:) :: SsAlbSnwRadDir ! Mie single scatter albedos for direct-beam ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: AsyPrmSnwRadDir ! asymmetry parameter of direct-beam ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ExtCffMassSnwRadDir ! mass extinction coefficient for direct-beam ice [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: SsAlbSnwRadDif ! Mie single scatter albedos for diffuse ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: AsyPrmSnwRadDif ! asymmetry parameter of diffuse ice + real(kind=kind_noahmp), allocatable, dimension(:,:) :: ExtCffMassSnwRadDif ! mass extinction coefficient for diffuse ice [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbBCphi ! Mie single scatter albedos for hydrophillic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmBCphi ! asymmetry parameter for hydrophillic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassBCphi ! mass extinction coefficient for hydrophillic BC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbBCpho ! Mie single scatter albedos for hydrophobic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmBCpho ! asymmetry parameter for hydrophobic BC + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassBCpho ! mass extinction coefficient for hydrophobic BC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbOCphi ! Mie single scatter albedos for hydrophillic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmOCphi ! asymmetry parameter for hydrophillic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassOCphi ! mass extinction coefficient for hydrophillic OC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbOCpho ! Mie single scatter albedos for hydrophobic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmOCpho ! asymmetry parameter for hydrophobic OC + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassOCpho ! mass extinction coefficient for hydrophobic OC [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbDustB1 ! Mie single scatter albedos for dust species 1 + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmDustB1 ! asymmetry parameter for dust species 1 + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassDustB1 ! mass extinction coefficient for dust species 1 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbDustB2 ! Mie single scatter albedos for dust species 2 + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmDustB2 ! asymmetry parameter for dust species 2 + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassDustB2 ! mass extinction coefficient for dust species 3 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbDustB3 ! Mie single scatter albedos for dust species 3 + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmDustB3 ! asymmetry parameter for dust species 3 + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassDustB3 ! mass extinction coefficient for dust species 3 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbDustB4 ! Mie single scatter albedos for dust species 4 + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmDustB4 ! asymmetry parameter for dust species 4 + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassDustB4 ! mass extinction coefficient for dust species 4 [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: SsAlbDustB5 ! Mie single scatter albedos for dust species 5 + real(kind=kind_noahmp), allocatable, dimension(:) :: AsyPrmDustB5 ! asymmetry parameter for dust species 5 + real(kind=kind_noahmp), allocatable, dimension(:) :: ExtCffMassDustB5 ! 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..17e7bf66 100644 --- a/src/ForcingVarInitMod.F90 +++ b/src/ForcingVarInitMod.F90 @@ -38,6 +38,18 @@ 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%RadSwVisFrac = undefined_real + noahmp%forcing%RadSwDirFrac = undefined_real + end subroutine ForcingVarInitDefault end module ForcingVarInitMod diff --git a/src/ForcingVarType.F90 b/src/ForcingVarType.F90 index a88aa316..9c00e1e5 100644 --- a/src/ForcingVarType.F90 +++ b/src/ForcingVarType.F90 @@ -31,6 +31,17 @@ 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 flux [kg m-2 s-1] + real(kind=kind_noahmp) :: DepBChydrophi ! hydrophillic Black Carbon deposition flux [kg m-2 s-1] + real(kind=kind_noahmp) :: DepOChydropho ! hydrophobic Organic Carbon deposition flux [kg m-2 s-1] + real(kind=kind_noahmp) :: DepOChydrophi ! hydrophillic Organic Carbon deposition flux [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust1 ! dust species 1 deposition flux [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust2 ! dust species 2 deposition flux [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust3 ! dust species 3 deposition flux [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust4 ! dust species 4 deposition flux [kg m-2 s-1] + real(kind=kind_noahmp) :: DepDust5 ! dust species 4 deposition flux [kg m-2 s-1] + real(kind=kind_noahmp) :: RadSwVisFrac ! fraction of visible band radiation + real(kind=kind_noahmp) :: RadSwDirFrac ! fraction of direct raidation end type forcing_type diff --git a/src/GlacierTemperatureMainMod.F90 b/src/GlacierTemperatureMainMod.F90 index 80938077..36bf817f 100644 --- a/src/GlacierTemperatureMainMod.F90 +++ b/src/GlacierTemperatureMainMod.F90 @@ -29,6 +29,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 @@ -41,7 +42,10 @@ subroutine GlacierTemperatureMain(noahmp) 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 + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo 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] ) @@ -57,8 +61,18 @@ subroutine GlacierTemperatureMain(noahmp) MatLeft2(:) = 0.0 MatLeft3(:) = 0.0 - ! compute solar penetration through water, needs more work - RadSwPenetrateGrd(NumSnowLayerNeg+1:NumSoilLayer) = 0.0 + ! compute solar penetration through snowpack and glacier ice + RadSwPenetrateGrd(-NumSnowLayerMax+1:NumSoilLayer) = 0.0 + + if (OptSnowAlbedo == 3 .and. NumSnowLayerNeg < 0 .and. sum(RadSwAbsSnowSoilLayer) > 0.0) 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/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 da2d8569..709bff8a 100644 --- a/src/Makefile +++ b/src/Makefile @@ -69,9 +69,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 \ @@ -142,7 +148,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: @@ -215,7 +221,8 @@ 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 SnowpackCompactionAR24Mod.o + SnowLayerCombineMod.o SnowpackHydrologyMod.o SnowpackCompactionAR24Mod.o \ + SnowAerosolSnicarMod.o SoilHydraulicPropertyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SoilMoistureSolverMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ MatrixSolverTriDiagonalMod.o @@ -258,12 +265,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 \ @@ -320,7 +336,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 \ @@ -347,10 +363,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 SnowpackCompactionAR24Mod.o + SnowpackHydrologyGlacierMod.o SnowpackCompactionAR24Mod.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/SnowAerosolSnicarMod.F90 b/src/SnowAerosolSnicarMod.F90 new file mode 100644 index 00000000..398cfbfe --- /dev/null +++ b/src/SnowAerosolSnicarMod.F90 @@ -0,0 +1,366 @@ +module SnowAerosolSnicarMod + +!!! compute aerosol content in snow and its evolution prepared for SNICAR snow albedo calculation + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowAerosolSnicar(noahmp) + +! --------------------------------- Code history ----------------------------------- +! Implementation: T.-S. Lin, C. He, et al. (2025, JHM) +! Adapted from CTSM, AerosolFluxes, AerosolMasses, CalcAndApplyAerosolFluxes modules +! ---------------------------------------------------------------------------------- + + 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) :: 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) + 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] + ScavEffMeltScale => noahmp%water%param%ScavEffMeltScale ,& ! in, Scaling factor modifying scavenging factors for aerosol in meltwater (-) + ScavEffMeltBCphi => noahmp%water%param%ScavEffMeltBCphi ,& ! in, scavenging factor for hydrophillic BC inclusion in meltwater [frc] + ScavEffMeltBCpho => noahmp%water%param%ScavEffMeltBCpho ,& ! in, scavenging factor for hydrophobic BC inclusion in meltwater [frc] + ScavEffMeltOCphi => noahmp%water%param%ScavEffMeltOCphi ,& ! in, scavenging factor for hydrophillic OC inclusion in meltwater [frc] + ScavEffMeltOCpho => noahmp%water%param%ScavEffMeltOCpho ,& ! in, scavenging factor for hydrophobic OC inclusion in meltwater [frc] + ScavEffMeltDust1 => noahmp%water%param%ScavEffMeltDust1 ,& ! in, scavenging factor for dust species 1 inclusion in meltwater [frc] + ScavEffMeltDust2 => noahmp%water%param%ScavEffMeltDust2 ,& ! in, scavenging factor for dust species 2 inclusion in meltwater [frc] + ScavEffMeltDust3 => noahmp%water%param%ScavEffMeltDust3 ,& ! in, scavenging factor for dust species 3 inclusion in meltwater [frc] + ScavEffMeltDust4 => noahmp%water%param%ScavEffMeltDust4 ,& ! in, scavenging factor for dust species 4 inclusion in meltwater [frc] + ScavEffMeltDust5 => noahmp%water%param%ScavEffMeltDust5 ,& ! in, scavenging factor for dust species 5 inclusion in meltwater [frc] + 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] + OutflowSnowLayer => noahmp%water%flux%OutflowSnowLayer ,& ! in, water flow out of each snow layer [mm/s] + 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] + ) +! ---------------------------------------------------------------------- + + ! initialize + 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 + FluxOutBChydropho = 0.0 + FluxOutBChydrophi = 0.0 + FluxOutOChydropho = 0.0 + FluxOutOChydrophi = 0.0 + FluxOutDust1 = 0.0 + FluxOutDust2 = 0.0 + FluxOutDust3 = 0.0 + FluxOutDust4 = 0.0 + FluxOutDust5 = 0.0 + + ! compute aerosol mass in snow for each layer from interlayer flux + do LoopInd = -NumSnowLayerMax+1, 0 + + SnowMass = SnowLiqWater(LoopInd) + SnowIce(LoopInd) + + if (LoopInd >= NumSnowLayerNeg+1 .and. SnowMass > 0.0) 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) * ScavEffMeltScale * & + ScavEffMeltBCpho * (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) * ScavEffMeltScale * & + ScavEffMeltBCphi * (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) * ScavEffMeltScale * & + ScavEffMeltOCpho * (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) * ScavEffMeltScale * & + ScavEffMeltOCphi * (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) * ScavEffMeltScale * & + ScavEffMeltDust1 * (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) * ScavEffMeltScale * & + ScavEffMeltDust2 * (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) * ScavEffMeltScale * & + ScavEffMeltDust3 * (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) * ScavEffMeltScale * & + ScavEffMeltDust4 * (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) * ScavEffMeltScale * & + ScavEffMeltDust5 * (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 + + else ! SnowMass <=0 or non-existence snow layer + + 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 + 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 + FluxOutBChydropho = 0.0 + FluxOutBChydrophi = 0.0 + FluxOutOChydropho = 0.0 + FluxOutOChydrophi = 0.0 + FluxOutDust1 = 0.0 + FluxOutDust2 = 0.0 + FluxOutDust3 = 0.0 + FluxOutDust4 = 0.0 + FluxOutDust5 = 0.0 + + endif + enddo + + ! update aerosol mass for the top snow layer from atmos deposition flux + 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 + + ! update aerosol mass concentration in snow for each layer + 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 + + ! special treatment for very shallow snowpack (NumSnowLayerNeg = 0 and SnowMass > 0.0) + if ( NumSnowLayerNeg == 0 ) then + + SnowMass = SnowWaterEquiv + + if ( SnowMass > 0.1 ) then ! set minimum threshold (0.1 mm SWE) for computing aerosol-snow albedo + MassBChydropho(0) = MassBChydropho (0) + DepBChydropho * MainTimeStep + MassBChydrophi(0) = MassBChydrophi (0) + DepBChydrophi * MainTimeStep + MassOChydropho(0) = MassOChydropho (0) + DepOChydropho * MainTimeStep + MassOChydrophi(0) = MassOChydrophi (0) + DepOChydrophi * MainTimeStep + MassDust1(0) = MassDust1 (0) + DepDust1 * MainTimeStep + MassDust2(0) = MassDust2 (0) + DepDust2 * MainTimeStep + MassDust3(0) = MassDust3 (0) + DepDust3 * MainTimeStep + MassDust4(0) = MassDust4 (0) + DepDust4 * MainTimeStep + MassDust5(0) = MassDust5 (0) + DepDust5 * MainTimeStep + MassConcBChydropho(0) = MassBChydropho(0) / SnowMass + MassConcBChydrophi(0) = MassBChydrophi(0) / SnowMass + MassConcOChydropho(0) = MassOChydropho(0) / SnowMass + MassConcOChydrophi(0) = MassOChydrophi(0) / SnowMass + MassConcDust1(0) = MassDust1(0) / SnowMass + MassConcDust2(0) = MassDust2(0) / SnowMass + MassConcDust3(0) = MassDust3(0) / SnowMass + MassConcDust4(0) = MassDust4(0) / SnowMass + MassConcDust5(0) = MassDust5(0) / SnowMass + else + MassBChydropho(0) = 0.0 + MassBChydrophi(0) = 0.0 + MassOChydropho(0) = 0.0 + MassOChydrophi(0) = 0.0 + MassDust1(0) = 0.0 + MassDust2(0) = 0.0 + MassDust3(0) = 0.0 + MassDust4(0) = 0.0 + MassDust5(0) = 0.0 + MassConcBChydropho(0) = 0.0 + MassConcBChydrophi(0) = 0.0 + MassConcOChydropho(0) = 0.0 + MassConcOChydrophi(0) = 0.0 + MassConcDust1(0) = 0.0 + MassConcDust2(0) = 0.0 + MassConcDust3(0) = 0.0 + MassConcDust4(0) = 0.0 + MassConcDust5(0) = 0.0 + endif + + endif + + end associate + + end subroutine SnowAerosolSnicar + +end module SnowAerosolSnicarMod diff --git a/src/SnowAgingSnicarMod.F90 b/src/SnowAgingSnicarMod.F90 new file mode 100644 index 00000000..0fba66ed --- /dev/null +++ b/src/SnowAgingSnicarMod.F90 @@ -0,0 +1,268 @@ +module SnowAgingSnicarMod + +!!! Compute snow effective grain size (radius) based on SNICAR scheme (Flanner et al. (2021) GMD) +!!! Description: SNICAR snow aging process, 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 not well quantified. + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowAgingSnicar(noahmp) + +! ------------------------ Code history ----------------------------------- +! Implementation: T.-S. Lin, C. He, et al. (2025, JHM) +! Adapted from Flanner and Zender (2006) in CTSM, SnowAge_grain module +! ------------------------------------------------------------------------- + + 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 :: IndTempSnwAgeMin = 1 ! minimum temperature index used in aging lookup table [idx] + integer, parameter :: IndTempGradSnwAgeMin = 1 ! minimum temperature gradient index used in aging lookup table [idx] + integer, parameter :: IndDensitySnwAgeMin = 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) :: SnowMassLayer ! 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) :: SnowRadiusChgTot ! incremental change in snow effective radius [um] + real(kind=kind_noahmp) :: SnowRadiusChgWet ! incremental change in snow effective radius from wet growth [um] + real(kind=kind_noahmp) :: SnowRadiusChgFresh ! 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] + NumTempSnwAgeSnicar => noahmp%config%domain%NumTempSnwAgeSnicar ,& ! in, maxiumum temperature index used in aging lookup table [idx] + NumTempGradSnwAgeSnicar => noahmp%config%domain%NumTempGradSnwAgeSnicar ,& ! in, maxiumum temperature gradient index used in aging lookup table [idx] + NumDensitySnwAgeSnicar => noahmp%config%domain%NumDensitySnwAgeSnicar ,& ! in, maxiumum snow density index used in aging lookup table [idx] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + SnowIce => noahmp%water%state%SnowIce ,& ! in, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! in, snow layer liquid water [mm] + 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] + SnowfallGround => noahmp%water%flux%SnowfallGround ,& ! in, snowfall at ground surface [mm/s] + SnowFreezeRate => noahmp%water%flux%SnowFreezeRate ,& ! in, rate of snow freezing [mm/s] + SnowRadiusMin => noahmp%water%param%SnowRadiusMin ,& ! in, minimum allowed snow effective radius (also cold "fresh snow" value) [microns] + SnowRadiusMax => noahmp%water%param%SnowRadiusMax ,& ! in, maximum allowed snow effective radius [microns] + SnowWetAgeC1Brun89 => noahmp%water%param%SnowWetAgeC1Brun89 ,& ! in, constant for liquid water grain growth [m3 s-1], from Brun89 + SnowWetAgeC2Brun89 => noahmp%water%param%SnowWetAgeC2Brun89 ,& ! in, constant for liquid water grain growth [m3 s-1], from Brun89 corrected for LWC + SnowAgeScaleFac => noahmp%water%param%SnowAgeScaleFac ,& ! in, arbitrary tuning/scaling factor applied to snow aging rate (-) + 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] + ) +! ---------------------------------------------------------------------- + + ! initialize + 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 *********** + SnowMassLayer = 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 = SnowMassLayer / ThicknessSnowSoilLayer(LoopInd) + + ! make sure snow density doesn't drop below 50 (see SnowDensityInd below) + SnowDensity = max(50.0, SnowDensity) + + ! best-fit table indices + TemperatureInd = nint((TemperatureSoilSnow(LoopInd)-223.15) / 5) + 1 + TemperatureGradientInd = nint(TemperatureGradient(LoopInd) / 10) + 1 + SnowDensityInd = nint((SnowDensity-50.0) / 50.0) + 1 + + ! boundary check: + if (TemperatureInd < IndTempSnwAgeMin) then + TemperatureInd = IndTempSnwAgeMin + endif + if (TemperatureInd > NumTempSnwAgeSnicar) then + TemperatureInd = NumTempSnwAgeSnicar + endif + if (TemperatureGradientInd < IndTempGradSnwAgeMin) then + TemperatureGradientInd = IndTempGradSnwAgeMin + endif + if (TemperatureGradientInd > NumTempGradSnwAgeSnicar) then + TemperatureGradientInd = NumTempGradSnwAgeSnicar + endif + if (SnowDensityInd < IndDensitySnwAgeMin) then + SnowDensityInd = IndDensitySnwAgeMin + endif + if (SnowDensityInd > NumDensitySnwAgeSnicar) then + SnowDensityInd = NumDensitySnwAgeSnicar + 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) + + ! 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 + if (SnowRadius(LoopInd) < SnowRadiusFresh) then + SnowRadius(LoopInd) = SnowRadiusFresh + endif + + ! change in snow effective radius, using best-fit parameters + SnowRadiusChgFresh = SnowRadius(LoopInd) - SnowRadiusMin + SnowRadiusChgTot = (bst_drdt0 * (bst_tau/(SnowRadiusChgFresh+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 SnowWetAgeC1Brun89 to zero [Brun, 1989] + + ! liquid water faction + FracLiqWater = min(0.1, (SnowLiqWater(LoopInd)/SnowMassLayer)) + SnowRadiusChgWet = 1.0e18 * ( MainTimeStep*(SnowWetAgeC1Brun89 + SnowWetAgeC2Brun89*(FracLiqWater**(3))) / & + (4.0 * ConstPI * SnowRadius(LoopInd)**(2)) ) + SnowRadiusChgTot = SnowRadiusChgTot + SnowRadiusChgWet + + + !********** 3. SNOWAGE SCALING (TUNING OPTION) *********** + ! Multiply rate of change of effective radius by some constant, SnowAgeScaleFac + + SnowRadiusChgTot = SnowRadiusChgTot * SnowAgeScaleFac + + + !********** 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 / SnowMassLayer + + ! fraction of layer mass that is new snow + if (LoopInd == SnowLayerTop) then + FracNewSnow = NewSnow / SnowMassLayer + 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) + SnowRadiusChgTot)*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 ! layer loop + + ! sanity check for snow layer + 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..9300ceb6 --- /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 ----------------------------------- +! Implementation: T.-S. Lin, C. He, et al. (2025, JHM) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: FlagSwRadType ! 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 + + FlagSwRadType = 1 ! Direct + call SnowRadiationSnicar(noahmp,FlagSwRadType) + + FlagSwRadType = 2 ! Diffuse + call SnowRadiationSnicar(noahmp,FlagSwRadType) + + end associate + + end subroutine SnowAlbedoSnicar + +end module SnowAlbedoSnicarMod diff --git a/src/SnowFreshRadiusMod.F90 b/src/SnowFreshRadiusMod.F90 new file mode 100644 index 00000000..d5107657 --- /dev/null +++ b/src/SnowFreshRadiusMod.F90 @@ -0,0 +1,62 @@ +module SnowFreshRadiusMod + +!!! Compute fresh fallen snow grain size for SNICAR albedo calculation +!!! 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. + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowFreshRadius(noahmp) + +! ------------------------ Code history ----------------------------------- +! Implementation: T.-S. Lin, C. He, et al. (2025, JHM) +! Adapted from CTSM function: FreshSnowRadius +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: Tmin ! start of linear ramp + real(kind=kind_noahmp) :: Tmax ! end 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..bb9079cb --- /dev/null +++ b/src/SnowInputSnicarMod.F90 @@ -0,0 +1,4835 @@ +module SnowInputSnicarMod + +!!! read in required SNICAR snow albedo parameter datasets +!!! This module should be called in host model driver but archived here in NoahMP src cold + + 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. (2025, JHM) +! ------------------------------------------------------------------------- + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! local variables + 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 + snicar_optic_flnm => NoahmpIO%snicar_optic_flnm ,& ! in, filename for SNICAR optics parameters + snicar_age_flnm => NoahmpIO%snicar_age_flnm ,& ! in, filename for snow aging parameters + 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] + ) +! ---------------------------------------------------------------------- + +#ifdef _PARALLEL_ + call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr) + if (ierr /= MPI_SUCCESS) stop "MPI_COMM_RANK" +#else + rank = 0 +#endif + + !=================== read in SNICAR snow and aerosol optics parameters ========================= + + ! Open the NetCDF file. + if (rank == 0) write(*,'("Snicar SnowOptics init: ''", A, "''")') trim(snicar_optic_flnm) +#ifdef _PARALLEL_ + ierr = nf90_open_par(snicar_optic_flnm, NF90_NOWRITE, MPI_COMM_WORLD, MPI_INFO_NULL, ncid) +#else + ierr = nf90_open(snicar_optic_flnm, NF90_NOWRITE, ncid) +#endif + if (ierr /= 0) then + write(*,'("read_snicar_data: Problem opening file: ''", A, "''")') trim(snicar_optic_flnm) +#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 ! end of 480-band read in + + ! 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) + + + !=================== read in SNICAR aging parameters ========================= + + ! Open the NetCDF file. + if (rank == 0) write(*,'("Snicar SnowAge init: ''", A, "''")') trim(snicar_age_flnm) +#ifdef _PARALLEL_ + ierr = nf90_open_par(snicar_age_flnm, NF90_NOWRITE, MPI_COMM_WORLD, MPI_INFO_NULL, ncid) +#else + ierr = nf90_open(snicar_age_flnm, NF90_NOWRITE, ncid) +#endif + if (ierr /= 0) then + write(*,'("read_snicar_data: Problem opening file: ''", A, "''")') trim(snicar_age_flnm) +#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..8a0316c1 100644 --- a/src/SnowLayerCombineMod.F90 +++ b/src/SnowLayerCombineMod.F90 @@ -37,21 +37,32 @@ 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] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] 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 + PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow when changing from multilayer to no layer ) ! ---------------------------------------------------------------------- -! check and combine small ice content layer + ! check and combine small ice content layer NumSnowLayerOld = NumSnowLayerNeg do J = NumSnowLayerOld+1,0 @@ -60,11 +71,37 @@ 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 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,10 +119,22 @@ subroutine SnowLayerCombine(noahmp) SnowLiqWater(J) = 0.0 SnowIce(J) = 0.0 ThicknessSnowSoilLayer(J) = 0.0 - endif ! if(NumSnowLayerOld < -1) - !SoilLiqWater(1) = SoilLiqWater(1) + SnowLiqWater(J)/(ThicknessSnowSoilLayer(1)*1000.0) - !SoilIce(1) = SoilIce(1) + SnowIce(J)/(ThicknessSnowSoilLayer(1)*1000.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(NumSnowLayerNeg < -1) endif ! if(J /= 0) ! shift all elements above this down by one. @@ -95,6 +144,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 @@ -102,7 +165,7 @@ subroutine SnowLayerCombine(noahmp) endif ! if(SnowIce(J) <= 0.1) enddo ! do J -! to conserve water in case of too large surface sublimation + ! to conserve water in case of too large surface sublimation if ( SoilIce(1) < 0.0) then SoilLiqWater(1) = SoilLiqWater(1) + SoilIce(1) SoilIce(1) = 0.0 @@ -122,8 +185,8 @@ subroutine SnowLayerCombine(noahmp) SnowLiqTmp = SnowLiqTmp + SnowLiqWater(J) enddo -! check the snow depth - all snow gone, the liquid water assumes ponding on soil surface. - !if ( (SnowDepth < 0.05) .and. (NumSnowLayerNeg < 0) ) then + ! check the snow depth - all snow gone, the liquid water assumes ponding on soil surface. + ! if ( (SnowDepth < 0.05) .and. (NumSnowLayerNeg < 0) ) then if ( (SnowDepth < 0.025) .and. (NumSnowLayerNeg < 0) ) then ! MB: change limit NumSnowLayerNeg = 0 SnowWaterEquiv = SnowIceTmp @@ -131,7 +194,7 @@ subroutine SnowLayerCombine(noahmp) if ( SnowWaterEquiv <= 0.0 ) SnowDepth = 0.0 ! SHOULD BE ZERO; SEE ABOVE endif -! check the snow depth - snow layers combined + ! check the snow depth - snow layers combined if ( NumSnowLayerNeg < -1 ) then NumSnowLayerOld = NumSnowLayerNeg IndLayer = 1 @@ -155,10 +218,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 +244,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..c666148f 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 BC in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassBChydrophiExtra ! extra mass of hydrophillic BC in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassOChydrophoExtra ! extra mass of hydrophobic OC in snow [kg m-2] to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: MassOChydrophiExtra ! extra mass of hydrophillic OC 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( & + 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 ,& ! 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,57 @@ 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 +151,78 @@ 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 +246,29 @@ 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 +279,48 @@ 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 +334,19 @@ 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 +355,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..38b1cc12 --- /dev/null +++ b/src/SnowRadiationSnicarMod.F90 @@ -0,0 +1,1797 @@ +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 + + use Machine + use NoahmpVarType + use ConstantDefineMod + use PiecewiseLinearInterp1dMod + + implicit none + +contains + + subroutine SnowRadiationSnicar(noahmp,FlagSwRadType) + +! ------------------------ Code history ----------------------------------- +! Implementation: T.-S. Lin, C. He, et al. (2025, JHM) +! Adapted from SNICAR module SNICAR_RT from CTSM +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + integer, intent(in) :: FlagSwRadType ! flag: =1 for direct-beam incident flux,=2 for diffuse incident flux + +! local variables + ! general 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 + + ! local constant 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 + + ! local 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 + + ! local 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 + + ! local 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: 1=sphere; 2=spheroid; 3=hexagonal plate; 4=koch snowflake + OptSnicarRTSolver => noahmp%config%nmlist%OptSnicarRTSolver ,& ! in, SNICAR radiative transfer solver + FlagSnicarSnowBCIntmix => noahmp%config%nmlist%FlagSnicarSnowBCIntmix ,& ! in, flag to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC) + FlagSnicarSnowDustIntmix => noahmp%config%nmlist%FlagSnicarSnowDustIntmix ,& ! in, flag to activate dust-snow internal mixing in SNICAR (He et al. 2017 JC) + FlagSnicarUseAerosol => noahmp%config%nmlist%FlagSnicarUseAerosol ,& ! in, flag to turn on/off aerosol deposition flux effect in snow in SNICAR + FlagSnicarUseOC => noahmp%config%nmlist%FlagSnicarUseOC ,& ! in, flag to activate OC in snow in SNICAR + 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 + RadSwWgtDir => noahmp%energy%param%RadSwWgtDir ,& ! in, downward solar radiation spectral weights (direct) + RadSwWgtDif => noahmp%energy%param%RadSwWgtDif ,& ! in, downward solar radiation spectral weights (diffuse) + SsAlbSnwRadDir => noahmp%energy%param%SsAlbSnwRadDir ,& ! in, Mie single scatter albedos for direct-beam ice + AsyPrmSnwRadDir => noahmp%energy%param%AsyPrmSnwRadDir ,& ! in, asymmetry parameter of direct-beam ice + ExtCffMassSnwRadDir => noahmp%energy%param%ExtCffMassSnwRadDir ,& ! in, mass extinction coefficient for direct-beam ice [m2/kg] + SsAlbSnwRadDif => noahmp%energy%param%SsAlbSnwRadDif ,& ! in, Mie single scatter albedos for diffuse ice + AsyPrmSnwRadDif => noahmp%energy%param%AsyPrmSnwRadDif ,& ! in, asymmetry parameter of diffuse ice + ExtCffMassSnwRadDif => noahmp%energy%param%ExtCffMassSnwRadDif ,& ! in, mass extinction coefficient for diffuse ice [m2/kg] + SsAlbBCphi => noahmp%energy%param%SsAlbBCphi ,& ! in, Mie single scatter albedos for hydrophillic BC + AsyPrmBCphi => noahmp%energy%param%AsyPrmBCphi ,& ! in, asymmetry parameter for hydrophillic BC + ExtCffMassBCphi => noahmp%energy%param%ExtCffMassBCphi ,& ! in, mass extinction coefficient for hydrophillic BC [m2/kg] + SsAlbBCpho => noahmp%energy%param%SsAlbBCpho ,& ! in, Mie single scatter albedos for hydrophobic BC + AsyPrmBCpho => noahmp%energy%param%AsyPrmBCpho ,& ! in, asymmetry parameter for hydrophobic BC + ExtCffMassBCpho => noahmp%energy%param%ExtCffMassBCpho ,& ! in, mass extinction coefficient for hydrophobic BC [m2/kg] + SsAlbOCphi => noahmp%energy%param%SsAlbOCphi ,& ! in, Mie single scatter albedos for hydrophillic OC + AsyPrmOCphi => noahmp%energy%param%AsyPrmOCphi ,& ! in, asymmetry parameter for hydrophillic OC + ExtCffMassOCphi => noahmp%energy%param%ExtCffMassOCphi ,& ! in, mass extinction coefficient for hydrophillic OC [m2/kg] + SsAlbOCpho => noahmp%energy%param%SsAlbOCpho ,& ! in, Mie single scatter albedos for hydrophobic OC + AsyPrmOCpho => noahmp%energy%param%AsyPrmOCpho ,& ! in, asymmetry parameter for hydrophobic OC + ExtCffMassOCpho => noahmp%energy%param%ExtCffMassOCpho ,& ! in, mass extinction coefficient for hydrophobic OC [m2/kg] + SsAlbDustB1 => noahmp%energy%param%SsAlbDustB1 ,& ! in, Mie single scatter albedos for dust species 1 + AsyPrmDustB1 => noahmp%energy%param%AsyPrmDustB1 ,& ! in, asymmetry parameter for dust species 1 + ExtCffMassDustB1 => noahmp%energy%param%ExtCffMassDustB1 ,& ! in, mass extinction coefficient for dust species 1 [m2/kg] + SsAlbDustB2 => noahmp%energy%param%SsAlbDustB2 ,& ! in, Mie single scatter albedos for dust species 2 + AsyPrmDustB2 => noahmp%energy%param%AsyPrmDustB2 ,& ! in, asymmetry parameter for dust species 2 + ExtCffMassDustB2 => noahmp%energy%param%ExtCffMassDustB2 ,& ! in, mass extinction coefficient for dust species 2 [m2/kg] + SsAlbDustB3 => noahmp%energy%param%SsAlbDustB3 ,& ! in, Mie single scatter albedos for dust species 3 + AsyPrmDustB3 => noahmp%energy%param%AsyPrmDustB3 ,& ! in, asymmetry parameter for dust species 3 + ExtCffMassDustB3 => noahmp%energy%param%ExtCffMassDustB3 ,& ! in, mass extinction coefficient for dust species 3 [m2/kg] + SsAlbDustB4 => noahmp%energy%param%SsAlbDustB4 ,& ! in, Mie single scatter albedos for dust species 4 + AsyPrmDustB4 => noahmp%energy%param%AsyPrmDustB4 ,& ! in, asymmetry parameter for dust species 4 + ExtCffMassDustB4 => noahmp%energy%param%ExtCffMassDustB4 ,& ! in, mass extinction coefficient for dust species 4 [m2/kg] + SsAlbDustB5 => noahmp%energy%param%SsAlbDustB5 ,& ! in, Mie single scatter albedos for dust species 5 + AsyPrmDustB5 => noahmp%energy%param%AsyPrmDustB5 ,& ! in, asymmetry parameter for dust species 5 + ExtCffMassDustB5 => noahmp%energy%param%ExtCffMassDustB5 ,& ! 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] + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif & ! out, diffuse solar flux factor absorbed by snow [frc] + ) +! ---------------------------------------------------------------------- + + ! 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)) + + ! determin band start and end index + if (NumSnicarRadBand == 5) nir_bnd_bgn = 2 + if (NumSnicarRadBand == 480) nir_bnd_bgn = 51 + nir_bnd_end = NumSnicarRadBand + + ! initialize for adding-doubling solver parameter + 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 SWE (mm) threshold for precision + if (NumSnicarRadBand == 480) then + SnowWaterEquivMin = 1.0e-1 + elseif (NumSnicarRadBand == 5) then + SnowWaterEquivMin = 1.0e-2 + 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 (FlagSwRadType == 1) then + albsfc_lcl(1:(nir_bnd_bgn-1)) = AlbedoSoilDir(1) + albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = AlbedoSoilDir(2) + elseif (FlagSwRadType == 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 "ERROR in SNICAR grain size" + 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 (FlagSwRadType == 1) then + flx_wgt(1) = 1.0 + flx_wgt(2) = 0.66628670195247 + flx_wgt(3) = 0.33371329804753 + ! Diffuse: + elseif (FlagSwRadType == 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 (FlagSwRadType == 1) then + flx_wgt(1:NumSnicarRadBand) = RadSwWgtDir(1:NumSnicarRadBand) ! VIS or NIR band sum is already normalized to 1.0 in input data + ! Diffuse: + elseif (FlagSwRadType == 2) then + flx_wgt(1:NumSnicarRadBand) = RadSwWgtDif(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 (FlagSwRadType == 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 (FlagSwRadType == 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) = SsAlbSnwRadDir(rds_idx,LoopInd) + ext_cff_mss_snw_lcl(i) = ExtCffMassSnwRadDir(rds_idx,LoopInd) + if (sno_shp(i) == 1) asm_prm_snw_lcl(i) = AsyPrmSnwRadDir(rds_idx,LoopInd) + enddo + elseif (FlagSwRadType == 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) = SsAlbSnwRadDif(rds_idx,LoopInd) + ext_cff_mss_snw_lcl(i) = ExtCffMassSnwRadDif(rds_idx,LoopInd) + if (sno_shp(i) == 1) asm_prm_snw_lcl(i) = AsyPrmSnwRadDif(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) = SsAlbBCpho(LoopInd) + asm_prm_aer_lcl(2) = AsyPrmBCpho(LoopInd) + ext_cff_mss_aer_lcl(2) = ExtCffMassBCpho(LoopInd) + + ! aerosol species 3 optical properties, hydrophilic OC + ss_alb_aer_lcl(3) = SsAlbOCphi(LoopInd) + asm_prm_aer_lcl(3) = AsyPrmOCphi(LoopInd) + ext_cff_mss_aer_lcl(3) = ExtCffMassOCphi(LoopInd) + + ! aerosol species 4 optical properties, hydrophobic OC + ss_alb_aer_lcl(4) = SsAlbOCpho(LoopInd) + asm_prm_aer_lcl(4) = AsyPrmOCpho(LoopInd) + ext_cff_mss_aer_lcl(4) = ExtCffMassOCpho(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) = SsAlbBCphi(LoopInd) + asm_prm_aer_lcl(1) = AsyPrmBCphi(LoopInd) + ext_cff_mss_aer_lcl(1) = ExtCffMassBCphi(LoopInd) + ! aerosol species 5 optical properties, dust size1 + ss_alb_aer_lcl(5) = SsAlbDustB1(LoopInd) + asm_prm_aer_lcl(5) = AsyPrmDustB1(LoopInd) + ext_cff_mss_aer_lcl(5) = ExtCffMassDustB1(LoopInd) + ! aerosol species 6 optical properties, dust size2 + ss_alb_aer_lcl(6) = SsAlbDustB2(LoopInd) + asm_prm_aer_lcl(6) = AsyPrmDustB2(LoopInd) + ext_cff_mss_aer_lcl(6) = ExtCffMassDustB2(LoopInd) + ! aerosol species 7 optical properties, dust size3 + ss_alb_aer_lcl(7) = SsAlbDustB3(LoopInd) + asm_prm_aer_lcl(7) = AsyPrmDustB3(LoopInd) + ext_cff_mss_aer_lcl(7) = ExtCffMassDustB3(LoopInd) + ! aerosol species 8 optical properties, dust size4 + ss_alb_aer_lcl(8) = SsAlbDustB4(LoopInd) + asm_prm_aer_lcl(8) = AsyPrmDustB4(LoopInd) + ext_cff_mss_aer_lcl(8) = ExtCffMassDustB4(LoopInd) + ! aerosol species 9 optical properties, dust size5 + ss_alb_aer_lcl(9) = SsAlbDustB5(LoopInd) + asm_prm_aer_lcl(9) = AsyPrmDustB5(LoopInd) + ext_cff_mss_aer_lcl(9) = ExtCffMassDustB5(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 (FlagSwRadType == 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 + 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 (FlagSwRadType == 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 (FlagSwRadType == 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 (FlagSwRadType == 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: OCphi(0)= ", mss_cnc_aer_lcl(0,3) + write(*,*) "SNICAR_AD STATS: OCpho(0)= ", mss_cnc_aer_lcl(0,4) + 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 "ERROR in SNICAR absorption" + 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 "ERROR in SNICAR energy conservation" + 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= ", FlagSwRadType + 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 "ERROR in SNICAR too large albedo" + + endif + + enddo ! loop over all snow spectral bands + + ! Weight output NIR albedo appropriately + ! for 5- and 3-band cases + if (NumSnicarRadBand <= 5) then + if (FlagSwRadType == 1) then + AlbedoSnowDir(1) = albout_lcl(1) + elseif (FlagSwRadType == 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 (FlagSwRadType == 1) then + AlbedoSnowDir(2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + elseif (FlagSwRadType == 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 (FlagSwRadType == 1) then + AlbedoSnowDir(1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + elseif (FlagSwRadType == 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 (FlagSwRadType == 1) then + AlbedoSnowDir(2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + elseif (FlagSwRadType == 2) then + AlbedoSnowDif(2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + endif + + end if + + if (NumSnicarRadBand <= 5) then + if (FlagSwRadType == 1) then + FracRadSwAbsSnowDir(:,1) = flx_abs_lcl(:,1) + elseif (FlagSwRadType == 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 (FlagSwRadType == 1) then + FracRadSwAbsSnowDir(i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + elseif (FlagSwRadType == 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 (FlagSwRadType == 1) then + FracRadSwAbsSnowDir(i,1)=flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + elseif (FlagSwRadType == 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 (FlagSwRadType == 1) then + FracRadSwAbsSnowDir(i,2)=flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + elseif (FlagSwRadType == 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. (FlagSwRadType == 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 (FlagSwRadType == 1) then + AlbedoSnowDir(1) = AlbedoSoilDir(1) + AlbedoSnowDir(2) = AlbedoSoilDir(2) + elseif (FlagSwRadType == 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 (FlagSwRadType == 1) then + AlbedoSnowDir(1) = 0.0 + AlbedoSnowDir(2) = 0.0 + elseif (FlagSwRadType == 2) then + AlbedoSnowDif(1) = 0.0 + AlbedoSnowDif(2) = 0.0 + endif + + endif ! if column has mim snow + + if (FlagSwRadType == 1) then + if (AlbedoSnowDir(1)<0.0 .or. AlbedoSnowDir(2)<0.0 .or. AlbedoSnowDir(1)>1.0 .or. AlbedoSnowDir(2)>1.0)then + print *,'Error in SNICAR direct snow albedo: ',FlagSwRadType,AlbedoSnowDir(1),AlbedoSnowDir(2),CosSolarZenithAngle + stop "Error in SNICAR direct snow albedo" + endif + endif + + if (FlagSwRadType == 2) then + if (AlbedoSnowDif(1)<0.0 .or. AlbedoSnowDif(2)<0.0 .or. AlbedoSnowDif(1)>1.0 .or. AlbedoSnowDif(2)>1.0)then + print *,'Error in SNICAR diffuse snow albedo',FlagSwRadType,AlbedoSnowDif(1),AlbedoSnowDif(2),CosSolarZenithAngle + stop "Error in SNICAR diffuse snow albedo" + endif + endif + + end associate + + end subroutine SnowRadiationSnicar + +end module SnowRadiationSnicarMod diff --git a/src/SnowWaterMainGlacierMod.F90 b/src/SnowWaterMainGlacierMod.F90 index d050ba0b..93efc581 100644 --- a/src/SnowWaterMainGlacierMod.F90 +++ b/src/SnowWaterMainGlacierMod.F90 @@ -12,6 +12,7 @@ module SnowWaterMainGlacierMod use SnowLayerCombineMod, only : SnowLayerCombine use SnowLayerDivideMod, only : SnowLayerDivide use SnowpackHydrologyGlacierMod, only : SnowpackHydrologyGlacier + use SnowAerosolSnicarMod, only : SnowAerosolSnicar implicit none @@ -30,8 +31,9 @@ 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( & @@ -39,26 +41,37 @@ subroutine SnowWaterMainGlacier(noahmp) NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo OptSnowCompaction => noahmp%config%nmlist%OptSnowCompaction ,& ! in, options for ground snowpack compaction SnoWatEqvMaxGlacier => noahmp%water%param%SnoWatEqvMaxGlacier ,& ! in, Maximum SWE allowed at glaciers [mm] ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] DepthSnowSoilLayer => noahmp%config%domain%DepthSnowSoilLayer ,& ! inout, depth of snow/soil layer-bottom [m] NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] 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 + PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow when changing from multilayer to no layer ) ! ---------------------------------------------------------------------- ! 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) @@ -85,6 +98,18 @@ subroutine SnowWaterMainGlacier(noahmp) TemperatureSoilSnow(LoopInd) = 0.0 ThicknessSnowSoilLayer(LoopInd) = 0.0 DepthSnowSoilLayer(LoopInd) = 0.0 + + if ( (OptSnowAlbedo == 3) .and. (NumSnowLayerNeg < 0) ) 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 @@ -94,8 +119,24 @@ 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 2b15fb97..572f074c 100644 --- a/src/SnowWaterMainMod.F90 +++ b/src/SnowWaterMainMod.F90 @@ -12,6 +12,7 @@ module SnowWaterMainMod use SnowLayerCombineMod, only : SnowLayerCombine use SnowLayerDivideMod, only : SnowLayerDivide use SnowpackHydrologyMod, only : SnowpackHydrology + use SnowAerosolSnicarMod, only : SnowAerosolSnicar implicit none @@ -30,8 +31,9 @@ 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( & @@ -39,26 +41,37 @@ subroutine SnowWaterMain(noahmp) NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo OptSnowCompaction => noahmp%config%nmlist%OptSnowCompaction ,& ! in, options for ground snowpack compaction SnoWatEqvMaxGlacier => noahmp%water%param%SnoWatEqvMaxGlacier ,& ! in, Maximum SWE allowed at glaciers [mm] ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] DepthSnowSoilLayer => noahmp%config%domain%DepthSnowSoilLayer ,& ! inout, depth of snow/soil layer-bottom [m] NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] 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 + PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow when changing from multilayer to no layer ) ! ---------------------------------------------------------------------- ! 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) @@ -85,6 +98,18 @@ subroutine SnowWaterMain(noahmp) TemperatureSoilSnow(LoopInd) = 0.0 ThicknessSnowSoilLayer(LoopInd) = 0.0 DepthSnowSoilLayer(LoopInd) = 0.0 + + if ( (OptSnowAlbedo == 3) .and. (NumSnowLayerNeg < 0) ) 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 @@ -94,8 +119,24 @@ 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 diff --git a/src/SnowpackHydrologyGlacierMod.F90 b/src/SnowpackHydrologyGlacierMod.F90 index dc702cea..bfce5175 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..f0f36cc9 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..5f5034cc 100644 --- a/src/SoilSnowTemperatureMainMod.F90 +++ b/src/SoilSnowTemperatureMainMod.F90 @@ -29,6 +29,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 @@ -41,7 +42,10 @@ subroutine SoilSnowTemperatureMain(noahmp) 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 + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo 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] @@ -58,8 +62,18 @@ subroutine SoilSnowTemperatureMain(noahmp) MatLeft2(:) = 0.0 MatLeft3(:) = 0.0 - ! compute solar penetration through water, needs more work - RadSwPenetrateGrd(NumSnowLayerNeg+1:NumSoilLayer) = 0.0 + ! compute solar penetration through snowpack and soil + RadSwPenetrateGrd(-NumSnowLayerMax+1:NumSoilLayer) = 0.0 + + if (OptSnowAlbedo == 3 .and. NumSnowLayerNeg < 0 .and. sum(RadSwAbsSnowSoilLayer) > 0.0) 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..ad2106ac 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..df083dbd 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( & @@ -49,15 +50,16 @@ subroutine SoilWaterInfilSmithParlange(noahmp, IndInfilMax, InfilSfcAcc, InfilSf ! ---------------------------------------------------------------------- ! smith-parlang weighing parameter, Gamma - WeighFac = 0.82 - IndSoil = 1 + WeighFac = 0.82 + IniSoilIce = 0.0 + IndSoil = 1 ! check whether we are estimating infiltration for current SoilMoisture or SoilMoistureWilt if ( IndInfilMax == 1 ) then ! not active for now as the maximum infiltration is estimated based on table values ! 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..1e70287b 100644 --- a/src/SoilWaterSupercoolKoren99Mod.F90 +++ b/src/SoilWaterSupercoolKoren99Mod.F90 @@ -82,10 +82,16 @@ subroutine SoilWaterSupercoolKoren99(noahmp, IndSoil, SoilWatSupercool, & if ( SoilIce < 0.0 ) SoilIce = 0.0 1001 Continue if ( .not. ((NumIter < 10) .and. (IndCnt == 0)) ) goto 1002 - NumIter = NumIter +1 - DF = alog((SoilMatPotentialSat(IndSoil)*ConstGravityAcc/ConstLatHeatFusion) * & - ((1.0 + CK*SoilIce)**2.0) * (SoilMoistureSat(IndSoil)/(SoilMoisture - SoilIce))**SoilExpB) - & - alog(-(SoilTemperature - ConstFreezePoint) / SoilTemperature) + 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 0a534c98..11fae889 100644 --- a/src/SurfaceAlbedoGlacierMod.F90 +++ b/src/SurfaceAlbedoGlacierMod.F90 @@ -9,6 +9,9 @@ module SurfaceAlbedoGlacierMod 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 @@ -39,7 +42,9 @@ 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] + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif & ! out, diffuse solar flux factor absorbed by snow [frc] ) ! ---------------------------------------------------------------------- @@ -51,17 +56,26 @@ subroutine SurfaceAlbedoGlacier(noahmp) AlbedoGrdDif (IndBand) = 0.0 AlbedoSnowDir(IndBand) = 0.0 AlbedoSnowDif(IndBand) = 0.0 + FracRadSwAbsSnowDir(:,IndBand) = 0.0 + FracRadSwAbsSnowDif(:,IndBand) = 0.0 enddo ! snow aging (allow nighttime BATS snow albedo aging) - call SnowAgingBats(noahmp) + if ( OptSnowAlbedo == 1 ) call SnowAgingBats(noahmp) + + ! snow grain size and aging for SNICAR + if ( OptSnowAlbedo == 3 ) then + call SnowFreshRadius(noahmp) + call SnowAgingSnicar(noahmp) + endif ! solar radiation process is only done if there is light if ( CosSolarZenithAngle > 0 ) then ! snow albedo - if ( OptSnowAlbedo == 1 ) call SnowAlbedoBats(noahmp) - if ( OptSnowAlbedo == 2 ) call SnowAlbedoClass(noahmp) + 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 e3462fdd..53cf553a 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 @@ -63,6 +66,8 @@ subroutine SurfaceAlbedo(noahmp) TransmittanceVeg => noahmp%energy%state%TransmittanceVeg ,& ! out, leaf/stem transmittance weighted by fraction LAI and SAI VegAreaIndEff => noahmp%energy%state%VegAreaIndEff ,& ! out, one-sided leaf+stem area index [m2/m2] VegAreaProjDir => noahmp%energy%state%VegAreaProjDir ,& ! out, projected leaf+stem area in solar direction + FracRadSwAbsSnowDir => noahmp%energy%flux%FracRadSwAbsSnowDir ,& ! out, direct solar flux factor absorbed by snow [frc] + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif ,& ! out, diffuse solar flux factor absorbed by snow [frc] RadSwAbsVegDir => noahmp%energy%flux%RadSwAbsVegDir ,& ! out, flux abs by veg (per unit direct flux) RadSwAbsVegDif => noahmp%energy%flux%RadSwAbsVegDif ,& ! out, flux abs by veg (per unit diffuse flux) RadSwDirTranGrdDir => noahmp%energy%flux%RadSwDirTranGrdDir ,& ! out, down direct flux below veg (per unit dir flux) @@ -101,11 +106,19 @@ 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 ! snow aging (allow nighttime BATS snow albedo aging) - call SnowAgingBats(noahmp) + if ( OptSnowAlbedo == 1 ) call SnowAgingBats(noahmp) + + ! snow grain size and aging for SNICAR + if ( OptSnowAlbedo == 3 ) then + call SnowFreshRadius(noahmp) + call SnowAgingSnicar(noahmp) + endif ! solar radiation process is only done if there is light if ( CosSolarZenithAngle > 0 ) then @@ -119,8 +132,9 @@ subroutine SurfaceAlbedo(noahmp) enddo ! snow albedos - if ( OptSnowAlbedo == 1 ) call SnowAlbedoBats(noahmp) - if ( OptSnowAlbedo == 2 ) call SnowAlbedoClass(noahmp) + 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..5bf757d5 100644 --- a/src/SurfaceRadiationGlacierMod.F90 +++ b/src/SurfaceRadiationGlacierMod.F90 @@ -23,20 +23,33 @@ subroutine SurfaceRadiationGlacier(noahmp) type(noahmp_type), intent(inout) :: noahmp ! local variable - integer :: IndBand ! waveband indices (1=vis, 2=nir) - real(kind=kind_noahmp) :: RadSwAbsGrdTmp ! ground absorbed solar radiation [W/m2] - real(kind=kind_noahmp) :: RadSwReflGrdTmp ! ground reflected solar radiation [W/m2] + 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 + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDifMean ! diffuse solar flux factor absorbed by snow [frc] scaling ! ----------------------------------------------------------------- - associate( & - NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands - 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) - 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] + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo + RadSwDownDir => noahmp%energy%flux%RadSwDownDir ,& ! in, incoming direct solar radiation [W/m2] + RadSwDownDif => noahmp%energy%flux%RadSwDownDif ,& ! in, incoming diffuse solar radiation [W/m2] + FracRadSwAbsSnowDir => noahmp%energy%flux%FracRadSwAbsSnowDir ,& ! in, direct solar flux factor absorbed by snow [frc] + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif ,& ! in, diffuse solar flux factor absorbed by snow [frc] + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! in, ground albedo (direct beam: vis, nir) + AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! in, ground albedo (diffuse: vis, nir) + 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) + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + 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] + RadSwAbsSnowSoilLayer => noahmp%energy%flux%RadSwAbsSnowSoilLayer & ! out, total absorbed solar radiation by snow for each layer [W/m2] ) ! ---------------------------------------------------------------------- @@ -44,7 +57,15 @@ subroutine SurfaceRadiationGlacier(noahmp) RadSwAbsGrd = 0.0 RadSwAbsSfc = 0.0 RadSwReflSfc = 0.0 + RadSwAbsSnowSoilLayer(:) = 0.0 + 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)) + FracRadSwAbsSnowDirMean(:,:) = 0.0 + FracRadSwAbsSnowDifMean(:,:) = 0.0 + endif + ! aggretate radiative flux do IndBand = 1, NumSwRadBand ! solar radiation absorbed by glacier surface RadSwAbsGrdTmp = RadSwDownDir(IndBand) * (1.0 - AlbedoGrdDir(IndBand)) + & @@ -56,8 +77,32 @@ 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..364901cc 100644 --- a/src/SurfaceRadiationMod.F90 +++ b/src/SurfaceRadiationMod.F90 @@ -23,55 +23,76 @@ subroutine SurfaceRadiation(noahmp) type(noahmp_type), intent(inout) :: noahmp ! local variable - integer :: IndBand ! waveband indices (1=vis, 2=nir) - 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] - real(kind=kind_noahmp) :: RadSwReflSfcVis ! surface reflected solar radiation VIS [W/m2] - real(kind=kind_noahmp) :: LeafAreaIndFrac ! leaf area fraction of canopy - real(kind=kind_noahmp) :: RadSwTranGrdDir ! transmitted solar radiation at ground: direct [W/m2] - 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] + 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] + real(kind=kind_noahmp) :: RadSwReflSfcVis ! surface reflected solar radiation VIS [W/m2] + real(kind=kind_noahmp) :: LeafAreaIndFrac ! leaf area fraction of canopy + real(kind=kind_noahmp) :: RadSwTranGrdDir ! transmitted solar radiation at ground: direct [W/m2] + 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 + real(kind=kind_noahmp), allocatable, dimension(:,:) :: FracRadSwAbsSnowDifMean ! diffuse solar flux factor absorbed by snow [frc] scaling ! -------------------------------------------------------------------- - associate( & - NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands - 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 - CanopyShadeFrac => noahmp%energy%state%CanopyShadeFrac ,& ! in, shaded fraction of canopy - LeafAreaIndSunlit => noahmp%energy%state%LeafAreaIndSunlit ,& ! in, sunlit leaf area - LeafAreaIndShade => noahmp%energy%state%LeafAreaIndShade ,& ! in, shaded leaf area - RadSwDownDir => noahmp%energy%flux%RadSwDownDir ,& ! in, incoming direct solar radiation [W/m2] - RadSwDownDif => noahmp%energy%flux%RadSwDownDif ,& ! in, incoming diffuse solar radiation [W/m2] - RadSwAbsVegDir => noahmp%energy%flux%RadSwAbsVegDir ,& ! in, flux abs by veg (per unit direct flux) - RadSwAbsVegDif => noahmp%energy%flux%RadSwAbsVegDif ,& ! in, flux abs by veg (per unit diffuse flux) - RadSwDirTranGrdDir => noahmp%energy%flux%RadSwDirTranGrdDir ,& ! in, down direct flux below veg (per unit dir flux) - RadSwDifTranGrdDir => noahmp%energy%flux%RadSwDifTranGrdDir ,& ! in, down diffuse flux below veg (per unit dir flux) - RadSwDifTranGrdDif => noahmp%energy%flux%RadSwDifTranGrdDif ,& ! in, down diffuse flux below veg (per unit dif flux) - AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! in, ground albedo (direct beam: vis, nir) - 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) - 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) - 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] - 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] + 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) + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + 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 + CanopyShadeFrac => noahmp%energy%state%CanopyShadeFrac ,& ! in, shaded fraction of canopy + LeafAreaIndSunlit => noahmp%energy%state%LeafAreaIndSunlit ,& ! in, sunlit leaf area + LeafAreaIndShade => noahmp%energy%state%LeafAreaIndShade ,& ! in, shaded leaf area + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! in, ground albedo (direct beam: vis, nir) + 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) + RadSwDownDir => noahmp%energy%flux%RadSwDownDir ,& ! in, incoming direct solar radiation [W/m2] + RadSwDownDif => noahmp%energy%flux%RadSwDownDif ,& ! in, incoming diffuse solar radiation [W/m2] + RadSwAbsVegDir => noahmp%energy%flux%RadSwAbsVegDir ,& ! in, flux abs by veg (per unit direct flux) + RadSwAbsVegDif => noahmp%energy%flux%RadSwAbsVegDif ,& ! in, flux abs by veg (per unit diffuse flux) + RadSwDirTranGrdDir => noahmp%energy%flux%RadSwDirTranGrdDir ,& ! in, down direct flux below veg (per unit dir flux) + RadSwDifTranGrdDir => noahmp%energy%flux%RadSwDifTranGrdDir ,& ! in, down diffuse flux below veg (per unit dir flux) + RadSwDifTranGrdDif => noahmp%energy%flux%RadSwDifTranGrdDif ,& ! in, down diffuse flux below veg (per unit dif flux) + 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) + FracRadSwAbsSnowDir => noahmp%energy%flux%FracRadSwAbsSnowDir ,& ! in, direct solar flux factor absorbed by snow [frc] + FracRadSwAbsSnowDif => noahmp%energy%flux%FracRadSwAbsSnowDif ,& ! in, diffuse solar flux factor absorbed by snow [frc] + 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] ) ! ---------------------------------------------------------------------- ! initialization 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)) + FracRadSwAbsSnowDirMean(:,:) = 0.0 + FracRadSwAbsSnowDifMean(:,:) = 0.0 + endif + MinThr = 1.0e-6 RadSwAbsCanDir = 0.0 RadSwAbsCanDif = 0.0 @@ -83,7 +104,9 @@ subroutine SurfaceRadiation(noahmp) RadSwReflGrd = 0.0 RadPhotoActAbsSunlit = 0.0 RadPhotoActAbsShade = 0.0 + RadSwAbsSnowSoilLayer(:) = 0.0 + ! aggregate radiative flux do IndBand = 1, NumSwRadBand ! absorbed by canopy RadSwAbsCanDir(IndBand) = RadSwDownDir(IndBand) * RadSwAbsVegDir(IndBand) @@ -94,13 +117,34 @@ 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 + + ! SNICAR snow layer absorption + 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 +174,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 c07122c9..0cf25bcc 100644 --- a/src/WaterVarInitMod.F90 +++ b/src/WaterVarInitMod.F90 @@ -22,9 +22,12 @@ subroutine WaterVarInitDefault(noahmp) type(noahmp_type), intent(inout) :: noahmp - associate( & - NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& - NumSoilLayer => noahmp%config%domain%NumSoilLayer & + associate( & + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + NumDensitySnwAgeSnicar => noahmp%config%domain%NumDensitySnwAgeSnicar ,& + NumTempGradSnwAgeSnicar => noahmp%config%domain%NumTempGradSnwAgeSnicar ,& + NumTempSnwAgeSnicar => noahmp%config%domain%NumTempSnwAgeSnicar & ) ! water state variables @@ -139,6 +142,69 @@ subroutine WaterVarInitDefault(noahmp) noahmp%water%state%SoilTranspFac (:) = undefined_real noahmp%water%state%SoilMatPotential (:) = 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 + endif + ! water flux variables noahmp%water%flux%PrecipTotRefHeight = undefined_real noahmp%water%flux%RainfallRefHeight = undefined_real @@ -209,8 +275,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 @@ -219,6 +287,15 @@ 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 + + ! SNICAR + if ( noahmp%config%nmlist%OptSnowAlbedo == 3 )then + if ( .not. allocated(noahmp%water%flux%SnowFreezeRate) ) & + allocate( noahmp%water%flux%SnowFreezeRate(-NumSnowLayerMax+1:0) ) + + noahmp%water%flux%SnowFreezeRate(:) = undefined_real + endif ! water parameter variables noahmp%water%param%DrainSoilLayerInd = undefined_int @@ -312,6 +389,37 @@ 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%param%snowage_tau) ) & + allocate( noahmp%water%param%snowage_tau(NumDensitySnwAgeSnicar,NumTempGradSnwAgeSnicar,NumTempSnwAgeSnicar) ) + if ( .not. allocated(noahmp%water%param%snowage_kappa) ) & + allocate( noahmp%water%param%snowage_kappa(NumDensitySnwAgeSnicar,NumTempGradSnwAgeSnicar,NumTempSnwAgeSnicar) ) + if ( .not. allocated(noahmp%water%param%snowage_drdt0) ) & + allocate( noahmp%water%param%snowage_drdt0(NumDensitySnwAgeSnicar,NumTempGradSnwAgeSnicar,NumTempSnwAgeSnicar) ) + + 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 + noahmp%water%param%ScavEffMeltScale = undefined_real + noahmp%water%param%ScavEffMeltBCphi = undefined_real + noahmp%water%param%ScavEffMeltBCpho = undefined_real + noahmp%water%param%ScavEffMeltOCphi = undefined_real + noahmp%water%param%ScavEffMeltOCpho = undefined_real + noahmp%water%param%ScavEffMeltDust1 = undefined_real + noahmp%water%param%ScavEffMeltDust2 = undefined_real + noahmp%water%param%ScavEffMeltDust3 = undefined_real + noahmp%water%param%ScavEffMeltDust4 = undefined_real + noahmp%water%param%ScavEffMeltDust5 = undefined_real + noahmp%water%param%SnowRadiusMax = undefined_real + noahmp%water%param%SnowWetAgeC1Brun89 = undefined_real + noahmp%water%param%SnowWetAgeC2Brun89 = undefined_real + noahmp%water%param%SnowAgeScaleFac = undefined_real + endif + end associate end subroutine WaterVarInitDefault diff --git a/src/WaterVarType.F90 b/src/WaterVarType.F90 index b23d7966..7e7d6bdc 100644 --- a/src/WaterVarType.F90 +++ b/src/WaterVarType.F90 @@ -81,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 @@ -136,6 +138,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] @@ -157,6 +160,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 @@ -199,7 +221,7 @@ module WaterVarType real(kind=kind_noahmp) :: TileDrainCoeffSp ! drainage coefficient [mm d^-1] for simple scheme real(kind=kind_noahmp) :: DrainFacSoilWat ! drainage factor for soil moisture real(kind=kind_noahmp) :: TileDrainCoeff ! drainage coefficent [m d^-1] for Hooghoudt scheme - real(kind=kind_noahmp) :: DrainDepthToImperv ! Actual depth of tile drainage to impermeable layer form surface + real(kind=kind_noahmp) :: DrainDepthToImperv ! actual depth of tile drainage to impermeable layer form surface real(kind=kind_noahmp) :: LateralWatCondFac ! multiplication factor to determine lateral hydraulic conductivity real(kind=kind_noahmp) :: TileDrainDepth ! Depth of drain [m] for Hooghoudt scheme real(kind=kind_noahmp) :: DrainTubeDist ! distance between two drain tubes or tiles [m] @@ -213,9 +235,9 @@ module WaterVarType real(kind=kind_noahmp) :: MicroPoreContent ! microprore content (0.0-1.0), 0.0: close to free drainage real(kind=kind_noahmp) :: WaterStorageLakeMax ! maximum lake water storage [mm] real(kind=kind_noahmp) :: SnoWatEqvMaxGlacier ! Maximum SWE allowed at glaciers [mm] - real(kind=kind_noahmp) :: SoilConductivityRef ! Reference Soil Conductivity parameter (used in runoff formulation) - real(kind=kind_noahmp) :: SoilInfilFacRef ! Reference Soil Infiltration Parameter (used in runoff formulation) - real(kind=kind_noahmp) :: GroundFrzCoeff ! Frozen ground parameter to compute frozen soil impervious fraction + real(kind=kind_noahmp) :: SoilConductivityRef ! reference Soil Conductivity parameter (used in runoff formulation) + real(kind=kind_noahmp) :: SoilInfilFacRef ! reference Soil Infiltration Parameter (used in runoff formulation) + real(kind=kind_noahmp) :: GroundFrzCoeff ! frozen ground parameter to compute frozen soil impervious fraction real(kind=kind_noahmp) :: IrriTriggerLaiMin ! minimum lai to trigger irrigation real(kind=kind_noahmp) :: SoilWatDeficitAllow ! management allowable deficit (0-1) real(kind=kind_noahmp) :: IrriFloodLossFrac ! factor of flood irrigation loss @@ -228,15 +250,35 @@ module WaterVarType 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) :: WetlandCapMax ! maximum wetland capacity [m] + 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) :: ScavEffMeltScale ! Scaling factor modifying scavenging factors for aerosol in meltwater (-) + real(kind=kind_noahmp) :: ScavEffMeltBCphi ! scavenging factor for hydrophillic BC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltBCpho ! scavenging factor for hydrophobic BC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltOCphi ! scavenging factor for hydrophillic OC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltOCpho ! scavenging factor for hydrophobic OC inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust1 ! scavenging factor for dust species 1 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust2 ! scavenging factor for dust species 2 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust3 ! scavenging factor for dust species 3 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust4 ! scavenging factor for dust species 4 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: ScavEffMeltDust5 ! scavenging factor for dust species 5 inclusion in meltwater [frc] + real(kind=kind_noahmp) :: SnowRadiusMax ! maximum allowed snow effective radius [microns] + real(kind=kind_noahmp) :: SnowWetAgeC1Brun89 ! constant for liquid water grain growth [m3 s-1], from Brun89 + real(kind=kind_noahmp) :: SnowWetAgeC2Brun89 ! constant for liquid water grain growth [m3 s-1], from Brun89: corrected for LWC + real(kind=kind_noahmp) :: SnowAgeScaleFac ! arbitrary tuning/scaling factor applied to snow aging rate (-) - 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..e0e599a7 --- /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 (NCAR), 2024 +! ---------------------------------------------------------------------------------------- + + 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.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.0 - T) * YD(1) + T * YD(2) + elseif ( XI > XD(ND) ) then ! extrapolate + T = ( XI - XD(ND-1) ) / ( XD(ND) - XD(ND-1) ) + YI = (1.0 - 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.0 - T) * YD(K-1) + T * YD(K) + exit + endif + enddo + endif + + + end subroutine PiecewiseLinearInterp1d + +end module PiecewiseLinearInterp1dMod