From a625eac45094b69f6cd096b383b90478226ac123 Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Tue, 18 Jan 2022 23:16:09 -0700 Subject: [PATCH 01/62] add output for SNICAR related albedo variables --- src/biogeophys/SurfaceAlbedoMod.F90 | 2 +- src/biogeophys/SurfaceAlbedoType.F90 | 53 ++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+), 1 deletion(-) diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index ba025023db..62c4673696 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -12,7 +12,7 @@ module SurfaceAlbedoMod use decompMod , only : bounds_type, subgrid_level_patch use abortutils , only : endrun use landunit_varcon , only : istsoil, istcrop, istdlak - use clm_varcon , only : grlnd + use clm_varcon , only : grlnd, spval ! cenlin use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE use pftconMod , only : pftcon diff --git a/src/biogeophys/SurfaceAlbedoType.F90 b/src/biogeophys/SurfaceAlbedoType.F90 index cf6b0a518a..98a9b0839e 100644 --- a/src/biogeophys/SurfaceAlbedoType.F90 +++ b/src/biogeophys/SurfaceAlbedoType.F90 @@ -221,6 +221,59 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='surface albedo (indirect)', & ptr_patch=this%albi_patch, default=defaultoutput, c2l_scale_type='urbanf') +! cenlin: add for snow albedo and snicar-related output 01/18/2022 + this%albgrd_pur_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_PUR', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without aerosol in snow (direct)', & + ptr_col=this%albgrd_pur_col, default='inactive') + + this%albgri_pur_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_PUR', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without aerosol in snow (diffuse)', & + ptr_col=this%albgri_pur_col, default='inactive') + + this%albgrd_bc_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_BC', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without BC in snow (direct)', & + ptr_col=this%albgrd_bc_col, default='inactive') + + this%albgri_bc_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_BC', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without BC in snow (diffuse)', & + ptr_col=this%albgri_bc_col, default='inactive') + + this%albgrd_oc_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_OC', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without OC in snow (direct)', & + ptr_col=this%albgrd_oc_col, default='inactive') + + this%albgri_oc_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_OC', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without OC in snow (diffuse)', & + ptr_col=this%albgri_oc_col, default='inactive') + + this%albgrd_dst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_DST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without dust in snow (direct)', & + ptr_col=this%albgrd_dst_col, default='inactive') + + this%albgri_dst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_DST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without dust in snow (diffuse)', & + ptr_col=this%albgri_dst_col, default='inactive') + + this%albsnd_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBSND', units='proportion', type2d='numrad', & + avgflag='A', long_name='snow albedo (direct)', & + ptr_col=this%albsnd_hst_col, default='inactive') + + this%albsni_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBSNI', units='proportion', type2d='numrad', & + avgflag='A', long_name='snow albedo (diffuse)', & + ptr_col=this%albsni_hst_col, default='inactive') + +! cenlin: end + end subroutine InitHistory !----------------------------------------------------------------------- From 759ef18645ce3b3c7a5190c37b0a18257703eeb2 Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Wed, 19 Jan 2022 19:59:42 -0700 Subject: [PATCH 02/62] bug fix for adding new albedo output variables --- src/biogeophys/SurfaceAlbedoMod.F90 | 70 +++++++- src/biogeophys/SurfaceAlbedoType.F90 | 250 +++++++++++++++++++++------ src/biogeophys/UrbanAlbedoMod.F90 | 30 +++- 3 files changed, 294 insertions(+), 56 deletions(-) diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index 62c4673696..df92dbcb41 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -349,7 +349,7 @@ subroutine SurfaceAlbedo(bounds,nc, & esai => canopystate_inst%esai_patch , & ! Input: [real(r8) (:) ] one-sided stem area index with burying by snow frac_sno => waterdiagnosticbulk_inst%frac_sno_col , & ! Input: [real(r8) (:) ] fraction of ground covered by snow (0 to 1) - fcansno => waterdiagnosticbulk_inst%fcansno_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is snow-covered (0 to 1) + fcansno => waterdiagnosticbulk_inst%fcansno_patch , & ! Input: [real(r8) (:) ] fraction of canopy that is snow-covered (0 to 1) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col , & ! Input: [real(r8) (:,:) ] liquid water content (col,lyr) [kg/m2] h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col , & ! Input: [real(r8) (:,:) ] ice lens content (col,lyr) [kg/m2] snw_rds => waterdiagnosticbulk_inst%snw_rds_col , & ! Input: [real(r8) (:,:) ] snow grain radius (col,lyr) [microns] @@ -387,6 +387,22 @@ subroutine SurfaceAlbedo(bounds,nc, & albsni_hst => surfalb_inst%albsni_hst_col , & ! Output: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd) [frc] albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) +! cenlin: add new output albedo variables for history fields + albgrd_hst => surfalb_inst%albgrd_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) for history files + albgri_hst => surfalb_inst%albgri_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) for history files + albgrd_pur_hst => surfalb_inst%albgrd_pur_hst_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (direct) for history files + albgri_pur_hst => surfalb_inst%albgri_pur_hst_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (diffuse) for history files + albgrd_bc_hst => surfalb_inst%albgrd_bc_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (direct) for history files + albgri_bc_hst => surfalb_inst%albgri_bc_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo without BC (diffuse) for history files + albgrd_oc_hst => surfalb_inst%albgrd_oc_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (direct) for history files + albgri_oc_hst => surfalb_inst%albgri_oc_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo without OC (diffuse) for history files + albgrd_dst_hst => surfalb_inst%albgrd_dst_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (direct) for history files + albgri_dst_hst => surfalb_inst%albgri_dst_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo without dust (diffuse) for history files + albsnd_hst2 => surfalb_inst%albsnd_hst2_col , & ! Output: [real(r8) (:,:) ] snow albedo, direct, for history files (col,bnd) for history files + albsni_hst2 => surfalb_inst%albsni_hst2_col , & ! Output: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd) for history files + albd_hst => surfalb_inst%albd_hst_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) for history files + albi_hst => surfalb_inst%albi_hst_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) for history files +! cenlin: end albdSF => surfalb_inst%albdSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (direct) albiSF => surfalb_inst%albiSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (diffuse) fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux @@ -420,7 +436,7 @@ subroutine SurfaceAlbedo(bounds,nc, & do fp = 1,num_nourbanp p = filter_nourbanp(fp) g = patch%gridcell(p) - coszen_patch(p) = coszen_gcell(g) + coszen_patch(p) = coszen_gcell(g) end do ! Initialize output because solar radiation only done if coszen > 0 @@ -440,6 +456,20 @@ subroutine SurfaceAlbedo(bounds,nc, & albgri_oc(c,ib) = 0._r8 albgrd_dst(c,ib) = 0._r8 albgri_dst(c,ib) = 0._r8 +! cenlin: add output variables for history files + albgrd_hst(c,ib) = spval + albgri_hst(c,ib) = spval + albgrd_pur_hst(c,ib) = spval + albgri_pur_hst(c,ib) = spval + albgrd_bc_hst(c,ib) = spval + albgri_bc_hst(c,ib) = spval + albgrd_oc_hst(c,ib) = spval + albgri_oc_hst(c,ib) = spval + albgrd_dst_hst(c,ib) = spval + albgri_dst_hst(c,ib) = spval + albsnd_hst2(c,ib) = spval + albsni_hst2(c,ib) = spval +! cenlin: end do i=-nlevsno+1,1,1 flx_absdv(c,i) = 0._r8 flx_absdn(c,i) = 0._r8 @@ -452,6 +482,10 @@ subroutine SurfaceAlbedo(bounds,nc, & p = filter_nourbanp(fp) albd(p,ib) = 1._r8 albi(p,ib) = 1._r8 +! cenlin: add output variables for history files + albd_hst(p,ib) = spval + albi_hst(p,ib) = spval +! cenlin: end if (use_SSRE) then albdSF(p,ib) = 1._r8 albiSF(p,ib) = 1._r8 @@ -1048,6 +1082,38 @@ subroutine SurfaceAlbedo(bounds,nc, & end do end do +! cenlin: add output variables for history files + do ib = 1, numrad + do fc = 1,num_nourbanc + c = filter_nourbanc(fc) + if (coszen_col(c) > 0._r8) then + albgrd_hst(c,ib) = albgrd(c,ib) + albgri_hst(c,ib) = albgri(c,ib) + albgrd_pur_hst(c,ib) = albgrd_pur(c,ib) + albgri_pur_hst(c,ib) = albgri_pur(c,ib) + albgrd_bc_hst(c,ib) = albgrd_bc(c,ib) + albgri_bc_hst(c,ib) = albgri_bc(c,ib) + albgrd_oc_hst(c,ib) = albgrd_oc(c,ib) + albgri_oc_hst(c,ib) = albgri_oc(c,ib) + albgrd_dst_hst(c,ib) = albgrd_dst(c,ib) + albgri_dst_hst(c,ib) = albgri_dst(c,ib) + if (h2osno_total(c) > 0._r8) then + albsnd_hst2(c,ib) = albsnd_hst(c,ib) + albsni_hst2(c,ib) = albsnd_hst(c,ib) + end if + end if + end do + + do fp = 1,num_nourbanp + p = filter_nourbanp(fp) + if (coszen_patch(p) > 0._r8) then + albd_hst(p,ib) = albd(p,ib) + albi_hst(p,ib) = albi(p,ib) + end if + end do + end do +! cenlin: end + end associate end subroutine SurfaceAlbedo diff --git a/src/biogeophys/SurfaceAlbedoType.F90 b/src/biogeophys/SurfaceAlbedoType.F90 index 98a9b0839e..eb8ec9ef03 100644 --- a/src/biogeophys/SurfaceAlbedoType.F90 +++ b/src/biogeophys/SurfaceAlbedoType.F90 @@ -7,7 +7,7 @@ module SurfaceAlbedoType use decompMod , only : bounds_type use clm_varpar , only : numrad, nlevcan, nlevsno use abortutils , only : endrun - use clm_varctl , only : use_SSRE + use clm_varctl , only : use_SSRE, use_snicar_frc ! cenlin ! ! !PUBLIC TYPES: implicit none @@ -35,6 +35,22 @@ module SurfaceAlbedoType real(r8), pointer :: albsoi_col (:,:) ! col soil albedo: diffuse (col,bnd) [frc] real(r8), pointer :: albsnd_hst_col (:,:) ! col snow albedo, direct , for history files (col,bnd) [frc] real(r8), pointer :: albsni_hst_col (:,:) ! col snow albedo, diffuse, for history files (col,bnd) [frc] +! cenlin add new output variables for albedo for history files only + real(r8), pointer :: albd_hst_patch (:,:) ! patch surface albedo (direct) for history files (numrad) + real(r8), pointer :: albi_hst_patch (:,:) ! patch surface albedo (diffuse) for history files (numrad) + real(r8), pointer :: albgrd_pur_hst_col (:,:) ! col pure snow ground direct albedo for history files (numrad) + real(r8), pointer :: albgri_pur_hst_col (:,:) ! col pure snow ground diffuse albedo for history files (numrad) + real(r8), pointer :: albgrd_bc_hst_col (:,:) ! col ground direct albedo without BC for history files (numrad) + real(r8), pointer :: albgri_bc_hst_col (:,:) ! col ground diffuse albedo without BC for history files (numrad) + real(r8), pointer :: albgrd_oc_hst_col (:,:) ! col ground direct albedo without OC for history files (numrad) + real(r8), pointer :: albgri_oc_hst_col (:,:) ! col ground diffuse albedo without OC for history files (numrad) + real(r8), pointer :: albgrd_dst_hst_col (:,:) ! col ground direct albedo without dust for history files (numrad) + real(r8), pointer :: albgri_dst_hst_col (:,:) ! col ground diffuse albedo without dust for history files (numrad) + real(r8), pointer :: albgrd_hst_col (:,:) ! col ground albedo (direct) for history files (numrad) + real(r8), pointer :: albgri_hst_col (:,:) ! col ground albedo (diffuse) for history files (numrad) + real(r8), pointer :: albsnd_hst2_col (:,:) ! col snow albedo, direct , for history files (col,bnd) [frc] + real(r8), pointer :: albsni_hst2_col (:,:) ! col snow albedo, diffuse, for history files (col,bnd) [frc] +! cenlin end real(r8), pointer :: ftdd_patch (:,:) ! patch down direct flux below canopy per unit direct flx (numrad) real(r8), pointer :: ftid_patch (:,:) ! patch down diffuse flux below canopy per unit direct flx (numrad) @@ -157,6 +173,23 @@ subroutine InitAllocate(this, bounds) allocate(this%vcmaxcintsun_patch (begp:endp)) ; this%vcmaxcintsun_patch (:) = nan allocate(this%vcmaxcintsha_patch (begp:endp)) ; this%vcmaxcintsha_patch (:) = nan +! cenlin add new output variables for albedo for history files only + allocate(this%albgrd_hst_col (begc:endc,numrad)) ; this%albgrd_hst_col (:,:) = spval + allocate(this%albgri_hst_col (begc:endc,numrad)) ; this%albgri_hst_col (:,:) = spval + allocate(this%albsnd_hst2_col (begc:endc,numrad)) ; this%albsnd_hst2_col (:,:) = spval + allocate(this%albsni_hst2_col (begc:endc,numrad)) ; this%albsni_hst2_col (:,:) = spval + allocate(this%albgrd_pur_hst_col (begc:endc,numrad)) ; this%albgrd_pur_hst_col (:,:) = spval + allocate(this%albgri_pur_hst_col (begc:endc,numrad)) ; this%albgri_pur_hst_col (:,:) = spval + allocate(this%albgrd_bc_hst_col (begc:endc,numrad)) ; this%albgrd_bc_hst_col (:,:) = spval + allocate(this%albgri_bc_hst_col (begc:endc,numrad)) ; this%albgri_bc_hst_col (:,:) = spval + allocate(this%albgrd_oc_hst_col (begc:endc,numrad)) ; this%albgrd_oc_hst_col (:,:) = spval + allocate(this%albgri_oc_hst_col (begc:endc,numrad)) ; this%albgri_oc_hst_col (:,:) = spval + allocate(this%albgrd_dst_hst_col (begc:endc,numrad)) ; this%albgrd_dst_hst_col (:,:) = spval + allocate(this%albgri_dst_hst_col (begc:endc,numrad)) ; this%albgri_dst_hst_col (:,:) = spval + allocate(this%albd_hst_patch (begp:endp,numrad)) ; this%albd_hst_patch (:,:) = spval + allocate(this%albi_hst_patch (begp:endp,numrad)) ; this%albi_hst_patch (:,:) = spval +! cenlin end + end subroutine InitAllocate !----------------------------------------------------------------------- @@ -188,7 +221,7 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='cosine of solar zenith angle', & ptr_col=this%coszen_col, default='inactive') - this%albgri_col(begc:endc,:) = spval + this%albgrd_col(begc:endc,:) = spval call hist_addfld2d (fname='ALBGRD', units='proportion', type2d='numrad', & avgflag='A', long_name='ground albedo (direct)', & ptr_col=this%albgrd_col, default='inactive') @@ -221,57 +254,80 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='surface albedo (indirect)', & ptr_patch=this%albi_patch, default=defaultoutput, c2l_scale_type='urbanf') -! cenlin: add for snow albedo and snicar-related output 01/18/2022 - this%albgrd_pur_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBGRD_PUR', units='proportion', type2d='numrad', & - avgflag='A', long_name='ground albedo without aerosol in snow (direct)', & - ptr_col=this%albgrd_pur_col, default='inactive') - - this%albgri_pur_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBGRI_PUR', units='proportion', type2d='numrad', & - avgflag='A', long_name='ground albedo without aerosol in snow (diffuse)', & - ptr_col=this%albgri_pur_col, default='inactive') - - this%albgrd_bc_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBGRD_BC', units='proportion', type2d='numrad', & - avgflag='A', long_name='ground albedo without BC in snow (direct)', & - ptr_col=this%albgrd_bc_col, default='inactive') - - this%albgri_bc_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBGRI_BC', units='proportion', type2d='numrad', & - avgflag='A', long_name='ground albedo without BC in snow (diffuse)', & - ptr_col=this%albgri_bc_col, default='inactive') - - this%albgrd_oc_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBGRD_OC', units='proportion', type2d='numrad', & - avgflag='A', long_name='ground albedo without OC in snow (direct)', & - ptr_col=this%albgrd_oc_col, default='inactive') - - this%albgri_oc_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBGRI_OC', units='proportion', type2d='numrad', & - avgflag='A', long_name='ground albedo without OC in snow (diffuse)', & - ptr_col=this%albgri_oc_col, default='inactive') - - this%albgrd_dst_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBGRD_DST', units='proportion', type2d='numrad', & - avgflag='A', long_name='ground albedo without dust in snow (direct)', & - ptr_col=this%albgrd_dst_col, default='inactive') - - this%albgri_dst_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBGRI_DST', units='proportion', type2d='numrad', & - avgflag='A', long_name='ground albedo without dust in snow (diffuse)', & - ptr_col=this%albgri_dst_col, default='inactive') - - this%albsnd_hst_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBSND', units='proportion', type2d='numrad', & - avgflag='A', long_name='snow albedo (direct)', & - ptr_col=this%albsnd_hst_col, default='inactive') +! cenlin add new output variables for albedo for history files only + if (use_snicar_frc) then + + this%albd_hst_patch(begp:endp,:) = spval + call hist_addfld2d (fname='ALBD_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='surface albedo (direct)', & + ptr_patch=this%albd_hst_patch, default='inactive', c2l_scale_type='urbanf') + + this%albi_hst_patch(begp:endp,:) = spval + call hist_addfld2d (fname='ALBI_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='surface albedo (indirect)', & + ptr_patch=this%albi_hst_patch, default='inactive', c2l_scale_type='urbanf') + + this%albgrd_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo (direct)', & + ptr_col=this%albgrd_hst_col, default='inactive') + + this%albgri_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo (indirect)', & + ptr_col=this%albgri_hst_col, default='inactive') + + this%albgrd_pur_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_PUR_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without aerosol in snow (direct)', & + ptr_col=this%albgrd_pur_hst_col, default='inactive') + + this%albgri_pur_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_PUR_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without aerosol in snow (diffuse)', & + ptr_col=this%albgri_pur_hst_col, default='inactive') + + this%albgrd_bc_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_BC_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without BC in snow (direct)', & + ptr_col=this%albgrd_bc_hst_col, default='inactive') + + this%albgri_bc_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_BC_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without BC in snow (diffuse)', & + ptr_col=this%albgri_bc_hst_col, default='inactive') + + this%albgrd_oc_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_OC_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without OC in snow (direct)', & + ptr_col=this%albgrd_oc_hst_col, default='inactive') + + this%albgri_oc_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_OC_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without OC in snow (diffuse)', & + ptr_col=this%albgri_oc_hst_col, default='inactive') + + this%albgrd_dst_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRD_DST_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without dust in snow (direct)', & + ptr_col=this%albgrd_dst_hst_col, default='inactive') + + this%albgri_dst_hst_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBGRI_DST_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='ground albedo without dust in snow (diffuse)', & + ptr_col=this%albgri_dst_hst_col, default='inactive') + + this%albsnd_hst2_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBSND_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='snow albedo (direct)', & + ptr_col=this%albsnd_hst2_col, default='inactive') - this%albsni_hst_col(begc:endc,:) = spval - call hist_addfld2d (fname='ALBSNI', units='proportion', type2d='numrad', & - avgflag='A', long_name='snow albedo (diffuse)', & - ptr_col=this%albsni_hst_col, default='inactive') + this%albsni_hst2_col(begc:endc,:) = spval + call hist_addfld2d (fname='ALBSNI_HIST', units='proportion', type2d='numrad', & + avgflag='A', long_name='snow albedo (diffuse)', & + ptr_col=this%albsni_hst2_col, default='inactive') + end if ! end of use_snicar_frc ! cenlin: end end subroutine InitHistory @@ -323,7 +379,7 @@ subroutine InitCold(this, bounds) this%ftdd_patch (begp:endp, :) = 1.0_r8 this%ftid_patch (begp:endp, :) = 0.0_r8 this%ftii_patch (begp:endp, :) = 1.0_r8 - + end subroutine InitCold !--------------------------------------------------------------------- @@ -598,6 +654,96 @@ subroutine Restart(this, bounds, ncid, flag, & end if ! end of if-use_snicar_frc +! cenlin add new output variables for albedo for history files only + if (use_snicar_frc) then + + call restartvar(ncid=ncid, flag=flag, varname='albd_hist', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='surface albedo (direct) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albd_hst_patch) + + call restartvar(ncid=ncid, flag=flag, varname='albi_hist', xtype=ncd_double, & + dim1name='pft', dim2name='numrad', switchdim=.true., & + long_name='surface albedo (diffuse) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albi_hst_patch) + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo (direct) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgrd_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgri_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo (indirect) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgri_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albsnd_hst2', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='snow albedo (direct) (0 to 1)', units='proportion', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albsnd_hst2_col) + + call restartvar(ncid=ncid, flag=flag, varname='albsni_hst2', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='snow albedo (diffuse) (0 to 1)', units='proportion', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albsni_hst2_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_bc_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without BC (direct) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp',readvar=readvar, data=this%albgrd_bc_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgri_bc_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without BC (diffuse) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgri_bc_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_pur_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='pure snow ground albedo (direct) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgrd_pur_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgri_pur_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='pure snow ground albedo (diffuse) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgri_pur_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_oc_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without OC (direct) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgrd_oc_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgri_oc_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without OC (diffuse) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgri_oc_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgrd_dst_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without dust (direct) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgrd_dst_hst_col) + + call restartvar(ncid=ncid, flag=flag, varname='albgri_dst_hist', xtype=ncd_double, & + dim1name='column', dim2name='numrad', switchdim=.true., & + long_name='ground albedo without dust (diffuse) (0 to 1)', units='', & + scale_by_thickness=.false., & + interpinic_flag='interp', readvar=readvar, data=this%albgri_dst_hst_col) + + end if ! end of if-use_snicar_frc +! cenlin end + ! patch type physical state variable - fabd call restartvar(ncid=ncid, flag=flag, varname='fabd', xtype=ncd_double, & dim1name='pft', dim2name='numrad', switchdim=.true., & diff --git a/src/biogeophys/UrbanAlbedoMod.F90 b/src/biogeophys/UrbanAlbedoMod.F90 index 73fd3db08d..5ec225294f 100644 --- a/src/biogeophys/UrbanAlbedoMod.F90 +++ b/src/biogeophys/UrbanAlbedoMod.F90 @@ -12,7 +12,7 @@ module UrbanAlbedoMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type, subgrid_level_landunit use clm_varpar , only : numrad - use clm_varcon , only : isecspday, degpsec + use clm_varcon , only : isecspday, degpsec, spval ! cenlin use clm_varctl , only : iulog use abortutils , only : endrun use UrbanParamsType , only : urbanparams_type @@ -156,7 +156,12 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] urban col ground albedo (diffuse) albd => surfalb_inst%albd_patch , & ! Output [real(r8) (:,:) ] urban pft surface albedo (direct) albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] urban pft surface albedo (diffuse) - +! cenlin: add albedo output for history files + albd_hst => surfalb_inst%albd_hst_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) for history files + albi_hst => surfalb_inst%albi_hst_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) for history files + albgrd_hst => surfalb_inst%albgrd_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) for history files + albgri_hst => surfalb_inst%albgri_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) for history files +! cenlin: end begl => bounds%begl , & vf_sr => urbanparams_inst%vf_sr , & ! Input: [real(r8) (:) ] view factor of sky for road vf_sw => urbanparams_inst%vf_sw , & ! Input: [real(r8) (:) ] view factor of sky for one wall @@ -182,6 +187,10 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & c = filter_urbanc(fc) albgrd(c,ib) = 0._r8 albgri(c,ib) = 0._r8 +! cenlin: add output variables for history files + albgrd_hst(c,ib) = spval + albgri_hst(c,ib) = spval +! cenlin: end end do do fp = 1,num_urbanp @@ -203,6 +212,10 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & albd(p,ib) = 1._r8 albi(p,ib) = 1._r8 endif +! cenlin: add output variables for history files + albd_hst(p,ib) = spval + albi_hst(p,ib) = spval +! cenlin: end fabd(p,ib) = 0._r8 fabd_sun(p,ib) = 0._r8 fabd_sha(p,ib) = 0._r8 @@ -418,12 +431,25 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & albgrd(c,ib) = sref_improad_dir(l,ib) albgri(c,ib) = sref_improad_dif(l,ib) endif +! cenlin: add albedo variables for history fields + if (coszen(l) > 0._r8) then + albgrd_hst(c,ib) = albgrd(c,ib) + albgri_hst(c,ib) = albgri(c,ib) + end if +! cenlin: end end do do fp = 1,num_urbanp p = filter_urbanp(fp) c = patch%column(p) + l = patch%landunit(p) albd(p,ib) = albgrd(c,ib) albi(p,ib) = albgri(c,ib) +! cenlin: add albedo variables for history fields + if (coszen(l) > 0._r8) then + albd_hst(p,ib) = albd(p,ib) + albi_hst(p,ib) = albi(p,ib) + end if +! cenlin: end end do end do end if From e3c5459ab70c834179a40d076bd93e1f6b636afb Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Tue, 25 Jan 2022 15:34:04 -0700 Subject: [PATCH 03/62] expand SNICAR from 5-band to 480-band with namelist control option --- .../namelist_definition_ctsm.xml | 34 ++ src/biogeophys/AerosolMod.F90 | 28 ++ src/biogeophys/SnowSnicarMod.F90 | 447 ++++++++++++++---- src/main/clm_varctl.F90 | 18 + src/main/controlMod.F90 | 48 +- 5 files changed, 474 insertions(+), 101 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index a79991efd8..73dc049406 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -160,6 +160,34 @@ specify spatially variable soil thickness. If not present, use bottom of soil column (nlevsoi). + +number of wavelength bands used in SNICAR snow albedo calculation + + + +type of downward solar radiation spectrum for SNICAR snow albedo calculation +(only used in 480-band version) + + + +snow optics type using different refractive index databases in SNICAR +(only used in 480-band version) + + + +dust optics type for SNICAR snow albedo calculation +(only used in 480-band version) + + + +Toggle to turn on/off aerosol deposition flux in snow in SNICAR + + Index of rooting profile for water @@ -763,6 +791,12 @@ Full pathname of surface data file. SNICAR (SNow, ICe, and Aerosol Radiative model) optical data file name + +SNICAR (SNow, ICe, and Aerosol Radiative model) 480-band optical data file name + + + SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name diff --git a/src/biogeophys/AerosolMod.F90 b/src/biogeophys/AerosolMod.F90 index f0e0c3fa88..c648632a5b 100644 --- a/src/biogeophys/AerosolMod.F90 +++ b/src/biogeophys/AerosolMod.F90 @@ -15,6 +15,7 @@ module AerosolMod use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type use ColumnType , only : col use abortutils , only : endrun + use CLM_varctl , only : snicar_use_aerosol ! cenlin ! ! !PUBLIC TYPES: implicit none @@ -806,6 +807,33 @@ subroutine AerosolFluxes(bounds, num_snowc, filter_snowc, & forc_aer(g,13) + forc_aer(g,14) end do + ! if turn off aerosol effect in snow, zero out deposition flux + if (.not. snicar_use_aerosol) then + do c = bounds%begc,bounds%endc + g = col%gridcell(c) + + flx_bc_dep_dry(c) = 0._r8 + flx_bc_dep_wet(c) = 0._r8 + flx_bc_dep_phi(c) = 0._r8 + flx_bc_dep_pho(c) = 0._r8 + flx_bc_dep(c) = 0._r8 + flx_oc_dep_dry(c) = 0._r8 + flx_oc_dep_wet(c) = 0._r8 + flx_oc_dep_phi(c) = 0._r8 + flx_oc_dep_pho(c) = 0._r8 + flx_oc_dep(c) = 0._r8 + flx_dst_dep_wet1(c) = 0._r8 + flx_dst_dep_dry1(c) = 0._r8 + flx_dst_dep_wet2(c) = 0._r8 + flx_dst_dep_dry2(c) = 0._r8 + flx_dst_dep_wet3(c) = 0._r8 + flx_dst_dep_dry3(c) = 0._r8 + flx_dst_dep_wet4(c) = 0._r8 + flx_dst_dep_dry4(c) = 0._r8 + flx_dst_dep(c) = 0._r8 + end do + end if + ! aerosol deposition fluxes into top layer ! This is done after the inter-layer fluxes so that some aerosol ! is in the top layer after deposition, and is not immediately diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 77cc5b53d6..b8a2db6bdd 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -11,7 +11,7 @@ module SnowSnicarMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : iulog + use clm_varctl , only : iulog, snicar_numrad_snw ! cenlin use clm_varcon , only : tfrz use shr_const_mod , only : SHR_CONST_RHOICE use abortutils , only : endrun @@ -51,9 +51,9 @@ module SnowSnicarMod logical, public, parameter :: DO_SNO_AER = .true. ! parameter to include aerosols in snowpack radiative calculations ! !PRIVATE DATA MEMBERS: - integer, parameter :: numrad_snw = 5 ! number of spectral bands used in snow model [nbr] - integer, parameter :: nir_bnd_bgn = 2 ! first band index in near-IR spectrum [idx] - integer, parameter :: nir_bnd_end = 5 ! ending near-IR band index [idx] +! integer, parameter :: numrad_snw = 5 ! number of spectral bands used in snow model [nbr] cenlin +! integer, parameter :: nir_bnd_bgn = 2 ! first band index in near-IR spectrum [idx] cenlin +! integer, parameter :: nir_bnd_end = 5 ! ending near-IR band index [idx] cenlin integer, parameter :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx] integer, parameter :: idx_T_max = 11 ! maxiumum temperature index used in aging lookup table [idx] @@ -90,54 +90,58 @@ module SnowSnicarMod ! (idx_Mie_snw_mx is number of snow radii with defined parameters (i.e. from 30um to 1500um)) ! direct-beam weighted ice optical properties - real(r8) :: ss_alb_snw_drc(idx_Mie_snw_mx,numrad_snw) - real(r8) :: asm_prm_snw_drc(idx_Mie_snw_mx,numrad_snw) - real(r8) :: ext_cff_mss_snw_drc(idx_Mie_snw_mx,numrad_snw) + real(r8), pointer :: ss_alb_snw_drc(:,:) !(idx_Mie_snw_mx,numrad_snw) + real(r8), pointer :: asm_prm_snw_drc(:,:) !(idx_Mie_snw_mx,numrad_snw) + real(r8), pointer :: ext_cff_mss_snw_drc(:,:) !(idx_Mie_snw_mx,numrad_snw) ! diffuse radiation weighted ice optical properties - real(r8) :: ss_alb_snw_dfs(idx_Mie_snw_mx,numrad_snw) - real(r8) :: asm_prm_snw_dfs(idx_Mie_snw_mx,numrad_snw) - real(r8) :: ext_cff_mss_snw_dfs(idx_Mie_snw_mx,numrad_snw) + real(r8), pointer :: ss_alb_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) + real(r8), pointer :: asm_prm_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) + real(r8), pointer :: ext_cff_mss_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) ! hydrophiliic BC - real(r8) :: ss_alb_bc1(numrad_snw) - real(r8) :: asm_prm_bc1(numrad_snw) - real(r8) :: ext_cff_mss_bc1(numrad_snw) + real(r8), pointer :: ss_alb_bc1(:) !(numrad_snw) + real(r8), pointer :: asm_prm_bc1(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_bc1(:) !(numrad_snw) ! hydrophobic BC - real(r8) :: ss_alb_bc2(numrad_snw) - real(r8) :: asm_prm_bc2(numrad_snw) - real(r8) :: ext_cff_mss_bc2(numrad_snw) + real(r8), pointer :: ss_alb_bc2(:) !(numrad_snw) + real(r8), pointer :: asm_prm_bc2(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_bc2(:) !(numrad_snw) ! hydrophobic OC - real(r8) :: ss_alb_oc1(numrad_snw) - real(r8) :: asm_prm_oc1(numrad_snw) - real(r8) :: ext_cff_mss_oc1(numrad_snw) + real(r8), pointer :: ss_alb_oc1(:) !(numrad_snw) + real(r8), pointer :: asm_prm_oc1(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_oc1(:) !(numrad_snw) ! hydrophilic OC - real(r8) :: ss_alb_oc2(numrad_snw) - real(r8) :: asm_prm_oc2(numrad_snw) - real(r8) :: ext_cff_mss_oc2(numrad_snw) + real(r8), pointer :: ss_alb_oc2(:) !(numrad_snw) + real(r8), pointer :: asm_prm_oc2(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_oc2(:) !(numrad_snw) ! dust species 1: - real(r8) :: ss_alb_dst1(numrad_snw) - real(r8) :: asm_prm_dst1(numrad_snw) - real(r8) :: ext_cff_mss_dst1(numrad_snw) + real(r8), pointer :: ss_alb_dst1(:) !(numrad_snw) + real(r8), pointer :: asm_prm_dst1(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_dst1(:) !(numrad_snw) ! dust species 2: - real(r8) :: ss_alb_dst2(numrad_snw) - real(r8) :: asm_prm_dst2(numrad_snw) - real(r8) :: ext_cff_mss_dst2(numrad_snw) + real(r8), pointer :: ss_alb_dst2(:) !(numrad_snw) + real(r8), pointer :: asm_prm_dst2(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_dst2(:) !(numrad_snw) ! dust species 3: - real(r8) :: ss_alb_dst3(numrad_snw) - real(r8) :: asm_prm_dst3(numrad_snw) - real(r8) :: ext_cff_mss_dst3(numrad_snw) + real(r8), pointer :: ss_alb_dst3(:) !(numrad_snw) + real(r8), pointer :: asm_prm_dst3(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_dst3(:) !(numrad_snw) ! dust species 4: - real(r8) :: ss_alb_dst4(numrad_snw) - real(r8) :: asm_prm_dst4(numrad_snw) - real(r8) :: ext_cff_mss_dst4(numrad_snw) + real(r8), pointer :: ss_alb_dst4(:) !(numrad_snw) + real(r8), pointer :: asm_prm_dst4(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_dst4(:) !(numrad_snw) + + ! downward solar radiation spectral weights for 480-band + real(r8), pointer :: flx_wgt_dir480(:) !(numrad_snw) ! direct + real(r8), pointer :: flx_wgt_dif480(:) !(numrad_snw) ! diffuse ! best-fit parameters for snow aging defined over: ! 11 temperatures from 225 to 273 K @@ -149,7 +153,8 @@ module SnowSnicarMod real(r8), pointer :: snowage_drdt0(:,:,:) ! idx_rhos_max,idx_Tgrd_max,idx_T_max) ! ! !REVISION HISTORY: - ! Created by Mark Flanner + ! Created by Mark Flanner (Univ. of Michigan) + ! Updated by Cenlin He (NCAR) based on Flanner et al. 2021 GMD character(len=*), parameter, private :: sourcefile = & __FILE__ @@ -229,17 +234,19 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! !LOCAL VARIABLES: ! ! variables for snow radiative transfer calculations + integer :: nir_bnd_bgn ! first band index in near-IR spectrum [idx] cenlin + integer :: nir_bnd_end ! ending near-IR band index [idx] cenlin ! Local variables representing single-column values of arrays: integer :: snl_lcl ! negative number of snow layers [nbr] integer :: snw_rds_lcl(-nlevsno+1:0) ! snow effective radius [m^-6] - real(r8):: flx_slrd_lcl(1:numrad_snw) ! direct beam incident irradiance [W/m2] (set to 1) - real(r8):: flx_slri_lcl(1:numrad_snw) ! diffuse incident irradiance [W/m2] (set to 1) + real(r8):: flx_slrd_lcl(1:snicar_numrad_snw) ! direct beam incident irradiance [W/m2] (set to 1) + real(r8):: flx_slri_lcl(1:snicar_numrad_snw) ! diffuse incident irradiance [W/m2] (set to 1) real(r8):: mss_cnc_aer_lcl(-nlevsno+1:0,1:sno_nbr_aer) ! aerosol mass concentration (lyr,aer_nbr) [kg/kg] real(r8):: h2osno_lcl ! total column snow mass [kg/m2] real(r8):: h2osno_liq_lcl(-nlevsno+1:0) ! liquid water mass [kg/m2] real(r8):: h2osno_ice_lcl(-nlevsno+1:0) ! ice mass [kg/m2] - real(r8):: albsfc_lcl(1:numrad_snw) ! albedo of underlying surface [frc] + real(r8):: albsfc_lcl(1:snicar_numrad_snw) ! albedo of underlying surface [frc] real(r8):: ss_alb_snw_lcl(-nlevsno+1:0) ! single-scatter albedo of ice grains (lyr) [frc] real(r8):: asm_prm_snw_lcl(-nlevsno+1:0) ! asymmetry parameter of ice grains (lyr) [frc] real(r8):: ext_cff_mss_snw_lcl(-nlevsno+1:0) ! mass extinction coefficient of ice grains (lyr) [m2/kg] @@ -253,7 +260,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! (1=Eddington, 2=Quadrature, 3=Hemispheric Mean) [nbr] integer :: DELTA ! flag to use Delta approximation (Joseph, 1976) ! (1= use, 0= don't use) - real(r8):: flx_wgt(1:numrad_snw) ! weights applied to spectral bands, + real(r8):: flx_wgt(1:snicar_numrad_snw) ! weights applied to spectral bands, ! specific to direct and diffuse cases (bnd) [frc] integer :: flg_nosnl ! flag: =1 if there is snow, but zero snow layers, @@ -263,8 +270,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: albedo ! temporary snow albedo [frc] real(r8):: flx_sum ! temporary summation variable for NIR weighting - real(r8):: albout_lcl(numrad_snw) ! snow albedo by band [frc] - real(r8):: flx_abs_lcl(-nlevsno+1:1,numrad_snw)! absorbed flux per unit incident flux at top of snowpack (lyr,bnd) [frc] + real(r8):: albout_lcl(snicar_numrad_snw) ! snow albedo by band [frc] + real(r8):: flx_abs_lcl(-nlevsno+1:1,snicar_numrad_snw)! absorbed flux per unit incident flux at top of snowpack (lyr,bnd) [frc] real(r8):: L_snw(-nlevsno+1:0) ! h2o mass (liquid+solid) in snow layer (lyr) [kg/m2] real(r8):: tau_snw(-nlevsno+1:0) ! snow optical depth (lyr) [unitless] @@ -286,7 +293,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & integer :: nstep ! current timestep [nbr] (debugging only) integer :: g_idx, c_idx, l_idx ! gridcell, column, and landunit indices [idx] - integer :: bnd_idx ! spectral band index (1 <= bnd_idx <= numrad_snw) [idx] + integer :: bnd_idx ! spectral band index (1 <= bnd_idx <= snicar_numrad_snw) [idx] integer :: rds_idx ! snow effective radius index for retrieving ! Mie parameters from lookup table [idx] integer :: snl_btm ! index of bottom snow layer (0) [idx] @@ -353,10 +360,13 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & associate(& snl => col%snl , & ! Input: [integer (:)] negative number of snow layers (col) [nbr] - frac_sno => waterdiagnosticbulk_inst%frac_sno_eff_col & ! Input: [real(r8) (:)] fraction of ground covered by snow (0 to 1) ) + ! Define parameter, cenlin + nir_bnd_bgn = nint(snicar_numrad_snw/9.6) + 1 ! 5-band starts at 2; 480-band starts at 51 + nir_bnd_end = snicar_numrad_snw + ! Define constants pi = SHR_CONST_PI @@ -442,7 +452,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos - albsfc_lcl(1) = albsfc(c_idx,1) + albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,1) ! cenlin: update for hyperspectral calculation albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,2) @@ -470,16 +480,20 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Band 4: 1.2-1.5um (NIR) ! Band 5: 1.5-5.0um (NIR) ! + ! Updated hyperspectral (10-nm) bands (480-band case) cenlin + ! Band 1~50 : 0.2-0.7um (VIS); near-UV (0.2-0.3um) is combined to VIS for now + ! Band 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 (numrad_snw==3) then + if (snicar_numrad_snw==3) then ! Direct: if (flg_slr_in == 1) then flx_wgt(1) = 1._r8 flx_wgt(2) = 0.66628670195247_r8 flx_wgt(3) = 0.33371329804753_r8 - ! Diffuse: + ! Diffuse: elseif (flg_slr_in == 2) then flx_wgt(1) = 1._r8 flx_wgt(2) = 0.77887652162877_r8 @@ -487,7 +501,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & endif ! 5-band weights - elseif(numrad_snw==5) then + elseif (snicar_numrad_snw==5) then ! Direct: if (flg_slr_in == 1) then flx_wgt(1) = 1._r8 @@ -495,7 +509,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & flx_wgt(3) = 0.18099494230665_r8 flx_wgt(4) = 0.12094898498813_r8 flx_wgt(5) = 0.20453448749347_r8 - ! Diffuse: + ! Diffuse: elseif (flg_slr_in == 2) then flx_wgt(1) = 1._r8 flx_wgt(2) = 0.58581507618433_r8 @@ -503,10 +517,20 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & flx_wgt(4) = 0.10917889346386_r8 flx_wgt(5) = 0.10343699264369_r8 endif + + ! 480-band weights, cenlin + elseif (snicar_numrad_snw == 480) then + ! Direct: + if (flg_slr_in == 1) then + flx_wgt(1:snicar_numrad_snw) = flx_wgt_dir480(1:snicar_numrad_snw) ! either VIS or NIR band sum is 1.0 in the input dataset + ! Diffuse: + elseif (flg_slr_in == 2) then + flx_wgt(1:snicar_numrad_snw) = flx_wgt_dif480(1:snicar_numrad_snw) ! either VIS or NIR band sum is 1.0 in the input dataset + endif endif ! Loop over snow spectral bands - do bnd_idx = 1,numrad_snw + do bnd_idx = 1,snicar_numrad_snw mu_not = coszen(c_idx) ! must set here, because of error handling flg_dover = 1 ! default is to redo @@ -532,7 +556,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 3rd error (flg_dover=4): switch approximation with new zenith ! Subsequent errors: repeatedly change zenith and approximations... - if (bnd_idx == 1) then + if (bnd_idx < nir_bnd_bgn) then ! VIS, cenlin if (flg_dover == 2) then APRX_TYP = 3 elseif (flg_dover == 3) then @@ -548,7 +572,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & APRX_TYP = 1 endif - else + else ! NIR if (flg_dover == 2) then APRX_TYP = 1 elseif (flg_dover == 3) then @@ -578,14 +602,19 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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 ( (numrad_snw == 5).and.((bnd_idx == 5).or.(bnd_idx == 4)) ) then + if ( (snicar_numrad_snw == 5).and.((bnd_idx == 5).or.(bnd_idx == 4)) ) then + mss_cnc_aer_lcl(:,:) = 0._r8 + endif + + if ( (snicar_numrad_snw == 3).and.(bnd_idx == 3) ) then mss_cnc_aer_lcl(:,:) = 0._r8 endif - if ( (numrad_snw == 3).and.(bnd_idx == 3) ) then + if ( (snicar_numrad_snw == 480).and.(bnd_idx > 100) ) then ! >1.2um cenlin mss_cnc_aer_lcl(:,:) = 0._r8 endif + ! Define local Mie parameters based on snow grain size and aerosol species, ! retrieved from a lookup table. if (flg_slr_in == 1) then @@ -981,22 +1010,60 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Weight output NIR albedo appropriately - albout(c_idx,1) = albout_lcl(1) - flx_sum = 0._r8 - do bnd_idx= nir_bnd_bgn,nir_bnd_end - flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) - end do - albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + ! for 5- and 3-band cases cenlin + if (snicar_numrad_snw <= 5) then + albout(c_idx,1) = albout_lcl(1) + flx_sum = 0._r8 + do bnd_idx= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) + end do + albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + end if + ! for 480-band case, cenlin + if (snicar_numrad_snw == 480) then + ! average for VIS band + flx_sum = 0._r8 + do bnd_idx= 1, (nir_bnd_bgn-1) + flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) + end do + albout(c_idx,1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + ! average for NIR band + flx_sum = 0._r8 + do bnd_idx= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) + end do + albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + end if ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately - flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) - do i=snl_top,1,1 - flx_sum = 0._r8 - do bnd_idx= nir_bnd_bgn,nir_bnd_end - flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) - enddo - flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) - end do + ! for 5- and 3-band cases cenlin + if (snicar_numrad_snw <= 5) then + flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) + do i=snl_top,1,1 + flx_sum = 0._r8 + do bnd_idx= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) + enddo + flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + end do + end if + ! for 480-band case cenlin + if (snicar_numrad_snw == 480) then + do i=snl_top,1,1 + ! average for VIS band + flx_sum = 0._r8 + do bnd_idx= 1,(nir_bnd_bgn-1) + flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) + enddo + flx_abs(c_idx,i,1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + ! average for NIR band + flx_sum = 0._r8 + do bnd_idx= nir_bnd_bgn,nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) + enddo + flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + end do + end if ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo elseif ( (coszen(c_idx) > 0._r8) .and. (h2osno_lcl < min_snw) .and. (h2osno_lcl > 0._r8) ) then @@ -1362,7 +1429,8 @@ end function FreshSnowRadius subroutine SnowOptics_init( ) use fileutils , only : getfil - use CLM_varctl , only : fsnowoptics + use CLM_varctl , only : fsnowoptics,snicar_numrad_snw,fsnowoptics480,snicar_solarspec,& + snicar_snw_optics,snicar_dust_optics ! cenlin use spmdMod , only : masterproc use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile @@ -1373,20 +1441,84 @@ subroutine SnowOptics_init( ) ! ! Open optics file: - if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....' - call getfil (fsnowoptics, locfn, 0) - call ncd_pio_openfile(ncid, locfn, 0) - if(masterproc) write(iulog,*) subname,trim(fsnowoptics) + allocate(ss_alb_snw_drc(idx_Mie_snw_mx,snicar_numrad_snw)) + allocate(asm_prm_snw_drc(idx_Mie_snw_mx,snicar_numrad_snw)) + allocate(ext_cff_mss_snw_drc(idx_Mie_snw_mx,snicar_numrad_snw)) + allocate(ss_alb_snw_dfs(idx_Mie_snw_mx,snicar_numrad_snw)) + allocate(asm_prm_snw_dfs(idx_Mie_snw_mx,snicar_numrad_snw)) + allocate(ext_cff_mss_snw_dfs(idx_Mie_snw_mx,snicar_numrad_snw)) + allocate(ss_alb_bc1(snicar_numrad_snw)) + allocate(asm_prm_bc1(snicar_numrad_snw)) + allocate(ext_cff_mss_bc1(snicar_numrad_snw)) + allocate(ss_alb_bc2(snicar_numrad_snw)) + allocate(asm_prm_bc2(snicar_numrad_snw)) + allocate(ext_cff_mss_bc2(snicar_numrad_snw)) + allocate(ss_alb_oc1(snicar_numrad_snw)) + allocate(asm_prm_oc1(snicar_numrad_snw)) + allocate(ext_cff_mss_oc1(snicar_numrad_snw)) + allocate(ss_alb_oc2(snicar_numrad_snw)) + allocate(asm_prm_oc2(snicar_numrad_snw)) + allocate(ext_cff_mss_oc2(snicar_numrad_snw)) + allocate(ss_alb_dst1(snicar_numrad_snw)) + allocate(asm_prm_dst1(snicar_numrad_snw)) + allocate(ext_cff_mss_dst1(snicar_numrad_snw)) + allocate(ss_alb_dst2(snicar_numrad_snw)) + allocate(asm_prm_dst2(snicar_numrad_snw)) + allocate(ext_cff_mss_dst2(snicar_numrad_snw)) + allocate(ss_alb_dst3(snicar_numrad_snw)) + allocate(asm_prm_dst3(snicar_numrad_snw)) + allocate(ext_cff_mss_dst3(snicar_numrad_snw)) + allocate(ss_alb_dst4(snicar_numrad_snw)) + allocate(asm_prm_dst4(snicar_numrad_snw)) + allocate(ext_cff_mss_dst4(snicar_numrad_snw)) + allocate(flx_wgt_dir480(snicar_numrad_snw)) + allocate(flx_wgt_dif480(snicar_numrad_snw)) - ! direct-beam snow Mie parameters: - call ncd_io('ss_alb_ice_drc', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_drc',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_drc', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....' + ! for 5-band data, cenlin + if (snicar_numrad_snw <= 5) then + call getfil (fsnowoptics, locfn, 0) + call ncd_pio_openfile(ncid, locfn, 0) + if(masterproc) write(iulog,*) subname,trim(fsnowoptics) + end if + ! for 480-band data, cenlin + if (snicar_numrad_snw == 480) then + call getfil (fsnowoptics480, locfn, 0) + call ncd_pio_openfile(ncid, locfn, 0) + if(masterproc) write(iulog,*) subname,trim(fsnowoptics480) + end if - ! diffuse snow Mie parameters - call ncd_io( 'ss_alb_ice_dfs', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_dfs', asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_dfs', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + if (snicar_numrad_snw <= 5) then + ! direct-beam snow Mie parameters: + call ncd_io( 'ss_alb_ice_drc', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_drc',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_drc', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + + ! diffuse snow Mie parameters + call ncd_io( 'ss_alb_ice_dfs', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_dfs', asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_dfs', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + endif ! BC species 1 Mie parameters call ncd_io( 'ss_alb_bcphil', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) @@ -1408,26 +1540,143 @@ subroutine SnowOptics_init( ) call ncd_io( 'asm_prm_ocphob', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) - ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) - - ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) - - ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) - - ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + ! new data for 480-band + if (snicar_numrad_snw == 480) then + + ! 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) + call ncd_io( 'ss_alb_ice_wrn84', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn84', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + call ncd_io( 'ss_alb_ice_wrn08', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn08', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + else + write(iulog,*) 'invalid snow optics type option in namelist' + ! for invalid spectrum type, use Picard et al (2016) (default) + call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + endif + + ! dust optical properties + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_sah', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_sah', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_sah', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_sah', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_sah', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_sah', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_sah', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_sah', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_sah', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_sah', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_sah', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_sah', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_col', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_col', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_col', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_col', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_col', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_col', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_col', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_col', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_col', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_col', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_col', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_col', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_gre', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_gre', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_gre', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_gre', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_gre', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_gre', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_gre', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_gre', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_gre', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_gre', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_gre', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_gre', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + else + write(iulog,*) 'invalid dust optics type option in namelist' + ! for invalid dust optics type, use Saharan dust (default) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_sah', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_sah', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_sah', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_sah', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_sah', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_sah', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_sah', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_sah', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_sah', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_sah', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_sah', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_sah', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + endif + + ! downward solar radiation spectral weights for 480-band + if (snicar_solarspec == 1) then ! mid-latitude winter + call ncd_io( 'flx_wgt_dir480_mlw', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_mlw', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_solarspec == 2) then ! mid-latitude summer + call ncd_io( 'flx_wgt_dir480_mls', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_mls', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_solarspec == 3) then ! sub-Arctic winter + call ncd_io( 'flx_wgt_dir480_saw', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_saw', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_solarspec == 4) then ! sub-Arctic summer + call ncd_io( 'flx_wgt_dir480_sas', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_sas', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_solarspec == 5) then ! Summit,Greenland,summer + call ncd_io( 'flx_wgt_dir480_smm', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_smm', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_solarspec == 6) then ! High Mountain summer + call ncd_io( 'flx_wgt_dir480_hmn', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_hmn', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + else + write(iulog,*) 'invalid downward solar radiation spectrum option in namelist' + ! for invalid spectrum type, use mid-latitude winter (default) + call ncd_io( 'flx_wgt_dir480_mlw', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_mlw', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + endif + endif call ncd_pio_closefile(ncid) if (masterproc) then diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 3ad4b14bef..8fac958db5 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -93,6 +93,7 @@ module clm_varctl character(len=fname_len), public :: nrevsn = ' ' ! restart data file name for branch run character(len=fname_len), public :: fsnowoptics = ' ' ! snow optical properties file name character(len=fname_len), public :: fsnowaging = ' ' ! snow aging parameters file name + character(len=fname_len), public :: fsnowoptics480 = ' ' ! snow optical properties file name for 480 bands, cenlin character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid ! only needed for LILAC and MCT drivers @@ -205,6 +206,23 @@ module clm_varctl real(r8), public :: o3_ppbv = 100._r8 + ! number of wavelength bands used in SNICAR snow albedo calculation, cenlin + integer, public :: snicar_numrad_snw = 5 + + ! type of downward solar radiation spectrum for SNICAR snow albedo calculation (only used in 480-band version), cenlin + integer, public :: snicar_solarspec = 1 ! 1->mid-latitude winter;2->mid-latitude summer;3->sub-Arctic winter; + ! 4->sub-Arctic summer;5->Summit,Greenland,summer;6->High Mountain summer; + + ! snow optics type using different refractive index databases in SNICAR (only used in 480-band version), cenlin + integer, public :: snicar_snw_optics = 3 ! 1->Warren (1984);2->Warren and Brandt (2008);3->Picard et al (2016) + + ! dust optics type for SNICAR snow albedo calculation (only used in 480-band version), cenlin + integer, public :: snicar_dust_optics = 1 ! 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) + ! option to turn off aerosol effect in snow in SNICAR + logical, public :: snicar_use_aerosol = .true. ! if .false., turn off aerosol deposition flux + !---------------------------------------------------------- ! C isotopes !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 082d68e8eb..91fd1cc61a 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -147,7 +147,7 @@ subroutine control_init(dtime) namelist /clm_inparm/ & fsurdat, & - paramfile, fsnowoptics, fsnowaging + paramfile, fsnowoptics, fsnowaging, fsnowoptics480 ! cenlin ! History, restart options @@ -201,7 +201,8 @@ subroutine control_init(dtime) albice, soil_layerstruct_predefined, soil_layerstruct_userdefined, & soil_layerstruct_userdefined_nlevsoi, use_subgrid_fluxes, snow_cover_fraction_method, & irrigate, run_zero_weight_urban, all_active, & - crop_fsat_equals_zero, for_testing_run_ncdiopio_tests + crop_fsat_equals_zero, for_testing_run_ncdiopio_tests,snicar_numrad_snw,snicar_solarspec,& + snicar_snw_optics,snicar_dust_optics,snicar_use_aerosol ! cenlin ! vertical soil mixing variables namelist /clm_inparm/ & @@ -568,6 +569,30 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if + ! check on snow albedo wavelength bands, cenlin + if ( (snicar_numrad_snw /= 5) .and. (snicar_numrad_snw /= 480) ) then + call endrun(msg=' ERROR: snicar_numrad_snw is out of a reasonable range (5 or 480)'//& + errMsg(sourcefile, __LINE__)) + end if + + ! check on downward solar radiation spectrum, cenlin + if ( (snicar_solarspec < 0) .or. (snicar_solarspec > 6) ) then + call endrun(msg=' ERROR: snicar_solarspec is out of a reasonable range (1~6)'//& + errMsg(sourcefile, __LINE__)) + end if + + ! check on snow optics type + if ( (snicar_snw_optics < 0) .or. (snicar_snw_optics > 3) ) then + call endrun(msg=' ERROR: snicar_snw_optics is out of a reasonable range (1~3)'//& + errMsg(sourcefile, __LINE__)) + end if + + ! check on dust optics type + if ( (snicar_dust_optics < 0) .or. (snicar_dust_optics > 3) ) then + call endrun(msg=' ERROR: snicar_dust_optics is out of a reasonable range (1~3)'//& + errMsg(sourcefile, __LINE__)) + end if + ! Consistency settings for nrevsn if (nsrest == nsrStartup ) nrevsn = ' ' @@ -646,6 +671,7 @@ subroutine control_spmd() call mpi_bcast (paramfile, len(paramfile) , MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsnowoptics, len(fsnowoptics), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsnowaging, len(fsnowaging), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (fsnowoptics480, len(fsnowoptics480), MPI_CHARACTER, 0, mpicom, ier) ! cenlin ! Irrigation call mpi_bcast(irrigate, 1, MPI_LOGICAL, 0, mpicom, ier) @@ -787,6 +813,11 @@ subroutine control_spmd() call mpi_bcast (soil_layerstruct_predefined,len(soil_layerstruct_predefined), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (soil_layerstruct_userdefined,size(soil_layerstruct_userdefined), MPI_REAL8, 0, mpicom, ier) call mpi_bcast (soil_layerstruct_userdefined_nlevsoi, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (snicar_numrad_snw, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin + call mpi_bcast (snicar_solarspec, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin + call mpi_bcast (snicar_snw_optics, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin + call mpi_bcast (snicar_dust_optics, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin + call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin ! snow pack variables call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier) @@ -873,6 +904,7 @@ subroutine control_print () write(iulog,*) ' use_grainproduct = ', use_grainproduct write(iulog,*) ' o3_veg_stress_method = ', o3_veg_stress_method write(iulog,*) ' use_snicar_frc = ', use_snicar_frc + write(iulog,*) ' snicar_use_aerosol = ',snicar_use_aerosol write(iulog,*) ' use_vancouver = ', use_vancouver write(iulog,*) ' use_mexicocity = ', use_mexicocity write(iulog,*) ' use_noio = ', use_noio @@ -959,9 +991,21 @@ subroutine control_print () else write(iulog,*) ' snow aging parameters file = ',trim(fsnowaging) endif + ! cenlin + if (snicar_numrad_snw==480) then + if (fsnowoptics480 == ' ') then + write(iulog,*) ' SNICAR snow optical properties (480-band) file NOT set' + else + write(iulog,*) ' SNICAR snow optical properties (480-band) file = ',trim(fsnowoptics480) + endif + write(iulog,*) ' Downward solar radiation spectrum for SNICAR =', snicar_solarspec + write(iulog,*) ' Snow refractive index type = ', snicar_snw_optics + write(iulog,*) ' Dust optics type = ', snicar_dust_optics + endif write(iulog,*) ' Number of snow layers =', nlevsno write(iulog,*) ' Max snow depth (mm) =', h2osno_max + write(iulog,*) ' Number of bands in SNICAR snow albedo calculation =', snicar_numrad_snw ! cenlin write(iulog,*) ' glc number of elevation classes =', maxpatch_glc if (glc_do_dynglacier) then From 314c7d38fe2917fe65e7bfcc52e4d336750930ed Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Tue, 25 Jan 2022 21:04:18 -0700 Subject: [PATCH 04/62] add adding-doubling solver in SNICAR with namelist option --- .../namelist_definition_ctsm.xml | 5 + src/biogeophys/SnowSnicarMod.F90 | 1069 ++++++++++++----- src/main/clm_varctl.F90 | 4 + src/main/controlMod.F90 | 10 +- 4 files changed, 772 insertions(+), 316 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 73dc049406..6a841ae588 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -188,6 +188,11 @@ dust optics type for SNICAR snow albedo calculation Toggle to turn on/off aerosol deposition flux in snow in SNICAR + +SNICAR radiative transfer solver type + + Index of rooting profile for water diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index b8a2db6bdd..fc7c95bcb7 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -11,7 +11,7 @@ module SnowSnicarMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : iulog, snicar_numrad_snw ! cenlin + use clm_varctl , only : iulog, snicar_numrad_snw, snicar_rt_solver ! cenlin use clm_varcon , only : tfrz use shr_const_mod , only : SHR_CONST_RHOICE use abortutils , only : endrun @@ -209,6 +209,21 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Present-day climate forcing and response from black carbon in snow, ! J. Geophys. Res., 112, D11202, doi: 10.1029/2006JD008003 ! + ! Updated radiative transfer solver: + ! + ! The multi-layer solution for multiple-scattering used here is from: + ! Briegleb, P. and Light, B.: A Delta-Eddington mutiple scattering + ! parameterization for solar radiation in the sea ice component of the + ! community climate system model, 2007. + ! + ! The implementation of the SNICAR-AD model in CLM is described in: + ! Dang et al.2019, Inter-comparison and improvement of 2-stream shortwave + ! radiative transfer models for unified treatment of cryospheric surfaces + ! in ESMs; and Flanner et al. 2021, SNICAR-ADv3: a community tool for modeling + ! spectral snow albedo + ! + ! To use this new adding-doubling solver, set snicar_rt_solver=2 in CLM namelist + ! ! !USES: use clm_varpar , only : nlevsno, numrad use clm_time_manager , only : get_nstep @@ -254,25 +269,21 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: asm_prm_aer_lcl(sno_nbr_aer) ! asymmetry parameter of aerosol species (aer_nbr) [frc] real(r8):: ext_cff_mss_aer_lcl(sno_nbr_aer) ! mass extinction coefficient of aerosol species (aer_nbr) [m2/kg] - ! Other local variables integer :: APRX_TYP ! two-stream approximation type ! (1=Eddington, 2=Quadrature, 3=Hemispheric Mean) [nbr] integer :: DELTA ! flag to use Delta approximation (Joseph, 1976) ! (1= use, 0= don't use) real(r8):: flx_wgt(1:snicar_numrad_snw) ! weights applied to spectral bands, - ! specific to direct and diffuse cases (bnd) [frc] - + ! specific to direct and diffuse cases (bnd) [frc] integer :: flg_nosnl ! flag: =1 if there is snow, but zero snow layers, ! =0 if at least 1 snow layer [flg] integer :: trip ! flag: =1 to redo RT calculation if result is unrealistic integer :: flg_dover ! defines conditions for RT redo (explained below) - real(r8):: albedo ! temporary snow albedo [frc] real(r8):: flx_sum ! temporary summation variable for NIR weighting real(r8):: albout_lcl(snicar_numrad_snw) ! snow albedo by band [frc] real(r8):: flx_abs_lcl(-nlevsno+1:1,snicar_numrad_snw)! absorbed flux per unit incident flux at top of snowpack (lyr,bnd) [frc] - real(r8):: L_snw(-nlevsno+1:0) ! h2o mass (liquid+solid) in snow layer (lyr) [kg/m2] real(r8):: tau_snw(-nlevsno+1:0) ! snow optical depth (lyr) [unitless] real(r8):: L_aer(-nlevsno+1:0,sno_nbr_aer) ! aerosol mass in snow layer (lyr,nbr_aer) [kg/m2] @@ -281,7 +292,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: tau_clm(-nlevsno+1:0) ! column optical depth from layer bottom to snowpack top (lyr) [unitless] real(r8):: omega_sum ! temporary summation of single-scatter albedo of all aerosols [frc] real(r8):: g_sum ! temporary summation of asymmetry parameter of all aerosols [frc] - real(r8):: tau(-nlevsno+1:0) ! weighted optical depth of snow+aerosol layer (lyr) [unitless] real(r8):: omega(-nlevsno+1:0) ! weighted single-scatter albedo of snow+aerosol layer (lyr) [frc] real(r8):: g(-nlevsno+1:0) ! weighted asymmetry parameter of snow+aerosol layer (lyr) [frc] @@ -290,7 +300,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: omega_star(-nlevsno+1:0) ! transformed (i.e. Delta-Eddington) SSA of snow+aerosol layer (lyr) [frc] real(r8):: g_star(-nlevsno+1:0) ! transformed (i.e. Delta-Eddington) asymmetry paramater of snow+aerosol layer ! (lyr) [frc] - integer :: nstep ! current timestep [nbr] (debugging only) integer :: g_idx, c_idx, l_idx ! gridcell, column, and landunit indices [idx] integer :: bnd_idx ! spectral band index (1 <= bnd_idx <= snicar_numrad_snw) [idx] @@ -302,8 +311,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & integer :: i ! layer index [idx] integer :: j ! aerosol number index [idx] integer :: n ! tridiagonal matrix index [idx] - integer :: m ! secondary layer index [idx] - + integer :: m ! secondary layer index [idx] real(r8):: F_direct(-nlevsno+1:0) ! direct-beam radiation at bottom of layer interface (lyr) [W/m^2] real(r8):: F_net(-nlevsno+1:0) ! net radiative flux at bottom of layer interface (lyr) [W/m^2] real(r8):: F_abs(-nlevsno+1:0) ! net absorbed radiative energy (lyr) [W/m^2] @@ -314,13 +322,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: energy_sum ! sum of all energy terms; should be 0.0 [W/m^2] real(r8):: F_direct_btm ! direct-beam radiation at bottom of snowpack [W/m^2] real(r8):: mu_not ! cosine of solar zenith angle (used locally) [frc] - integer :: err_idx ! counter for number of times through error loop [nbr] real(r8):: lat_coord ! gridcell latitude (debugging only) real(r8):: lon_coord ! gridcell longitude (debugging only) integer :: sfctype ! underlying surface type (debugging only) real(r8):: pi ! 3.1415... + !----------------------------------------------------------------------- + ! variables used for Toon et al. 1989 2-stream solver (Flanner et al. 2007): ! intermediate variables for radiative transfer approximation: real(r8):: gamma1(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] real(r8):: gamma2(-nlevsno+1:0) ! two-stream coefficient from Toon et al. (lyr) [unitless] @@ -346,6 +355,96 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: X(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) real(r8):: Y(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) !----------------------------------------------------------------------- + ! + ! variables used for Adding-doubling 2-stream solver based on SNICAR-ADv3 version + ! (Dang et al. 2019; Flanner et al. 2021) + real(r8):: trndir(-nlevsno+1:1) ! solar beam down transmission from top + real(r8):: trntdr(-nlevsno+1:1) ! total transmission to direct beam for layers above + real(r8):: trndif(-nlevsno+1:1) ! diffuse transmission to diffuse beam for layers above + real(r8):: rupdir(-nlevsno+1:1) ! reflectivity to direct radiation for layers below + real(r8):: rupdif(-nlevsno+1:1) ! reflectivity to diffuse radiation for layers below + real(r8):: rdndif(-nlevsno+1:1) ! reflectivity to diffuse radiation for layers above + real(r8):: dfdir(-nlevsno+1:1) ! down-up flux at interface due to direct beam at top surface + real(r8):: dfdif(-nlevsno+1:1) ! down-up flux at interface due to diffuse beam at top surface + real(r8):: dftmp(-nlevsno+1:1) ! temporary variable for down-up flux at interface + real(r8):: rdir(-nlevsno+1:0) ! layer reflectivity to direct radiation + real(r8):: rdif_a(-nlevsno+1:0) ! layer reflectivity to diffuse radiation from above + real(r8):: rdif_b(-nlevsno+1:0) ! layer reflectivity to diffuse radiation from below + real(r8):: tdir(-nlevsno+1:0) ! layer transmission to direct radiation (solar beam + diffuse) + real(r8):: tdif_a(-nlevsno+1:0) ! layer transmission to diffuse radiation from above + real(r8):: tdif_b(-nlevsno+1:0) ! layer transmission to diffuse radiation from below + real(r8):: trnlay(-nlevsno+1:0) ! solar beam transm for layer (direct beam only) + real(r8):: ts ! layer delta-scaled extinction optical depth + real(r8):: ws ! layer delta-scaled single scattering albedo + real(r8):: gs ! layer delta-scaled asymmetry parameter + real(r8):: extins ! extinction + real(r8):: alp ! temporary for alpha + real(r8):: gam ! temporary for agamm + real(r8):: amg ! alp - gam + real(r8):: apg ! alp + gam + real(r8):: ue ! temporary for u + real(r8):: refk ! interface multiple scattering + real(r8):: refkp1 ! interface multiple scattering for k+1 + real(r8):: refkm1 ! interface multiple scattering for k-1 + real(r8):: tdrrdir ! direct tran times layer direct ref + real(r8):: tdndif ! total down diffuse = tot tran - direct tran + real(r8):: taus ! scaled extinction optical depth + real(r8):: omgs ! scaled single particle scattering albedo + real(r8):: asys ! scaled asymmetry parameter + real(r8):: lm ! temporary for el + real(r8):: mu ! cosine solar zenith for either snow or water + real(r8):: ne ! temporary for n + real(r8):: R1 ! perpendicular polarization reflection amplitude + real(r8):: R2 ! parallel polarization reflection amplitude + real(r8):: T1 ! perpendicular polarization transmission amplitude + real(r8):: T2 ! parallel polarization transmission amplitude + real(r8):: Rf_dir_a ! fresnel reflection to direct radiation + real(r8):: Tf_dir_a ! fresnel transmission to direct radiation + real(r8):: Rf_dif_a ! fresnel reflection to diff radiation from above + real(r8):: Rf_dif_b ! fresnel reflection to diff radiation from below + real(r8):: Tf_dif_a ! fresnel transmission to diff radiation from above + real(r8):: Tf_dif_b ! fresnel transmission to diff radiation from below + real(r8):: gwt ! gaussian weight + real(r8):: swt ! sum of weights + real(r8):: trn ! layer transmission + real(r8):: rdr ! rdir for gaussian integration + real(r8):: tdr ! tdir for gaussian integration + real(r8):: smr ! accumulator for rdif gaussian integration + real(r8):: smt ! accumulator for tdif gaussian integration + real(r8):: exp_min ! minimum exponential value + real(r8):: difgauspt(1:8) ! Gaussian integration angle + real(r8):: difgauswt(1:8) ! Gaussian integration coefficients/weights + integer :: ng ! gaussian integration index + integer :: snl_btm_itf ! index of bottom snow layer interfaces (1) [idx] + integer :: ngmax = 8 ! maxmimum gaussian integration index + ! constants used in algorithm + real(r8):: c0 = 0.0_r8 + real(r8):: c1 = 1.0_r8 + real(r8):: c3 = 3.0_r8 + real(r8):: c4 = 4.0_r8 + real(r8):: c6 = 6.0_r8 + real(r8):: cp01 = 0.01_r8 + real(r8):: cp5 = 0.5_r8 + real(r8):: cp75 = 0.75_r8 + real(r8):: c1p5 = 1.5_r8 + real(r8):: trmin = 0.001_r8 + real(r8):: argmax = 10.0_r8 ! maximum argument of exponential + ! cconstant and coefficients used for SZA parameterization + real(r8):: sza_a0 = 0.085730_r8 + real(r8):: sza_a1 = -0.630883_r8 + real(r8):: sza_a2 = 1.303723_r8 + real(r8):: sza_b0 = 1.467291_r8 + real(r8):: sza_b1 = -3.338043_r8 + real(r8):: sza_b2 = 6.807489_r8 + real(r8):: puny = 1.0e-11_r8 + real(r8):: mu_75 = 0.2588_r8 ! cosine of 75 degree + real(r8):: sza_c1 ! coefficient, SZA parameteirzation + real(r8):: sza_c0 ! coefficient, SZA parameterization + real(r8):: sza_factor ! factor used to adjust NIR direct albedo + real(r8):: flx_sza_adjust ! direct NIR flux adjustment from sza_factor + real(r8):: mu0 ! incident solar zenith angle + ! + !----------------------------------------------------------------------- ! Enforce expected array sizes SHR_ASSERT_ALL_FL((ubound(coszen) == (/bounds%endc/)), sourcefile, __LINE__) @@ -364,8 +463,18 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ) ! Define parameter, cenlin - nir_bnd_bgn = nint(snicar_numrad_snw/9.6) + 1 ! 5-band starts at 2; 480-band starts at 51 - nir_bnd_end = snicar_numrad_snw + nir_bnd_bgn = nint(snicar_numrad_snw/9.6) + 1 ! 5-band starts at 2; 480-band starts at 51 + nir_bnd_end = snicar_numrad_snw + difgauspt(1:8) = & ! gaussian angles (radians) + (/ 0.9894009_r8, 0.9445750_r8, & + 0.8656312_r8, 0.7554044_r8, & + 0.6178762_r8, 0.4580168_r8, & + 0.2816036_r8, 0.0950125_r8/) + difgauswt(1:8) = & ! gaussian weights + (/ 0.0271525_r8, 0.0622535_r8, & + 0.0951585_r8, 0.1246290_r8, & + 0.1495960_r8, 0.1691565_r8, & + 0.1826034_r8, 0.1894506_r8/) ! Define constants pi = SHR_CONST_PI @@ -381,7 +490,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & do fc = 1,num_nourbanc c_idx = filter_nourbanc(fc) - ! Zero absorbed radiative fluxes: do i=-nlevsno+1,1,1 flx_abs_lcl(:,:) = 0._r8 @@ -395,7 +503,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & h2osno_lcl = h2osno_ice(c_idx,0) endif - ! Qualifier for computing snow RT: ! 1) sunlight from atmosphere model ! 2) minimum amount of snow on ground. @@ -430,8 +537,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & lat_coord = grc%latdeg(g_idx) lon_coord = grc%londeg(g_idx) - - ! Set variables specific to CSIM + ! Set variables specific to CSIM else flg_nosnl = 0 snl_lcl = -1 @@ -443,7 +549,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & sfctype = -1 lat_coord = -90 lon_coord = 0 - endif + endif ! end if flg_snw_ice == 1 + ! Set local aerosol array do j=1,sno_nbr_aer @@ -454,7 +561,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,1) ! cenlin: update for hyperspectral calculation albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,2) - + ! Error check for snow grain size: do i=snl_top,snl_btm,1 @@ -469,6 +576,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & endif enddo + ! Incident flux weighting parameters ! - sum of all VIS bands must equal 1 ! - sum of all NIR bands must equal 1 @@ -481,8 +589,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Band 5: 1.5-5.0um (NIR) ! ! Updated hyperspectral (10-nm) bands (480-band case) cenlin - ! Band 1~50 : 0.2-0.7um (VIS); near-UV (0.2-0.3um) is combined to VIS for now - ! Band 51~480: 0.7~5.0um (NIR) + ! Bands 1~50 : 0.2-0.7um (VIS); near-UV (0.2-0.3um) is combined to VIS for now + ! Bands 51~480: 0.7~5.0um (NIR) ! ! The following weights are appropriate for surface-incident flux in a mid-latitude winter atmosphere ! @@ -500,7 +608,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & flx_wgt(3) = 0.22112347837123_r8 endif - ! 5-band weights + ! 5-band weights elseif (snicar_numrad_snw==5) then ! Direct: if (flg_slr_in == 1) then @@ -527,68 +635,87 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & elseif (flg_slr_in == 2) then flx_wgt(1:snicar_numrad_snw) = flx_wgt_dif480(1:snicar_numrad_snw) ! either VIS or NIR band sum is 1.0 in the input dataset endif - endif + endif ! end if snicar_numrad_snw + + exp_min = exp(-argmax) ! Loop over snow spectral bands do bnd_idx = 1,snicar_numrad_snw - mu_not = coszen(c_idx) ! must set here, because of error handling - flg_dover = 1 ! default is to redo - err_idx = 0 ! number of times through loop + ! Toon et al 2-stream + if (snicar_rt_solver == 1) then + mu_not = coszen(c_idx) ! must set here, because of error handling + + ! Adding-doubling 2-stream + elseif (snicar_rt_solver == 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(coszen(c_idx), cp01) + endif + + flg_dover = 1 ! default is to redo + err_idx = 0 ! number of times through loop do while (flg_dover > 0) - ! 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 (bnd_idx < nir_bnd_bgn) then ! VIS, cenlin - if (flg_dover == 2) then - APRX_TYP = 3 - elseif (flg_dover == 3) then - APRX_TYP = 1 - if (coszen(c_idx) > 0.5_r8) then - mu_not = mu_not - 0.02_r8 - else - mu_not = mu_not + 0.02_r8 - 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 (coszen(c_idx) > 0.5_r8) then - mu_not = mu_not - 0.02_r8 - else - mu_not = mu_not + 0.02_r8 - endif - elseif (flg_dover == 4) then - APRX_TYP = 1 - else - APRX_TYP = 3 - endif + ! Only for Toon et al 2-stream solver: + if (snicar_rt_solver == 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 (bnd_idx < nir_bnd_bgn) then ! VIS, cenlin + if (flg_dover == 2) then + APRX_TYP = 3 + elseif (flg_dover == 3) then + APRX_TYP = 1 + if (coszen(c_idx) > 0.5_r8) then + mu_not = mu_not - 0.02_r8 + else + mu_not = mu_not + 0.02_r8 + 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 (coszen(c_idx) > 0.5_r8) then + mu_not = mu_not - 0.02_r8 + else + mu_not = mu_not + 0.02_r8 + endif + elseif (flg_dover == 4) then + APRX_TYP = 1 + else + APRX_TYP = 3 + endif + endif ! end if bnd_idx < nir_bnd_bgn + + endif ! end if snicar_rt_solver == 1 - endif ! Set direct or diffuse incident irradiance to 1 ! (This has to be within the bnd loop because mu_not is adjusted in rare cases) @@ -615,6 +742,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & endif + !--------------------------- Start snow & aerosol optics -------------------------------- ! Define local Mie parameters based on snow grain size and aerosol species, ! retrieved from a lookup table. if (flg_slr_in == 1) then @@ -719,180 +847,183 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & tau_star(i) = tau(i) enddo endif - - ! Total column optical depth: - ! tau_clm(i) = total optical depth above the bottom of layer i - tau_clm(snl_top) = 0._r8 - do i=snl_top+1,snl_btm,1 - tau_clm(i) = tau_clm(i-1)+tau_star(i-1) - enddo - - ! Direct radiation at bottom of snowpack: - F_direct_btm = albsfc_lcl(bnd_idx)*mu_not * & - exp(-(tau_clm(snl_btm)+tau_star(snl_btm))/mu_not)*pi*flx_slrd_lcl(bnd_idx) - - ! Intermediates - ! Gamma values are approximation-specific. - - ! Eddington - if (APRX_TYP==1) then - do i=snl_top,snl_btm,1 - gamma1(i) = (7._r8-(omega_star(i)*(4._r8+(3._r8*g_star(i)))))/4._r8 - gamma2(i) = -(1._r8-(omega_star(i)*(4._r8-(3._r8*g_star(i)))))/4._r8 - gamma3(i) = (2._r8-(3._r8*g_star(i)*mu_not))/4._r8 - gamma4(i) = 1._r8-gamma3(i) - mu_one = 0.5_r8 - enddo - - ! Quadrature - elseif (APRX_TYP==2) then - do i=snl_top,snl_btm,1 - gamma1(i) = (3._r8**0.5)*(2._r8-(omega_star(i)*(1._r8+g_star(i))))/2._r8 - gamma2(i) = omega_star(i)*(3._r8**0.5)*(1._r8-g_star(i))/2._r8 - gamma3(i) = (1._r8-((3._r8**0.5)*g_star(i)*mu_not))/2._r8 - gamma4(i) = 1._r8-gamma3(i) - mu_one = 1._r8/(3._r8**0.5_r8) - enddo - - ! Hemispheric Mean - elseif (APRX_TYP==3) then - do i=snl_top,snl_btm,1 - gamma1(i) = 2._r8 - (omega_star(i)*(1._r8+g_star(i))) - gamma2(i) = omega_star(i)*(1-g_star(i)) - gamma3(i) = (1._r8-((3._r8**0.5_r8)*g_star(i)*mu_not))/2._r8 - gamma4(i) = 1._r8-gamma3(i) - mu_one = 0.5_r8 - enddo - endif - - ! Intermediates for tri-diagonal solution - do i=snl_top,snl_btm,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 !enddo over snow layers - - - ! Intermediates for tri-diagonal solution - do i=snl_top,snl_btm,1 - if (flg_slr_in == 1) then - - C_pls_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & - 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)*pi*flx_slrd_lcl(bnd_idx)* & - 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)*pi*flx_slrd_lcl(bnd_idx)* & - 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)*pi*flx_slrd_lcl(bnd_idx)* & - 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._r8 - C_mns_btm(i) = 0._r8 - C_pls_top(i) = 0._r8 - C_mns_top(i) = 0._r8 - endif - enddo - - ! 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._r8 - B(i) = e1(snl_top) - D(i) = -e2(snl_top) - E(i) = flx_slri_lcl(bnd_idx)-C_mns_top(snl_top) - - elseif(i==0) then - A(i) = e1(snl_btm)-(albsfc_lcl(bnd_idx)*e3(snl_btm)) - B(i) = e2(snl_btm)-(albsfc_lcl(bnd_idx)*e4(snl_btm)) - D(i) = 0._r8 - E(i) = F_direct_btm-C_pls_btm(snl_btm)+(albsfc_lcl(bnd_idx)*C_mns_btm(snl_btm)) - - 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=snl_top,snl_btm,1 - F_direct(i) = mu_not*pi*flx_slrd_lcl(bnd_idx)*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(snl_top)*tau_star(snl_top))+ & - GAMMA(snl_top))) + (Y(2*snl_lcl+2)*(exp(-lambda(snl_top)* & - tau_star(snl_top))-GAMMA(snl_top))) + C_pls_top(snl_top) - - ! Net flux at bottom = absorbed radiation by underlying surface: - F_btm_net = -F_net(snl_btm) - - - ! Bulk column albedo and surface net flux - albedo = F_sfc_pls/((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) - F_sfc_net = F_sfc_pls - ((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) - - trip = 0 - ! Absorbed flux in each layer - do i=snl_top,snl_btm,1 - if(i==snl_top) 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,bnd_idx) = F_abs(i) - - - ! ERROR check: negative absorption - if (flx_abs_lcl(i,bnd_idx) < -0.00001_r8) then - trip = 1 - endif - enddo - - flx_abs_lcl(1,bnd_idx) = F_btm_net - - if (flg_nosnl == 1) then + !--------------------------- End of snow & aerosol optics -------------------------------- + + + !--------------------------- Start Toon et al. RT solver -------------------------------- + if (snicar_rt_solver == 1) then + + ! Total column optical depth: + ! tau_clm(i) = total optical depth above the bottom of layer i + tau_clm(snl_top) = 0._r8 + do i=snl_top+1,snl_btm,1 + tau_clm(i) = tau_clm(i-1)+tau_star(i-1) + enddo + + ! Direct radiation at bottom of snowpack: + F_direct_btm = albsfc_lcl(bnd_idx)*mu_not * & + exp(-(tau_clm(snl_btm)+tau_star(snl_btm))/mu_not)*pi*flx_slrd_lcl(bnd_idx) + + ! Intermediates + ! Gamma values are approximation-specific. + + ! Eddington + if (APRX_TYP==1) then + do i=snl_top,snl_btm,1 + gamma1(i) = (7._r8-(omega_star(i)*(4._r8+(3._r8*g_star(i)))))/4._r8 + gamma2(i) = -(1._r8-(omega_star(i)*(4._r8-(3._r8*g_star(i)))))/4._r8 + gamma3(i) = (2._r8-(3._r8*g_star(i)*mu_not))/4._r8 + gamma4(i) = 1._r8-gamma3(i) + mu_one = 0.5_r8 + enddo + + ! Quadrature + elseif (APRX_TYP==2) then + do i=snl_top,snl_btm,1 + gamma1(i) = (3._r8**0.5)*(2._r8-(omega_star(i)*(1._r8+g_star(i))))/2._r8 + gamma2(i) = omega_star(i)*(3._r8**0.5)*(1._r8-g_star(i))/2._r8 + gamma3(i) = (1._r8-((3._r8**0.5)*g_star(i)*mu_not))/2._r8 + gamma4(i) = 1._r8-gamma3(i) + mu_one = 1._r8/(3._r8**0.5_r8) + enddo + + ! Hemispheric Mean + elseif (APRX_TYP==3) then + do i=snl_top,snl_btm,1 + gamma1(i) = 2._r8 - (omega_star(i)*(1._r8+g_star(i))) + gamma2(i) = omega_star(i)*(1-g_star(i)) + gamma3(i) = (1._r8-((3._r8**0.5_r8)*g_star(i)*mu_not))/2._r8 + gamma4(i) = 1._r8-gamma3(i) + mu_one = 0.5_r8 + enddo + endif + + ! Intermediates for tri-diagonal solution + do i=snl_top,snl_btm,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 !enddo over snow layers + + ! Intermediates for tri-diagonal solution + do i=snl_top,snl_btm,1 + if (flg_slr_in == 1) then + + C_pls_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & + 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)*pi*flx_slrd_lcl(bnd_idx)* & + 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)*pi*flx_slrd_lcl(bnd_idx)* & + 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)*pi*flx_slrd_lcl(bnd_idx)* & + 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._r8 + C_mns_btm(i) = 0._r8 + C_pls_top(i) = 0._r8 + C_mns_top(i) = 0._r8 + endif + enddo + + ! 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._r8 + B(i) = e1(snl_top) + D(i) = -e2(snl_top) + E(i) = flx_slri_lcl(bnd_idx)-C_mns_top(snl_top) + + elseif(i==0) then + A(i) = e1(snl_btm)-(albsfc_lcl(bnd_idx)*e3(snl_btm)) + B(i) = e2(snl_btm)-(albsfc_lcl(bnd_idx)*e4(snl_btm)) + D(i) = 0._r8 + E(i) = F_direct_btm-C_pls_btm(snl_btm)+(albsfc_lcl(bnd_idx)*C_mns_btm(snl_btm)) + + 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=snl_top,snl_btm,1 + F_direct(i) = mu_not*pi*flx_slrd_lcl(bnd_idx)*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(snl_top)*tau_star(snl_top))+ & + GAMMA(snl_top))) + (Y(2*snl_lcl+2)*(exp(-lambda(snl_top)* & + tau_star(snl_top))-GAMMA(snl_top))) + C_pls_top(snl_top) + + ! Net flux at bottom = absorbed radiation by underlying surface: + F_btm_net = -F_net(snl_btm) + + + ! Bulk column albedo and surface net flux + albedo = F_sfc_pls/((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) + F_sfc_net = F_sfc_pls - ((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) + + trip = 0 + ! Absorbed flux in each layer + do i=snl_top,snl_btm,1 + if(i==snl_top) 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,bnd_idx) = F_abs(i) + + ! ERROR check: negative absorption + if (flx_abs_lcl(i,bnd_idx) < -0.00001_r8) then + trip = 1 + endif + enddo + + flx_abs_lcl(1,bnd_idx) = 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 @@ -901,65 +1032,347 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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,bnd_idx) = F_abs(0) - flx_abs_lcl(1,bnd_idx) = F_btm_net - - endif - - !Underflow check (we've already tripped the error condition above) - do i=snl_top,1,1 - if (flx_abs_lcl(i,bnd_idx) < 0._r8) then - flx_abs_lcl(i,bnd_idx) = 0._r8 - endif - enddo - - F_abs_sum = 0._r8 - do i=snl_top,snl_btm,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._r8) then - trip = 1 - endif - - !ERROR check: - if ((albedo < 0._r8).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(iulog,*) "SNICAR ERROR: FOUND A WORMHOLE. STUCK IN INFINITE LOOP! Called from: ", flg_snw_ice - write(iulog,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0) - write(iulog,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) - write(iulog,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl - write(iulog,*) "SNICAR STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1) - write(iulog,*) "SNICAR STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2) - write(iulog,*) "SNICAR STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3) - write(iulog,*) "SNICAR STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4) - write(iulog,*) "SNICAR STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5) - write(iulog,*) "SNICAR STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6) - l_idx = col%landunit(c_idx) - write(iulog,*) "column index: ", c_idx - write(iulog,*) "landunit type", lun%itype(l_idx) - write(iulog,*) "frac_sno: ", frac_sno(c_idx) - call endrun(subgrid_index=c_idx, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) - else - flg_dover = 0 - endif + flx_abs_lcl(0,bnd_idx) = F_abs(0) + flx_abs_lcl(1,bnd_idx) = F_btm_net + endif + + !Underflow check (we've already tripped the error condition above) + do i=snl_top,1,1 + if (flx_abs_lcl(i,bnd_idx) < 0._r8) then + flx_abs_lcl(i,bnd_idx) = 0._r8 + endif + enddo + + F_abs_sum = 0._r8 + do i=snl_top,snl_btm,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._r8) then + trip = 1 + endif + + !ERROR check: + if ((albedo < 0._r8).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(iulog,*) "SNICAR ERROR: FOUND A WORMHOLE. STUCK IN INFINITE LOOP! Called from: ", flg_snw_ice + write(iulog,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0) + write(iulog,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) + write(iulog,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl + write(iulog,*) "SNICAR STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1) + write(iulog,*) "SNICAR STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2) + write(iulog,*) "SNICAR STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3) + write(iulog,*) "SNICAR STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4) + write(iulog,*) "SNICAR STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5) + write(iulog,*) "SNICAR STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6) + l_idx = col%landunit(c_idx) + write(iulog,*) "column index: ", c_idx + write(iulog,*) "landunit type", lun%itype(l_idx) + write(iulog,*) "frac_sno: ", frac_sno(c_idx) + call endrun(subgrid_index=c_idx, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) + else + flg_dover = 0 + endif + + endif ! end if snicar_rt_solver==1 + !--------------------------- End of Toon et al. RT solver -------------------------------- + + + !--------------------------- Start Adding-doubling RT solver -------------------------------- + if (snicar_rt_solver == 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 = snl_btm + 1 + + ! initialization for layer interface + do i = snl_top,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(snl_top) = c1 + trntdr(snl_top) = c1 + trndif(snl_top) = c1 + rdndif(snl_top) = c0 + + ! begin main level loop for snow layer interfaces except for the very bottom + do i = snl_top,snl_btm,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 + 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)) + 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(k) > 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 ! end i main level loop + + ! 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 + rupdir(snl_btm_itf) = albsfc(c_idx,2) + rupdif(snl_btm_itf) = albsfc(c_idx,2) + if (bnd_idx < nir_bnd_bgn) then + rupdir(snl_btm_itf) = albsfc(c_idx,1) + rupdif(snl_btm_itf) = albsfc(c_idx,1) + endif + + do i=snl_btm,snl_top,-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 = snl_top, 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 ! k + + ! SNICAR_AD_RT is called twice for direct and diffuse incident fluxes + ! direct incident + if (flg_slr_in == 1) then + albedo = rupdir(snl_top) + dftmp = dfdir + refk = c1/(c1 - rdndif(snl_top)*rupdif(snl_top)) + F_sfc_pls = (trndir(snl_top)*rupdir(snl_top) + & + (trntdr(snl_top)-trndir(snl_top)) & + *rupdif(snl_top))*refk + !diffuse incident + else + albedo = rupdif(snl_top) + dftmp = dfdif + refk = c1/(c1 - rdndif(snl_top)*rupdif(snl_top)) + F_sfc_pls = trndif(snl_top)*rupdif(snl_top)*refk + endif + + ! Absorbed flux in each layer + do i=snl_top,snl_btm,1 + F_abs(i) = dftmp(i)-dftmp(i+1) + flx_abs_lcl(i,bnd_idx) = F_abs(i) + + ! ERROR check: negative absorption + if (flx_abs_lcl(i,bnd_idx) < -0.00001_r8) then + write (iulog,"(a,e13.6,a,i6,a,i6)") "SNICAR ERROR: negative absoption : ", & + flx_abs_lcl(i,bnd_idx), " at timestep: ", nstep, " at column: ", c_idx + write(iulog,*) "SNICAR_AD STATS: snw_rds(0)= ", snw_rds(c_idx,0) + write(iulog,*) "SNICAR_AD STATS: L_snw(0)= ", L_snw(0) + write(iulog,*) "SNICAR_AD STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl + write(iulog,*) "SNICAR_AD STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1) + write(iulog,*) "SNICAR_AD STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2) + write(iulog,*) "SNICAR_AD STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3) + write(iulog,*) "SNICAR_AD STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4) + write(iulog,*) "SNICAR_AD STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5) + write(iulog,*) "SNICAR_AD STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6) + call endrun(subgrid_index=c_idx, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) + 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,bnd_idx) = 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,bnd_idx) = F_abs(0) + flx_abs_lcl(1,bnd_idx) = F_btm_net + endif + + !Underflow check (we've already tripped the error condition above) + do i=snl_top,1,1 + if (flx_abs_lcl(i,bnd_idx) < 0._r8) then + flx_abs_lcl(i,bnd_idx) = 0._r8 + endif + enddo + + F_abs_sum = 0._r8 + do i=snl_top,snl_btm,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 snicar_rt_solver==2 + !--------------------------- End of Adding-doubling RT solver -------------------------------- enddo !enddo while (flg_dover > 0) @@ -969,6 +1382,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & if (abs(energy_sum) > 0.00001_r8) then write (iulog,"(a,e12.6,a,i6,a,i6)") "SNICAR ERROR: Energy conservation error of : ", energy_sum, & " at timestep: ", nstep, " at column: ", c_idx + write(iulog,*) "F_abs_sum: ",F_abs_sum + write(iulog,*) "F_btm_net: ",F_btm_net + write(iulog,*) "F_sfc_pls: ",F_sfc_pls + write(iulog,*) "mu_not*pi*flx_slrd_lcl(bnd_idx): ", mu_not*pi*flx_slrd_lcl(bnd_idx) + write(iulog,*) "flx_slri_lcl(bnd_idx)", flx_slri_lcl(bnd_idx) + write(iulog,*) "bnd_idx", bnd_idx + write(iulog,*) "F_abs", F_abs + write(iulog,*) "albedo", albedo call endrun(subgrid_index=c_idx, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) endif @@ -1010,7 +1431,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Weight output NIR albedo appropriately - ! for 5- and 3-band cases cenlin + ! for 5- and 3-band cases cenlin if (snicar_numrad_snw <= 5) then albout(c_idx,1) = albout_lcl(1) flx_sum = 0._r8 @@ -1019,7 +1440,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & end do albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) end if - ! for 480-band case, cenlin + + ! for 480-band case, cenlin if (snicar_numrad_snw == 480) then ! average for VIS band flx_sum = 0._r8 @@ -1036,7 +1458,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & end if ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately - ! for 5- and 3-band cases cenlin + ! for 5- and 3-band cases cenlin if (snicar_numrad_snw <= 5) then flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) do i=snl_top,1,1 @@ -1047,7 +1469,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) end do end if - ! for 480-band case cenlin + + ! for 480-band case cenlin if (snicar_numrad_snw == 480) then do i=snl_top,1,1 ! average for VIS band @@ -1065,12 +1488,28 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & end do end if - ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo + ! high solar zenith angle adjustment for Adding-doubling solver results + if (snicar_rt_solver==2) then + ! near-IR direct albedo/absorption adjustment for high solar zenith angles + ! solar zenith angle parameterization + ! calculate the scaling factor for NIR direct albedo if SZA>75 degree + if ((mu_not < mu_75) .and. (flg_slr_in == 1)) then + sza_c1 = sza_a0 + sza_a1 * mu_not + sza_a2 * mu_not**2 + sza_c0 = sza_b0 + sza_b1 * mu_not + sza_b2 * mu_not**2 + sza_factor = sza_c1 * (log10(snw_rds_lcl(snl_top) * c1) - c6) + sza_c0 + flx_sza_adjust = albout(c_idx,2) * (sza_factor-c1) * sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + albout(c_idx,2) = albout(c_idx,2) * sza_factor + flx_abs(c_idx,snl_top,2) = flx_abs(c_idx,snl_top,2) - flx_sza_adjust + endif + endif ! end of snicar_rt_solver==2 + + + ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo elseif ( (coszen(c_idx) > 0._r8) .and. (h2osno_lcl < min_snw) .and. (h2osno_lcl > 0._r8) ) then albout(c_idx,1) = albsfc(c_idx,1) albout(c_idx,2) = albsfc(c_idx,2) - ! There is either zero snow, or no sun + ! There is either zero snow, or no sun else albout(c_idx,1) = 0._r8 albout(c_idx,2) = 0._r8 diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 8fac958db5..9e4e0235f0 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -223,6 +223,10 @@ module clm_varctl ! option to turn off aerosol effect in snow in SNICAR logical, public :: snicar_use_aerosol = .true. ! if .false., turn off aerosol deposition flux + ! option for two different SNICAR radiative transfer solver, cenlin + integer, public :: snicar_rt_solver = 2 ! 1->Toon et a 1989 2-stream (Flanner et al. 2007) + ! 2->Adding-doubling 2-stream (Dang et al.2019) + !---------------------------------------------------------- ! C isotopes !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 91fd1cc61a..ff5305606e 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -202,7 +202,7 @@ subroutine control_init(dtime) soil_layerstruct_userdefined_nlevsoi, use_subgrid_fluxes, snow_cover_fraction_method, & irrigate, run_zero_weight_urban, all_active, & crop_fsat_equals_zero, for_testing_run_ncdiopio_tests,snicar_numrad_snw,snicar_solarspec,& - snicar_snw_optics,snicar_dust_optics,snicar_use_aerosol ! cenlin + snicar_snw_optics,snicar_dust_optics,snicar_use_aerosol,snicar_rt_solver ! cenlin ! vertical soil mixing variables namelist /clm_inparm/ & @@ -593,6 +593,12 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if + ! check on SNICAR solver option + if ( (snicar_rt_solver < 0) .or. (snicar_rt_solver > 2) ) then + call endrun(msg=' ERROR: snicar_rt_solver is out of a reasonable range (1,2)'//& + errMsg(sourcefile, __LINE__)) + end if + ! Consistency settings for nrevsn if (nsrest == nsrStartup ) nrevsn = ' ' @@ -818,6 +824,7 @@ subroutine control_spmd() call mpi_bcast (snicar_snw_optics, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_dust_optics, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin + call mpi_bcast (snicar_rt_solver, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin ! snow pack variables call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier) @@ -1006,6 +1013,7 @@ subroutine control_print () write(iulog,*) ' Number of snow layers =', nlevsno write(iulog,*) ' Max snow depth (mm) =', h2osno_max write(iulog,*) ' Number of bands in SNICAR snow albedo calculation =', snicar_numrad_snw ! cenlin + write(iulog,*) ' SNICAR radiative transfer solver type = ',snicar_rt_solver ! cenlin write(iulog,*) ' glc number of elevation classes =', maxpatch_glc if (glc_do_dynglacier) then From 3e9299f8a5a8c104d2f8c41c7e778794730a4036 Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Thu, 27 Jan 2022 22:22:05 -0700 Subject: [PATCH 05/62] add nonspherical snow grains with namelist option --- .../namelist_definition_ctsm.xml | 5 + src/biogeophys/SnowSnicarMod.F90 | 242 ++++++++++++++++-- src/main/clm_varctl.F90 | 3 + src/main/controlMod.F90 | 44 ++-- 4 files changed, 261 insertions(+), 33 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 6a841ae588..5a07a2a9f4 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -193,6 +193,11 @@ Toggle to turn on/off aerosol deposition flux in snow in SNICAR SNICAR radiative transfer solver type + +snow grain shape used in SNICAR snow albedo calculation + + Index of rooting profile for water diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index fc7c95bcb7..02dd763d14 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -11,7 +11,8 @@ module SnowSnicarMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : iulog, snicar_numrad_snw, snicar_rt_solver ! cenlin + use clm_varctl , only : iulog, snicar_numrad_snw, snicar_rt_solver, & + snicar_snw_shape ! cenlin use clm_varcon , only : tfrz use shr_const_mod , only : SHR_CONST_RHOICE use abortutils , only : endrun @@ -354,8 +355,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: DS(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) real(r8):: X(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) real(r8):: Y(-2*nlevsno+1:0) ! tri-diag intermediate variable from Toon et al. (2*lyr) + !----------------------------------------------------------------------- - ! ! variables used for Adding-doubling 2-stream solver based on SNICAR-ADv3 version ! (Dang et al. 2019; Flanner et al. 2021) real(r8):: trndir(-nlevsno+1:1) ! solar beam down transmission from top @@ -428,7 +429,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: cp75 = 0.75_r8 real(r8):: c1p5 = 1.5_r8 real(r8):: trmin = 0.001_r8 - real(r8):: argmax = 10.0_r8 ! maximum argument of exponential + real(r8):: argmax = 10.0_r8 ! maximum argument of exponential ! cconstant and coefficients used for SZA parameterization real(r8):: sza_a0 = 0.085730_r8 real(r8):: sza_a1 = -0.630883_r8 @@ -437,12 +438,54 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: sza_b1 = -3.338043_r8 real(r8):: sza_b2 = 6.807489_r8 real(r8):: puny = 1.0e-11_r8 - real(r8):: mu_75 = 0.2588_r8 ! cosine of 75 degree - real(r8):: sza_c1 ! coefficient, SZA parameteirzation - real(r8):: sza_c0 ! coefficient, SZA parameterization - real(r8):: sza_factor ! factor used to adjust NIR direct albedo - real(r8):: flx_sza_adjust ! direct NIR flux adjustment from sza_factor - real(r8):: mu0 ! incident solar zenith angle + real(r8):: mu_75 = 0.2588_r8 ! cosine of 75 degree + real(r8):: sza_c1 ! coefficient, SZA parameteirzation + real(r8):: sza_c0 ! coefficient, SZA parameterization + real(r8):: sza_factor ! factor used to adjust NIR direct albedo + real(r8):: flx_sza_adjust ! direct NIR flux adjustment from sza_factor + real(r8):: mu0 ! incident solar zenith angle + + !----------------------------------------------------------------------- + ! variables used for nonspherical snow grain treatment (He et al. 2017 J of Climate): + integer :: sno_shp(-nlevsno+1:0) ! Snow shape type: 1=sphere; 2=spheroid; 3=hexagonal plate; 4=koch snowflake + ! currently only assuming same shapes for all snow layers + real(r8) :: sno_fs(-nlevsno+1:0) ! Snow shape factor: ratio of nonspherical grain effective radii to that of equal-volume sphere + ! only activated when snicar_snw_shape > 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 waterdiagnosticbulk_inst%frac_sno_eff_col & ! Input: [real(r8) (:)] fraction of ground covered by snow (0 to 1) ) - ! Define parameter, cenlin + ! initialize parameter, cenlin nir_bnd_bgn = nint(snicar_numrad_snw/9.6) + 1 ! 5-band starts at 2; 480-band starts at 51 nir_bnd_end = snicar_numrad_snw + + ! initialize for adding-doubling solver difgauspt(1:8) = & ! gaussian angles (radians) (/ 0.9894009_r8, 0.9445750_r8, & 0.8656312_r8, 0.7554044_r8, & @@ -476,6 +521,39 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 0.1495960_r8, 0.1691565_r8, & 0.1826034_r8, 0.1894506_r8/) + ! initialize for nonspherical snow grains + sno_shp(:) = snicar_snw_shape ! currently only assuming same shapes for all snow layers + sno_fs(:) = 0._r8 + sno_AR(:) = 0._r8 + ! Table 3 of He et al 2017 JC + g_wvl(1:8) = (/ 0.25_r8, 0.70_r8, 1.41_r8, 1.90_r8, & + 2.50_r8, 3.50_r8, 4.00_r8, 5.00_r8 /) + g_wvl_ct(1:7) = g_wvl(2:8) / 2._r8 + g_wvl(1:7) / 2._r8 + g_b0(1:7) = (/ 9.76029E-1_r8, 9.67798E-1_r8, 1.00111_r8, 1.00224_r8, & + 9.64295E-1_r8, 9.97475E-1_r8, 9.97475E-1_r8 /) + g_b1(1:7) = (/ 5.21042E-1_r8, 4.96181E-1_r8, 1.83711E-1_r8, 1.37082E-1_r8, & + 5.50598E-2_r8, 8.48743E-2_r8, 8.48743E-2_r8 /) + g_b2(1:7) = (/ -2.66792E-4_r8, 1.14088E-3_r8, 2.37011E-4_r8, -2.35905E-4_r8, & + 8.40449E-4_r8, -4.71484E-4_r8, -4.71484E-4_r8 /) + ! Tables 1 & 2 and Eqs. 3.1-3.4 from Fu, 2007 JAS + g_F07_c2(1:7) = (/ 1.349959E-1_r8, 1.115697E-1_r8, 9.853958E-2_r8, 5.557793E-2_r8, & + -1.233493E-1_r8, 0.0_r8 , 0.0_r8 /) + g_F07_c1(1:7) = (/ -3.987320E-1_r8, -3.723287E-1_r8, -3.924784E-1_r8, -3.259404E-1_r8, & + 4.429054E-2_r8, -1.726586E-1_r8, -1.726586E-1_r8 /) + g_F07_c0(1:7) = (/ 7.938904E-1_r8, 8.030084E-1_r8, 8.513932E-1_r8, 8.692241E-1_r8, & + 7.085850E-1_r8, 6.412701E-1_r8, 6.412701E-1_r8 /) + g_F07_p2(1:7) = (/ 3.165543E-3_r8, 2.014810E-3_r8, 1.780838E-3_r8, 6.987734E-4_r8, & + -1.882932E-2_r8, -2.277872E-2_r8, -2.277872E-2_r8 /) + g_F07_p1(1:7) = (/ 1.140557E-1_r8, 1.143152E-1_r8, 1.143814E-1_r8, 1.071238E-1_r8, & + 1.353873E-1_r8, 1.914431E-1_r8, 1.914431E-1_r8 /) + g_F07_p0(1:7) = (/ 5.292852E-1_r8, 5.425909E-1_r8, 5.601598E-1_r8, 6.023407E-1_r8, & + 6.473899E-1_r8, 4.634944E-1_r8, 4.634944E-1_r8 /) + ! band center wavelength (um) + wvl_ct5(1:5) = (/ 0.5_r8, 0.85_r8, 1.1_r8, 1.35_r8, 3.25_r8 /) ! 5-band + do igb = 1,480 + wvl_ct480(igb) = 0.205_r8 + 0.01_r8 * (igb-1) ! 480-band + enddo + ! Define constants pi = SHR_CONST_PI @@ -492,7 +570,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Zero absorbed radiative fluxes: do i=-nlevsno+1,1,1 - flx_abs_lcl(:,:) = 0._r8 + flx_abs_lcl(i,:) = 0._r8 flx_abs(c_idx,i,:) = 0._r8 enddo @@ -743,26 +821,110 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & !--------------------------- Start snow & aerosol optics -------------------------------- - ! Define local Mie parameters based on snow grain size and aerosol species, - ! retrieved from a lookup table. + ! Define local Mie parameters based on snow grain size and aerosol species retrieved from a lookup table. + + ! Spherical snow: single-scatter albedo, mass extinction coefficient, asymmetry factor if (flg_slr_in == 1) then do i=snl_top,snl_btm,1 rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 ! snow optical properties (direct radiation) ss_alb_snw_lcl(i) = ss_alb_snw_drc(rds_idx,bnd_idx) - asm_prm_snw_lcl(i) = asm_prm_snw_drc(rds_idx,bnd_idx) ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_drc(rds_idx,bnd_idx) + if (sno_shp(i) == 1) asm_prm_snw_lcl(i) = asm_prm_snw_drc(rds_idx,bnd_idx) enddo elseif (flg_slr_in == 2) then do i=snl_top,snl_btm,1 rds_idx = snw_rds_lcl(i) - snw_rds_min_tbl + 1 ! snow optical properties (diffuse radiation) ss_alb_snw_lcl(i) = ss_alb_snw_dfs(rds_idx,bnd_idx) - asm_prm_snw_lcl(i) = asm_prm_snw_dfs(rds_idx,bnd_idx) ext_cff_mss_snw_lcl(i) = ext_cff_mss_snw_dfs(rds_idx,bnd_idx) + if (sno_shp(i) == 1) asm_prm_snw_lcl(i) = asm_prm_snw_dfs(rds_idx,bnd_idx) enddo endif + ! Nonspherical snow: shape-dependent asymmetry factors + do i=snl_top,snl_btm,1 + + ! spheroid + if (sno_shp(i) == 2) then + diam_ice = 2._r8 * snw_rds_lcl(i) ! unit: microns + if (sno_fs(i) == 0._r8) then + fs_sphd = 0.929_r8 ! default; He et al. (2017), Table 1 + else + fs_sphd = sno_fs(i) ! user specified value + endif + fs_hex = 0.788_r8 ! reference shape factor + if (sno_AR(i) == 0._r8) then + AR_tmp = 0.5_r8 ! 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._r8) ! Eqn. 3.1 in Fu (2007) + enddo + + ! hexagonal plate + elseif (sno_shp(i) == 3) then + diam_ice = 2._r8 * snw_rds_lcl(i) ! unit: microns + if (sno_fs(i) == 0._r8) then + fs_hex0 = 0.788_r8 ! default; He et al. (2017), Table 1 + else + fs_hex0 = sno_fs(i) ! user specified value + endif + fs_hex = 0.788_r8 ! reference shape factor + if (sno_AR(i) == 0._r8) then + AR_tmp = 2.5_r8 ! 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._r8) ! Eqn. 3.3 in Fu (2007) + enddo + + ! Koch snowflake + elseif (sno_shp(i) == 4) then + diam_ice = 2._r8 * snw_rds_lcl(i) / 0.544_r8 ! unit: microns + if (sno_fs(i) == 0._r8) then + fs_koch = 0.712_r8 ! default; He et al. (2017), Table 1 + else + fs_koch = sno_fs(i) ! user specified value + endif + fs_hex = 0.788_r8 ! reference shape factor + if (sno_AR(i) == 0._r8) then + AR_tmp = 2.5_r8 ! 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._r8) ! Eqn. 3.3 in Fu (2007) + enddo + + endif ! if snow shape + + ! 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 + if (snicar_numrad_snw == 5) then + call piecewise_linear_interp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct5(bnd_idx),g_Cg_intp) + call piecewise_linear_interp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct5(bnd_idx),gg_F07_intp) + endif + if (snicar_numrad_snw == 480) then + call piecewise_linear_interp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct480(bnd_idx),g_Cg_intp) + call piecewise_linear_interp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct480(bnd_idx),gg_F07_intp) + endif + g_ice_F07 = gg_F07_intp + (1._r8 - gg_F07_intp) / ss_alb_snw_lcl(i) / 2._r8 ! 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_r8) asm_prm_snw_lcl(i) = 0.99_r8 !avoid unreasonable values (rarely occur in large-size spheroid cases) + + enddo ! snow layer loop + + ! aerosol species 1 optical properties ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) @@ -2197,5 +2359,53 @@ subroutine SnowAge_init( ) endif end subroutine SnowAge_init - + + !----------------------------------------------------------------------- + subroutine piecewise_linear_interp1d(nd, xd, yd, xi, yi) + + ! 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), 01/27/2022 + + implicit none + + integer , intent(in) :: nd ! number of data points of (xd) + real(r8), intent(in) :: xd(1:nd) ! x-value of data points + real(r8), intent(in) :: yd(1:nd) ! y-value of data points + real(r8), intent(in) :: xi ! x-value for to-be-interpolated point + real(r8), intent(out) :: yi ! the interpolated value at xi + + ! local variables + integer :: i, k ! loop index + real(r8) :: t + + yi = 0._r8 + + ! 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._r8 - t) * yd(1) + t * yd(2) + elseif ( xi > xd(nd) ) then ! extrapolate + t = ( xi - xd(nd-1) ) / ( xd(nd) - xd(nd-1) ) + yi = (1._r8 - 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._r8 - t) * yd(k-1) + t * yd(k) + exit + endif + enddo + endif + + return + + end subroutine piecewise_linear_interp1d + end module SnowSnicarMod diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 9e4e0235f0..a313eed435 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -227,6 +227,9 @@ module clm_varctl integer, public :: snicar_rt_solver = 2 ! 1->Toon et a 1989 2-stream (Flanner et al. 2007) ! 2->Adding-doubling 2-stream (Dang et al.2019) + ! option for snow grain shape in SNICAR (He et al. 2017 JC), ceniln + integer, public :: snicar_snw_shape = 1 ! 1->sphere; 2->spheroid; 3->hexagonal plate; 4->Koch snowflake + !---------------------------------------------------------- ! C isotopes !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index ff5305606e..608bef6cb1 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -201,8 +201,9 @@ subroutine control_init(dtime) albice, soil_layerstruct_predefined, soil_layerstruct_userdefined, & soil_layerstruct_userdefined_nlevsoi, use_subgrid_fluxes, snow_cover_fraction_method, & irrigate, run_zero_weight_urban, all_active, & - crop_fsat_equals_zero, for_testing_run_ncdiopio_tests,snicar_numrad_snw,snicar_solarspec,& - snicar_snw_optics,snicar_dust_optics,snicar_use_aerosol,snicar_rt_solver ! cenlin + crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & + snicar_numrad_snw, snicar_solarspec, snicar_snw_optics, snicar_dust_optics, & + snicar_use_aerosol, snicar_rt_solver, snicar_snw_shape ! cenlin ! vertical soil mixing variables namelist /clm_inparm/ & @@ -571,34 +572,40 @@ subroutine control_init(dtime) ! check on snow albedo wavelength bands, cenlin if ( (snicar_numrad_snw /= 5) .and. (snicar_numrad_snw /= 480) ) then - call endrun(msg=' ERROR: snicar_numrad_snw is out of a reasonable range (5 or 480)'//& + call endrun(msg=' ERROR: snicar_numrad_snw is out of a reasonable range (5, 480)'//& errMsg(sourcefile, __LINE__)) end if ! check on downward solar radiation spectrum, cenlin - if ( (snicar_solarspec < 0) .or. (snicar_solarspec > 6) ) then - call endrun(msg=' ERROR: snicar_solarspec is out of a reasonable range (1~6)'//& + if ( (snicar_solarspec < 1) .or. (snicar_solarspec > 6) ) then + call endrun(msg=' ERROR: snicar_solarspec is out of a reasonable range (1,2,3,4,5,6)'//& errMsg(sourcefile, __LINE__)) end if ! check on snow optics type - if ( (snicar_snw_optics < 0) .or. (snicar_snw_optics > 3) ) then - call endrun(msg=' ERROR: snicar_snw_optics is out of a reasonable range (1~3)'//& + if ( (snicar_snw_optics < 1) .or. (snicar_snw_optics > 3) ) then + call endrun(msg=' ERROR: snicar_snw_optics is out of a reasonable range (1,2,3)'//& errMsg(sourcefile, __LINE__)) end if ! check on dust optics type - if ( (snicar_dust_optics < 0) .or. (snicar_dust_optics > 3) ) then - call endrun(msg=' ERROR: snicar_dust_optics is out of a reasonable range (1~3)'//& + if ( (snicar_dust_optics < 1) .or. (snicar_dust_optics > 3) ) then + call endrun(msg=' ERROR: snicar_dust_optics is out of a reasonable range (1,2,3)'//& errMsg(sourcefile, __LINE__)) end if ! check on SNICAR solver option - if ( (snicar_rt_solver < 0) .or. (snicar_rt_solver > 2) ) then + if ( (snicar_rt_solver < 1) .or. (snicar_rt_solver > 2) ) then call endrun(msg=' ERROR: snicar_rt_solver is out of a reasonable range (1,2)'//& errMsg(sourcefile, __LINE__)) end if + ! check on SNICAR snow grain shape option + if ( (snicar_snw_shape < 1) .or. (snicar_snw_shape > 4) ) then + call endrun(msg=' ERROR: snicar_snw_shape is out of a reasonable range (1,2,3,4)'//& + errMsg(sourcefile, __LINE__)) + end if + ! Consistency settings for nrevsn if (nsrest == nsrStartup ) nrevsn = ' ' @@ -825,6 +832,7 @@ subroutine control_spmd() call mpi_bcast (snicar_dust_optics, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_rt_solver, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin + call mpi_bcast (snicar_snw_shape, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin ! snow pack variables call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier) @@ -1001,19 +1009,21 @@ subroutine control_print () ! cenlin if (snicar_numrad_snw==480) then if (fsnowoptics480 == ' ') then - write(iulog,*) ' SNICAR snow optical properties (480-band) file NOT set' + write(iulog,*) ' SNICAR: snow optical properties (480-band) file NOT set' else - write(iulog,*) ' SNICAR snow optical properties (480-band) file = ',trim(fsnowoptics480) + write(iulog,*) ' SNICAR: snow optical properties (480-band) file = ',trim(fsnowoptics480) endif - write(iulog,*) ' Downward solar radiation spectrum for SNICAR =', snicar_solarspec - write(iulog,*) ' Snow refractive index type = ', snicar_snw_optics - write(iulog,*) ' Dust optics type = ', snicar_dust_optics + write(iulog,*) ' SNICAR: downward solar radiation spectrum type =', snicar_solarspec + write(iulog,*) ' SNICAR: snow refractive index type = ', snicar_snw_optics + write(iulog,*) ' SNICAR: dust optics type = ', snicar_dust_optics endif write(iulog,*) ' Number of snow layers =', nlevsno write(iulog,*) ' Max snow depth (mm) =', h2osno_max - write(iulog,*) ' Number of bands in SNICAR snow albedo calculation =', snicar_numrad_snw ! cenlin - write(iulog,*) ' SNICAR radiative transfer solver type = ',snicar_rt_solver ! cenlin + write(iulog,*) ' SNICAR: number of bands in snow albedo calculation =', snicar_numrad_snw ! cenlin + write(iulog,*) ' SNICAR: radiative transfer solver type = ',snicar_rt_solver ! cenlin + write(iulog,*) ' SNICAR: snow grain shape type = ',snicar_snw_shape ! cenlin + write(iulog,*) ' glc number of elevation classes =', maxpatch_glc if (glc_do_dynglacier) then From e006dc54c2f17e9004894f3f608a5279d2618e6d Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Fri, 28 Jan 2022 19:39:30 -0700 Subject: [PATCH 06/62] add BC-snow internal mixing and namelist control --- .../namelist_definition_ctsm.xml | 5 + src/biogeophys/SnowSnicarMod.F90 | 141 +++++++++++++++--- src/main/clm_varctl.F90 | 3 + src/main/controlMod.F90 | 5 +- 4 files changed, 132 insertions(+), 22 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 5a07a2a9f4..261244e21e 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -198,6 +198,11 @@ SNICAR radiative transfer solver type snow grain shape used in SNICAR snow albedo calculation + +option to activate BC-snow internal mixing in SNICAR snow albedo calculation + + Index of rooting profile for water diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 02dd763d14..087fb374c7 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -12,7 +12,7 @@ module SnowSnicarMod use shr_sys_mod , only : shr_sys_flush use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varctl , only : iulog, snicar_numrad_snw, snicar_rt_solver, & - snicar_snw_shape ! cenlin + snicar_snw_shape, snicar_snobc_intmix ! cenlin use clm_varcon , only : tfrz use shr_const_mod , only : SHR_CONST_RHOICE use abortutils , only : endrun @@ -486,6 +486,29 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8) :: gg_F07_intp ! interpolated asymmetry factor related to geometric reflection & refraction real(r8) :: g_ice_F07 ! asymmetry factor for Fu 2007 parameterization value integer :: igb ! loop index + + !----------------------------------------------------------------------- + ! variables used for BC-snow internal mixing (He et al. 2017 J of Climate): + real(r8) :: enh_omg_bcint ! BC-induced enhancement in snow single-scattering co-albedo (1-omega) + real(r8) :: enh_omg_bcint_tmp(1:16) ! temporary BC-induced enhancement in snow 1-omega + real(r8) :: enh_omg_bcint_tmp2(1:16) ! temporary BC-induced enhancement in snow 1-omega + real(r8) :: bcint_wvl(1:17) ! Parameterization band (0.2-1.2um) for BC-induced enhancement in snow 1-omega + real(r8) :: bcint_wvl_ct(1:16) ! Parameterization band center wavelength (um) + real(r8) :: bcint_d0(1:16) ! Parameterization coefficients at each band center wavelength + real(r8) :: bcint_d1(1:16) ! Parameterization coefficients at each band center wavelength + real(r8) :: bcint_d2(1:16) ! Parameterization coefficients at each band center wavelength + real(r8) :: den_bc = 1.49_r8 ! target BC particle density (g/cm3) used in BC MAC adjustment + real(r8) :: Re_bc = 0.045 ! target BC effective radius (um) used in BC MAC adjustment + real(r8) :: bcint_m(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix + real(r8) :: bcint_n(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix + real(r8) :: bcint_dd ! intermediate parameter + real(r8) :: bcint_dd2 ! intermediate parameter + real(r8) :: bcint_f ! intermediate parameter + real(r8) :: enh_omg_bcint_intp ! BC-induced enhancement in snow 1-omega (logscale) interpolated to CLM wavelength + real(r8) :: enh_omg_bcint_intp2 ! BC-induced enhancement in snow 1-omega interpolated to CLM wavelength + real(r8) :: wvl_doint ! wavelength doing BC-snow int mixing (<=1.2um) + integer :: ibb ! loop index + ! !----------------------------------------------------------------------- @@ -548,7 +571,29 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 1.353873E-1_r8, 1.914431E-1_r8, 1.914431E-1_r8 /) g_F07_p0(1:7) = (/ 5.292852E-1_r8, 5.425909E-1_r8, 5.601598E-1_r8, 6.023407E-1_r8, & 6.473899E-1_r8, 4.634944E-1_r8, 4.634944E-1_r8 /) - ! band center wavelength (um) + + ! initialize for BC-snow internal mixing + ! Eq. 8b & Table 4 in He et al., 2017 J. Climate (wavelength>1.2um, no BC-snow int mixi effect) + bcint_wvl(1:17) = (/ 0.20_r8, 0.25_r8, 0.30_r8, 0.33_r8, 0.36_r8, 0.40_r8, 0.44_r8, 0.48_r8, & + 0.52_r8, 0.57_r8, 0.64_r8, 0.69_r8, 0.75_r8, 0.78_r8, 0.87_r8, 1._r8, 1.2_r8 /) + bcint_wvl_ct(1:16) = bcint_wvl(2:17) / 2._r8 + bcint_wvl(1:16) / 2._r8 + bcint_d0(1:16) = (/ 2.48045_r8 , 4.70305_r8 , 4.68619_r8 , 4.67369_r8 , 4.65040_r8 , & + 2.40364_r8 , 7.95408E-1_r8, 2.92745E-1_r8, 8.63396E-2_r8, 2.76299E-2_r8, & + 1.40864E-2_r8, 8.65705E-3_r8, 6.12971E-3_r8, 4.45697E-3_r8, 3.06648E-2_r8, & + 7.96544E-1_r8 /) + bcint_d1(1:16) = (/ 9.77209E-1_r8, 9.73317E-1_r8, 9.79650E-1_r8, 9.84579E-1_r8, 9.93537E-1_r8, & + 9.95955E-1_r8, 9.95218E-1_r8, 9.74284E-1_r8, 9.81193E-1_r8, 9.81239E-1_r8, & + 9.55515E-1_r8, 9.10491E-1_r8, 8.74196E-1_r8, 8.27238E-1_r8, 4.82870E-1_r8, & + 4.36649E-2_r8 /) + bcint_d2(1:16) = (/ 3.95960E-1_r8, 2.04820E-1_r8, 2.07410E-1_r8, 2.09390E-1_r8, 2.13030E-1_r8, & + 4.18570E-1_r8, 1.29682_r8 , 3.75514_r8 , 1.27372E+1_r8, 3.93293E+1_r8, & + 8.78918E+1_r8, 1.86969E+2_r8, 3.45600E+2_r8, 7.08637E+2_r8, 1.41067E+3_r8, & + 2.57288E+2_r8 /) + ! Eq. 1a,1b and Table S1 in He et al. 2018 GRL + bcint_m(1:3) = (/ -0.8724_r8, -0.1866_r8, -0.0046_r8 /) + bcint_n(1:3) = (/ -0.0072_r8, -0.1918_r8, -0.5177_r8 /) + + ! SNICAR/CLM snow band center wavelength (um) wvl_ct5(1:5) = (/ 0.5_r8, 0.85_r8, 1.1_r8, 1.35_r8, 3.25_r8 /) ! 5-band do igb = 1,480 wvl_ct480(igb) = 0.205_r8 + 0.01_r8 * (igb-1) ! 480-band @@ -925,42 +970,42 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & enddo ! snow layer loop - ! aerosol species 1 optical properties + ! aerosol species 1 optical properties, hydrophilic BC ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) - ! aerosol species 2 optical properties + ! aerosol species 2 optical properties, hydrophobic BC ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) asm_prm_aer_lcl(2) = asm_prm_bc2(bnd_idx) ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc2(bnd_idx) - ! aerosol species 3 optical properties + ! aerosol species 3 optical properties, hydrophilic OC ss_alb_aer_lcl(3) = ss_alb_oc1(bnd_idx) asm_prm_aer_lcl(3) = asm_prm_oc1(bnd_idx) ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc1(bnd_idx) - ! aerosol species 4 optical properties + ! aerosol species 4 optical properties, hydrophobic OC ss_alb_aer_lcl(4) = ss_alb_oc2(bnd_idx) asm_prm_aer_lcl(4) = asm_prm_oc2(bnd_idx) ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) - ! aerosol species 5 optical properties + ! aerosol species 5 optical properties, dust size1 ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) - ! aerosol species 6 optical properties + ! aerosol species 6 optical properties, dust size2 ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) - ! aerosol species 7 optical properties + ! aerosol species 7 optical properties, dust size3 ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) - ! aerosol species 8 optical properties + ! aerosol species 8 optical properties, dust size4 ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) @@ -972,6 +1017,62 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Weighted Mie parameters of each layer do i=snl_top,snl_btm,1 + + ! BC-snow internal mixing applied to hydrophilic BC if activated + ! BC-snow internal mixing primarily affect snow single-scattering albedo + if ( snicar_snobc_intmix .and. (mss_cnc_aer_lcl(i,1)>0._r8) ) then + if (snicar_numrad_snw == 5) wvl_doint = wvl_ct5(bnd_idx) + if (snicar_numrad_snw == 480) wvl_doint = wvl_ct480(bnd_idx) + + if (wvl_doint <= 1.2_r8) then ! only do for wavelength<=1.2um + ! 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_r8*1.7_r8/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_r8)**bcint_m(1) + bcint_dd2 = (0.1_r8/0.05_r8)**bcint_m(1) + bcint_f = (Re_bc/0.1_r8)**bcint_n(1) + endif + if ( (ibb >= 3) .and. (ibb <= 11) ) then ! visible + bcint_dd = (Re_bc/0.05_r8)**bcint_m(2) + bcint_dd2 = (0.1_r8/0.05_r8)**bcint_m(2) + bcint_f = (Re_bc/0.1_r8)**bcint_n(2) + endif + if ( ibb > 11 ) then ! NIR + bcint_dd = (Re_bc/0.05_r8)**bcint_m(3) + bcint_dd2 = (0.1_r8/0.05_r8)**bcint_m(3) + bcint_f = (Re_bc/0.1_r8)**bcint_n(3) + endif + enh_omg_bcint_tmp2(ibb) = LOG10( bcint_dd * ((enh_omg_bcint_tmp(ibb) / bcint_dd2)**bcint_f) ) + enddo + + ! piecewise linear interpolate into targeted SNICAR bands in a logscale space + call piecewise_linear_interp1d(16,bcint_wvl_ct,enh_omg_bcint_tmp2,wvl_doint,enh_omg_bcint_intp) + + ! update snow single-scattering albedo + enh_omg_bcint_intp2 = 10._r8 ** enh_omg_bcint_intp + enh_omg_bcint_intp2 = max(enh_omg_bcint_intp2, 1._r8) ! BC does not reduce snow absorption + ss_alb_snw_lcl(i) = 1._r8 - (1._r8 - ss_alb_snw_lcl(i)) * enh_omg_bcint_intp2 + ss_alb_snw_lcl(i) = max(0._r8, min(ss_alb_snw_lcl(i),1._r8)) + + ! 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 wvl_doint <= 1.2 + endif ! end if BC-snow internal mixing + L_snw(i) = h2osno_ice_lcl(i)+h2osno_liq_lcl(i) tau_snw(i) = L_snw(i)*ext_cff_mss_snw_lcl(i) @@ -2121,22 +2222,22 @@ subroutine SnowOptics_init( ) call ncd_io( 'ext_cff_mss_dust04', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) endif - ! BC species 1 Mie parameters - call ncd_io( 'ss_alb_bcphil', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphil', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphil', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! BC species 1 Mie parameters, uncoated BC, same as bc2 without BC-snow internal mixing + call ncd_io( 'ss_alb_bcphob', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) - ! BC species 2 Mie parameters + ! BC species 2 Mie parameters, uncoated BC call ncd_io( 'ss_alb_bcphob', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_bcphob', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) - ! OC species 1 Mie parameters - call ncd_io( 'ss_alb_ocphil', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphil', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphil', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 without OC-snow internal mixing + call ncd_io( 'ss_alb_ocphob', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) - ! OC species 2 Mie parameters + ! OC species 2 Mie parameters, uncoated OC call ncd_io( 'ss_alb_ocphob', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_ocphob', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index a313eed435..edde42ea22 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -230,6 +230,9 @@ module clm_varctl ! option for snow grain shape in SNICAR (He et al. 2017 JC), ceniln integer, public :: snicar_snw_shape = 1 ! 1->sphere; 2->spheroid; 3->hexagonal plate; 4->Koch snowflake + ! option to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln + logical, public :: snicar_snobc_intmix = .true. ! false->external mixing for all BC; true->internal mixing for hydrophilic BC + !---------------------------------------------------------- ! C isotopes !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 608bef6cb1..1804cb7757 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -203,7 +203,7 @@ subroutine control_init(dtime) irrigate, run_zero_weight_urban, all_active, & crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & snicar_numrad_snw, snicar_solarspec, snicar_snw_optics, snicar_dust_optics, & - snicar_use_aerosol, snicar_rt_solver, snicar_snw_shape ! cenlin + snicar_use_aerosol, snicar_rt_solver, snicar_snw_shape, snicar_snobc_intmix ! cenlin ! vertical soil mixing variables namelist /clm_inparm/ & @@ -833,6 +833,7 @@ subroutine control_spmd() call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_rt_solver, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_snw_shape, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin + call mpi_bcast (snicar_snobc_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin ! snow pack variables call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier) @@ -1023,7 +1024,7 @@ subroutine control_print () write(iulog,*) ' SNICAR: number of bands in snow albedo calculation =', snicar_numrad_snw ! cenlin write(iulog,*) ' SNICAR: radiative transfer solver type = ',snicar_rt_solver ! cenlin write(iulog,*) ' SNICAR: snow grain shape type = ',snicar_snw_shape ! cenlin - + write(iulog,*) ' SNICAR: BC-snow internal mixing = ', snicar_snobc_intmix ! cenlin write(iulog,*) ' glc number of elevation classes =', maxpatch_glc if (glc_do_dynglacier) then From 43e52bfdc62e0fd6b7e43e2337a60d653707e57c Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Fri, 28 Jan 2022 21:54:58 -0700 Subject: [PATCH 07/62] add dust-snow internal mixing and namelist control --- .../namelist_definition_ctsm.xml | 5 ++ src/biogeophys/SnowSnicarMod.F90 | 82 +++++++++++++++---- src/main/clm_varctl.F90 | 4 + src/main/controlMod.F90 | 11 ++- 4 files changed, 87 insertions(+), 15 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 261244e21e..51264f7b58 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -203,6 +203,11 @@ snow grain shape used in SNICAR snow albedo calculation option to activate BC-snow internal mixing in SNICAR snow albedo calculation + +option to activate dust-snow internal mixing in SNICAR snow albedo calculation + + Index of rooting profile for water diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 087fb374c7..b4e75d4173 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -12,7 +12,8 @@ module SnowSnicarMod use shr_sys_mod , only : shr_sys_flush use shr_log_mod , only : errMsg => shr_log_errMsg use clm_varctl , only : iulog, snicar_numrad_snw, snicar_rt_solver, & - snicar_snw_shape, snicar_snobc_intmix ! cenlin + snicar_snw_shape, snicar_snobc_intmix, & + snicar_snodst_intmix ! cenlin use clm_varcon , only : tfrz use shr_const_mod , only : SHR_CONST_RHOICE use abortutils , only : endrun @@ -509,7 +510,22 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8) :: wvl_doint ! wavelength doing BC-snow int mixing (<=1.2um) integer :: ibb ! loop index - ! + !----------------------------------------------------------------------- + ! variables used for dust-snow internal mixing (He et al. 2019 JAMES): + real(r8) :: enh_omg_dstint ! dust-induced enhancement in snow single-scattering co-albedo (1-omega) + real(r8) :: enh_omg_dstint_tmp(1:6) ! temporary dust-induced enhancement in snow 1-omega + real(r8) :: enh_omg_dstint_tmp2(1:6) ! temporary dust-induced enhancement in snow 1-omega + real(r8) :: dstint_wvl(1:7) ! Parameterization band (0.2-1.2um) for dust-induced enhancement in snow 1-omega + real(r8) :: dstint_wvl_ct(1:6) ! Parameterization band center wavelength (um) + real(r8) :: dstint_a1(1:6) ! Parameterization coefficients at each band center wavelength + real(r8) :: dstint_a2(1:6) ! Parameterization coefficients at each band center wavelength + real(r8) :: dstint_a3(1:6) ! Parameterization coefficients at each band center wavelength + real(r8) :: enh_omg_dstint_intp ! dust-induced enhancement in snow 1-omega (logscale) interpolated to CLM wavelength + real(r8) :: enh_omg_dstint_intp2 ! dust-induced enhancement in snow 1-omega interpolated to CLM wavelength + real(r8) :: wvl_doint2 ! wavelength doing dust-snow int mixing (<=1.2um) + real(r8) :: tot_dst_snw_conc ! total dust content in snow across all size bins (ppm=ug/g) + integer :: idb ! loop index + !----------------------------------------------------------------------- ! Enforce expected array sizes @@ -573,10 +589,10 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 6.473899E-1_r8, 4.634944E-1_r8, 4.634944E-1_r8 /) ! initialize for BC-snow internal mixing - ! Eq. 8b & Table 4 in He et al., 2017 J. Climate (wavelength>1.2um, no BC-snow int mixi effect) + ! 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_r8, 0.25_r8, 0.30_r8, 0.33_r8, 0.36_r8, 0.40_r8, 0.44_r8, 0.48_r8, & 0.52_r8, 0.57_r8, 0.64_r8, 0.69_r8, 0.75_r8, 0.78_r8, 0.87_r8, 1._r8, 1.2_r8 /) - bcint_wvl_ct(1:16) = bcint_wvl(2:17) / 2._r8 + bcint_wvl(1:16) / 2._r8 + bcint_wvl_ct(1:16) = bcint_wvl(2:17)/2._r8 + bcint_wvl(1:16)/2._r8 bcint_d0(1:16) = (/ 2.48045_r8 , 4.70305_r8 , 4.68619_r8 , 4.67369_r8 , 4.65040_r8 , & 2.40364_r8 , 7.95408E-1_r8, 2.92745E-1_r8, 8.63396E-2_r8, 2.76299E-2_r8, & 1.40864E-2_r8, 8.65705E-3_r8, 6.12971E-3_r8, 4.45697E-3_r8, 3.06648E-2_r8, & @@ -593,6 +609,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & bcint_m(1:3) = (/ -0.8724_r8, -0.1866_r8, -0.0046_r8 /) bcint_n(1:3) = (/ -0.0072_r8, -0.1918_r8, -0.5177_r8 /) + ! 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_r8, 0.2632_r8, 0.3448_r8, 0.4415_r8, 0.625_r8, 0.7782_r8, 1.2422_r8/) + dstint_wvl_ct(1:6) = dstint_wvl(2:7)/2._r8 + dstint_wvl(1:6)/2._r8 + dstint_a1(1:6) = (/ -2.1307E+1_r8, -1.5815E+1_r8, -9.2880_r8 , 1.1115_r8 , 1.0307_r8 , 1.0185_r8 /) + dstint_a2(1:6) = (/ 1.1746E+2_r8, 9.3241E+1_r8, 4.0605E+1_r8, 3.7389E-1_r8, 1.4800E-2_r8, 2.8921E-4_r8 /) + dstint_a3(1:6) = (/ 9.9701E-1_r8, 9.9781E-1_r8, 9.9848E-1_r8, 1.0035_r8 , 1.0024_r8 , 1.0356_r8 /) + ! SNICAR/CLM snow band center wavelength (um) wvl_ct5(1:5) = (/ 0.5_r8, 0.85_r8, 1.1_r8, 1.35_r8, 3.25_r8 /) ! 5-band do igb = 1,480 @@ -925,7 +949,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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._r8) ! Eqn. 3.3 in Fu (2007) + gg_ice_F07_tmp(igb) = g_F07_p0(igb)+g_F07_p1(igb)*LOG(AR_tmp)+g_F07_p2(igb)*((LOG(AR_tmp))**2._r8) ! Eqn. 3.3 in Fu (2007) enddo ! Koch snowflake @@ -944,7 +968,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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._r8) ! Eqn. 3.3 in Fu (2007) + gg_ice_F07_tmp(igb) = g_F07_p0(igb)+g_F07_p1(igb)*LOG(AR_tmp)+g_F07_p2(igb)*((LOG(AR_tmp))**2._r8) ! Eqn. 3.3 in Fu (2007) enddo endif ! if snow shape @@ -1020,11 +1044,11 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! BC-snow internal mixing applied to hydrophilic BC if activated ! BC-snow internal mixing primarily affect snow single-scattering albedo - if ( snicar_snobc_intmix .and. (mss_cnc_aer_lcl(i,1)>0._r8) ) then + if ( snicar_snobc_intmix .and. (mss_cnc_aer_lcl(i,1) > 0._r8) ) then if (snicar_numrad_snw == 5) wvl_doint = wvl_ct5(bnd_idx) if (snicar_numrad_snw == 480) wvl_doint = wvl_ct480(bnd_idx) - - if (wvl_doint <= 1.2_r8) then ! only do for wavelength<=1.2um + ! only do for wavelength<=1.2um + if (wvl_doint <= 1.2_r8) 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) @@ -1053,26 +1077,56 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & bcint_dd2 = (0.1_r8/0.05_r8)**bcint_m(3) bcint_f = (Re_bc/0.1_r8)**bcint_n(3) endif - enh_omg_bcint_tmp2(ibb) = LOG10( bcint_dd * ((enh_omg_bcint_tmp(ibb) / bcint_dd2)**bcint_f) ) + enh_omg_bcint_tmp2(ibb)=LOG10(max(1._r8,bcint_dd*((enh_omg_bcint_tmp(ibb)/bcint_dd2)**bcint_f))) enddo - ! piecewise linear interpolate into targeted SNICAR bands in a logscale space call piecewise_linear_interp1d(16,bcint_wvl_ct,enh_omg_bcint_tmp2,wvl_doint,enh_omg_bcint_intp) - ! update snow single-scattering albedo enh_omg_bcint_intp2 = 10._r8 ** enh_omg_bcint_intp enh_omg_bcint_intp2 = max(enh_omg_bcint_intp2, 1._r8) ! BC does not reduce snow absorption ss_alb_snw_lcl(i) = 1._r8 - (1._r8 - ss_alb_snw_lcl(i)) * enh_omg_bcint_intp2 ss_alb_snw_lcl(i) = max(0._r8, min(ss_alb_snw_lcl(i),1._r8)) - ! 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 wvl_doint <= 1.2 endif ! end if BC-snow internal mixing + + ! 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)) * 1.0E6_r8 + if ( snicar_snodst_intmix .and. (tot_dst_snw_conc > 0._r8) ) then + if (snicar_numrad_snw == 5) wvl_doint2 = wvl_ct5(bnd_idx) + if (snicar_numrad_snw == 480) wvl_doint2 = wvl_ct480(bnd_idx) + ! only do for wavelength<=1.2um + if (wvl_doint2 <= 1.2_r8) 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._r8)) + enddo + ! piecewise linear interpolate into targeted SNICAR bands in a logscale space + call piecewise_linear_interp1d(6,dstint_wvl_ct,enh_omg_dstint_tmp2,wvl_doint2,enh_omg_dstint_intp) + ! update snow single-scattering albedo + enh_omg_dstint_intp2 = 10._r8 ** enh_omg_dstint_intp + enh_omg_dstint_intp2 = max(enh_omg_dstint_intp2, 1._r8) + ss_alb_snw_lcl(i) = 1._r8 - (1._r8 - ss_alb_snw_lcl(i)) * enh_omg_dstint_intp2 + ss_alb_snw_lcl(i) = max(0._r8, min(ss_alb_snw_lcl(i),1._r8)) + ! reset all dust optics to zero since it is accounted by updated snow ss_alb above + ss_alb_aer_lcl(5:8) = 0._r8 + asm_prm_aer_lcl(5:8) = 0._r8 + ext_cff_mss_aer_lcl(5:8) = 0._r8 + endif ! end if wvl_doint2 <= 1.2 + endif ! end if dust-snow internal mixing + + L_snw(i) = h2osno_ice_lcl(i)+h2osno_liq_lcl(i) tau_snw(i) = L_snw(i)*ext_cff_mss_snw_lcl(i) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index edde42ea22..d8a56384eb 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -233,6 +233,10 @@ module clm_varctl ! option to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln logical, public :: snicar_snobc_intmix = .true. ! false->external mixing for all BC; true->internal mixing for hydrophilic BC + ! option to activate dust-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln + logical, public :: snicar_snodst_intmix = .false. ! false->external mixing for all dust; true->internal mixing for all dust + + !---------------------------------------------------------- ! C isotopes !---------------------------------------------------------- diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 1804cb7757..195356b77f 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -203,7 +203,8 @@ subroutine control_init(dtime) irrigate, run_zero_weight_urban, all_active, & crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & snicar_numrad_snw, snicar_solarspec, snicar_snw_optics, snicar_dust_optics, & - snicar_use_aerosol, snicar_rt_solver, snicar_snw_shape, snicar_snobc_intmix ! cenlin + snicar_use_aerosol, snicar_rt_solver, snicar_snw_shape, snicar_snobc_intmix,& + snicar_snodst_intmix ! cenlin ! vertical soil mixing variables namelist /clm_inparm/ & @@ -606,6 +607,12 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if + ! check on SNICAR BC-snow and dust-snow internal mixing + if ( snicar_snobc_intmix .and. snicar_snodst_intmix ) then + call endrun(msg=' ERROR: currently dust-snow and BC-snow internal mixing cannot be activated together'//& + errMsg(sourcefile, __LINE__)) + end if + ! Consistency settings for nrevsn if (nsrest == nsrStartup ) nrevsn = ' ' @@ -834,6 +841,7 @@ subroutine control_spmd() call mpi_bcast (snicar_rt_solver, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_snw_shape, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_snobc_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin + call mpi_bcast (snicar_snodst_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin ! snow pack variables call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier) @@ -1025,6 +1033,7 @@ subroutine control_print () write(iulog,*) ' SNICAR: radiative transfer solver type = ',snicar_rt_solver ! cenlin write(iulog,*) ' SNICAR: snow grain shape type = ',snicar_snw_shape ! cenlin write(iulog,*) ' SNICAR: BC-snow internal mixing = ', snicar_snobc_intmix ! cenlin + write(iulog,*) ' SNICAR: dust-snow internal mixing = ', snicar_snodst_intmix ! cenlin write(iulog,*) ' glc number of elevation classes =', maxpatch_glc if (glc_do_dynglacier) then From 7dc18abffca804a440fad962b99b8b0d9ccbb7d2 Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Sat, 29 Jan 2022 15:04:18 -0700 Subject: [PATCH 08/62] bug fix for BC/dust-snow internal mixing --- src/biogeophys/SnowSnicarMod.F90 | 125 ++++++++++++++++++------------- 1 file changed, 72 insertions(+), 53 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index b4e75d4173..484bfc8fd5 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -522,7 +522,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8) :: dstint_a3(1:6) ! Parameterization coefficients at each band center wavelength real(r8) :: enh_omg_dstint_intp ! dust-induced enhancement in snow 1-omega (logscale) interpolated to CLM wavelength real(r8) :: enh_omg_dstint_intp2 ! dust-induced enhancement in snow 1-omega interpolated to CLM wavelength - real(r8) :: wvl_doint2 ! wavelength doing dust-snow int mixing (<=1.2um) real(r8) :: tot_dst_snw_conc ! total dust content in snow across all size bins (ppm=ug/g) integer :: idb ! loop index @@ -995,9 +994,9 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! aerosol species 1 optical properties, hydrophilic BC - ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) - asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) - ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) + !ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) + !asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) + !ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) ! aerosol species 2 optical properties, hydrophobic BC ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) @@ -1015,24 +1014,24 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) ! aerosol species 5 optical properties, dust size1 - ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) - asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) - ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) + !ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) + !asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) + !ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) ! aerosol species 6 optical properties, dust size2 - ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) - asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) - ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) + !ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) + !asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) + !ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) ! aerosol species 7 optical properties, dust size3 - ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) - asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) - ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) + !ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) + !asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) + !ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) ! aerosol species 8 optical properties, dust size4 - ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) - asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) - ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) + !ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) + !asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) + !ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) ! 1. snow and aerosol layer column mass (L_snw, L_aer [kg/m^2]) @@ -1042,13 +1041,37 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Weighted Mie parameters of each layer do i=snl_top,snl_btm,1 - ! BC-snow internal mixing applied to hydrophilic BC if activated - ! BC-snow internal mixing primarily affect snow single-scattering albedo - if ( snicar_snobc_intmix .and. (mss_cnc_aer_lcl(i,1) > 0._r8) ) then - if (snicar_numrad_snw == 5) wvl_doint = wvl_ct5(bnd_idx) - if (snicar_numrad_snw == 480) wvl_doint = wvl_ct480(bnd_idx) - ! only do for wavelength<=1.2um - if (wvl_doint <= 1.2_r8) then + ! Optics for BC/dust-snow external mixing: + ! aerosol species 1 optical properties, hydrophilic BC + ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) + asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) + ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) + ! aerosol species 5 optical properties, dust size1 + ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) + asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) + ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) + ! aerosol species 6 optical properties, dust size2 + ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) + asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) + ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) + ! aerosol species 7 optical properties, dust size3 + ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) + asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) + ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) + ! aerosol species 8 optical properties, dust size4 + ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) + asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) + ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) + + + ! Start BC/dust-snow internal mixing for wavelength<=1.2um + if (snicar_numrad_snw == 5) wvl_doint = wvl_ct5(bnd_idx) + if (snicar_numrad_snw == 480) wvl_doint = wvl_ct480(bnd_idx) + if (wvl_doint <= 1.2_r8) then + + ! BC-snow internal mixing applied to hydrophilic BC if activated + ! BC-snow internal mixing primarily affect snow single-scattering albedo + if ( snicar_snobc_intmix .and. (mss_cnc_aer_lcl(i,1) > 0._r8) ) 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) @@ -1083,48 +1106,43 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & call piecewise_linear_interp1d(16,bcint_wvl_ct,enh_omg_bcint_tmp2,wvl_doint,enh_omg_bcint_intp) ! update snow single-scattering albedo enh_omg_bcint_intp2 = 10._r8 ** enh_omg_bcint_intp - enh_omg_bcint_intp2 = max(enh_omg_bcint_intp2, 1._r8) ! BC does not reduce snow absorption - ss_alb_snw_lcl(i) = 1._r8 - (1._r8 - ss_alb_snw_lcl(i)) * enh_omg_bcint_intp2 - ss_alb_snw_lcl(i) = max(0._r8, min(ss_alb_snw_lcl(i),1._r8)) + enh_omg_bcint_intp2 = min(1.0E5_r8, max(enh_omg_bcint_intp2,1._r8)) ! constrain enhancement to a reasonable range + ss_alb_snw_lcl(i) = 1._r8 - (1._r8 - ss_alb_snw_lcl(i)) * enh_omg_bcint_intp2 + ss_alb_snw_lcl(i) = max(0.5_r8, min(ss_alb_snw_lcl(i),1._r8)) ! 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 wvl_doint <= 1.2 - endif ! end if BC-snow internal mixing - - - ! 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)) * 1.0E6_r8 - if ( snicar_snodst_intmix .and. (tot_dst_snw_conc > 0._r8) ) then - if (snicar_numrad_snw == 5) wvl_doint2 = wvl_ct5(bnd_idx) - if (snicar_numrad_snw == 480) wvl_doint2 = wvl_ct480(bnd_idx) - ! only do for wavelength<=1.2um - if (wvl_doint2 <= 1.2_r8) then + 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)) * 1.0E6_r8 !kg/kg->ppm + if ( snicar_snodst_intmix .and. (tot_dst_snw_conc > 0._r8) ) 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._r8)) enddo ! piecewise linear interpolate into targeted SNICAR bands in a logscale space - call piecewise_linear_interp1d(6,dstint_wvl_ct,enh_omg_dstint_tmp2,wvl_doint2,enh_omg_dstint_intp) + call piecewise_linear_interp1d(6,dstint_wvl_ct,enh_omg_dstint_tmp2,wvl_doint,enh_omg_dstint_intp) ! update snow single-scattering albedo enh_omg_dstint_intp2 = 10._r8 ** enh_omg_dstint_intp - enh_omg_dstint_intp2 = max(enh_omg_dstint_intp2, 1._r8) + enh_omg_dstint_intp2 = min(1.0E5_r8, max(enh_omg_dstint_intp2,1._r8)) ! constrain enhancement to a reasonable range ss_alb_snw_lcl(i) = 1._r8 - (1._r8 - ss_alb_snw_lcl(i)) * enh_omg_dstint_intp2 - ss_alb_snw_lcl(i) = max(0._r8, min(ss_alb_snw_lcl(i),1._r8)) + ss_alb_snw_lcl(i) = max(0.5_r8, min(ss_alb_snw_lcl(i),1._r8)) ! reset all dust optics to zero since it is accounted by updated snow ss_alb above ss_alb_aer_lcl(5:8) = 0._r8 asm_prm_aer_lcl(5:8) = 0._r8 ext_cff_mss_aer_lcl(5:8) = 0._r8 - endif ! end if wvl_doint2 <= 1.2 - endif ! end if dust-snow internal mixing + 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) @@ -1148,7 +1166,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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 + + enddo ! end do snow layers ! DELTA transformations, if requested if (DELTA == 1) then From 9d5fee6ad1f1de3ab3ade7423184e00151e2bef6 Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Mon, 31 Jan 2022 22:38:44 -0700 Subject: [PATCH 09/62] update 5-band input optics database & move DO_SNO_OC to namelist control --- .../namelist_definition_ctsm.xml | 3 - src/biogeophys/SnowSnicarMod.F90 | 797 +++++++++++++++--- src/biogeophys/SurfaceAlbedoMod.F90 | 4 +- src/biogeophys/SurfaceRadiationMod.F90 | 4 +- src/main/clm_varctl.F90 | 8 +- src/main/controlMod.F90 | 26 +- 6 files changed, 679 insertions(+), 163 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 51264f7b58..baa18b77dc 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -168,19 +168,16 @@ number of wavelength bands used in SNICAR snow albedo calculation type of downward solar radiation spectrum for SNICAR snow albedo calculation -(only used in 480-band version) snow optics type using different refractive index databases in SNICAR -(only used in 480-band version) dust optics type for SNICAR snow albedo calculation -(only used in 480-band version) shr_log_errMsg use clm_varctl , only : iulog, snicar_numrad_snw, snicar_rt_solver, & snicar_snw_shape, snicar_snobc_intmix, & - snicar_snodst_intmix ! cenlin + snicar_snodst_intmix, DO_SNO_OC ! cenlin use clm_varcon , only : tfrz use shr_const_mod , only : SHR_CONST_RHOICE use abortutils , only : endrun @@ -48,8 +48,9 @@ module SnowSnicarMod ! !PUBLIC DATA MEMBERS: integer, public, parameter :: sno_nbr_aer = 8 ! number of aerosol species in snowpack ! (indices described above) [nbr] - logical, public, parameter :: DO_SNO_OC = .false. ! parameter to include organic carbon (OC) - ! in snowpack radiative calculations + ! DO_SNO_OC moved to namelist control + !logical, public, parameter :: DO_SNO_OC = .false. ! parameter to include organic carbon (OC) + ! ! in snowpack radiative calculations logical, public, parameter :: DO_SNO_AER = .true. ! parameter to include aerosols in snowpack radiative calculations ! !PRIVATE DATA MEMBERS: @@ -141,9 +142,9 @@ module SnowSnicarMod real(r8), pointer :: asm_prm_dst4(:) !(numrad_snw) real(r8), pointer :: ext_cff_mss_dst4(:) !(numrad_snw) - ! downward solar radiation spectral weights for 480-band - real(r8), pointer :: flx_wgt_dir480(:) !(numrad_snw) ! direct - real(r8), pointer :: flx_wgt_dif480(:) !(numrad_snw) ! diffuse + ! downward solar radiation spectral weights for 5-band or 480-band + real(r8), pointer :: flx_wgt_dir(:) !(numrad_snw) ! direct + real(r8), pointer :: flx_wgt_dif(:) !(numrad_snw) ! diffuse ! best-fit parameters for snow aging defined over: ! 11 temperatures from 225 to 273 K @@ -544,7 +545,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ) ! initialize parameter, cenlin - nir_bnd_bgn = nint(snicar_numrad_snw/9.6) + 1 ! 5-band starts at 2; 480-band starts at 51 + if (snicar_numrad_snw == 5) nir_bnd_bgn = 2 + if (snicar_numrad_snw == 480) nir_bnd_bgn = 51 nir_bnd_end = snicar_numrad_snw ! initialize for adding-doubling solver @@ -705,7 +707,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos - albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,1) ! cenlin: update for hyperspectral calculation + albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,1) ! cenlin albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,2) @@ -734,8 +736,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Band 4: 1.2-1.5um (NIR) ! Band 5: 1.5-5.0um (NIR) ! - ! Updated hyperspectral (10-nm) bands (480-band case) cenlin - ! Bands 1~50 : 0.2-0.7um (VIS); near-UV (0.2-0.3um) is combined to VIS for now + ! Hyperspectral (10-nm) bands (480-band case) cenlin + ! 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 @@ -753,33 +755,30 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & flx_wgt(2) = 0.77887652162877_r8 flx_wgt(3) = 0.22112347837123_r8 endif - ! 5-band weights - elseif (snicar_numrad_snw==5) then - ! Direct: - if (flg_slr_in == 1) then - flx_wgt(1) = 1._r8 - flx_wgt(2) = 0.49352158521175_r8 - flx_wgt(3) = 0.18099494230665_r8 - flx_wgt(4) = 0.12094898498813_r8 - flx_wgt(5) = 0.20453448749347_r8 - ! Diffuse: - elseif (flg_slr_in == 2) then - flx_wgt(1) = 1._r8 - flx_wgt(2) = 0.58581507618433_r8 - flx_wgt(3) = 0.20156903770812_r8 - flx_wgt(4) = 0.10917889346386_r8 - flx_wgt(5) = 0.10343699264369_r8 - endif - - ! 480-band weights, cenlin - elseif (snicar_numrad_snw == 480) then + !elseif (snicar_numrad_snw==5) then + ! ! Direct: + ! if (flg_slr_in == 1) then + ! flx_wgt(1) = 1._r8 + ! flx_wgt(2) = 0.49352158521175_r8 + ! flx_wgt(3) = 0.18099494230665_r8 + ! flx_wgt(4) = 0.12094898498813_r8 + ! flx_wgt(5) = 0.20453448749347_r8 + ! ! Diffuse: + ! elseif (flg_slr_in == 2) then + ! flx_wgt(1) = 1._r8 + ! flx_wgt(2) = 0.58581507618433_r8 + ! flx_wgt(3) = 0.20156903770812_r8 + ! flx_wgt(4) = 0.10917889346386_r8 + ! flx_wgt(5) = 0.10343699264369_r8 + ! endif + else ! works for both 5-band & 480-band, flux weights directly read from input data, cenlin ! Direct: if (flg_slr_in == 1) then - flx_wgt(1:snicar_numrad_snw) = flx_wgt_dir480(1:snicar_numrad_snw) ! either VIS or NIR band sum is 1.0 in the input dataset + flx_wgt(1:snicar_numrad_snw) = flx_wgt_dir(1:snicar_numrad_snw) ! VIS or NIR band sum is already normalized to 1.0 in input data ! Diffuse: elseif (flg_slr_in == 2) then - flx_wgt(1:snicar_numrad_snw) = flx_wgt_dif480(1:snicar_numrad_snw) ! either VIS or NIR band sum is 1.0 in the input dataset + flx_wgt(1:snicar_numrad_snw) = flx_wgt_dif(1:snicar_numrad_snw) ! VIS or NIR band sum is already normalized to 1.0 in input data endif endif ! end if snicar_numrad_snw @@ -976,6 +975,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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 (snicar_numrad_snw == 5) then call piecewise_linear_interp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct5(bnd_idx),g_Cg_intp) call piecewise_linear_interp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct5(bnd_idx),gg_F07_intp) @@ -1063,7 +1063,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) - ! Start BC/dust-snow internal mixing for wavelength<=1.2um if (snicar_numrad_snw == 5) wvl_doint = wvl_ct5(bnd_idx) if (snicar_numrad_snw == 480) wvl_doint = wvl_ct480(bnd_idx) @@ -1144,7 +1143,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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) @@ -2215,7 +2213,7 @@ subroutine SnowOptics_init( ) integer :: ier ! error status ! - ! Open optics file: + ! Initialize optical variables allocate(ss_alb_snw_drc(idx_Mie_snw_mx,snicar_numrad_snw)) allocate(asm_prm_snw_drc(idx_Mie_snw_mx,snicar_numrad_snw)) allocate(ext_cff_mss_snw_drc(idx_Mie_snw_mx,snicar_numrad_snw)) @@ -2246,78 +2244,630 @@ subroutine SnowOptics_init( ) allocate(ss_alb_dst4(snicar_numrad_snw)) allocate(asm_prm_dst4(snicar_numrad_snw)) allocate(ext_cff_mss_dst4(snicar_numrad_snw)) - allocate(flx_wgt_dir480(snicar_numrad_snw)) - allocate(flx_wgt_dif480(snicar_numrad_snw)) + allocate(flx_wgt_dir(snicar_numrad_snw)) + allocate(flx_wgt_dif(snicar_numrad_snw)) if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....' - ! for 5-band data, cenlin - if (snicar_numrad_snw <= 5) then + + !--------------------- for 5-band data, cenlin + if (snicar_numrad_snw == 5) then + call getfil (fsnowoptics, locfn, 0) call ncd_pio_openfile(ncid, locfn, 0) if(masterproc) write(iulog,*) subname,trim(fsnowoptics) - end if - ! for 480-band data, cenlin - if (snicar_numrad_snw == 480) then - call getfil (fsnowoptics480, locfn, 0) - call ncd_pio_openfile(ncid, locfn, 0) - if(masterproc) write(iulog,*) subname,trim(fsnowoptics480) - end if - if (snicar_numrad_snw <= 5) then - ! direct-beam snow Mie parameters: - call ncd_io( 'ss_alb_ice_drc', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_drc',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_drc', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - - ! diffuse snow Mie parameters - call ncd_io( 'ss_alb_ice_dfs', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_dfs', asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_dfs', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - - ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) - - ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) - - ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) - - ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - endif + ! mid-latitude winter spectrum + if (snicar_solarspec == 1) then + ! flux weights/spectrum + call ncd_io( 'flx_wgt_dir5_mlw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif5_mlw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + call ncd_io( 'ss_alb_bcphob_dif_mlw', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_mlw', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_mlw', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! BC species 2 Mie parameters, uncoated BC + call ncd_io( 'ss_alb_bcphob_dif_mlw', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_mlw', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_mlw', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + call ncd_io( 'ss_alb_ocphob_dif_mlw', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_mlw', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! OC species 2 Mie parameters, uncoated OC + call ncd_io( 'ss_alb_ocphob_dif_mlw', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_mlw', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + ! ice refractive index options + if (snicar_snw_optics == 1) then ! Warren (1984) + call ncd_io( 'ss_alb_ice_wrn84_dir_mlw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dir_mlw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn84_dif_mlw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + call ncd_io( 'ss_alb_ice_wrn08_dir_mlw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dir_mlw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn08_dif_mlw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + call ncd_io( 'ss_alb_ice_pic16_dir_mlw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_mlw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_mlw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + endif + ! dust optical properties + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_sah_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_sah_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_sah_dif_mlw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_sah_dif_mlw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_sah_dif_mlw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_sah_dif_mlw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_sah_dif_mlw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_sah_dif_mlw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_sah_dif_mlw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_sah_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_sah_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_sah_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_col_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_col_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_col_dif_mlw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_col_dif_mlw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_col_dif_mlw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_col_dif_mlw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_col_dif_mlw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_col_dif_mlw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_col_dif_mlw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_col_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_col_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_col_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_gre_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_gre_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_gre_dif_mlw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_gre_dif_mlw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_gre_dif_mlw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_gre_dif_mlw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_gre_dif_mlw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_gre_dif_mlw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_gre_dif_mlw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_gre_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_gre_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_gre_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + endif - ! BC species 1 Mie parameters, uncoated BC, same as bc2 without BC-snow internal mixing - call ncd_io( 'ss_alb_bcphob', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! mid-latitude summer spectrum + elseif (snicar_solarspec == 2) then + ! flux weights/spectrum + call ncd_io( 'flx_wgt_dir5_mls', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif5_mls', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + call ncd_io( 'ss_alb_bcphob_dif_mls', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_mls', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_mls', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! BC species 2 Mie parameters, uncoated BC + call ncd_io( 'ss_alb_bcphob_dif_mls', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_mls', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_mls', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + call ncd_io( 'ss_alb_ocphob_dif_mls', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_mls', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! OC species 2 Mie parameters, uncoated OC + call ncd_io( 'ss_alb_ocphob_dif_mls', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_mls', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + ! ice refractive index options + if (snicar_snw_optics == 1) then ! Warren (1984) + call ncd_io( 'ss_alb_ice_wrn84_dir_mls', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dir_mls',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn84_dif_mls', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + call ncd_io( 'ss_alb_ice_wrn08_dir_mls', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dir_mls',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn08_dif_mls', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + call ncd_io( 'ss_alb_ice_pic16_dir_mls', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_mls',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_mls', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + endif + ! dust optical properties + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_sah_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_sah_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_sah_dif_mls', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_sah_dif_mls', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_sah_dif_mls', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_sah_dif_mls', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_sah_dif_mls', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_sah_dif_mls', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_sah_dif_mls', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_sah_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_sah_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_sah_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_col_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_col_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_col_dif_mls', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_col_dif_mls', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_col_dif_mls', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_col_dif_mls', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_col_dif_mls', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_col_dif_mls', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_col_dif_mls', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_col_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_col_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_col_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_gre_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_gre_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_gre_dif_mls', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_gre_dif_mls', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_gre_dif_mls', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_gre_dif_mls', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_gre_dif_mls', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_gre_dif_mls', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_gre_dif_mls', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_gre_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_gre_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_gre_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + endif - ! BC species 2 Mie parameters, uncoated BC - call ncd_io( 'ss_alb_bcphob', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + ! sub-Arctic winter spectrum + elseif (snicar_solarspec == 3) then + call ncd_io( 'flx_wgt_dir5_saw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif5_saw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + call ncd_io( 'ss_alb_bcphob_dif_saw', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_saw', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_saw', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! BC species 2 Mie parameters, uncoated BC + call ncd_io( 'ss_alb_bcphob_dif_saw', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_saw', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_saw', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + call ncd_io( 'ss_alb_ocphob_dif_saw', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_saw', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! OC species 2 Mie parameters, uncoated OC + call ncd_io( 'ss_alb_ocphob_dif_saw', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_saw', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + ! ice refractive index options + if (snicar_snw_optics == 1) then ! Warren (1984) + call ncd_io( 'ss_alb_ice_wrn84_dir_saw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dir_saw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn84_dif_saw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + call ncd_io( 'ss_alb_ice_wrn08_dir_saw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dir_saw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn08_dif_saw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + call ncd_io( 'ss_alb_ice_pic16_dir_saw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_saw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_saw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + endif + ! dust optical properties + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_sah_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_sah_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_sah_dif_saw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_sah_dif_saw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_sah_dif_saw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_sah_dif_saw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_sah_dif_saw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_sah_dif_saw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_sah_dif_saw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_sah_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_sah_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_sah_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_col_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_col_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_col_dif_saw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_col_dif_saw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_col_dif_saw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_col_dif_saw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_col_dif_saw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_col_dif_saw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_col_dif_saw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_col_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_col_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_col_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_gre_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_gre_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_gre_dif_saw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_gre_dif_saw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_gre_dif_saw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_gre_dif_saw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_gre_dif_saw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_gre_dif_saw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_gre_dif_saw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_gre_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_gre_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_gre_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + endif + + ! sub-Arctic summer spectrum + elseif (snicar_solarspec == 4) then + call ncd_io( 'flx_wgt_dir5_sas', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif5_sas', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + call ncd_io( 'ss_alb_bcphob_dif_sas', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_sas', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_sas', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! BC species 2 Mie parameters, uncoated BC + call ncd_io( 'ss_alb_bcphob_dif_sas', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_sas', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_sas', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + call ncd_io( 'ss_alb_ocphob_dif_sas', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_sas', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! OC species 2 Mie parameters, uncoated OC + call ncd_io( 'ss_alb_ocphob_dif_sas', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_sas', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + ! ice refractive index options + if (snicar_snw_optics == 1) then ! Warren (1984) + call ncd_io( 'ss_alb_ice_wrn84_dir_sas', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dir_sas',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn84_dif_sas', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + call ncd_io( 'ss_alb_ice_wrn08_dir_sas', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dir_sas',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn08_dif_sas', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + call ncd_io( 'ss_alb_ice_pic16_dir_sas', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_sas',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_sas', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + endif + ! dust optical properties + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_sah_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_sah_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_sah_dif_sas', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_sah_dif_sas', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_sah_dif_sas', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_sah_dif_sas', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_sah_dif_sas', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_sah_dif_sas', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_sah_dif_sas', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_sah_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_sah_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_sah_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_col_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_col_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_col_dif_sas', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_col_dif_sas', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_col_dif_sas', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_col_dif_sas', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_col_dif_sas', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_col_dif_sas', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_col_dif_sas', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_col_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_col_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_col_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_gre_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_gre_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_gre_dif_sas', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_gre_dif_sas', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_gre_dif_sas', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_gre_dif_sas', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_gre_dif_sas', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_gre_dif_sas', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_gre_dif_sas', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_gre_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_gre_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_gre_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + endif - ! OC species 1 Mie parameters, uncoated OC, same as oc2 without OC-snow internal mixing - call ncd_io( 'ss_alb_ocphob', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! Summit,Greenland,summer spectrum + elseif (snicar_solarspec == 5) then + call ncd_io( 'flx_wgt_dir5_smm', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif5_smm', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + call ncd_io( 'ss_alb_bcphob_dif_smm', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_smm', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_smm', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! BC species 2 Mie parameters, uncoated BC + call ncd_io( 'ss_alb_bcphob_dif_smm', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_smm', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_smm', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + call ncd_io( 'ss_alb_ocphob_dif_smm', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_smm', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! OC species 2 Mie parameters, uncoated OC + call ncd_io( 'ss_alb_ocphob_dif_smm', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_smm', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + ! ice refractive index options + if (snicar_snw_optics == 1) then ! Warren (1984) + call ncd_io( 'ss_alb_ice_wrn84_dir_smm', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dir_smm',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn84_dif_smm', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + call ncd_io( 'ss_alb_ice_wrn08_dir_smm', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dir_smm',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn08_dif_smm', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + call ncd_io( 'ss_alb_ice_pic16_dir_smm', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_smm',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_smm', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + endif + ! dust optical properties + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_sah_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_sah_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_sah_dif_smm', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_sah_dif_smm', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_sah_dif_smm', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_sah_dif_smm', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_sah_dif_smm', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_sah_dif_smm', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_sah_dif_smm', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_sah_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_sah_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_sah_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_col_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_col_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_col_dif_smm', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_col_dif_smm', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_col_dif_smm', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_col_dif_smm', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_col_dif_smm', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_col_dif_smm', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_col_dif_smm', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_col_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_col_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_col_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_gre_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_gre_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_gre_dif_smm', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_gre_dif_smm', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_gre_dif_smm', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_gre_dif_smm', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_gre_dif_smm', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_gre_dif_smm', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_gre_dif_smm', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_gre_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_gre_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_gre_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + endif - ! OC species 2 Mie parameters, uncoated OC - call ncd_io( 'ss_alb_ocphob', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + ! High Mountain summer spectrum + elseif (snicar_solarspec == 6) then + call ncd_io( 'flx_wgt_dir5_hmn', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif5_hmn', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + call ncd_io( 'ss_alb_bcphob_dif_hmn', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_hmn', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_hmn', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! BC species 2 Mie parameters, uncoated BC + call ncd_io( 'ss_alb_bcphob_dif_hmn', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob_dif_hmn', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob_dif_hmn', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + call ncd_io( 'ss_alb_ocphob_dif_hmn', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_hmn', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! OC species 2 Mie parameters, uncoated OC + call ncd_io( 'ss_alb_ocphob_dif_hmn', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob_dif_hmn', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + ! ice refractive index options + if (snicar_snw_optics == 1) then ! Warren (1984) + call ncd_io( 'ss_alb_ice_wrn84_dir_hmn', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dir_hmn',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn84_dif_hmn', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn84_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn84_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) + call ncd_io( 'ss_alb_ice_wrn08_dir_hmn', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dir_hmn',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_wrn08_dif_hmn', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_wrn08_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_wrn08_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_snw_optics == 3) then ! Picard et al (2016) + call ncd_io( 'ss_alb_ice_pic16_dir_hmn', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_hmn',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_hmn', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + endif + ! dust optical properties + if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_sah_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_sah_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_sah_dif_hmn', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_sah_dif_hmn', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_sah_dif_hmn', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_sah_dif_hmn', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_sah_dif_hmn', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_sah_dif_hmn', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_sah_dif_hmn', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_sah_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_sah_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_sah_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_col_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_col_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_col_dif_hmn', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_col_dif_hmn', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_col_dif_hmn', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_col_dif_hmn', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_col_dif_hmn', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_col_dif_hmn', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_col_dif_hmn', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_col_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_col_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_col_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + ! dust species 1 Mie parameters + call ncd_io( 'ss_alb_dust01_gre_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust01_gre_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust01_gre_dif_hmn', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + ! dust species 2 Mie parameters + call ncd_io( 'ss_alb_dust02_gre_dif_hmn', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust02_gre_dif_hmn', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust02_gre_dif_hmn', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + ! dust species 3 Mie parameters + call ncd_io( 'ss_alb_dust03_gre_dif_hmn', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust03_gre_dif_hmn', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust03_gre_dif_hmn', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + ! dust species 4 Mie parameters + call ncd_io( 'ss_alb_dust04_gre_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_dust04_gre_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_dust04_gre_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + endif + endif ! end of snicar_solarspec - ! new data for 480-band + end if ! end if snicar_numrad_snw == 5 + + + !-------------------- for 480-band data, cenlin if (snicar_numrad_snw == 480) then + call getfil (fsnowoptics480, locfn, 0) + call ncd_pio_openfile(ncid, locfn, 0) + if(masterproc) write(iulog,*) subname,trim(fsnowoptics480) + + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + call ncd_io( 'ss_alb_bcphob', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + ! BC species 2 Mie parameters, uncoated BC + call ncd_io( 'ss_alb_bcphob', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_bcphob', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + call ncd_io( 'ss_alb_ocphob', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + ! OC species 2 Mie parameters, uncoated OC + call ncd_io( 'ss_alb_ocphob', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ocphob', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + ! 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) @@ -2341,15 +2891,6 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - else - write(iulog,*) 'invalid snow optics type option in namelist' - ! for invalid spectrum type, use Picard et al (2016) (default) - call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) endif ! dust optical properties @@ -2404,54 +2945,30 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_gre', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_gre', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_gre', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - else - write(iulog,*) 'invalid dust optics type option in namelist' - ! for invalid dust optics type, use Saharan dust (default) - ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_sah', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_sah', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_sah', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) - ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_sah', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_sah', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_sah', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) - ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_sah', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_sah', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_sah', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) - ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_sah', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_sah', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_sah', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) endif ! downward solar radiation spectral weights for 480-band if (snicar_solarspec == 1) then ! mid-latitude winter - call ncd_io( 'flx_wgt_dir480_mlw', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_mlw', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dir480_mlw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_mlw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) elseif (snicar_solarspec == 2) then ! mid-latitude summer - call ncd_io( 'flx_wgt_dir480_mls', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_mls', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dir480_mls', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_mls', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) elseif (snicar_solarspec == 3) then ! sub-Arctic winter - call ncd_io( 'flx_wgt_dir480_saw', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_saw', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dir480_saw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_saw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) elseif (snicar_solarspec == 4) then ! sub-Arctic summer - call ncd_io( 'flx_wgt_dir480_sas', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_sas', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dir480_sas', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_sas', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) elseif (snicar_solarspec == 5) then ! Summit,Greenland,summer - call ncd_io( 'flx_wgt_dir480_smm', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_smm', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dir480_smm', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_smm', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) elseif (snicar_solarspec == 6) then ! High Mountain summer - call ncd_io( 'flx_wgt_dir480_hmn', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_hmn', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) - else - write(iulog,*) 'invalid downward solar radiation spectrum option in namelist' - ! for invalid spectrum type, use mid-latitude winter (default) - call ncd_io( 'flx_wgt_dir480_mlw', flx_wgt_dir480, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_mlw', flx_wgt_dif480, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dir480_hmn', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'flx_wgt_dif480_hmn', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) endif - endif + endif ! end if snicar_numrad_snw == 480 call ncd_pio_closefile(ncid) if (masterproc) then diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index df92dbcb41..6aff5dada4 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -14,9 +14,9 @@ module SurfaceAlbedoMod use landunit_varcon , only : istsoil, istcrop, istdlak use clm_varcon , only : grlnd, spval ! cenlin use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan - use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE + use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE, DO_SNO_OC !cenlin use pftconMod , only : pftcon - use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER, DO_SNO_OC + use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER use AerosolMod , only : aerosol_type use CanopyStateType , only : canopystate_type use LakeStateType , only : lakestate_type diff --git a/src/biogeophys/SurfaceRadiationMod.F90 b/src/biogeophys/SurfaceRadiationMod.F90 index 5378e6315c..5a00a67b23 100644 --- a/src/biogeophys/SurfaceRadiationMod.F90 +++ b/src/biogeophys/SurfaceRadiationMod.F90 @@ -477,9 +477,9 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & use clm_varpar , only : numrad, nlevsno use clm_varcon , only : spval use landunit_varcon , only : istsoil, istcrop - use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE + use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE, DO_SNO_OC !cenlin use clm_time_manager , only : get_step_size_real, is_near_local_noon - use SnowSnicarMod , only : DO_SNO_OC + ! use SnowSnicarMod , only : DO_SNO_OC use abortutils , only : endrun ! ! !ARGUMENTS: diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index d8a56384eb..eaae254593 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -209,14 +209,14 @@ module clm_varctl ! number of wavelength bands used in SNICAR snow albedo calculation, cenlin integer, public :: snicar_numrad_snw = 5 - ! type of downward solar radiation spectrum for SNICAR snow albedo calculation (only used in 480-band version), cenlin + ! type of downward solar radiation spectrum for SNICAR snow albedo calculation cenlin integer, public :: snicar_solarspec = 1 ! 1->mid-latitude winter;2->mid-latitude summer;3->sub-Arctic winter; ! 4->sub-Arctic summer;5->Summit,Greenland,summer;6->High Mountain summer; - ! snow optics type using different refractive index databases in SNICAR (only used in 480-band version), cenlin + ! snow optics type using different refractive index databases in SNICAR, cenlin integer, public :: snicar_snw_optics = 3 ! 1->Warren (1984);2->Warren and Brandt (2008);3->Picard et al (2016) - ! dust optics type for SNICAR snow albedo calculation (only used in 480-band version), cenlin + ! dust optics type for SNICAR snow albedo calculation, cenlin integer, public :: snicar_dust_optics = 1 ! 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) @@ -236,6 +236,8 @@ module clm_varctl ! option to activate dust-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln logical, public :: snicar_snodst_intmix = .false. ! false->external mixing for all dust; true->internal mixing for all dust + ! option to activate OC in snow in SNICAR, cenlin + logical, public :: DO_SNO_OC = .false. ! control to include organic carbon (OC) in snow !---------------------------------------------------------- ! C isotopes diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 195356b77f..a59dee79c9 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -204,7 +204,7 @@ subroutine control_init(dtime) crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & snicar_numrad_snw, snicar_solarspec, snicar_snw_optics, snicar_dust_optics, & snicar_use_aerosol, snicar_rt_solver, snicar_snw_shape, snicar_snobc_intmix,& - snicar_snodst_intmix ! cenlin + snicar_snodst_intmix,DO_SNO_OC ! cenlin ! vertical soil mixing variables namelist /clm_inparm/ & @@ -842,6 +842,7 @@ subroutine control_spmd() call mpi_bcast (snicar_snw_shape, 1, MPI_INTEGER, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_snobc_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin call mpi_bcast (snicar_snodst_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin + call mpi_bcast (DO_SNO_OC, 1, MPI_LOGICAL, 0, mpicom, ier) ! cenlin ! snow pack variables call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier) @@ -1016,24 +1017,23 @@ subroutine control_print () write(iulog,*) ' snow aging parameters file = ',trim(fsnowaging) endif ! cenlin - if (snicar_numrad_snw==480) then - if (fsnowoptics480 == ' ') then - write(iulog,*) ' SNICAR: snow optical properties (480-band) file NOT set' - else - write(iulog,*) ' SNICAR: snow optical properties (480-band) file = ',trim(fsnowoptics480) - endif - write(iulog,*) ' SNICAR: downward solar radiation spectrum type =', snicar_solarspec - write(iulog,*) ' SNICAR: snow refractive index type = ', snicar_snw_optics - write(iulog,*) ' SNICAR: dust optics type = ', snicar_dust_optics + if (fsnowoptics480 == ' ') then + write(iulog,*) ' SNICAR: snow optical properties (480-band) file NOT set' + else + write(iulog,*) ' SNICAR: snow optical properties (480-band) file = ',trim(fsnowoptics480) endif - - write(iulog,*) ' Number of snow layers =', nlevsno - write(iulog,*) ' Max snow depth (mm) =', h2osno_max + write(iulog,*) ' SNICAR: downward solar radiation spectrum type =', snicar_solarspec + write(iulog,*) ' SNICAR: snow refractive index type = ', snicar_snw_optics + write(iulog,*) ' SNICAR: dust optics type = ', snicar_dust_optics write(iulog,*) ' SNICAR: number of bands in snow albedo calculation =', snicar_numrad_snw ! cenlin write(iulog,*) ' SNICAR: radiative transfer solver type = ',snicar_rt_solver ! cenlin write(iulog,*) ' SNICAR: snow grain shape type = ',snicar_snw_shape ! cenlin write(iulog,*) ' SNICAR: BC-snow internal mixing = ', snicar_snobc_intmix ! cenlin write(iulog,*) ' SNICAR: dust-snow internal mixing = ', snicar_snodst_intmix ! cenlin + write(iulog,*) ' SNICAR: OC in snow = ', DO_SNO_OC ! cenlin + + write(iulog,*) ' Number of snow layers =', nlevsno + write(iulog,*) ' Max snow depth (mm) =', h2osno_max write(iulog,*) ' glc number of elevation classes =', maxpatch_glc if (glc_do_dynglacier) then From a6e168e5876da60b555b4eba2ba37f25cd986db0 Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Mon, 31 Jan 2022 23:14:59 -0700 Subject: [PATCH 10/62] add DO_SNO_OC to namelist_definition_ctsm --- bld/namelist_files/namelist_definition_ctsm.xml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index baa18b77dc..853892b90b 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -205,6 +205,11 @@ option to activate BC-snow internal mixing in SNICAR snow albedo calculation option to activate dust-snow internal mixing in SNICAR snow albedo calculation + +option to activate organic carbon (OC) in SNICAR snow albedo calculation + + Index of rooting profile for water From 7191233c7b46917ee0ce0f40fdce2cae8d83b8e5 Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Sun, 10 Apr 2022 20:31:03 -0600 Subject: [PATCH 11/62] bug fix for albsni_hst2 --- src/biogeophys/SurfaceAlbedoMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index 6aff5dada4..d7c3305710 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -1099,7 +1099,7 @@ subroutine SurfaceAlbedo(bounds,nc, & albgri_dst_hst(c,ib) = albgri_dst(c,ib) if (h2osno_total(c) > 0._r8) then albsnd_hst2(c,ib) = albsnd_hst(c,ib) - albsni_hst2(c,ib) = albsnd_hst(c,ib) + albsni_hst2(c,ib) = albsni_hst(c,ib) end if end if end do From 83991f7b4592919719bb3d88bdc3ad84ebbe12a6 Mon Sep 17 00:00:00 2001 From: cenlinhe Date: Mon, 10 Apr 2023 21:15:51 -0600 Subject: [PATCH 12/62] correcting default values for new SNICAR namelist options --- src/main/clm_varctl.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index eaae254593..da5f55fc8a 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -228,10 +228,10 @@ module clm_varctl ! 2->Adding-doubling 2-stream (Dang et al.2019) ! option for snow grain shape in SNICAR (He et al. 2017 JC), ceniln - integer, public :: snicar_snw_shape = 1 ! 1->sphere; 2->spheroid; 3->hexagonal plate; 4->Koch snowflake + integer, public :: snicar_snw_shape = 3 ! 1->sphere; 2->spheroid; 3->hexagonal plate; 4->Koch snowflake ! option to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln - logical, public :: snicar_snobc_intmix = .true. ! false->external mixing for all BC; true->internal mixing for hydrophilic BC + logical, public :: snicar_snobc_intmix = .false. ! false->external mixing for all BC; true->internal mixing for hydrophilic BC ! option to activate dust-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln logical, public :: snicar_snodst_intmix = .false. ! false->external mixing for all dust; true->internal mixing for all dust From 32ca5eca96837acfc958736d45d2e543dcd55390 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 2 Aug 2023 16:46:17 -0600 Subject: [PATCH 13/62] snicar_snw_optics: keep option 3 only --- .../namelist_definition_ctsm.xml | 5 - src/biogeophys/SnowSnicarMod.F90 | 212 +++++------------- src/main/clm_varctl.F90 | 3 - src/main/controlMod.F90 | 10 +- 4 files changed, 51 insertions(+), 179 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index fde179c99e..dd91973ef3 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -160,11 +160,6 @@ number of wavelength bands used in SNICAR snow albedo calculation type of downward solar radiation spectrum for SNICAR snow albedo calculation - -snow optics type using different refractive index databases in SNICAR - - dust optics type for SNICAR snow albedo calculation diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 033ad97eb0..72ac2e0976 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -2203,7 +2203,7 @@ subroutine SnowOptics_init( ) use fileutils , only : getfil use CLM_varctl , only : fsnowoptics,snicar_numrad_snw,fsnowoptics480,snicar_solarspec,& - snicar_snw_optics,snicar_dust_optics ! cenlin + snicar_dust_optics ! cenlin use spmdMod , only : masterproc use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile @@ -2277,29 +2277,13 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_ocphob_dif_mlw', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_ocphob_dif_mlw', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) - ! ice refractive index options - if (snicar_snw_optics == 1) then ! Warren (1984) - call ncd_io( 'ss_alb_ice_wrn84_dir_mlw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dir_mlw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn84_dif_mlw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) - call ncd_io( 'ss_alb_ice_wrn08_dir_mlw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dir_mlw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn08_dif_mlw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 3) then ! Picard et al (2016) - call ncd_io( 'ss_alb_ice_pic16_dir_mlw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_mlw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_mlw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - endif + ! ice refractive index (Picard et al., 2016) + call ncd_io( 'ss_alb_ice_pic16_dir_mlw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_mlw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_mlw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters @@ -2375,29 +2359,13 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_ocphob_dif_mls', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_ocphob_dif_mls', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) - ! ice refractive index options - if (snicar_snw_optics == 1) then ! Warren (1984) - call ncd_io( 'ss_alb_ice_wrn84_dir_mls', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dir_mls',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn84_dif_mls', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) - call ncd_io( 'ss_alb_ice_wrn08_dir_mls', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dir_mls',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn08_dif_mls', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 3) then ! Picard et al (2016) - call ncd_io( 'ss_alb_ice_pic16_dir_mls', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_mls',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_mls', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - endif + ! ice refractive index (Picard et al., 2016) + call ncd_io( 'ss_alb_ice_pic16_dir_mls', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_mls',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_mls', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters @@ -2472,29 +2440,13 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_ocphob_dif_saw', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_ocphob_dif_saw', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) - ! ice refractive index options - if (snicar_snw_optics == 1) then ! Warren (1984) - call ncd_io( 'ss_alb_ice_wrn84_dir_saw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dir_saw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn84_dif_saw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) - call ncd_io( 'ss_alb_ice_wrn08_dir_saw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dir_saw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn08_dif_saw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 3) then ! Picard et al (2016) - call ncd_io( 'ss_alb_ice_pic16_dir_saw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_saw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_saw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - endif + ! ice refractive index (Picard et al., 2016) + call ncd_io( 'ss_alb_ice_pic16_dir_saw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_saw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_saw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters @@ -2569,29 +2521,13 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_ocphob_dif_sas', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_ocphob_dif_sas', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) - ! ice refractive index options - if (snicar_snw_optics == 1) then ! Warren (1984) - call ncd_io( 'ss_alb_ice_wrn84_dir_sas', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dir_sas',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn84_dif_sas', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) - call ncd_io( 'ss_alb_ice_wrn08_dir_sas', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dir_sas',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn08_dif_sas', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 3) then ! Picard et al (2016) - call ncd_io( 'ss_alb_ice_pic16_dir_sas', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_sas',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_sas', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - endif + ! ice refractive index (Picard et al., 2016) + call ncd_io( 'ss_alb_ice_pic16_dir_sas', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_sas',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_sas', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters @@ -2666,29 +2602,13 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_ocphob_dif_smm', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_ocphob_dif_smm', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) - ! ice refractive index options - if (snicar_snw_optics == 1) then ! Warren (1984) - call ncd_io( 'ss_alb_ice_wrn84_dir_smm', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dir_smm',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn84_dif_smm', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) - call ncd_io( 'ss_alb_ice_wrn08_dir_smm', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dir_smm',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn08_dif_smm', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 3) then ! Picard et al (2016) - call ncd_io( 'ss_alb_ice_pic16_dir_smm', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_smm',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_smm', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - endif + ! ice refractive index (Picard et al., 2016) + call ncd_io( 'ss_alb_ice_pic16_dir_smm', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_smm',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_smm', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters @@ -2763,29 +2683,13 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_ocphob_dif_hmn', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_ocphob_dif_hmn', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) - ! ice refractive index options - if (snicar_snw_optics == 1) then ! Warren (1984) - call ncd_io( 'ss_alb_ice_wrn84_dir_hmn', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dir_hmn',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn84_dif_hmn', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) - call ncd_io( 'ss_alb_ice_wrn08_dir_hmn', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dir_hmn',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn08_dif_hmn', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 3) then ! Picard et al (2016) - call ncd_io( 'ss_alb_ice_pic16_dir_hmn', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_hmn',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_hmn', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - endif + ! ice refractive index (Picard et al., 2016) + call ncd_io( 'ss_alb_ice_pic16_dir_hmn', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dir_hmn',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16_dif_hmn', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters @@ -2869,29 +2773,13 @@ subroutine SnowOptics_init( ) call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) ! 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) - call ncd_io( 'ss_alb_ice_wrn84', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn84', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn84',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn84', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 2) then ! Warren and Brandt (2008) - call ncd_io( 'ss_alb_ice_wrn08', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_wrn08', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_wrn08',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_wrn08', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_snw_optics == 3) then ! Picard et al (2016) - call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) - endif + ! same value for direct and diffuse due to high spectral res without spectra averaging in database (Picard et al., 2016) + call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 5cd01d4e90..e5492c4a8b 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -238,9 +238,6 @@ module clm_varctl integer, public :: snicar_solarspec = 1 ! 1->mid-latitude winter;2->mid-latitude summer;3->sub-Arctic winter; ! 4->sub-Arctic summer;5->Summit,Greenland,summer;6->High Mountain summer; - ! snow optics type using different refractive index databases in SNICAR, cenlin - integer, public :: snicar_snw_optics = 3 ! 1->Warren (1984);2->Warren and Brandt (2008);3->Picard et al (2016) - ! dust optics type for SNICAR snow albedo calculation, cenlin integer, public :: snicar_dust_optics = 1 ! 1->Saharan dust (Balkanski et al., 2007, central hematite) ! 2->San Juan Mountains dust, CO (Skiles et al, 2017) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index db7a897126..410229b87b 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -202,7 +202,7 @@ subroutine control_init(dtime) soil_layerstruct_userdefined_nlevsoi, use_subgrid_fluxes, snow_cover_fraction_method, & irrigate, run_zero_weight_urban, all_active, & crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & - snicar_numrad_snw, snicar_solarspec, snicar_snw_optics, snicar_dust_optics, & + snicar_numrad_snw, snicar_solarspec, snicar_dust_optics, & snicar_use_aerosol, snicar_rt_solver, snicar_snw_shape, snicar_snobc_intmix,& snicar_snodst_intmix,DO_SNO_OC, & for_testing_use_second_grain_pool, for_testing_use_repr_structure_pool, & @@ -584,12 +584,6 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if - ! check on snow optics type - if ( (snicar_snw_optics < 1) .or. (snicar_snw_optics > 3) ) then - call endrun(msg=' ERROR: snicar_snw_optics is out of a reasonable range (1,2,3)'//& - errMsg(sourcefile, __LINE__)) - end if - ! check on dust optics type if ( (snicar_dust_optics < 1) .or. (snicar_dust_optics > 3) ) then call endrun(msg=' ERROR: snicar_dust_optics is out of a reasonable range (1,2,3)'//& @@ -837,7 +831,6 @@ subroutine control_spmd() call mpi_bcast (soil_layerstruct_userdefined_nlevsoi, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_numrad_snw, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_solarspec, 1, MPI_INTEGER, 0, mpicom, ier) - call mpi_bcast (snicar_snw_optics, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_dust_optics, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snicar_rt_solver, 1, MPI_INTEGER, 0, mpicom, ier) @@ -1025,7 +1018,6 @@ subroutine control_print () write(iulog,*) ' SNICAR: snow optical properties (480-band) file = ',trim(fsnowoptics480) endif write(iulog,*) ' SNICAR: downward solar radiation spectrum type =', snicar_solarspec - write(iulog,*) ' SNICAR: snow refractive index type = ', snicar_snw_optics write(iulog,*) ' SNICAR: dust optics type = ', snicar_dust_optics write(iulog,*) ' SNICAR: number of bands in snow albedo calculation =', snicar_numrad_snw write(iulog,*) ' SNICAR: radiative transfer solver type = ',snicar_rt_solver From 725f5272a36ece1d5ec95d5d99373339ea20a67a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 2 Aug 2023 18:02:10 -0600 Subject: [PATCH 14/62] snicar_rt_solver: keep option 2 only --- .../namelist_definition_ctsm.xml | 5 - src/biogeophys/SnowSnicarMod.F90 | 863 ++++++------------ src/main/clm_varctl.F90 | 4 - src/main/controlMod.F90 | 10 +- 4 files changed, 275 insertions(+), 607 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index dd91973ef3..a9ec4e5559 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -170,11 +170,6 @@ dust optics type for SNICAR snow albedo calculation Toggle to turn on/off aerosol deposition flux in snow in SNICAR - -SNICAR radiative transfer solver type - - snow grain shape used in SNICAR snow albedo calculation diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 72ac2e0976..3264086ebe 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -11,7 +11,7 @@ module SnowSnicarMod use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : iulog, snicar_numrad_snw, snicar_rt_solver, & + use clm_varctl , only : iulog, snicar_numrad_snw, & snicar_snw_shape, snicar_snobc_intmix, & snicar_snodst_intmix, DO_SNO_OC ! cenlin use clm_varcon , only : tfrz @@ -225,8 +225,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! in ESMs; and Flanner et al. 2021, SNICAR-ADv3: a community tool for modeling ! spectral snow albedo ! - ! To use this new adding-doubling solver, set snicar_rt_solver=2 in CLM namelist - ! ! !USES: use clm_varpar , only : nlevsno, numrad use clm_time_manager , only : get_nstep @@ -786,82 +784,18 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Loop over snow spectral bands do bnd_idx = 1,snicar_numrad_snw - - ! Toon et al 2-stream - if (snicar_rt_solver == 1) then - mu_not = coszen(c_idx) ! must set here, because of error handling - - ! Adding-doubling 2-stream - elseif (snicar_rt_solver == 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(coszen(c_idx), cp01) - endif + ! 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(coszen(c_idx), cp01) flg_dover = 1 ! default is to redo err_idx = 0 ! number of times through loop do while (flg_dover > 0) - ! Only for Toon et al 2-stream solver: - if (snicar_rt_solver == 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 (bnd_idx < nir_bnd_bgn) then ! VIS, cenlin - if (flg_dover == 2) then - APRX_TYP = 3 - elseif (flg_dover == 3) then - APRX_TYP = 1 - if (coszen(c_idx) > 0.5_r8) then - mu_not = mu_not - 0.02_r8 - else - mu_not = mu_not + 0.02_r8 - 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 (coszen(c_idx) > 0.5_r8) then - mu_not = mu_not - 0.02_r8 - else - mu_not = mu_not + 0.02_r8 - endif - elseif (flg_dover == 4) then - APRX_TYP = 1 - else - APRX_TYP = 3 - endif - endif ! end if bnd_idx < nir_bnd_bgn - - endif ! end if snicar_rt_solver == 1 - - ! Set direct or diffuse incident irradiance to 1 ! (This has to be within the bnd loop because mu_not is adjusted in rare cases) if (flg_slr_in == 1) then @@ -1183,529 +1117,282 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & endif !--------------------------- End of snow & aerosol optics -------------------------------- - - !--------------------------- Start Toon et al. RT solver -------------------------------- - if (snicar_rt_solver == 1) then - - ! Total column optical depth: - ! tau_clm(i) = total optical depth above the bottom of layer i - tau_clm(snl_top) = 0._r8 - do i=snl_top+1,snl_btm,1 - tau_clm(i) = tau_clm(i-1)+tau_star(i-1) - enddo - - ! Direct radiation at bottom of snowpack: - F_direct_btm = albsfc_lcl(bnd_idx)*mu_not * & - exp(-(tau_clm(snl_btm)+tau_star(snl_btm))/mu_not)*pi*flx_slrd_lcl(bnd_idx) - - ! Intermediates - ! Gamma values are approximation-specific. - - ! Eddington - if (APRX_TYP==1) then - do i=snl_top,snl_btm,1 - gamma1(i) = (7._r8-(omega_star(i)*(4._r8+(3._r8*g_star(i)))))/4._r8 - gamma2(i) = -(1._r8-(omega_star(i)*(4._r8-(3._r8*g_star(i)))))/4._r8 - gamma3(i) = (2._r8-(3._r8*g_star(i)*mu_not))/4._r8 - gamma4(i) = 1._r8-gamma3(i) - mu_one = 0.5_r8 - enddo - - ! Quadrature - elseif (APRX_TYP==2) then - do i=snl_top,snl_btm,1 - gamma1(i) = (3._r8**0.5)*(2._r8-(omega_star(i)*(1._r8+g_star(i))))/2._r8 - gamma2(i) = omega_star(i)*(3._r8**0.5)*(1._r8-g_star(i))/2._r8 - gamma3(i) = (1._r8-((3._r8**0.5)*g_star(i)*mu_not))/2._r8 - gamma4(i) = 1._r8-gamma3(i) - mu_one = 1._r8/(3._r8**0.5_r8) - enddo - - ! Hemispheric Mean - elseif (APRX_TYP==3) then - do i=snl_top,snl_btm,1 - gamma1(i) = 2._r8 - (omega_star(i)*(1._r8+g_star(i))) - gamma2(i) = omega_star(i)*(1-g_star(i)) - gamma3(i) = (1._r8-((3._r8**0.5_r8)*g_star(i)*mu_not))/2._r8 - gamma4(i) = 1._r8-gamma3(i) - mu_one = 0.5_r8 - enddo - endif - - ! Intermediates for tri-diagonal solution - do i=snl_top,snl_btm,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 !enddo over snow layers - - ! Intermediates for tri-diagonal solution - do i=snl_top,snl_btm,1 - if (flg_slr_in == 1) then - - C_pls_btm(i) = (omega_star(i)*pi*flx_slrd_lcl(bnd_idx)* & - 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)*pi*flx_slrd_lcl(bnd_idx)* & - 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)*pi*flx_slrd_lcl(bnd_idx)* & - 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)*pi*flx_slrd_lcl(bnd_idx)* & - 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._r8 - C_mns_btm(i) = 0._r8 - C_pls_top(i) = 0._r8 - C_mns_top(i) = 0._r8 - endif - enddo - - ! 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._r8 - B(i) = e1(snl_top) - D(i) = -e2(snl_top) - E(i) = flx_slri_lcl(bnd_idx)-C_mns_top(snl_top) - - elseif(i==0) then - A(i) = e1(snl_btm)-(albsfc_lcl(bnd_idx)*e3(snl_btm)) - B(i) = e2(snl_btm)-(albsfc_lcl(bnd_idx)*e4(snl_btm)) - D(i) = 0._r8 - E(i) = F_direct_btm-C_pls_btm(snl_btm)+(albsfc_lcl(bnd_idx)*C_mns_btm(snl_btm)) - - 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=snl_top,snl_btm,1 - F_direct(i) = mu_not*pi*flx_slrd_lcl(bnd_idx)*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(snl_top)*tau_star(snl_top))+ & - GAMMA(snl_top))) + (Y(2*snl_lcl+2)*(exp(-lambda(snl_top)* & - tau_star(snl_top))-GAMMA(snl_top))) + C_pls_top(snl_top) - - ! Net flux at bottom = absorbed radiation by underlying surface: - F_btm_net = -F_net(snl_btm) - - - ! Bulk column albedo and surface net flux - albedo = F_sfc_pls/((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) - F_sfc_net = F_sfc_pls - ((mu_not*pi*flx_slrd_lcl(bnd_idx))+flx_slri_lcl(bnd_idx)) - - trip = 0 - ! Absorbed flux in each layer - do i=snl_top,snl_btm,1 - if(i==snl_top) 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,bnd_idx) = F_abs(i) - - ! ERROR check: negative absorption - if (flx_abs_lcl(i,bnd_idx) < -0.00001_r8) then - trip = 1 - endif - enddo - - flx_abs_lcl(1,bnd_idx) = 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,bnd_idx) = F_abs(0) - flx_abs_lcl(1,bnd_idx) = F_btm_net - endif - - !Underflow check (we've already tripped the error condition above) - do i=snl_top,1,1 - if (flx_abs_lcl(i,bnd_idx) < 0._r8) then - flx_abs_lcl(i,bnd_idx) = 0._r8 - endif - enddo - - F_abs_sum = 0._r8 - do i=snl_top,snl_btm,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._r8) then - trip = 1 - endif - - !ERROR check: - if ((albedo < 0._r8).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(iulog,*) "SNICAR ERROR: FOUND A WORMHOLE. STUCK IN INFINITE LOOP! Called from: ", flg_snw_ice - write(iulog,*) "SNICAR STATS: snw_rds(0)= ", snw_rds(c_idx,0) - write(iulog,*) "SNICAR STATS: L_snw(0)= ", L_snw(0) - write(iulog,*) "SNICAR STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl - write(iulog,*) "SNICAR STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1) - write(iulog,*) "SNICAR STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2) - write(iulog,*) "SNICAR STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3) - write(iulog,*) "SNICAR STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4) - write(iulog,*) "SNICAR STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5) - write(iulog,*) "SNICAR STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6) - l_idx = col%landunit(c_idx) - write(iulog,*) "column index: ", c_idx - write(iulog,*) "landunit type", lun%itype(l_idx) - write(iulog,*) "frac_sno: ", frac_sno(c_idx) - call endrun(subgrid_index=c_idx, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) - else - flg_dover = 0 - endif - - endif ! end if snicar_rt_solver==1 - !--------------------------- End of Toon et al. RT solver -------------------------------- - - !--------------------------- Start Adding-doubling RT solver -------------------------------- - if (snicar_rt_solver == 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 = snl_btm + 1 - - ! initialization for layer interface - do i = snl_top,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(snl_top) = c1 - trntdr(snl_top) = c1 - trndif(snl_top) = c1 - rdndif(snl_top) = c0 - - ! begin main level loop for snow layer interfaces except for the very bottom - do i = snl_top,snl_btm,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 - 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)) + + ! 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 = snl_btm + 1 + + ! initialization for layer interface + do i = snl_top,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(snl_top) = c1 + trntdr(snl_top) = c1 + trndif(snl_top) = c1 + rdndif(snl_top) = c0 + + ! begin main level loop for snow layer interfaces except for the very bottom + do i = snl_top,snl_btm,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 + 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)) + 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 - 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(k) > 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 ! end i main level loop - - ! compute reflectivity to direct and diffuse radiation for layers - ! below by adding succesive layers starting from the underlying - ! ground and working upwards: + 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(k) > 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 - ! --------------------- i+1 - ! i+1 ! --------------------- - ! set the underlying ground albedo == albedo of near-IR - ! unless bnd_idx < nir_bnd_bgn, for visible - rupdir(snl_btm_itf) = albsfc(c_idx,2) - rupdif(snl_btm_itf) = albsfc(c_idx,2) - if (bnd_idx < nir_bnd_bgn) then - rupdir(snl_btm_itf) = albsfc(c_idx,1) - rupdif(snl_btm_itf) = albsfc(c_idx,1) + 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 ! end i main level loop + + ! 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 + rupdir(snl_btm_itf) = albsfc(c_idx,2) + rupdif(snl_btm_itf) = albsfc(c_idx,2) + if (bnd_idx < nir_bnd_bgn) then + rupdir(snl_btm_itf) = albsfc(c_idx,1) + rupdif(snl_btm_itf) = albsfc(c_idx,1) + endif + + do i=snl_btm,snl_top,-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 = snl_top, 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 ! k + + ! SNICAR_AD_RT is called twice for direct and diffuse incident fluxes + ! direct incident + if (flg_slr_in == 1) then + albedo = rupdir(snl_top) + dftmp = dfdir + refk = c1/(c1 - rdndif(snl_top)*rupdif(snl_top)) + F_sfc_pls = (trndir(snl_top)*rupdir(snl_top) + & + (trntdr(snl_top)-trndir(snl_top)) & + *rupdif(snl_top))*refk + !diffuse incident + else + albedo = rupdif(snl_top) + dftmp = dfdif + refk = c1/(c1 - rdndif(snl_top)*rupdif(snl_top)) + F_sfc_pls = trndif(snl_top)*rupdif(snl_top)*refk + endif + + ! Absorbed flux in each layer + do i=snl_top,snl_btm,1 + F_abs(i) = dftmp(i)-dftmp(i+1) + flx_abs_lcl(i,bnd_idx) = F_abs(i) + + ! ERROR check: negative absorption + if (flx_abs_lcl(i,bnd_idx) < -0.00001_r8) then + write (iulog,"(a,e13.6,a,i6,a,i6)") "SNICAR ERROR: negative absoption : ", & + flx_abs_lcl(i,bnd_idx), " at timestep: ", nstep, " at column: ", c_idx + write(iulog,*) "SNICAR_AD STATS: snw_rds(0)= ", snw_rds(c_idx,0) + write(iulog,*) "SNICAR_AD STATS: L_snw(0)= ", L_snw(0) + write(iulog,*) "SNICAR_AD STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl + write(iulog,*) "SNICAR_AD STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1) + write(iulog,*) "SNICAR_AD STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2) + write(iulog,*) "SNICAR_AD STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3) + write(iulog,*) "SNICAR_AD STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4) + write(iulog,*) "SNICAR_AD STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5) + write(iulog,*) "SNICAR_AD STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6) + call endrun(subgrid_index=c_idx, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) endif + enddo - do i=snl_btm,snl_top,-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 - ! --------------------- + ! absobed flux by the underlying ground + F_btm_net = dftmp(snl_btm_itf) - do i = snl_top, 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 ! k - - ! SNICAR_AD_RT is called twice for direct and diffuse incident fluxes - ! direct incident - if (flg_slr_in == 1) then - albedo = rupdir(snl_top) - dftmp = dfdir - refk = c1/(c1 - rdndif(snl_top)*rupdif(snl_top)) - F_sfc_pls = (trndir(snl_top)*rupdir(snl_top) + & - (trntdr(snl_top)-trndir(snl_top)) & - *rupdif(snl_top))*refk - !diffuse incident - else - albedo = rupdif(snl_top) - dftmp = dfdif - refk = c1/(c1 - rdndif(snl_top)*rupdif(snl_top)) - F_sfc_pls = trndif(snl_top)*rupdif(snl_top)*refk - endif + ! note here, snl_btm_itf = 1 by snow column set up in CLM + flx_abs_lcl(1,bnd_idx) = F_btm_net - ! Absorbed flux in each layer - do i=snl_top,snl_btm,1 - F_abs(i) = dftmp(i)-dftmp(i+1) - flx_abs_lcl(i,bnd_idx) = F_abs(i) - - ! ERROR check: negative absorption - if (flx_abs_lcl(i,bnd_idx) < -0.00001_r8) then - write (iulog,"(a,e13.6,a,i6,a,i6)") "SNICAR ERROR: negative absoption : ", & - flx_abs_lcl(i,bnd_idx), " at timestep: ", nstep, " at column: ", c_idx - write(iulog,*) "SNICAR_AD STATS: snw_rds(0)= ", snw_rds(c_idx,0) - write(iulog,*) "SNICAR_AD STATS: L_snw(0)= ", L_snw(0) - write(iulog,*) "SNICAR_AD STATS: h2osno= ", h2osno_lcl, " snl= ", snl_lcl - write(iulog,*) "SNICAR_AD STATS: soot1(0)= ", mss_cnc_aer_lcl(0,1) - write(iulog,*) "SNICAR_AD STATS: soot2(0)= ", mss_cnc_aer_lcl(0,2) - write(iulog,*) "SNICAR_AD STATS: dust1(0)= ", mss_cnc_aer_lcl(0,3) - write(iulog,*) "SNICAR_AD STATS: dust2(0)= ", mss_cnc_aer_lcl(0,4) - write(iulog,*) "SNICAR_AD STATS: dust3(0)= ", mss_cnc_aer_lcl(0,5) - write(iulog,*) "SNICAR_AD STATS: dust4(0)= ", mss_cnc_aer_lcl(0,6) - call endrun(subgrid_index=c_idx, subgrid_level=subgrid_level_column, msg=errmsg(sourcefile, __LINE__)) - 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 + 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,bnd_idx) = F_abs(0) flx_abs_lcl(1,bnd_idx) = F_btm_net + endif - 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,bnd_idx) = F_abs(0) - flx_abs_lcl(1,bnd_idx) = F_btm_net + !Underflow check (we've already tripped the error condition above) + do i=snl_top,1,1 + if (flx_abs_lcl(i,bnd_idx) < 0._r8) then + flx_abs_lcl(i,bnd_idx) = 0._r8 endif + enddo - !Underflow check (we've already tripped the error condition above) - do i=snl_top,1,1 - if (flx_abs_lcl(i,bnd_idx) < 0._r8) then - flx_abs_lcl(i,bnd_idx) = 0._r8 - endif - enddo - - F_abs_sum = 0._r8 - do i=snl_top,snl_btm,1 - F_abs_sum = F_abs_sum + F_abs(i) - enddo + F_abs_sum = 0._r8 + do i=snl_top,snl_btm,1 + F_abs_sum = F_abs_sum + F_abs(i) + enddo - ! no need to repeat calculations for adding-doubling solver - flg_dover = 0 + ! no need to repeat calculations for adding-doubling solver + flg_dover = 0 - endif ! end if snicar_rt_solver==2 !--------------------------- End of Adding-doubling RT solver -------------------------------- enddo !enddo while (flg_dover > 0) @@ -1823,19 +1510,17 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & end if ! high solar zenith angle adjustment for Adding-doubling solver results - if (snicar_rt_solver==2) then - ! near-IR direct albedo/absorption adjustment for high solar zenith angles - ! solar zenith angle parameterization - ! calculate the scaling factor for NIR direct albedo if SZA>75 degree - if ((mu_not < mu_75) .and. (flg_slr_in == 1)) then - sza_c1 = sza_a0 + sza_a1 * mu_not + sza_a2 * mu_not**2 - sza_c0 = sza_b0 + sza_b1 * mu_not + sza_b2 * mu_not**2 - sza_factor = sza_c1 * (log10(snw_rds_lcl(snl_top) * c1) - c6) + sza_c0 - flx_sza_adjust = albout(c_idx,2) * (sza_factor-c1) * sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) - albout(c_idx,2) = albout(c_idx,2) * sza_factor - flx_abs(c_idx,snl_top,2) = flx_abs(c_idx,snl_top,2) - flx_sza_adjust - endif - endif ! end of snicar_rt_solver==2 + ! near-IR direct albedo/absorption adjustment for high solar zenith angles + ! solar zenith angle parameterization + ! calculate the scaling factor for NIR direct albedo if SZA>75 degree + if ((mu_not < mu_75) .and. (flg_slr_in == 1)) then + sza_c1 = sza_a0 + sza_a1 * mu_not + sza_a2 * mu_not**2 + sza_c0 = sza_b0 + sza_b1 * mu_not + sza_b2 * mu_not**2 + sza_factor = sza_c1 * (log10(snw_rds_lcl(snl_top) * c1) - c6) + sza_c0 + flx_sza_adjust = albout(c_idx,2) * (sza_factor-c1) * sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + albout(c_idx,2) = albout(c_idx,2) * sza_factor + flx_abs(c_idx,snl_top,2) = flx_abs(c_idx,snl_top,2) - flx_sza_adjust + endif ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index e5492c4a8b..7cf5a59560 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -245,10 +245,6 @@ module clm_varctl ! option to turn off aerosol effect in snow in SNICAR logical, public :: snicar_use_aerosol = .true. ! if .false., turn off aerosol deposition flux - ! option for two different SNICAR radiative transfer solver, cenlin - integer, public :: snicar_rt_solver = 2 ! 1->Toon et a 1989 2-stream (Flanner et al. 2007) - ! 2->Adding-doubling 2-stream (Dang et al.2019) - ! option for snow grain shape in SNICAR (He et al. 2017 JC), ceniln integer, public :: snicar_snw_shape = 3 ! 1->sphere; 2->spheroid; 3->hexagonal plate; 4->Koch snowflake diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 410229b87b..817a2b6d7a 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -203,7 +203,7 @@ subroutine control_init(dtime) irrigate, run_zero_weight_urban, all_active, & crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & snicar_numrad_snw, snicar_solarspec, snicar_dust_optics, & - snicar_use_aerosol, snicar_rt_solver, snicar_snw_shape, snicar_snobc_intmix,& + snicar_use_aerosol, snicar_snw_shape, snicar_snobc_intmix,& snicar_snodst_intmix,DO_SNO_OC, & for_testing_use_second_grain_pool, for_testing_use_repr_structure_pool, & for_testing_no_crop_seed_replenishment @@ -590,12 +590,6 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if - ! check on SNICAR solver option - if ( (snicar_rt_solver < 1) .or. (snicar_rt_solver > 2) ) then - call endrun(msg=' ERROR: snicar_rt_solver is out of a reasonable range (1,2)'//& - errMsg(sourcefile, __LINE__)) - end if - ! check on SNICAR snow grain shape option if ( (snicar_snw_shape < 1) .or. (snicar_snw_shape > 4) ) then call endrun(msg=' ERROR: snicar_snw_shape is out of a reasonable range (1,2,3,4)'//& @@ -833,7 +827,6 @@ subroutine control_spmd() call mpi_bcast (snicar_solarspec, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_dust_optics, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (snicar_rt_solver, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_snw_shape, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_snobc_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snicar_snodst_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) @@ -1020,7 +1013,6 @@ subroutine control_print () write(iulog,*) ' SNICAR: downward solar radiation spectrum type =', snicar_solarspec write(iulog,*) ' SNICAR: dust optics type = ', snicar_dust_optics write(iulog,*) ' SNICAR: number of bands in snow albedo calculation =', snicar_numrad_snw - write(iulog,*) ' SNICAR: radiative transfer solver type = ',snicar_rt_solver write(iulog,*) ' SNICAR: snow grain shape type = ',snicar_snw_shape write(iulog,*) ' SNICAR: BC-snow internal mixing = ', snicar_snobc_intmix write(iulog,*) ' SNICAR: dust-snow internal mixing = ', snicar_snodst_intmix From 5f8d50d3edb649cdd504b0dc45a50d0bd4e53c37 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Aug 2023 16:12:41 -0600 Subject: [PATCH 15/62] snicar_snw_shape: replace integers with descriptive options --- bld/CLMBuildNamelist.pm | 10 ++++++++ bld/namelist_files/namelist_defaults_ctsm.xml | 1 + .../namelist_definition_ctsm.xml | 21 ++++++++-------- src/biogeophys/SnowSnicarMod.F90 | 24 +++++++++---------- src/main/clm_varctl.F90 | 4 ++-- src/main/controlMod.F90 | 17 ++++--------- 6 files changed, 40 insertions(+), 37 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 256de592c6..596b97a7e5 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1569,6 +1569,7 @@ sub process_namelist_inline_logic { setup_logic_irrigate($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_start_type($opts, $nl_flags, $nl); setup_logic_decomp_performance($opts, $nl_flags, $definition, $defaults, $nl); + setup_logic_snicar_methods($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_snow($opts, $nl_flags, $definition, $defaults, $nl); setup_logic_glacier($opts, $nl_flags, $definition, $defaults, $nl, $envxml_ref); setup_logic_dynamic_plant_nitrogen_alloc($opts, $nl_flags, $definition, $defaults, $nl, $physv); @@ -1988,6 +1989,14 @@ sub setup_logic_decomp_performance { #------------------------------------------------------------------------------- +sub setup_logic_snicar_methods { + my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snw_shape' ); +} + +#------------------------------------------------------------------------------- + sub setup_logic_snow { my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; @@ -4378,6 +4387,7 @@ sub write_output_files { push @groups, "lifire_inparm"; push @groups, "ch4finundated"; push @groups, "soilbgc_decomp"; + push @groups, "snicar_inparm"; push @groups, "clm_canopy_inparm"; if (remove_leading_and_trailing_quotes($nl->get_value('snow_cover_fraction_method')) eq 'SwensonLawrence2012') { push @groups, "scf_swenson_lawrence_2012_inparm"; diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 3cf9a3ebc0..2d57fd9798 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1543,6 +1543,7 @@ use_crop=".true.">lnd/clm2/surfdata_map/ctsm5.1.dev052/landuse.timeseries_mpasa1 lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc +hexagonal_plate 2015 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index a9ec4e5559..6a5d5fccd7 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -151,42 +151,43 @@ of soil column (nlevsoi). + group="snicar_inparm" valid_values="5,480" > number of wavelength bands used in SNICAR snow albedo calculation + group="snicar_inparm" valid_values="1,2,3,4,5,6" > type of downward solar radiation spectrum for SNICAR snow albedo calculation + group="snicar_inparm" valid_values="1,2,3" > dust optics type for SNICAR snow albedo calculation + group="snicar_inparm" valid_values="" value=".true."> Toggle to turn on/off aerosol deposition flux in snow in SNICAR - + snow grain shape used in SNICAR snow albedo calculation +Default: "hexagonal_plate" + group="snicar_inparm" valid_values="" value=".true." > option to activate BC-snow internal mixing in SNICAR snow albedo calculation + group="snicar_inparm" valid_values="" value=".true." > option to activate dust-snow internal mixing in SNICAR snow albedo calculation + group="snicar_inparm" valid_values="" value=".false." > option to activate organic carbon (OC) in SNICAR snow albedo calculation @@ -1197,7 +1198,7 @@ DependsOnLatAndVeg - Arctic vegetation depends on latitude as above, but tempera + group="snicar_inparm" valid_values="" value=".false."> Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) radiative forcing (snicar_frc=".true." is EXPERIMENTAL NOT SUPPORTED!) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 3264086ebe..1a107bef6b 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -447,14 +447,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & !----------------------------------------------------------------------- ! variables used for nonspherical snow grain treatment (He et al. 2017 J of Climate): - integer :: sno_shp(-nlevsno+1:0) ! Snow shape type: 1=sphere; 2=spheroid; 3=hexagonal plate; 4=koch snowflake + character(len=15) :: sno_shp(-nlevsno+1:0) ! Snow shape type: sphere, spheroid, hexagonal plate, koch snowflake ! currently only assuming same shapes for all snow layers real(r8) :: sno_fs(-nlevsno+1:0) ! Snow shape factor: ratio of nonspherical grain effective radii to that of equal-volume sphere - ! only activated when snicar_snw_shape > 1 (i.e. nonspherical) + ! only activated when snicar_snw_shape is nonspherical ! 0=use recommended default value (He et al. 2017); ! others(0 1 (i.e. nonspherical) + ! only activated when snicar_snw_shape is nonspherical ! 0=use recommended default value (He et al. 2017); ! others(0.1 1) then + if (sno_shp(i) /= 'sphere') 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 diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 7cf5a59560..670b9ab54f 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -245,8 +245,8 @@ module clm_varctl ! option to turn off aerosol effect in snow in SNICAR logical, public :: snicar_use_aerosol = .true. ! if .false., turn off aerosol deposition flux - ! option for snow grain shape in SNICAR (He et al. 2017 JC), ceniln - integer, public :: snicar_snw_shape = 3 ! 1->sphere; 2->spheroid; 3->hexagonal plate; 4->Koch snowflake + ! option for snow grain shape in SNICAR (He et al. 2017 JC) + character(len=15), public :: snicar_snw_shape = 'hexagonal_plate' ! sphere, spheroid, hexagonal_plate, koch_snowflake ! option to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln logical, public :: snicar_snobc_intmix = .false. ! false->external mixing for all BC; true->internal mixing for hydrophilic BC diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 817a2b6d7a..b22965aff1 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -235,8 +235,8 @@ subroutine control_init(dtime) fates_parteh_mode, & use_fates_tree_damage - ! Ozone vegetation stress method - namelist / clm_inparam / o3_veg_stress_method + ! Ozone vegetation stress method + namelist / clm_inparm / o3_veg_stress_method ! CLM 5.0 nitrogen flags namelist /clm_inparm/ use_flexibleCN, use_luna @@ -281,7 +281,7 @@ subroutine control_init(dtime) namelist /clm_inparm/ & use_lch4, use_nitrif_denitrif, use_extralakelayers, & - use_vichydro, use_cn, use_cndv, use_crop, use_fertilizer, o3_veg_stress_method, & + use_vichydro, use_cn, use_cndv, use_crop, use_fertilizer, & use_grainproduct, use_snicar_frc, use_vancouver, use_mexicocity, use_noio, & use_nguardrail @@ -590,12 +590,6 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if - ! check on SNICAR snow grain shape option - if ( (snicar_snw_shape < 1) .or. (snicar_snw_shape > 4) ) then - call endrun(msg=' ERROR: snicar_snw_shape is out of a reasonable range (1,2,3,4)'//& - errMsg(sourcefile, __LINE__)) - end if - ! check on SNICAR BC-snow and dust-snow internal mixing if ( snicar_snobc_intmix .and. snicar_snodst_intmix ) then call endrun(msg=' ERROR: currently dust-snow and BC-snow internal mixing cannot be activated together'//& @@ -827,7 +821,7 @@ subroutine control_spmd() call mpi_bcast (snicar_solarspec, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_dust_optics, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (snicar_snw_shape, 1, MPI_INTEGER, 0, mpicom, ier) + call mpi_bcast (snicar_snw_shape, len(snicar_snw_shape), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (snicar_snobc_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snicar_snodst_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (DO_SNO_OC, 1, MPI_LOGICAL, 0, mpicom, ier) @@ -1013,7 +1007,7 @@ subroutine control_print () write(iulog,*) ' SNICAR: downward solar radiation spectrum type =', snicar_solarspec write(iulog,*) ' SNICAR: dust optics type = ', snicar_dust_optics write(iulog,*) ' SNICAR: number of bands in snow albedo calculation =', snicar_numrad_snw - write(iulog,*) ' SNICAR: snow grain shape type = ',snicar_snw_shape + write(iulog,*) ' SNICAR: snow grain shape type = ', snicar_snw_shape write(iulog,*) ' SNICAR: BC-snow internal mixing = ', snicar_snobc_intmix write(iulog,*) ' SNICAR: dust-snow internal mixing = ', snicar_snodst_intmix write(iulog,*) ' SNICAR: OC in snow = ', DO_SNO_OC @@ -1097,7 +1091,6 @@ subroutine control_print () write(iulog, *) ' carbon_resp_opt = ', carbon_resp_opt end if write(iulog, *) ' use_luna = ', use_luna - write(iulog, *) ' ozone vegetation stress method = ', o3_veg_stress_method write(iulog, *) ' ED/FATES: ' write(iulog, *) ' use_fates = ', use_fates From 3164bc61d629942859082d6434f88c88a20a4baa Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Aug 2023 16:14:18 -0600 Subject: [PATCH 16/62] snicar_solarspec & snicar_dust_optics: replace integers with descriptive options --- bld/CLMBuildNamelist.pm | 2 + bld/namelist_files/namelist_defaults_ctsm.xml | 2 + .../namelist_definition_ctsm.xml | 22 +++-- src/biogeophys/SnowSnicarMod.F90 | 97 ++++++++++--------- src/main/clm_varctl.F90 | 22 +++-- src/main/controlMod.F90 | 18 +--- 6 files changed, 85 insertions(+), 78 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 596b97a7e5..b5aacb96e1 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1993,6 +1993,8 @@ sub setup_logic_snicar_methods { my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snw_shape' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_solarspec' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_dust_optics' ); } #------------------------------------------------------------------------------- diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 2d57fd9798..1fddc07869 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1544,6 +1544,8 @@ use_crop=".true.">lnd/clm2/surfdata_map/ctsm5.1.dev052/landuse.timeseries_mpasa1 lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc hexagonal_plate +mid_latitude_summer +sahara 2015 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 6a5d5fccd7..5b864c0c07 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -155,27 +155,29 @@ of soil column (nlevsoi). number of wavelength bands used in SNICAR snow albedo calculation - + type of downward solar radiation spectrum for SNICAR snow albedo calculation +Default: "mid_latitude_winter" - + dust optics type for SNICAR snow albedo calculation +Default: "sahara" - -Toggle to turn on/off aerosol deposition flux in snow in SNICAR - - - snow grain shape used in SNICAR snow albedo calculation Default: "hexagonal_plate" + +Toggle to turn on/off aerosol deposition flux in snow in SNICAR + + option to activate BC-snow internal mixing in SNICAR snow albedo calculation diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 1a107bef6b..4ba8ec56cb 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1885,8 +1885,8 @@ end function FreshSnowRadius subroutine SnowOptics_init( ) use fileutils , only : getfil - use CLM_varctl , only : fsnowoptics,snicar_numrad_snw,fsnowoptics480,snicar_solarspec,& - snicar_dust_optics ! cenlin + use CLM_varctl , only : fsnowoptics, snicar_numrad_snw, fsnowoptics480 + use CLM_varctl , only : snicar_solarspec, snicar_dust_optics use spmdMod , only : masterproc use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile @@ -1939,8 +1939,9 @@ subroutine SnowOptics_init( ) call ncd_pio_openfile(ncid, locfn, 0) if(masterproc) write(iulog,*) subname,trim(fsnowoptics) + select case (snicar_solarspec) ! mid-latitude winter spectrum - if (snicar_solarspec == 1) then + case ('mid_latitude_winter') ! flux weights/spectrum call ncd_io( 'flx_wgt_dir5_mlw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif5_mlw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) @@ -1968,7 +1969,8 @@ subroutine SnowOptics_init( ) call ncd_io( 'asm_prm_ice_pic16_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ice_pic16_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties - if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + select case (snicar_dust_optics) + case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_sah_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_sah_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -1985,7 +1987,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_sah_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_sah_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_sah_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_col_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_col_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2002,7 +2004,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_col_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_col_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_col_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_gre_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_gre_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2019,10 +2021,10 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_gre_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_gre_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_gre_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - endif + end select ! mid-latitude summer spectrum - elseif (snicar_solarspec == 2) then + case ('mid_latitude_summer') ! flux weights/spectrum call ncd_io( 'flx_wgt_dir5_mls', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif5_mls', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) @@ -2050,7 +2052,8 @@ subroutine SnowOptics_init( ) call ncd_io( 'asm_prm_ice_pic16_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ice_pic16_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties - if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + select case (snicar_dust_optics) + case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_sah_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_sah_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2067,7 +2070,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_sah_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_sah_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_sah_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_col_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_col_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2084,7 +2087,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_col_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_col_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_col_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_gre_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_gre_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2101,10 +2104,10 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_gre_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_gre_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_gre_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - endif + end select ! sub-Arctic winter spectrum - elseif (snicar_solarspec == 3) then + case ('sub_arctic_winter') call ncd_io( 'flx_wgt_dir5_saw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif5_saw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing @@ -2131,7 +2134,8 @@ subroutine SnowOptics_init( ) call ncd_io( 'asm_prm_ice_pic16_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ice_pic16_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties - if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + select case (snicar_dust_optics) + case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_sah_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_sah_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2148,7 +2152,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_sah_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_sah_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_sah_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_col_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_col_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2165,7 +2169,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_col_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_col_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_col_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_gre_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_gre_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2182,10 +2186,10 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_gre_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_gre_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_gre_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - endif + end select ! sub-Arctic summer spectrum - elseif (snicar_solarspec == 4) then + case ('sub_arctic_summer') call ncd_io( 'flx_wgt_dir5_sas', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif5_sas', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing @@ -2212,7 +2216,8 @@ subroutine SnowOptics_init( ) call ncd_io( 'asm_prm_ice_pic16_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ice_pic16_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties - if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + select case (snicar_dust_optics) + case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_sah_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_sah_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2229,7 +2234,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_sah_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_sah_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_sah_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_col_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_col_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2246,7 +2251,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_col_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_col_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_col_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_gre_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_gre_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2263,10 +2268,10 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_gre_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_gre_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_gre_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - endif + end select ! Summit,Greenland,summer spectrum - elseif (snicar_solarspec == 5) then + case ('summit_greenland_summer') call ncd_io( 'flx_wgt_dir5_smm', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif5_smm', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing @@ -2293,7 +2298,8 @@ subroutine SnowOptics_init( ) call ncd_io( 'asm_prm_ice_pic16_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ice_pic16_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties - if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + select case (snicar_dust_optics) + case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_sah_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_sah_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2310,7 +2316,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_sah_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_sah_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_sah_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_col_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_col_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2327,7 +2333,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_col_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_col_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_col_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_gre_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_gre_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2344,10 +2350,10 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_gre_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_gre_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_gre_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - endif + end select ! High Mountain summer spectrum - elseif (snicar_solarspec == 6) then + case ('high_mountain_summer') call ncd_io( 'flx_wgt_dir5_hmn', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif5_hmn', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing @@ -2374,7 +2380,8 @@ subroutine SnowOptics_init( ) call ncd_io( 'asm_prm_ice_pic16_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_ice_pic16_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties - if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + select case (snicar_dust_optics) + case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_sah_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_sah_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2391,7 +2398,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_sah_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_sah_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_sah_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_col_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_col_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2408,7 +2415,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_col_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_col_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_col_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_gre_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_gre_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2425,8 +2432,8 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_gre_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_gre_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_gre_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - endif - endif ! end of snicar_solarspec + end select + end select end if ! end if snicar_numrad_snw == 5 @@ -2465,7 +2472,8 @@ subroutine SnowOptics_init( ) call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) ! dust optical properties - if (snicar_dust_optics == 1) then ! Saharan dust (Balkanski et al., 2007, central hematite) + select case (snicar_dust_optics) + case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_sah', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_sah', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2482,7 +2490,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_sah', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_sah', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_sah', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 2) then ! San Juan Mountains, CO (Skiles et al, 2017) + case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_col', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_col', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2499,7 +2507,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_col', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_col', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_col', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_dust_optics == 3) then ! Greenland (Polashenski et al., 2015, central absorptivity) + case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters call ncd_io( 'ss_alb_dust01_gre', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust01_gre', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) @@ -2516,28 +2524,29 @@ subroutine SnowOptics_init( ) call ncd_io( 'ss_alb_dust04_gre', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_dust04_gre', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'ext_cff_mss_dust04_gre', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) - endif + end select ! downward solar radiation spectral weights for 480-band - if (snicar_solarspec == 1) then ! mid-latitude winter + select case (snicar_solarspec) + case ('mid_latitude_winter') call ncd_io( 'flx_wgt_dir480_mlw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif480_mlw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_solarspec == 2) then ! mid-latitude summer + case ('mid_latitude_summer') call ncd_io( 'flx_wgt_dir480_mls', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif480_mls', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_solarspec == 3) then ! sub-Arctic winter + case ('sub_arctic_winter') call ncd_io( 'flx_wgt_dir480_saw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif480_saw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_solarspec == 4) then ! sub-Arctic summer + case ('sub_arctic_summer') call ncd_io( 'flx_wgt_dir480_sas', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif480_sas', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_solarspec == 5) then ! Summit,Greenland,summer + case ('summit_greenland_summer') call ncd_io( 'flx_wgt_dir480_smm', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif480_smm', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) - elseif (snicar_solarspec == 6) then ! High Mountain summer + case ('high_mountain_summer') call ncd_io( 'flx_wgt_dir480_hmn', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif480_hmn', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) - endif + end select endif ! end if snicar_numrad_snw == 480 diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 670b9ab54f..a0d5a9a122 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -234,19 +234,23 @@ module clm_varctl ! number of wavelength bands used in SNICAR snow albedo calculation, cenlin integer, public :: snicar_numrad_snw = 5 - ! type of downward solar radiation spectrum for SNICAR snow albedo calculation cenlin - integer, public :: snicar_solarspec = 1 ! 1->mid-latitude winter;2->mid-latitude summer;3->sub-Arctic winter; - ! 4->sub-Arctic summer;5->Summit,Greenland,summer;6->High Mountain summer; - - ! dust optics type for SNICAR snow albedo calculation, cenlin - integer, public :: snicar_dust_optics = 1 ! 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) + ! type of downward solar radiation spectrum for SNICAR snow albedo calculation + ! options: + ! mid_latitude_winter, mid_latitude_summer, sub_arctic_winter, + ! sub_arctic_summer, summit_greenland_summer, high_mountain_summer; + character(len=25), public :: snicar_solarspec = 'mid_latitude_winter' + + ! dust optics type for SNICAR snow albedo calculation + ! options: + ! sahara: Saharan dust (Balkanski et al., 2007, central hematite) + ! san_juan_mtns_colorado: San Juan Mountains dust, CO (Skiles et al, 2017) + ! greenland: Greenland dust (Polashenski et al., 2015, central absorptivity) + character(len=25), public :: snicar_dust_optics = 'sahara' ! option to turn off aerosol effect in snow in SNICAR logical, public :: snicar_use_aerosol = .true. ! if .false., turn off aerosol deposition flux ! option for snow grain shape in SNICAR (He et al. 2017 JC) - character(len=15), public :: snicar_snw_shape = 'hexagonal_plate' ! sphere, spheroid, hexagonal_plate, koch_snowflake + character(len=25), public :: snicar_snw_shape = 'hexagonal_plate' ! sphere, spheroid, hexagonal_plate, koch_snowflake ! option to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln logical, public :: snicar_snobc_intmix = .false. ! false->external mixing for all BC; true->internal mixing for hydrophilic BC diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index b22965aff1..11bb49b902 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -578,18 +578,6 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if - ! check on downward solar radiation spectrum - if ( (snicar_solarspec < 1) .or. (snicar_solarspec > 6) ) then - call endrun(msg=' ERROR: snicar_solarspec is out of a reasonable range (1,2,3,4,5,6)'//& - errMsg(sourcefile, __LINE__)) - end if - - ! check on dust optics type - if ( (snicar_dust_optics < 1) .or. (snicar_dust_optics > 3) ) then - call endrun(msg=' ERROR: snicar_dust_optics is out of a reasonable range (1,2,3)'//& - errMsg(sourcefile, __LINE__)) - end if - ! check on SNICAR BC-snow and dust-snow internal mixing if ( snicar_snobc_intmix .and. snicar_snodst_intmix ) then call endrun(msg=' ERROR: currently dust-snow and BC-snow internal mixing cannot be activated together'//& @@ -818,10 +806,10 @@ subroutine control_spmd() call mpi_bcast (soil_layerstruct_userdefined,size(soil_layerstruct_userdefined), MPI_REAL8, 0, mpicom, ier) call mpi_bcast (soil_layerstruct_userdefined_nlevsoi, 1, MPI_INTEGER, 0, mpicom, ier) call mpi_bcast (snicar_numrad_snw, 1, MPI_INTEGER, 0, mpicom, ier) - call mpi_bcast (snicar_solarspec, 1, MPI_INTEGER, 0, mpicom, ier) - call mpi_bcast (snicar_dust_optics, 1, MPI_INTEGER, 0, mpicom, ier) - call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (snicar_solarspec, len(snicar_solarspec), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (snicar_dust_optics, len(snicar_dust_optics), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (snicar_snw_shape, len(snicar_snw_shape), MPI_CHARACTER, 0, mpicom, ier) + call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snicar_snobc_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snicar_snodst_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (DO_SNO_OC, 1, MPI_LOGICAL, 0, mpicom, ier) From 230e3fce9837b61fc0e3e72e6c8ae63f60285d6f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Aug 2023 17:32:17 -0600 Subject: [PATCH 17/62] General clean-up of other snicar switches and comments --- bld/CLMBuildNamelist.pm | 5 +++ .../namelist_definition_ctsm.xml | 20 ++++++---- src/biogeophys/AerosolMod.F90 | 2 +- src/biogeophys/SnowSnicarMod.F90 | 39 ++++++++----------- src/biogeophys/SurfaceAlbedoMod.F90 | 31 +++++++-------- src/biogeophys/SurfaceAlbedoType.F90 | 18 ++++----- src/biogeophys/SurfaceRadiationMod.F90 | 5 +-- src/biogeophys/UrbanAlbedoMod.F90 | 22 +++++------ src/main/clm_varctl.F90 | 8 ++-- src/main/controlMod.F90 | 6 +-- 10 files changed, 79 insertions(+), 77 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index b5aacb96e1..017f13ecef 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1995,6 +1995,11 @@ sub setup_logic_snicar_methods { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snw_shape' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_solarspec' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_dust_optics' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_numrad_snw' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snobc_intmix' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snodst_intmix' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_use_aerosol' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'do_sno_oc' ); } #------------------------------------------------------------------------------- diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 5b864c0c07..5bcb1fe2c3 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -151,8 +151,9 @@ of soil column (nlevsoi). + group="snicar_inparm" valid_values="5,480" value="5" > number of wavelength bands used in SNICAR snow albedo calculation +Default: 5 + group="snicar_inparm" value=".true."> Toggle to turn on/off aerosol deposition flux in snow in SNICAR +Default: .true. + group="snicar_inparm" value=".true." > option to activate BC-snow internal mixing in SNICAR snow albedo calculation +Default: .true. + group="snicar_inparm" value=".true." > option to activate dust-snow internal mixing in SNICAR snow albedo calculation +Default: .true. - + option to activate organic carbon (OC) in SNICAR snow albedo calculation +Default: .false. + group="snicar_inparm" value=".false."> Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) radiative forcing (snicar_frc=".true." is EXPERIMENTAL NOT SUPPORTED!) +Default: .false. shr_log_errMsg use clm_varctl , only : iulog, snicar_numrad_snw, & snicar_snw_shape, snicar_snobc_intmix, & - snicar_snodst_intmix, DO_SNO_OC ! cenlin + snicar_snodst_intmix, do_sno_oc use clm_varcon , only : tfrz use shr_const_mod , only : SHR_CONST_RHOICE use abortutils , only : endrun @@ -48,16 +48,9 @@ module SnowSnicarMod ! !PUBLIC DATA MEMBERS: integer, public, parameter :: sno_nbr_aer = 8 ! number of aerosol species in snowpack ! (indices described above) [nbr] - ! DO_SNO_OC moved to namelist control - !logical, public, parameter :: DO_SNO_OC = .false. ! parameter to include organic carbon (OC) - ! ! in snowpack radiative calculations logical, public, parameter :: DO_SNO_AER = .true. ! parameter to include aerosols in snowpack radiative calculations ! !PRIVATE DATA MEMBERS: -! integer, parameter :: numrad_snw = 5 ! number of spectral bands used in snow model [nbr] cenlin -! integer, parameter :: nir_bnd_bgn = 2 ! first band index in near-IR spectrum [idx] cenlin -! integer, parameter :: nir_bnd_end = 5 ! ending near-IR band index [idx] cenlin - integer, parameter :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx] integer, parameter :: idx_T_max = 11 ! maxiumum temperature index used in aging lookup table [idx] integer, parameter :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx] @@ -250,8 +243,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! !LOCAL VARIABLES: ! ! variables for snow radiative transfer calculations - 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 :: nir_bnd_bgn ! first band index in near-IR spectrum [idx] + integer :: nir_bnd_end ! ending near-IR band index [idx] ! Local variables representing single-column values of arrays: integer :: snl_lcl ! negative number of snow layers [nbr] @@ -542,7 +535,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & frac_sno => waterdiagnosticbulk_inst%frac_sno_eff_col & ! Input: [real(r8) (:)] fraction of ground covered by snow (0 to 1) ) - ! initialize parameter, cenlin + ! initialize parameter if (snicar_numrad_snw == 5) nir_bnd_bgn = 2 if (snicar_numrad_snw == 480) nir_bnd_bgn = 51 nir_bnd_end = snicar_numrad_snw @@ -705,7 +698,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos - albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,1) ! cenlin + albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,1) albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,2) @@ -734,7 +727,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Band 4: 1.2-1.5um (NIR) ! Band 5: 1.5-5.0um (NIR) ! - ! Hyperspectral (10-nm) bands (480-band case) cenlin + ! Hyperspectral (10-nm) bands (480-band case) ! Bands 1~50 : 0.2-0.7um (VIS) ! Bands 51~480: 0.7~5.0um (NIR) ! @@ -770,7 +763,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! flx_wgt(4) = 0.10917889346386_r8 ! flx_wgt(5) = 0.10343699264369_r8 ! endif - else ! works for both 5-band & 480-band, flux weights directly read from input data, cenlin + else ! works for both 5-band & 480-band, flux weights directly read from input data ! Direct: if (flg_slr_in == 1) then flx_wgt(1:snicar_numrad_snw) = flx_wgt_dir(1:snicar_numrad_snw) ! VIS or NIR band sum is already normalized to 1.0 in input data @@ -816,7 +809,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & mss_cnc_aer_lcl(:,:) = 0._r8 endif - if ( (snicar_numrad_snw == 480).and.(bnd_idx > 100) ) then ! >1.2um cenlin + if ( (snicar_numrad_snw == 480).and.(bnd_idx > 100) ) then ! >1.2um mss_cnc_aer_lcl(:,:) = 0._r8 endif @@ -1450,7 +1443,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Weight output NIR albedo appropriately - ! for 5- and 3-band cases cenlin + ! for 5- and 3-band cases if (snicar_numrad_snw <= 5) then albout(c_idx,1) = albout_lcl(1) flx_sum = 0._r8 @@ -1460,7 +1453,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) end if - ! for 480-band case, cenlin + ! for 480-band case if (snicar_numrad_snw == 480) then ! average for VIS band flx_sum = 0._r8 @@ -1477,7 +1470,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & end if ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately - ! for 5- and 3-band cases cenlin + ! for 5- and 3-band cases if (snicar_numrad_snw <= 5) then flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) do i=snl_top,1,1 @@ -1489,7 +1482,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & end do end if - ! for 480-band case cenlin + ! for 480-band case if (snicar_numrad_snw == 480) then do i=snl_top,1,1 ! average for VIS band @@ -1932,7 +1925,7 @@ subroutine SnowOptics_init( ) if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....' - !--------------------- for 5-band data, cenlin + !--------------------- for 5-band data if (snicar_numrad_snw == 5) then call getfil (fsnowoptics, locfn, 0) @@ -2438,7 +2431,7 @@ subroutine SnowOptics_init( ) end if ! end if snicar_numrad_snw == 5 - !-------------------- for 480-band data, cenlin + !-------------------- for 480-band data if (snicar_numrad_snw == 480) then call getfil (fsnowoptics480, locfn, 0) @@ -2561,7 +2554,7 @@ subroutine SnowOptics_init( ) write (iulog,*) '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) - if (DO_SNO_OC) then + if (do_sno_oc) then write (iulog,*) 'SNICAR: Including OC aerosols from snow radiative transfer calculations' else write (iulog,*) 'SNICAR: Excluding OC aerosols from snow radiative transfer calculations' @@ -2570,7 +2563,7 @@ subroutine SnowOptics_init( ) ss_alb_bc1(1), ss_alb_bc1(2), ss_alb_bc1(3), ss_alb_bc1(4), ss_alb_bc1(5) write (iulog,*) '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) - if (DO_SNO_OC) then + if (do_sno_oc) then write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic OC: ', & ss_alb_oc1(1), ss_alb_oc1(2), ss_alb_oc1(3), ss_alb_oc1(4), ss_alb_oc1(5) write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophobic OC: ', & diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index d7c3305710..5d12767121 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -12,9 +12,9 @@ module SurfaceAlbedoMod use decompMod , only : bounds_type, subgrid_level_patch use abortutils , only : endrun use landunit_varcon , only : istsoil, istcrop, istdlak - use clm_varcon , only : grlnd, spval ! cenlin + use clm_varcon , only : grlnd, spval use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan - use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE, DO_SNO_OC !cenlin + use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE, do_sno_oc use pftconMod , only : pftcon use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER use AerosolMod , only : aerosol_type @@ -387,7 +387,7 @@ subroutine SurfaceAlbedo(bounds,nc, & albsni_hst => surfalb_inst%albsni_hst_col , & ! Output: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd) [frc] albd => surfalb_inst%albd_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) -! cenlin: add new output albedo variables for history fields +! add new snicar output albedo variables for history fields albgrd_hst => surfalb_inst%albgrd_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) for history files albgri_hst => surfalb_inst%albgri_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) for history files albgrd_pur_hst => surfalb_inst%albgrd_pur_hst_col , & ! Output: [real(r8) (:,:) ] pure snow ground albedo (direct) for history files @@ -402,7 +402,7 @@ subroutine SurfaceAlbedo(bounds,nc, & albsni_hst2 => surfalb_inst%albsni_hst2_col , & ! Output: [real(r8) (:,:) ] snow ground albedo, diffuse, for history files (col,bnd) for history files albd_hst => surfalb_inst%albd_hst_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) for history files albi_hst => surfalb_inst%albi_hst_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) for history files -! cenlin: end +! end add new snicar albdSF => surfalb_inst%albdSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (direct) albiSF => surfalb_inst%albiSF_patch , & ! Output: [real(r8) (:,:) ] diagnostic snow-free surface albedo (diffuse) fabd => surfalb_inst%fabd_patch , & ! Output: [real(r8) (:,:) ] flux absorbed by canopy per unit direct flux @@ -456,7 +456,7 @@ subroutine SurfaceAlbedo(bounds,nc, & albgri_oc(c,ib) = 0._r8 albgrd_dst(c,ib) = 0._r8 albgri_dst(c,ib) = 0._r8 -! cenlin: add output variables for history files +! add new snicar output variables for history files albgrd_hst(c,ib) = spval albgri_hst(c,ib) = spval albgrd_pur_hst(c,ib) = spval @@ -469,7 +469,7 @@ subroutine SurfaceAlbedo(bounds,nc, & albgri_dst_hst(c,ib) = spval albsnd_hst2(c,ib) = spval albsni_hst2(c,ib) = spval -! cenlin: end +! end add new snicar do i=-nlevsno+1,1,1 flx_absdv(c,i) = 0._r8 flx_absdn(c,i) = 0._r8 @@ -482,10 +482,10 @@ subroutine SurfaceAlbedo(bounds,nc, & p = filter_nourbanp(fp) albd(p,ib) = 1._r8 albi(p,ib) = 1._r8 -! cenlin: add output variables for history files +! add new snicar output variables for history files albd_hst(p,ib) = spval albi_hst(p,ib) = spval -! cenlin: end +! end add new snicar if (use_SSRE) then albdSF(p,ib) = 1._r8 albiSF(p,ib) = 1._r8 @@ -552,11 +552,11 @@ subroutine SurfaceAlbedo(bounds,nc, & mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) - ! DO_SNO_OC is set in SNICAR_varpar. Default case is to ignore OC concentrations because: + ! do_sno_oc is set in SNICAR_varpar. Default case is to ignore OC concentrations because: ! 1) Knowledge of their optical properties is primitive ! 2) When 'water-soluble' OPAC optical properties are applied to OC in snow, ! it has a negligible darkening effect. - if (DO_SNO_OC) then + if (do_sno_oc) then mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) mss_cnc_aer_in_fdb(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) endif @@ -580,7 +580,7 @@ subroutine SurfaceAlbedo(bounds,nc, & mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,6) = mss_cnc_dst2(bounds%begc:bounds%endc,:) mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,7) = mss_cnc_dst3(bounds%begc:bounds%endc,:) mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,8) = mss_cnc_dst4(bounds%begc:bounds%endc,:) - if (DO_SNO_OC) then + if (do_sno_oc) then mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) endif @@ -616,7 +616,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! 2. OC input array: ! set BC and dust concentrations, so OC_FRC=[(BC+OC+dust)-(BC+dust)] - if (DO_SNO_OC) then + if (do_sno_oc) then mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) mss_cnc_aer_in_frc_oc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) @@ -658,7 +658,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! set BC and OC concentrations, so DST_FRC=[(BC+OC+dust)-(BC+OC)] mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,1) = mss_cnc_bcphi(bounds%begc:bounds%endc,:) mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,2) = mss_cnc_bcpho(bounds%begc:bounds%endc,:) - if (DO_SNO_OC) then + if (do_sno_oc) then mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,3) = mss_cnc_ocphi(bounds%begc:bounds%endc,:) mss_cnc_aer_in_frc_dst(bounds%begc:bounds%endc,:,4) = mss_cnc_ocpho(bounds%begc:bounds%endc,:) endif @@ -768,7 +768,7 @@ subroutine SurfaceAlbedo(bounds,nc, & albgrd_bc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_bc(c,ib)*frac_sno(c) albgri_bc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_bc(c,ib)*frac_sno(c) - if (DO_SNO_OC) then + if (do_sno_oc) then ! OC forcing albedo albgrd_oc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_oc(c,ib)*frac_sno(c) albgri_oc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_oc(c,ib)*frac_sno(c) @@ -1082,7 +1082,7 @@ subroutine SurfaceAlbedo(bounds,nc, & end do end do -! cenlin: add output variables for history files + ! add output variables for history files do ib = 1, numrad do fc = 1,num_nourbanc c = filter_nourbanc(fc) @@ -1112,7 +1112,6 @@ subroutine SurfaceAlbedo(bounds,nc, & end if end do end do -! cenlin: end end associate diff --git a/src/biogeophys/SurfaceAlbedoType.F90 b/src/biogeophys/SurfaceAlbedoType.F90 index eb8ec9ef03..9e0743944b 100644 --- a/src/biogeophys/SurfaceAlbedoType.F90 +++ b/src/biogeophys/SurfaceAlbedoType.F90 @@ -7,7 +7,7 @@ module SurfaceAlbedoType use decompMod , only : bounds_type use clm_varpar , only : numrad, nlevcan, nlevsno use abortutils , only : endrun - use clm_varctl , only : use_SSRE, use_snicar_frc ! cenlin + use clm_varctl , only : use_SSRE, use_snicar_frc ! ! !PUBLIC TYPES: implicit none @@ -35,7 +35,7 @@ module SurfaceAlbedoType real(r8), pointer :: albsoi_col (:,:) ! col soil albedo: diffuse (col,bnd) [frc] real(r8), pointer :: albsnd_hst_col (:,:) ! col snow albedo, direct , for history files (col,bnd) [frc] real(r8), pointer :: albsni_hst_col (:,:) ! col snow albedo, diffuse, for history files (col,bnd) [frc] -! cenlin add new output variables for albedo for history files only +! add new snicar output variables for albedo for history files only real(r8), pointer :: albd_hst_patch (:,:) ! patch surface albedo (direct) for history files (numrad) real(r8), pointer :: albi_hst_patch (:,:) ! patch surface albedo (diffuse) for history files (numrad) real(r8), pointer :: albgrd_pur_hst_col (:,:) ! col pure snow ground direct albedo for history files (numrad) @@ -50,7 +50,7 @@ module SurfaceAlbedoType real(r8), pointer :: albgri_hst_col (:,:) ! col ground albedo (diffuse) for history files (numrad) real(r8), pointer :: albsnd_hst2_col (:,:) ! col snow albedo, direct , for history files (col,bnd) [frc] real(r8), pointer :: albsni_hst2_col (:,:) ! col snow albedo, diffuse, for history files (col,bnd) [frc] -! cenlin end +! end add new snicar real(r8), pointer :: ftdd_patch (:,:) ! patch down direct flux below canopy per unit direct flx (numrad) real(r8), pointer :: ftid_patch (:,:) ! patch down diffuse flux below canopy per unit direct flx (numrad) @@ -173,7 +173,7 @@ subroutine InitAllocate(this, bounds) allocate(this%vcmaxcintsun_patch (begp:endp)) ; this%vcmaxcintsun_patch (:) = nan allocate(this%vcmaxcintsha_patch (begp:endp)) ; this%vcmaxcintsha_patch (:) = nan -! cenlin add new output variables for albedo for history files only +! add new snicar output variables for albedo for history files only allocate(this%albgrd_hst_col (begc:endc,numrad)) ; this%albgrd_hst_col (:,:) = spval allocate(this%albgri_hst_col (begc:endc,numrad)) ; this%albgri_hst_col (:,:) = spval allocate(this%albsnd_hst2_col (begc:endc,numrad)) ; this%albsnd_hst2_col (:,:) = spval @@ -188,7 +188,7 @@ subroutine InitAllocate(this, bounds) allocate(this%albgri_dst_hst_col (begc:endc,numrad)) ; this%albgri_dst_hst_col (:,:) = spval allocate(this%albd_hst_patch (begp:endp,numrad)) ; this%albd_hst_patch (:,:) = spval allocate(this%albi_hst_patch (begp:endp,numrad)) ; this%albi_hst_patch (:,:) = spval -! cenlin end +! end and new snicar end subroutine InitAllocate @@ -254,7 +254,7 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='surface albedo (indirect)', & ptr_patch=this%albi_patch, default=defaultoutput, c2l_scale_type='urbanf') -! cenlin add new output variables for albedo for history files only +! add new snicar output variables for albedo for history files only if (use_snicar_frc) then this%albd_hst_patch(begp:endp,:) = spval @@ -328,7 +328,7 @@ subroutine InitHistory(this, bounds) ptr_col=this%albsni_hst2_col, default='inactive') end if ! end of use_snicar_frc -! cenlin: end +! end add new snicar end subroutine InitHistory @@ -654,7 +654,7 @@ subroutine Restart(this, bounds, ncid, flag, & end if ! end of if-use_snicar_frc -! cenlin add new output variables for albedo for history files only +! add new snicar output variables for albedo for history files only if (use_snicar_frc) then call restartvar(ncid=ncid, flag=flag, varname='albd_hist', xtype=ncd_double, & @@ -742,7 +742,7 @@ subroutine Restart(this, bounds, ncid, flag, & interpinic_flag='interp', readvar=readvar, data=this%albgri_dst_hst_col) end if ! end of if-use_snicar_frc -! cenlin end +! end add new snicar ! patch type physical state variable - fabd call restartvar(ncid=ncid, flag=flag, varname='fabd', xtype=ncd_double, & diff --git a/src/biogeophys/SurfaceRadiationMod.F90 b/src/biogeophys/SurfaceRadiationMod.F90 index 5a00a67b23..03557c6476 100644 --- a/src/biogeophys/SurfaceRadiationMod.F90 +++ b/src/biogeophys/SurfaceRadiationMod.F90 @@ -477,9 +477,8 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & use clm_varpar , only : numrad, nlevsno use clm_varcon , only : spval use landunit_varcon , only : istsoil, istcrop - use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE, DO_SNO_OC !cenlin + use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE, do_sno_oc use clm_time_manager , only : get_step_size_real, is_near_local_noon - ! use SnowSnicarMod , only : DO_SNO_OC use abortutils , only : endrun ! ! !ARGUMENTS: @@ -856,7 +855,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & sfc_frc_bc(p) = sabg(p) - sabg_bc(p) ! OC aerosol forcing (patch-level): - if (DO_SNO_OC) then + if (do_sno_oc) then sfc_frc_oc(p) = sabg(p) - sabg_oc(p) else sfc_frc_oc(p) = 0._r8 diff --git a/src/biogeophys/UrbanAlbedoMod.F90 b/src/biogeophys/UrbanAlbedoMod.F90 index 5ec225294f..c96671a420 100644 --- a/src/biogeophys/UrbanAlbedoMod.F90 +++ b/src/biogeophys/UrbanAlbedoMod.F90 @@ -12,7 +12,7 @@ module UrbanAlbedoMod use shr_log_mod , only : errMsg => shr_log_errMsg use decompMod , only : bounds_type, subgrid_level_landunit use clm_varpar , only : numrad - use clm_varcon , only : isecspday, degpsec, spval ! cenlin + use clm_varcon , only : isecspday, degpsec, spval use clm_varctl , only : iulog use abortutils , only : endrun use UrbanParamsType , only : urbanparams_type @@ -156,12 +156,12 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & albgri => surfalb_inst%albgri_col , & ! Output: [real(r8) (:,:) ] urban col ground albedo (diffuse) albd => surfalb_inst%albd_patch , & ! Output [real(r8) (:,:) ] urban pft surface albedo (direct) albi => surfalb_inst%albi_patch , & ! Output: [real(r8) (:,:) ] urban pft surface albedo (diffuse) -! cenlin: add albedo output for history files +! add new snicar albedo output for history files albd_hst => surfalb_inst%albd_hst_patch , & ! Output: [real(r8) (:,:) ] surface albedo (direct) for history files albi_hst => surfalb_inst%albi_hst_patch , & ! Output: [real(r8) (:,:) ] surface albedo (diffuse) for history files albgrd_hst => surfalb_inst%albgrd_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo (direct) for history files albgri_hst => surfalb_inst%albgri_hst_col , & ! Output: [real(r8) (:,:) ] ground albedo (diffuse) for history files -! cenlin: end +! end add new snicar begl => bounds%begl , & vf_sr => urbanparams_inst%vf_sr , & ! Input: [real(r8) (:) ] view factor of sky for road vf_sw => urbanparams_inst%vf_sw , & ! Input: [real(r8) (:) ] view factor of sky for one wall @@ -187,10 +187,10 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & c = filter_urbanc(fc) albgrd(c,ib) = 0._r8 albgri(c,ib) = 0._r8 -! cenlin: add output variables for history files +! add new snicar output variables for history files albgrd_hst(c,ib) = spval albgri_hst(c,ib) = spval -! cenlin: end +! end add new snicar end do do fp = 1,num_urbanp @@ -212,10 +212,10 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & albd(p,ib) = 1._r8 albi(p,ib) = 1._r8 endif -! cenlin: add output variables for history files +! add new snicar output variables for history files albd_hst(p,ib) = spval albi_hst(p,ib) = spval -! cenlin: end +! end add new snicar fabd(p,ib) = 0._r8 fabd_sun(p,ib) = 0._r8 fabd_sha(p,ib) = 0._r8 @@ -431,12 +431,12 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & albgrd(c,ib) = sref_improad_dir(l,ib) albgri(c,ib) = sref_improad_dif(l,ib) endif -! cenlin: add albedo variables for history fields +! add new snicar albedo variables for history fields if (coszen(l) > 0._r8) then albgrd_hst(c,ib) = albgrd(c,ib) albgri_hst(c,ib) = albgri(c,ib) end if -! cenlin: end +! end add new snicar end do do fp = 1,num_urbanp p = filter_urbanp(fp) @@ -444,12 +444,12 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & l = patch%landunit(p) albd(p,ib) = albgrd(c,ib) albi(p,ib) = albgri(c,ib) -! cenlin: add albedo variables for history fields +! add new snicar albedo variables for history fields if (coszen(l) > 0._r8) then albd_hst(p,ib) = albd(p,ib) albi_hst(p,ib) = albi(p,ib) end if -! cenlin: end +! end add new snicar end do end do end if diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index a0d5a9a122..8d2ea77b33 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -113,7 +113,7 @@ module clm_varctl character(len=fname_len), public :: nrevsn = ' ' ! restart data file name for branch run character(len=fname_len), public :: fsnowoptics = ' ' ! snow optical properties file name character(len=fname_len), public :: fsnowaging = ' ' ! snow aging parameters file name - character(len=fname_len), public :: fsnowoptics480 = ' ' ! snow optical properties file name for 480 bands, cenlin + character(len=fname_len), public :: fsnowoptics480 = ' ' ! snow optical properties file name for 480 bands character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid ! only needed for LILAC and MCT drivers @@ -231,7 +231,7 @@ module clm_varctl real(r8), public :: o3_ppbv = 100._r8 - ! number of wavelength bands used in SNICAR snow albedo calculation, cenlin + ! number of wavelength bands used in SNICAR snow albedo calculation integer, public :: snicar_numrad_snw = 5 ! type of downward solar radiation spectrum for SNICAR snow albedo calculation @@ -258,8 +258,8 @@ module clm_varctl ! option to activate dust-snow internal mixing in SNICAR (He et al. 2017 JC), ceniln logical, public :: snicar_snodst_intmix = .false. ! false->external mixing for all dust; true->internal mixing for all dust - ! option to activate OC in snow in SNICAR, cenlin - logical, public :: DO_SNO_OC = .false. ! control to include organic carbon (OC) in snow + ! option to activate OC in snow in SNICAR + logical, public :: do_sno_oc = .false. ! control to include organic carbon (OC) in snow !---------------------------------------------------------- ! C isotopes diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 11bb49b902..ac37760f49 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -204,7 +204,7 @@ subroutine control_init(dtime) crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & snicar_numrad_snw, snicar_solarspec, snicar_dust_optics, & snicar_use_aerosol, snicar_snw_shape, snicar_snobc_intmix,& - snicar_snodst_intmix,DO_SNO_OC, & + snicar_snodst_intmix,do_sno_oc, & for_testing_use_second_grain_pool, for_testing_use_repr_structure_pool, & for_testing_no_crop_seed_replenishment @@ -812,7 +812,7 @@ subroutine control_spmd() call mpi_bcast (snicar_use_aerosol, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snicar_snobc_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (snicar_snodst_intmix, 1, MPI_LOGICAL, 0, mpicom, ier) - call mpi_bcast (DO_SNO_OC, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (do_sno_oc, 1, MPI_LOGICAL, 0, mpicom, ier) ! snow pack variables call mpi_bcast (nlevsno, 1, MPI_INTEGER, 0, mpicom, ier) @@ -998,7 +998,7 @@ subroutine control_print () write(iulog,*) ' SNICAR: snow grain shape type = ', snicar_snw_shape write(iulog,*) ' SNICAR: BC-snow internal mixing = ', snicar_snobc_intmix write(iulog,*) ' SNICAR: dust-snow internal mixing = ', snicar_snodst_intmix - write(iulog,*) ' SNICAR: OC in snow = ', DO_SNO_OC + write(iulog,*) ' SNICAR: OC in snow = ', do_sno_oc write(iulog,'(a,i8)') ' Number of snow layers =', nlevsno write(iulog,'(a,d20.10)') ' Max snow depth (mm) =', h2osno_max From 4ab6738316715cd610171f4d935f5d6f1acb7101 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 3 Aug 2023 18:42:36 -0600 Subject: [PATCH 18/62] Some clean-up associated with snicar_numrad_snw --- src/biogeophys/SnowSnicarMod.F90 | 107 +++++++++++-------------------- 1 file changed, 36 insertions(+), 71 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 017f434c2e..0d58ffb35c 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -536,8 +536,12 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ) ! initialize parameter - if (snicar_numrad_snw == 5) nir_bnd_bgn = 2 - if (snicar_numrad_snw == 480) nir_bnd_bgn = 51 + select case (snicar_numrad_snw) + case (5) + nir_bnd_bgn = 2 + case (480) + nir_bnd_bgn = 51 + end select nir_bnd_end = snicar_numrad_snw ! initialize for adding-doubling solver @@ -733,45 +737,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! ! The following weights are appropriate for surface-incident flux in a mid-latitude winter atmosphere ! - ! 3-band weights - if (snicar_numrad_snw==3) then - ! Direct: - if (flg_slr_in == 1) then - flx_wgt(1) = 1._r8 - flx_wgt(2) = 0.66628670195247_r8 - flx_wgt(3) = 0.33371329804753_r8 - ! Diffuse: - elseif (flg_slr_in == 2) then - flx_wgt(1) = 1._r8 - flx_wgt(2) = 0.77887652162877_r8 - flx_wgt(3) = 0.22112347837123_r8 - endif - ! 5-band weights - !elseif (snicar_numrad_snw==5) then - ! ! Direct: - ! if (flg_slr_in == 1) then - ! flx_wgt(1) = 1._r8 - ! flx_wgt(2) = 0.49352158521175_r8 - ! flx_wgt(3) = 0.18099494230665_r8 - ! flx_wgt(4) = 0.12094898498813_r8 - ! flx_wgt(5) = 0.20453448749347_r8 - ! ! Diffuse: - ! elseif (flg_slr_in == 2) then - ! flx_wgt(1) = 1._r8 - ! flx_wgt(2) = 0.58581507618433_r8 - ! flx_wgt(3) = 0.20156903770812_r8 - ! flx_wgt(4) = 0.10917889346386_r8 - ! flx_wgt(5) = 0.10343699264369_r8 - ! endif - else ! works for both 5-band & 480-band, flux weights directly read from input data - ! Direct: - if (flg_slr_in == 1) then - flx_wgt(1:snicar_numrad_snw) = flx_wgt_dir(1:snicar_numrad_snw) ! VIS or NIR band sum is already normalized to 1.0 in input data - ! Diffuse: - elseif (flg_slr_in == 2) then - flx_wgt(1:snicar_numrad_snw) = flx_wgt_dif(1:snicar_numrad_snw) ! VIS or NIR band sum is already normalized to 1.0 in input data - endif - endif ! end if snicar_numrad_snw +! ! works for both 5-band & 480-band, flux weights directly read from input data + ! Direct: + if (flg_slr_in == 1) then + flx_wgt(1:snicar_numrad_snw) = flx_wgt_dir(1:snicar_numrad_snw) ! VIS or NIR band sum is already normalized to 1.0 in input data + ! Diffuse: + elseif (flg_slr_in == 2) then + flx_wgt(1:snicar_numrad_snw) = flx_wgt_dif(1:snicar_numrad_snw) ! VIS or NIR band sum is already normalized to 1.0 in input data + endif exp_min = exp(-argmax) @@ -805,10 +778,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & mss_cnc_aer_lcl(:,:) = 0._r8 endif - if ( (snicar_numrad_snw == 3).and.(bnd_idx == 3) ) then - mss_cnc_aer_lcl(:,:) = 0._r8 - endif - if ( (snicar_numrad_snw == 480).and.(bnd_idx > 100) ) then ! >1.2um mss_cnc_aer_lcl(:,:) = 0._r8 endif @@ -901,14 +870,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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 (snicar_numrad_snw == 5) then + select case (snicar_numrad_snw) + case (5) call piecewise_linear_interp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct5(bnd_idx),g_Cg_intp) call piecewise_linear_interp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct5(bnd_idx),gg_F07_intp) - endif - if (snicar_numrad_snw == 480) then + case (480) call piecewise_linear_interp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct480(bnd_idx),g_Cg_intp) call piecewise_linear_interp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct480(bnd_idx),gg_F07_intp) - endif + end select g_ice_F07 = gg_F07_intp + (1._r8 - gg_F07_intp) / ss_alb_snw_lcl(i) / 2._r8 ! Eq.2.2 in Fu (2007) asm_prm_snw_lcl(i) = g_ice_F07 * g_Cg_intp ! Eq.6, He et al. (2017) endif @@ -989,8 +958,12 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) ! Start BC/dust-snow internal mixing for wavelength<=1.2um - if (snicar_numrad_snw == 5) wvl_doint = wvl_ct5(bnd_idx) - if (snicar_numrad_snw == 480) wvl_doint = wvl_ct480(bnd_idx) + select case (snicar_numrad_snw) + case (5) + wvl_doint = wvl_ct5(bnd_idx) + case (480) + wvl_doint = wvl_ct480(bnd_idx) + end select if (wvl_doint <= 1.2_r8) then ! BC-snow internal mixing applied to hydrophilic BC if activated @@ -1443,18 +1416,15 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Weight output NIR albedo appropriately - ! for 5- and 3-band cases - if (snicar_numrad_snw <= 5) then + select case (snicar_numrad_snw) + case (5) ! 5-band case albout(c_idx,1) = albout_lcl(1) flx_sum = 0._r8 do bnd_idx= nir_bnd_bgn,nir_bnd_end flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) end do albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) - end if - - ! for 480-band case - if (snicar_numrad_snw == 480) then + case (480) ! 480-band case ! average for VIS band flx_sum = 0._r8 do bnd_idx= 1, (nir_bnd_bgn-1) @@ -1467,11 +1437,11 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) end do albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) - end if + end select ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately - ! for 5- and 3-band cases - if (snicar_numrad_snw <= 5) then + select case (snicar_numrad_snw) + case (5) ! 5-band case flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) do i=snl_top,1,1 flx_sum = 0._r8 @@ -1480,10 +1450,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & enddo flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) end do - end if - - ! for 480-band case - if (snicar_numrad_snw == 480) then + case (480) ! 480-band case do i=snl_top,1,1 ! average for VIS band flx_sum = 0._r8 @@ -1498,7 +1465,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & enddo flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) end do - end if + end select ! high solar zenith angle adjustment for Adding-doubling solver results ! near-IR direct albedo/absorption adjustment for high solar zenith angles @@ -1926,7 +1893,8 @@ subroutine SnowOptics_init( ) if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....' !--------------------- for 5-band data - if (snicar_numrad_snw == 5) then + select case (snicar_numrad_snw) + case (5) ! 5-band case call getfil (fsnowoptics, locfn, 0) call ncd_pio_openfile(ncid, locfn, 0) @@ -2428,11 +2396,8 @@ subroutine SnowOptics_init( ) end select end select - end if ! end if snicar_numrad_snw == 5 - - !-------------------- for 480-band data - if (snicar_numrad_snw == 480) then + case (480) call getfil (fsnowoptics480, locfn, 0) call ncd_pio_openfile(ncid, locfn, 0) @@ -2541,7 +2506,7 @@ subroutine SnowOptics_init( ) call ncd_io( 'flx_wgt_dif480_hmn', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) end select - endif ! end if snicar_numrad_snw == 480 + end select call ncd_pio_closefile(ncid) if (masterproc) then From 21b607dcf9558891bea08eadbbb5f33188eb71b6 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 4 Aug 2023 16:22:29 -0600 Subject: [PATCH 19/62] Update namelist defaults and differentiate clm5_1 from 5_0, 4_5 --- bld/CLMBuildNamelist.pm | 2 ++ bld/namelist_files/namelist_defaults_ctsm.xml | 24 +++++++++++++++---- .../namelist_definition_ctsm.xml | 13 +++++----- 3 files changed, 27 insertions(+), 12 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 017f13ecef..04aa4a29a4 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1999,6 +1999,7 @@ sub setup_logic_snicar_methods { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snobc_intmix' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snodst_intmix' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_use_aerosol' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_snicar_frc' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'do_sno_oc' ); } @@ -2007,6 +2008,7 @@ sub setup_logic_snicar_methods { sub setup_logic_snow { my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowoptics480' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowoptics' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowaging' ); } diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 1fddc07869..3b4812c15c 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1541,11 +1541,25 @@ use_crop=".true.">lnd/clm2/surfdata_map/ctsm5.1.dev052/landuse.timeseries_mpasa1 -lnd/clm2/snicardata/snicar_optics_5bnd_c090915.nc -lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc -hexagonal_plate -mid_latitude_summer -sahara +lnd/clm2/snicardata/snicar_optics_480bnd_c012422.nc +lnd/clm2/snicardata/snicar_optics_5bnd_c013122.nc +lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc + +hexagonal_plate +sphere +sphere + +.true. +.false. +.false. + +mid_latitude_winter +sahara +5 +.false. +.false. +.true. +.false. 2015 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 5bcb1fe2c3..ac13424695 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -181,15 +181,15 @@ Toggle to turn on/off aerosol deposition flux in snow in SNICAR + group="snicar_inparm" value=".false." > option to activate BC-snow internal mixing in SNICAR snow albedo calculation -Default: .true. +Default: .false. + group="snicar_inparm" value=".false." > option to activate dust-snow internal mixing in SNICAR snow albedo calculation -Default: .true. +Default: .false. + group="snicar_inparm" value=".true."> Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) radiative forcing -(snicar_frc=".true." is EXPERIMENTAL NOT SUPPORTED!) -Default: .false. +Default: .true. Date: Fri, 4 Aug 2023 17:14:37 -0600 Subject: [PATCH 20/62] Minor cleanup of unnecessary things --- src/biogeophys/AerosolMod.F90 | 1 - src/biogeophys/SurfaceAlbedoMod.F90 | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/biogeophys/AerosolMod.F90 b/src/biogeophys/AerosolMod.F90 index 33c65567f3..bce2b6f9ab 100644 --- a/src/biogeophys/AerosolMod.F90 +++ b/src/biogeophys/AerosolMod.F90 @@ -810,7 +810,6 @@ subroutine AerosolFluxes(bounds, num_snowc, filter_snowc, & ! if turn off aerosol effect in snow, zero out deposition flux if (.not. snicar_use_aerosol) then do c = bounds%begc,bounds%endc - g = col%gridcell(c) flx_bc_dep_dry(c) = 0._r8 flx_bc_dep_wet(c) = 0._r8 diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index 5d12767121..a6758a95bc 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -14,7 +14,7 @@ module SurfaceAlbedoMod use landunit_varcon , only : istsoil, istcrop, istdlak use clm_varcon , only : grlnd, spval use clm_varpar , only : numrad, nlevcan, nlevsno, nlevcan - use clm_varctl , only : fsurdat, iulog, use_snicar_frc, use_SSRE, do_sno_oc + use clm_varctl , only : fsurdat, iulog, use_SSRE, do_sno_oc use pftconMod , only : pftcon use SnowSnicarMod , only : sno_nbr_aer, SNICAR_RT, DO_SNO_AER use AerosolMod , only : aerosol_type From 9cd7a551469cff685f0ae38af1b04b7903c968f7 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 7 Aug 2023 17:19:10 -0600 Subject: [PATCH 21/62] Minor cleanup of unused things --- src/biogeophys/SolarAbsorbedType.F90 | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/biogeophys/SolarAbsorbedType.F90 b/src/biogeophys/SolarAbsorbedType.F90 index d42a072b06..d1941f68cc 100644 --- a/src/biogeophys/SolarAbsorbedType.F90 +++ b/src/biogeophys/SolarAbsorbedType.F90 @@ -168,7 +168,7 @@ subroutine InitHistory(this, bounds) ! ! !USES: use shr_infnan_mod, only : nan => shr_infnan_nan, assignment(=) - use clm_varctl , only : use_snicar_frc , use_SSRE + use clm_varctl , only : use_SSRE use clm_varpar , only : nlevsno use histFileMod , only : hist_addfld1d, hist_addfld2d use histFileMod , only : no_snow_normal @@ -375,7 +375,6 @@ subroutine Restart(this, bounds, ncid, flag) ! ! !USES: use shr_infnan_mod , only : shr_infnan_isnan - use clm_varctl , only : use_snicar_frc, iulog use spmdMod , only : masterproc use abortutils , only : endrun use ncdio_pio , only : file_desc_t, ncd_defvar, ncd_io, ncd_double, ncd_int, ncd_inqvdlen From a0cd959f0077471fc219fbca6aefe999f5987f60 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 7 Aug 2023 17:41:36 -0600 Subject: [PATCH 22/62] Rename use_snicar_frc to snicar_aerforc_diag and make default .false. --- bld/CLMBuildNamelist.pm | 2 +- bld/namelist_files/namelist_defaults_ctsm.xml | 5 +---- bld/namelist_files/namelist_definition_ctsm.xml | 8 ++++---- .../testmods_dirs/clm/SNICARFRC/user_nl_clm | 2 +- src/biogeophys/SurfaceAlbedoMod.F90 | 6 +++--- src/biogeophys/SurfaceAlbedoType.F90 | 16 ++++++++-------- src/biogeophys/SurfaceRadiationMod.F90 | 10 +++++----- src/main/clm_varctl.F90 | 2 +- src/main/controlMod.F90 | 6 +++--- 9 files changed, 27 insertions(+), 30 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 04aa4a29a4..e20b9ea6e8 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1999,7 +1999,7 @@ sub setup_logic_snicar_methods { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snobc_intmix' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snodst_intmix' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_use_aerosol' ); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_snicar_frc' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_aerforc_diag' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'do_sno_oc' ); } diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 3b4812c15c..0b174b7591 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1549,10 +1549,7 @@ use_crop=".true.">lnd/clm2/surfdata_map/ctsm5.1.dev052/landuse.timeseries_mpasa1 sphere sphere -.true. -.false. -.false. - +.false. mid_latitude_winter sahara 5 diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index ac13424695..f15083d222 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1204,10 +1204,10 @@ DependsOnLatAndVeg - Arctic vegetation depends on latitude as above, but tempera (only used when CN is on) - -Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) radiative forcing -Default: .true. + +Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) albedo forcing diagnostics for each aerosol species +Default: .false. shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : use_snicar_frc, use_fates + use clm_varctl , only : snicar_aerforc_diag, use_fates use decompMod , only : bounds_type, subgrid_level_column use atm2lndType , only : atm2lnd_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type @@ -173,7 +173,7 @@ subroutine InitHistory(this, bounds) begp = bounds%begp; endp = bounds%endp begc = bounds%begc; endc = bounds%endc - if (use_snicar_frc) then + if (snicar_aerforc_diag) then this%sfc_frc_aer_patch(begp:endp) = spval call hist_addfld1d (fname='SNOAERFRCL', units='W/m^2', & avgflag='A', long_name='surface forcing of all aerosols in snow (land) ', & @@ -477,7 +477,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & use clm_varpar , only : numrad, nlevsno use clm_varcon , only : spval use landunit_varcon , only : istsoil, istcrop - use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE, do_sno_oc + use clm_varctl , only : use_subgrid_fluxes, snicar_aerforc_diag, iulog, use_SSRE, do_sno_oc use clm_time_manager , only : get_step_size_real, is_near_local_noon use abortutils , only : endrun ! @@ -719,7 +719,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & sabg_soil(p) = sabg(p) endif - if (use_snicar_frc) then + if (snicar_aerforc_diag) then ! Solar radiation absorbed by ground surface without BC absrad_bc = trd(p,ib)*(1._r8-albgrd_bc(c,ib)) + tri(p,ib)*(1._r8-albgri_bc(c,ib)) sabg_bc(p) = sabg_bc(p) + absrad_bc @@ -849,7 +849,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & sabg_pen(p) = sabg(p) - sabg_lyr(p, snl(c)+1) end if - if (use_snicar_frc) then + if (snicar_aerforc_diag) then ! BC aerosol forcing (patch-level): sfc_frc_bc(p) = sabg(p) - sabg_bc(p) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 8d2ea77b33..cdf486eb8e 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -440,7 +440,7 @@ module clm_varctl logical, public :: use_cndv = .false. logical, public :: use_grainproduct = .false. logical, public :: use_fertilizer = .false. - logical, public :: use_snicar_frc = .false. + logical, public :: snicar_aerforc_diag = .false. logical, public :: use_vancouver = .false. logical, public :: use_mexicocity = .false. logical, public :: use_noio = .false. diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index ac37760f49..68edb706ff 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -282,7 +282,7 @@ subroutine control_init(dtime) namelist /clm_inparm/ & use_lch4, use_nitrif_denitrif, use_extralakelayers, & use_vichydro, use_cn, use_cndv, use_crop, use_fertilizer, & - use_grainproduct, use_snicar_frc, use_vancouver, use_mexicocity, use_noio, & + use_grainproduct, snicar_aerforc_diag, use_vancouver, use_mexicocity, use_noio, & use_nguardrail @@ -646,7 +646,7 @@ subroutine control_spmd() call mpi_bcast (use_fertilizer, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_grainproduct, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (o3_veg_stress_method, len(o3_veg_stress_method), MPI_CHARACTER, 0, mpicom, ier) - call mpi_bcast (use_snicar_frc, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (snicar_aerforc_diag, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_vancouver, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_mexicocity, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_noio, 1, MPI_LOGICAL, 0, mpicom, ier) @@ -899,7 +899,7 @@ subroutine control_print () write(iulog,*) ' use_fertilizer = ', use_fertilizer write(iulog,*) ' use_grainproduct = ', use_grainproduct write(iulog,*) ' o3_veg_stress_method = ', o3_veg_stress_method - write(iulog,*) ' use_snicar_frc = ', use_snicar_frc + write(iulog,*) ' snicar_aerforc_diag = ', snicar_aerforc_diag write(iulog,*) ' snicar_use_aerosol = ',snicar_use_aerosol write(iulog,*) ' use_vancouver = ', use_vancouver write(iulog,*) ' use_mexicocity = ', use_mexicocity From 0e6f1df6eeec018f9cd15325e96aeab15799b50a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Aug 2023 11:21:12 -0600 Subject: [PATCH 23/62] Correction of a typo in /testmods_dirs/.../user_nl_clm --- cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm index d8084a4814..449f749457 100644 --- a/cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm @@ -1 +1 @@ - snicar_aerfoc_diag = .true. + snicar_aerforc_diag = .true. From 55e91e465ea7bd6783309e1ea4faf786c2bce7b8 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Aug 2023 14:30:07 -0600 Subject: [PATCH 24/62] Replace dimension 8 with ngmax for two arrays; wait to hear about others --- src/biogeophys/SnowSnicarMod.F90 | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 0d58ffb35c..3cd910b1d2 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -66,10 +66,8 @@ module SnowSnicarMod real(r8), parameter :: min_snw = 1.0E-30_r8 ! minimum snow mass required for SNICAR RT calculation [kg m-2] - !real(r8), parameter :: C1_liq_Brun89 = 1.28E-17_r8 ! constant for liquid water grain growth [m3 s-1], - ! from Brun89 real(r8), parameter :: C1_liq_Brun89 = 0._r8 ! constant for liquid water grain growth [m3 s-1], - ! from Brun89: zeroed to accomodate dry snow aging + ! from Brun89: zeroed to accomodate dry snow aging, was 1.28E-17_r8 real(r8), parameter :: tim_cns_bc_rmv = 2.2E-8_r8 ! time constant for removal of BC in snow on sea-ice ! [s-1] (50% mass removal/year) @@ -406,11 +404,11 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: smr ! accumulator for rdif gaussian integration real(r8):: smt ! accumulator for tdif gaussian integration real(r8):: exp_min ! minimum exponential value - real(r8):: difgauspt(1:8) ! Gaussian integration angle - real(r8):: difgauswt(1:8) ! Gaussian integration coefficients/weights + real(r8), allocatable :: difgauspt(:) ! Gaussian integration angle + real(r8), allocatable :: difgauswt(:) ! Gaussian integration coefficients/weights integer :: ng ! gaussian integration index + integer :: ngmax = 8 ! max gaussian integration index integer :: snl_btm_itf ! index of bottom snow layer interfaces (1) [idx] - integer :: ngmax = 8 ! maxmimum gaussian integration index ! constants used in algorithm real(r8):: c0 = 0.0_r8 real(r8):: c1 = 1.0_r8 @@ -545,12 +543,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & nir_bnd_end = snicar_numrad_snw ! initialize for adding-doubling solver - difgauspt(1:8) = & ! gaussian angles (radians) + allocate(difgauspt(ngmax)) + allocate(difgauswt(ngmax)) + difgauspt(:) = & ! gaussian angles (radians) (/ 0.9894009_r8, 0.9445750_r8, & 0.8656312_r8, 0.7554044_r8, & 0.6178762_r8, 0.4580168_r8, & 0.2816036_r8, 0.0950125_r8/) - difgauswt(1:8) = & ! gaussian weights + difgauswt(:) = & ! gaussian weights (/ 0.0271525_r8, 0.0622535_r8, & 0.0951585_r8, 0.1246290_r8, & 0.1495960_r8, 0.1691565_r8, & @@ -1380,7 +1380,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & albout_lcl(bnd_idx) = albedo - ! Check that albedo is less than 1 + ! Fail if albedo > 1 if (albout_lcl(bnd_idx) > 1.0) then write (iulog,*) "SNICAR ERROR: Albedo > 1.0 at c: ", c_idx, " NSTEP= ",nstep From 992ef0fccb55fde22546c375fc0bddd427e3fc1c Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Aug 2023 17:16:37 -0600 Subject: [PATCH 25/62] Minor refactor: replace some / and ** with *, replace some ifs with min/max --- src/biogeophys/SnowSnicarMod.F90 | 89 ++++++++++---------------------- 1 file changed, 28 insertions(+), 61 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 3cd910b1d2..260098b784 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -492,6 +492,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8) :: Re_bc = 0.045 ! target BC effective radius (um) used in BC MAC adjustment real(r8) :: bcint_m(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix real(r8) :: bcint_n(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix + real(r8) :: bcint_m_tmp ! temporary of bcint_m + real(r8) :: bcint_n_tmp ! temporary of bcint_n real(r8) :: bcint_dd ! intermediate parameter real(r8) :: bcint_dd2 ! intermediate parameter real(r8) :: bcint_f ! intermediate parameter @@ -608,7 +610,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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_r8, 0.2632_r8, 0.3448_r8, 0.4415_r8, 0.625_r8, 0.7782_r8, 1.2422_r8/) - dstint_wvl_ct(1:6) = dstint_wvl(2:7)/2._r8 + dstint_wvl(1:6)/2._r8 + dstint_wvl_ct(1:6) = dstint_wvl(2:7) * 0.5_r8 + dstint_wvl(1:6) * 0.5_r8 dstint_a1(1:6) = (/ -2.1307E+1_r8, -1.5815E+1_r8, -9.2880_r8 , 1.1115_r8 , 1.0307_r8 , 1.0185_r8 /) dstint_a2(1:6) = (/ 1.1746E+2_r8, 9.3241E+1_r8, 4.0605E+1_r8, 3.7389E-1_r8, 1.4800E-2_r8, 2.8921E-4_r8 /) dstint_a3(1:6) = (/ 9.9701E-1_r8, 9.9781E-1_r8, 9.9848E-1_r8, 1.0035_r8 , 1.0024_r8 , 1.0356_r8 /) @@ -824,7 +826,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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._r8) ! Eqn. 3.1 in Fu (2007) + gg_ice_F07_tmp(igb) = g_F07_c0(igb) + g_F07_c1(igb) * AR_tmp + g_F07_c2(igb) * (AR_tmp * AR_tmp) ! Eqn. 3.1 in Fu (2007) enddo case ('hexagonal_plate') @@ -842,7 +844,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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._r8) ! Eqn. 3.3 in Fu (2007) + gg_ice_F07_tmp(igb) = g_F07_p0(igb) + g_F07_p1(igb) * log(AR_tmp) + g_F07_p2(igb) * (log(AR_tmp) * log(AR_tmp)) ! Eqn. 3.3 in Fu (2007) enddo case ('koch_snowflake') @@ -860,7 +862,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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._r8) ! Eqn. 3.3 in Fu (2007) + gg_ice_F07_tmp(igb) = g_F07_p0(igb) + g_F07_p1(igb) * log(AR_tmp) + g_F07_p2(igb) * (log(AR_tmp) * log(AR_tmp)) ! Eqn. 3.3 in Fu (2007) enddo end select @@ -878,7 +880,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & call piecewise_linear_interp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct480(bnd_idx),g_Cg_intp) call piecewise_linear_interp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct480(bnd_idx),gg_F07_intp) end select - g_ice_F07 = gg_F07_intp + (1._r8 - gg_F07_intp) / ss_alb_snw_lcl(i) / 2._r8 ! Eq.2.2 in Fu (2007) + g_ice_F07 = gg_F07_intp + 0.5_r8 * (1._r8 - gg_F07_intp) / ss_alb_snw_lcl(i) ! Eq.2.2 in Fu (2007) asm_prm_snw_lcl(i) = g_ice_F07 * g_Cg_intp ! Eq.6, He et al. (2017) endif @@ -886,12 +888,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & enddo ! snow layer loop - - ! aerosol species 1 optical properties, hydrophilic BC - !ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) - !asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) - !ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) - ! aerosol species 2 optical properties, hydrophobic BC ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) asm_prm_aer_lcl(2) = asm_prm_bc2(bnd_idx) @@ -907,27 +903,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & asm_prm_aer_lcl(4) = asm_prm_oc2(bnd_idx) ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) - ! aerosol species 5 optical properties, dust size1 - !ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) - !asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) - !ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) - - ! aerosol species 6 optical properties, dust size2 - !ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) - !asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) - !ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) - - ! aerosol species 7 optical properties, dust size3 - !ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) - !asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) - !ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) - - ! aerosol species 8 optical properties, dust size4 - !ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) - !asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) - !ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) - - ! 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) @@ -983,20 +958,19 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ( (mss_cnc_aer_lcl(i,1)*1.0E9_r8*1.7_r8/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_r8)**bcint_m(1) - bcint_dd2 = (0.1_r8/0.05_r8)**bcint_m(1) - bcint_f = (Re_bc/0.1_r8)**bcint_n(1) - endif - if ( (ibb >= 3) .and. (ibb <= 11) ) then ! visible - bcint_dd = (Re_bc/0.05_r8)**bcint_m(2) - bcint_dd2 = (0.1_r8/0.05_r8)**bcint_m(2) - bcint_f = (Re_bc/0.1_r8)**bcint_n(2) - endif - if ( ibb > 11 ) then ! NIR - bcint_dd = (Re_bc/0.05_r8)**bcint_m(3) - bcint_dd2 = (0.1_r8/0.05_r8)**bcint_m(3) - bcint_f = (Re_bc/0.1_r8)**bcint_n(3) + bcint_m_tmp = bcint_m(1) + bcint_n_tmp = bcint_n(1) + else if (ibb >= 3 .and. ibb <= 11) then ! visible + bcint_m_tmp = bcint_m(2) + bcint_n_tmp = bcint_n(2) + else ! ibb > 11, NIR + bcint_m_tmp = bcint_m(3) + bcint_n_tmp = bcint_n(3) endif + bcint_dd = (Re_bc * 20.0_r8)**bcint_m_tmp + bcint_dd2 = (0.1_r8 * 20.0_r8)**bcint_m_tmp + bcint_f = (Re_bc * 10.0_r8)**bcint_n_tmp + enh_omg_bcint_tmp2(ibb)=LOG10(max(1._r8,bcint_dd*((enh_omg_bcint_tmp(ibb)/bcint_dd2)**bcint_f))) enddo ! piecewise linear interpolate into targeted SNICAR bands in a logscale space @@ -1069,8 +1043,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & if (DELTA == 1) then do i=snl_top,snl_btm,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) + omega_star(i) = (1._r8 - g(i) * g(i)) * omega(i) / (1._r8 - omega(i) * (g(i) * g(i))) + tau_star(i) = (1._r8 - omega(i) * (g(i) * g(i))) * tau(i) enddo else do i=snl_top,snl_btm,1 @@ -1134,7 +1108,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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 + rdif_a(i) = (ue * ue - c1) * (c1 / extins - extins) / ne tdif_a(i) = c4*ue/ne ! evaluate rdir,tdir for direct beam @@ -1344,9 +1318,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & !Underflow check (we've already tripped the error condition above) do i=snl_top,1,1 - if (flx_abs_lcl(i,bnd_idx) < 0._r8) then - flx_abs_lcl(i,bnd_idx) = 0._r8 - endif + flx_abs_lcl(i,bnd_idx) = max(0._r8, flx_abs_lcl(i,bnd_idx)) enddo F_abs_sum = 0._r8 @@ -1472,8 +1444,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! solar zenith angle parameterization ! calculate the scaling factor for NIR direct albedo if SZA>75 degree if ((mu_not < mu_75) .and. (flg_slr_in == 1)) then - sza_c1 = sza_a0 + sza_a1 * mu_not + sza_a2 * mu_not**2 - sza_c0 = sza_b0 + sza_b1 * mu_not + sza_b2 * mu_not**2 + sza_c1 = sza_a0 + sza_a1 * mu_not + sza_a2 * (mu_not * mu_not) + sza_c0 = sza_b0 + sza_b1 * mu_not + sza_b2 * (mu_not * mu_not) sza_factor = sza_c1 * (log10(snw_rds_lcl(snl_top) * c1) - c6) + sza_c0 flx_sza_adjust = albout(c_idx,2) * (sza_factor-c1) * sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) albout(c_idx,2) = albout(c_idx,2) * sza_factor @@ -1703,7 +1675,7 @@ subroutine SnowAge_grain(bounds, & !dr_wet = 1E6_r8*(dtime*(C1_liq_Brun89 + C2_liq_Brun89*(frc_liq**(3))) / (4*SHR_CONST_PI*(snw_rds(c_idx,i)/1E6)**(2))) !simplified, units of microns: dr_wet = 1E18_r8*(dtime*(params_inst%C2_liq_Brun89*(frc_liq**(3))) / & - (4*SHR_CONST_PI*snw_rds(c_idx,i)**(2))) + (4._r8 * SHR_CONST_PI * (snw_rds(c_idx,i) * snw_rds(c_idx,i)))) dr = dr + dr_wet @@ -1757,13 +1729,8 @@ subroutine SnowAge_grain(bounds, & !********** 5. CHECK BOUNDARIES *********** ! ! boundary check - if (snw_rds(c_idx,i) < snw_rds_min) then - snw_rds(c_idx,i) = snw_rds_min - endif - - if (snw_rds(c_idx,i) > snw_rds_max) then - snw_rds(c_idx,i) = snw_rds_max - end if + snw_rds(c_idx,i) = max(snw_rds(c_idx,i), snw_rds_min) + snw_rds(c_idx,i) = min(snw_rds(c_idx,i), snw_rds_max) ! set top layer variables for history files if (i == snl_top) then From 5ddaa345926a1ff1d29967a6984b1ed96fb37ee8 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 8 Aug 2023 18:49:34 -0600 Subject: [PATCH 26/62] Correct comments that label hydrophilic/phobic OC and BC --- src/biogeophys/SnowSnicarMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 260098b784..fedd4292e0 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -93,7 +93,7 @@ module SnowSnicarMod real(r8), pointer :: asm_prm_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) real(r8), pointer :: ext_cff_mss_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) - ! hydrophiliic BC + ! hydrophilic BC real(r8), pointer :: ss_alb_bc1(:) !(numrad_snw) real(r8), pointer :: asm_prm_bc1(:) !(numrad_snw) real(r8), pointer :: ext_cff_mss_bc1(:) !(numrad_snw) @@ -103,12 +103,12 @@ module SnowSnicarMod real(r8), pointer :: asm_prm_bc2(:) !(numrad_snw) real(r8), pointer :: ext_cff_mss_bc2(:) !(numrad_snw) - ! hydrophobic OC + ! hydrophilic OC real(r8), pointer :: ss_alb_oc1(:) !(numrad_snw) real(r8), pointer :: asm_prm_oc1(:) !(numrad_snw) real(r8), pointer :: ext_cff_mss_oc1(:) !(numrad_snw) - ! hydrophilic OC + ! hydrophobic OC real(r8), pointer :: ss_alb_oc2(:) !(numrad_snw) real(r8), pointer :: asm_prm_oc2(:) !(numrad_snw) real(r8), pointer :: ext_cff_mss_oc2(:) !(numrad_snw) From d47da2930c2027d14b6fe8476bc91c00fa05e51e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 9 Aug 2023 17:59:47 -0600 Subject: [PATCH 27/62] Consolidated fsnowoptics480 with fsnowoptics --- bld/CLMBuildNamelist.pm | 5 +++-- bld/namelist_files/namelist_defaults_ctsm.xml | 12 ++++++++---- bld/namelist_files/namelist_definition_ctsm.xml | 6 ------ src/biogeophys/SnowSnicarMod.F90 | 15 +++++---------- src/main/clm_varctl.F90 | 1 - src/main/controlMod.F90 | 8 +------- 6 files changed, 17 insertions(+), 30 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index e20b9ea6e8..d028f8af61 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -2008,8 +2008,9 @@ sub setup_logic_snicar_methods { sub setup_logic_snow { my ($opts, $nl_flags, $definition, $defaults, $nl) = @_; - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowoptics480' ); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowoptics' ); + my $numrad_snw = $nl->get_value('snicar_numrad_snw'); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowoptics', + 'snicar_numrad_snw' => $numrad_snw); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'fsnowaging' ); } diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 0b174b7591..3c05a675fb 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1541,9 +1541,14 @@ use_crop=".true.">lnd/clm2/surfdata_map/ctsm5.1.dev052/landuse.timeseries_mpasa1 -lnd/clm2/snicardata/snicar_optics_480bnd_c012422.nc -lnd/clm2/snicardata/snicar_optics_5bnd_c013122.nc -lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc +lnd/clm2/snicardata/snicar_drdt_bst_fit_60_c070416.nc + +5 + + +lnd/clm2/snicardata/snicar_optics_5bnd_c013122.nc hexagonal_plate sphere @@ -1552,7 +1557,6 @@ use_crop=".true.">lnd/clm2/surfdata_map/ctsm5.1.dev052/landuse.timeseries_mpasa1 .false. mid_latitude_winter sahara -5 .false. .false. .true. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index f15083d222..81f904a215 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -807,12 +807,6 @@ Full pathname of surface data file. SNICAR (SNow, ICe, and Aerosol Radiative model) optical data file name - -SNICAR (SNow, ICe, and Aerosol Radiative model) 480-band optical data file name - - - SNICAR (SNow, ICe, and Aerosol Radiative model) snow aging data file name diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index fedd4292e0..f5c603d302 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1812,7 +1812,7 @@ end function FreshSnowRadius subroutine SnowOptics_init( ) use fileutils , only : getfil - use CLM_varctl , only : fsnowoptics, snicar_numrad_snw, fsnowoptics480 + use CLM_varctl , only : fsnowoptics, snicar_numrad_snw use CLM_varctl , only : snicar_solarspec, snicar_dust_optics use spmdMod , only : masterproc use ncdio_pio , only : file_desc_t, ncd_io, ncd_pio_openfile, ncd_pio_closefile @@ -1857,16 +1857,15 @@ subroutine SnowOptics_init( ) allocate(flx_wgt_dir(snicar_numrad_snw)) allocate(flx_wgt_dif(snicar_numrad_snw)) - if(masterproc) write(iulog,*) 'Attempting to read snow optical properties .....' + if (masterproc) write(iulog,*) 'Attempting to read snow optical properties...' + call getfil (fsnowoptics, locfn, 0) + call ncd_pio_openfile(ncid, locfn, 0) + if(masterproc) write(iulog,*) subname,trim(fsnowoptics) !--------------------- for 5-band data select case (snicar_numrad_snw) case (5) ! 5-band case - call getfil (fsnowoptics, locfn, 0) - call ncd_pio_openfile(ncid, locfn, 0) - if(masterproc) write(iulog,*) subname,trim(fsnowoptics) - select case (snicar_solarspec) ! mid-latitude winter spectrum case ('mid_latitude_winter') @@ -2366,10 +2365,6 @@ subroutine SnowOptics_init( ) !-------------------- for 480-band data case (480) - call getfil (fsnowoptics480, locfn, 0) - call ncd_pio_openfile(ncid, locfn, 0) - if(masterproc) write(iulog,*) subname,trim(fsnowoptics480) - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing call ncd_io( 'ss_alb_bcphob', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_bcphob', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index cdf486eb8e..ec31d90132 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -113,7 +113,6 @@ module clm_varctl character(len=fname_len), public :: nrevsn = ' ' ! restart data file name for branch run character(len=fname_len), public :: fsnowoptics = ' ' ! snow optical properties file name character(len=fname_len), public :: fsnowaging = ' ' ! snow aging parameters file name - character(len=fname_len), public :: fsnowoptics480 = ' ' ! snow optical properties file name for 480 bands character(len=fname_len), public :: fatmlndfrc = ' ' ! lnd frac file on atm grid ! only needed for LILAC and MCT drivers diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 68edb706ff..0d2a8f0bfd 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -146,7 +146,7 @@ subroutine control_init(dtime) namelist /clm_inparm/ & fsurdat, & - paramfile, fsnowoptics, fsnowaging, fsnowoptics480 + paramfile, fsnowoptics, fsnowaging ! History, restart options @@ -662,7 +662,6 @@ subroutine control_spmd() call mpi_bcast (paramfile, len(paramfile) , MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsnowoptics, len(fsnowoptics), MPI_CHARACTER, 0, mpicom, ier) call mpi_bcast (fsnowaging, len(fsnowaging), MPI_CHARACTER, 0, mpicom, ier) - call mpi_bcast (fsnowoptics480, len(fsnowoptics480), MPI_CHARACTER, 0, mpicom, ier) ! Irrigation call mpi_bcast(irrigate, 1, MPI_LOGICAL, 0, mpicom, ier) @@ -987,11 +986,6 @@ subroutine control_print () else write(iulog,'(a)') ' snow aging parameters file = '//trim(fsnowaging) endif - if (fsnowoptics480 == ' ') then - write(iulog,*) ' SNICAR: snow optical properties (480-band) file NOT set' - else - write(iulog,*) ' SNICAR: snow optical properties (480-band) file = ',trim(fsnowoptics480) - endif write(iulog,*) ' SNICAR: downward solar radiation spectrum type =', snicar_solarspec write(iulog,*) ' SNICAR: dust optics type = ', snicar_dust_optics write(iulog,*) ' SNICAR: number of bands in snow albedo calculation =', snicar_numrad_snw From afbe2d62d76ae20702c453b1087c21d51ad15a3f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 10 Aug 2023 14:30:20 -0600 Subject: [PATCH 28/62] Add quotes to correct namelist_defaults_ctsm.xml --- bld/namelist_files/namelist_defaults_ctsm.xml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index 3c05a675fb..a5af2ec374 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1545,10 +1545,8 @@ use_crop=".true.">lnd/clm2/surfdata_map/ctsm5.1.dev052/landuse.timeseries_mpasa1 5 - -lnd/clm2/snicardata/snicar_optics_5bnd_c013122.nc +lnd/clm2/snicardata/snicar_optics_480bnd_c012422.nc +lnd/clm2/snicardata/snicar_optics_5bnd_c013122.nc hexagonal_plate sphere From 9808d1adfba6934ae9cc23f9bb46271b947bbba8 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 10 Aug 2023 15:27:50 -0600 Subject: [PATCH 29/62] Consolidate some repetitive code pertaining to wvl_ct --- src/biogeophys/SnowSnicarMod.F90 | 38 ++++++++++++++------------------ 1 file changed, 16 insertions(+), 22 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index f5c603d302..f287de2032 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -463,8 +463,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8) :: g_F07_p1(1:7) real(r8) :: g_F07_p0(1:7) ! other temporary variables - real(r8) :: wvl_ct5(1:5) ! band center wavelength (um) for 5-band case - real(r8) :: wvl_ct480(1:480) ! band center wavelength (um) for 480-band case, computed below + real(r8), allocatable :: wvl_ct(:) ! band center wavelength (um) for 5 or 480-band case real(r8) :: diam_ice ! effective snow grain diameter (SSA-equivalent) unit: microns real(r8) :: fs_sphd ! shape factor for spheroid snow real(r8) :: fs_hex ! shape factor for reference hexagonal snow @@ -565,7 +564,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Table 3 of He et al 2017 JC g_wvl(1:8) = (/ 0.25_r8, 0.70_r8, 1.41_r8, 1.90_r8, & 2.50_r8, 3.50_r8, 4.00_r8, 5.00_r8 /) - g_wvl_ct(1:7) = g_wvl(2:8) / 2._r8 + g_wvl(1:7) / 2._r8 + g_wvl_ct(1:7) = g_wvl(2:8) * 0.5_r8 + g_wvl(1:7) * 0.5_r8 g_b0(1:7) = (/ 9.76029E-1_r8, 9.67798E-1_r8, 1.00111_r8, 1.00224_r8, & 9.64295E-1_r8, 9.97475E-1_r8, 9.97475E-1_r8 /) g_b1(1:7) = (/ 5.21042E-1_r8, 4.96181E-1_r8, 1.83711E-1_r8, 1.37082E-1_r8, & @@ -590,7 +589,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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_r8, 0.25_r8, 0.30_r8, 0.33_r8, 0.36_r8, 0.40_r8, 0.44_r8, 0.48_r8, & 0.52_r8, 0.57_r8, 0.64_r8, 0.69_r8, 0.75_r8, 0.78_r8, 0.87_r8, 1._r8, 1.2_r8 /) - bcint_wvl_ct(1:16) = bcint_wvl(2:17)/2._r8 + bcint_wvl(1:16)/2._r8 + bcint_wvl_ct(1:16) = bcint_wvl(2:17) * 0.5_r8 + bcint_wvl(1:16) * 0.5_r8 bcint_d0(1:16) = (/ 2.48045_r8 , 4.70305_r8 , 4.68619_r8 , 4.67369_r8 , 4.65040_r8 , & 2.40364_r8 , 7.95408E-1_r8, 2.92745E-1_r8, 8.63396E-2_r8, 2.76299E-2_r8, & 1.40864E-2_r8, 8.65705E-3_r8, 6.12971E-3_r8, 4.45697E-3_r8, 3.06648E-2_r8, & @@ -616,10 +615,15 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & dstint_a3(1:6) = (/ 9.9701E-1_r8, 9.9781E-1_r8, 9.9848E-1_r8, 1.0035_r8 , 1.0024_r8 , 1.0356_r8 /) ! SNICAR/CLM snow band center wavelength (um) - wvl_ct5(1:5) = (/ 0.5_r8, 0.85_r8, 1.1_r8, 1.35_r8, 3.25_r8 /) ! 5-band - do igb = 1,480 - wvl_ct480(igb) = 0.205_r8 + 0.01_r8 * (igb-1) ! 480-band - enddo + allocate(wvl_ct(snicar_numrad_snw)) + select case (snicar_numrad_snw) + case (5) + wvl_ct(:) = (/ 0.5_r8, 0.85_r8, 1.1_r8, 1.35_r8, 3.25_r8 /) ! 5-band + case (480) + do igb = 1, snicar_numrad_snw + wvl_ct(igb) = 0.205_r8 + 0.01_r8 * (igb - 1._r8) ! 480-band + enddo + end select ! Define constants pi = SHR_CONST_PI @@ -872,14 +876,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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 - select case (snicar_numrad_snw) - case (5) - call piecewise_linear_interp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct5(bnd_idx),g_Cg_intp) - call piecewise_linear_interp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct5(bnd_idx),gg_F07_intp) - case (480) - call piecewise_linear_interp1d(7,g_wvl_ct,g_ice_Cg_tmp,wvl_ct480(bnd_idx),g_Cg_intp) - call piecewise_linear_interp1d(7,g_wvl_ct,gg_ice_F07_tmp,wvl_ct480(bnd_idx),gg_F07_intp) - end select + call piecewise_linear_interp1d(7, g_wvl_ct, g_ice_Cg_tmp, wvl_ct(bnd_idx), g_Cg_intp) + call piecewise_linear_interp1d(7, g_wvl_ct, gg_ice_F07_tmp, wvl_ct(bnd_idx), gg_F07_intp) g_ice_F07 = gg_F07_intp + 0.5_r8 * (1._r8 - gg_F07_intp) / ss_alb_snw_lcl(i) ! Eq.2.2 in Fu (2007) asm_prm_snw_lcl(i) = g_ice_F07 * g_Cg_intp ! Eq.6, He et al. (2017) endif @@ -933,12 +931,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) ! Start BC/dust-snow internal mixing for wavelength<=1.2um - select case (snicar_numrad_snw) - case (5) - wvl_doint = wvl_ct5(bnd_idx) - case (480) - wvl_doint = wvl_ct480(bnd_idx) - end select + wvl_doint = wvl_ct(bnd_idx) + if (wvl_doint <= 1.2_r8) then ! BC-snow internal mixing applied to hydrophilic BC if activated From 5ad655a53f10dc4c9bd087902fc73d7b912d6d78 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 10 Aug 2023 15:52:07 -0600 Subject: [PATCH 30/62] Reduce repetitive code in 'Weight output NIR albedo' section --- src/biogeophys/SnowSnicarMod.F90 | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index f287de2032..1ac94ef552 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1384,27 +1384,24 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Weight output NIR albedo appropriately select case (snicar_numrad_snw) case (5) ! 5-band case + ! VIS band albout(c_idx,1) = albout_lcl(1) - flx_sum = 0._r8 - do bnd_idx= nir_bnd_bgn,nir_bnd_end - flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) - end do - albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) case (480) ! 480-band case ! average for VIS band - flx_sum = 0._r8 + flx_sum = 0._r8 do bnd_idx= 1, (nir_bnd_bgn-1) flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) end do albout(c_idx,1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) - ! average for NIR band - flx_sum = 0._r8 - do bnd_idx= nir_bnd_bgn,nir_bnd_end - flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) - end do - albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) end select + ! average for NIR band + flx_sum = 0._r8 + do bnd_idx = nir_bnd_bgn, nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx) * albout_lcl(bnd_idx) + end do + albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately select case (snicar_numrad_snw) case (5) ! 5-band case From 40bcf1560bfa892bedcd4224074c6afbabda6adf Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 10 Aug 2023 16:10:40 -0600 Subject: [PATCH 31/62] Reduce repetitive code in 'Weight output NIR absorbed' section --- src/biogeophys/SnowSnicarMod.F90 | 27 ++++++++++++--------------- 1 file changed, 12 insertions(+), 15 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 1ac94ef552..6c271c013b 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1395,7 +1395,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & albout(c_idx,1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) end select - ! average for NIR band + ! average for NIR band (5 or 480-band case) flx_sum = 0._r8 do bnd_idx = nir_bnd_bgn, nir_bnd_end flx_sum = flx_sum + flx_wgt(bnd_idx) * albout_lcl(bnd_idx) @@ -1405,31 +1405,28 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately select case (snicar_numrad_snw) case (5) ! 5-band case + ! VIS band flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) - do i=snl_top,1,1 - flx_sum = 0._r8 - do bnd_idx= nir_bnd_bgn,nir_bnd_end - flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) - enddo - flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) - end do case (480) ! 480-band case + ! average for VIS band do i=snl_top,1,1 - ! average for VIS band flx_sum = 0._r8 do bnd_idx= 1,(nir_bnd_bgn-1) flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) enddo flx_abs(c_idx,i,1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) - ! average for NIR band - flx_sum = 0._r8 - do bnd_idx= nir_bnd_bgn,nir_bnd_end - flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) - enddo - flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) end do end select + ! average for NIR band (5 or 480-band case) + do i = snl_top, 1, 1 + flx_sum = 0._r8 + do bnd_idx = nir_bnd_bgn, nir_bnd_end + flx_sum = flx_sum + flx_wgt(bnd_idx) * flx_abs_lcl(i,bnd_idx) + end do + flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + end do + ! high solar zenith angle adjustment for Adding-doubling solver results ! near-IR direct albedo/absorption adjustment for high solar zenith angles ! solar zenith angle parameterization From 98f229a838a1700e74b164025edcb58e32af839a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 10 Aug 2023 16:40:17 -0600 Subject: [PATCH 32/62] Replace if-statements with min/max --- src/biogeophys/SnowSnicarMod.F90 | 28 ++++++++-------------------- 1 file changed, 8 insertions(+), 20 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 6c271c013b..b4748085b2 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1610,30 +1610,18 @@ subroutine SnowAge_grain(bounds, & ! make sure rhos doesn't drop below 50 (see rhos_idx below) rhos=max(50._r8,rhos) - ! best-fit table indecies + ! best-fit table indices T_idx = nint((t_soisno(c_idx,i)-223) / 5) + 1 Tgrd_idx = nint(dTdz(c_idx,i) / 10) + 1 rhos_idx = nint((rhos-50) / 50) + 1 - ! boundary check: - if (T_idx < idx_T_min) then - T_idx = idx_T_min - endif - if (T_idx > idx_T_max) then - T_idx = idx_T_max - endif - if (Tgrd_idx < idx_Tgrd_min) then - Tgrd_idx = idx_Tgrd_min - endif - if (Tgrd_idx > idx_Tgrd_max) then - Tgrd_idx = idx_Tgrd_max - endif - if (rhos_idx < idx_rhos_min) then - rhos_idx = idx_rhos_min - endif - if (rhos_idx > idx_rhos_max) then - rhos_idx = idx_rhos_max - endif + ! boundary checks + T_idx = max(T_idx, idx_T_min) + T_idx = min(T_idx, idx_T_max) + Tgrd_idx = max(Tgrd_idx, idx_Tgrd_min) + Tgrd_idx = min(Tgrd_idx, idx_Tgrd_max) + rhos_idx = max(rhos_idx, idx_rhos_min) + rhos_idx = min(rhos_idx, idx_rhos_max) ! best-fit parameters bst_tau = snowage_tau(rhos_idx,Tgrd_idx,T_idx) From 2ee70af2bd6f6f4d09e015761794e5d72c976db5 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 10 Aug 2023 17:21:42 -0600 Subject: [PATCH 33/62] Replace another if-statmt with max and two ints with floats --- src/biogeophys/SnowSnicarMod.F90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index b4748085b2..2a7296178f 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1630,13 +1630,11 @@ subroutine SnowAge_grain(bounds, & !LvK extra boundary check, to prevent when using old restart file with lower snw_rds_min than current run - if (snw_rds(c_idx,i) < snw_rds_min) then - snw_rds(c_idx,i) = snw_rds_min - endif + snw_rds(c_idx,i) = max(snw_rds(c_idx,i), snw_rds_min) ! change in snow effective radius, using best-fit parameters dr_fresh = snw_rds(c_idx,i)-snw_rds_min - dr = (bst_drdt0*(bst_tau/(dr_fresh+bst_tau))**(1/bst_kappa)) * (dtime/3600) + dr = (bst_drdt0 * (bst_tau / (dr_fresh + bst_tau))**(1._r8 / bst_kappa)) * (dtime / 3600._r8) ! !********** 2. WET SNOW AGING *********** From 5709993881a361bc32d5a7e8870c1210f7f5c861 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 11 Aug 2023 14:38:59 -0600 Subject: [PATCH 34/62] Add a clarifying comment to the code --- src/biogeophys/SnowSnicarMod.F90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 2a7296178f..8453a8670d 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1846,6 +1846,25 @@ subroutine SnowOptics_init( ) ! flux weights/spectrum call ncd_io( 'flx_wgt_dir5_mlw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'flx_wgt_dif5_mlw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + ! + ! THIS NOTE APPLIES TO ALL THE call ncd_io LINES BELOW WHERE + ! bcphob AND ocphob GET ASSIGNED TO VARIABLES SUFFIXED bc1/oc1: + ! + ! Assumption (1) applies here, in the input section. + ! Assumption (2) applies later, in the snicar code. + ! + ! 1) In this section, hydrophillic particles behave like hydrophobic + ! particles. We assume bc1/oc1 to have the same optics as bc2/oc2 + ! because sulfate coating on the bc1/oc1 surface is assumed to be + ! dissolved into the hydrometeo (i.e, snow grain here) during the + ! deposition process. This is different from the assumption made in + ! prior model versions, where bc1/oc1 was coated by undissolved + ! sulfate. + ! 2) Later, in the snicar code, if the bc-snow internal mixing option + ! is on, bc1/oc1 (internally mixed within the snow grain) will be + ! treated differently than bc2/oc2 (mixed externally or outside the + ! snow grain). + ! ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing call ncd_io( 'ss_alb_bcphob_dif_mlw', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) call ncd_io( 'asm_prm_bcphob_dif_mlw', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) From a5e8c7c90e50000475ecab3399aa7b674c5ee664 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 11 Aug 2023 14:58:16 -0600 Subject: [PATCH 35/62] Draft of ChangeLog/Sum files --- doc/ChangeLog | 155 ++++++++++++++++++++++++++++++++++++++++++++++++++ doc/ChangeSum | 1 + 2 files changed, 156 insertions(+) diff --git a/doc/ChangeLog b/doc/ChangeLog index e65560d5c3..cfed3b83f3 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,4 +1,159 @@ =============================================================== +Tag name: ctsm5.1.dev13? +Originator(s): @cenlinhe (Cenlin He,UCAR/RAL), slevis (Samuel Levis,UCAR/TSS,303-665-1310) +Date: Fri Aug 11 14:39:06 MDT 2023 +One-line Summary: SNICAR snow albedo scheme updates + +Purpose and description of changes +---------------------------------- + + Notes copied here from the PR #1861: + + A few substantial changes in the SNICAR module for the following updated snow + albedo calculation features: + - Updated ice optical properties from Flanner et al. (2021), with multiple types + for ice refractive indices. The updated SNICAR database files are: + /glade/work/cenlinhe/NOAA_CPT_snowAER/CLM_SNICAR_data/snicar_optics_480bnd_c012422.nc + /glade/work/cenlinhe/NOAA_CPT_snowAER/CLM_SNICAR_data/snicar_optics_5bnd_c013122.nc + - Updated aerosol optical properties from Flanner et al. (2021) with multiple + dust types & new BC and OC optics (the updated data are in the new SNICAR + database files shown above). + - Updated downward solar spectra from Flanner et al. (2021) for multiple + condition types. + - More accurate radiative transfer solver (adding-doubling) from Dang et al. (2019). + - Nonspherical snow grain scheme from He et al. (2017). + - BC-snow internal mixing scheme from He et al. (2017). + - Dust-snow internal mixing scheme from He et al. (2019). + - Hyperspectral (480-band, 10-nm spectral res) capability with all the above features. + - New namelist controls for aerosol in snow and additional snow albedo + diagnostic output variables. + + Specific notes + - Code contributors: Cenlin He (NCAR/RAL) with advice from + Dave Lawrence (NCAR/CGD) and Mark Flanner (UMich). + - The manuscript to report this update is in preparation (He et al, 2022 JAMES in prep) + - These updates will change the snow and surface albedo results along with + other surface fluxes changes. + - There are a few new namelist options related to SNICAR scheme added to the + namelist control. + + +Significant changes to scientifically-supported configurations +-------------------------------------------------------------- + +Does this tag change answers significantly for any of the following physics configurations? +(Details of any changes will be given in the "Answer changes" section below.) + + [Put an [X] in the box for any configuration with significant answer changes.] + +[X] clm5_1 + +[ ] clm5_0 + +[ ] ctsm5_0-nwp + +[ ] clm4_5 + + +Bugs fixed or introduced +------------------------ +CTSM issues fixed (include CTSM Issue #): + + +Notes of particular relevance for users +--------------------------------------- +Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): + New namelist variables: + snicar_numrad_snw = 5 or 480 wavelength bands, default 5 + snicar_solarspec, default "mid_latitude_winter" among six available options + snicar_dust_optics, default "sahara" among three avail. options + snicar_snw_shape, default "hexagonal_plate" among fourn avail. options + snicar_use_aerosol, default .true. + snicar_snobc_intmix and snicar_snodst_intmix, default .false. means do not + activate bc-snow and dust-snow internal mixing + + do_sno_oc, default .false., already appeared in previous code but in caps + snicar_aerforc_diag, default .false., existed before as use_snicar_frc + fsnowoptics now points to an updated 5-band file and has an option for a + 480-band file, as well + +Substantial timing or memory changes: +[e.g., check PFS test in the test suite and look at timings, if you +expect possible significant timing changes] + + +Notes of particular relevance for developers: +--------------------------------------------- +Changes to tests or testing: + + +Testing summary: +---------------- +[Remove any lines that don't apply.] + + [PASS means all tests PASS; OK means tests PASS other than expected fails.] + + build-namelist tests (if CLMBuildNamelist.pm has changed): + + cheyenne - + + tools-tests (test/tools) (if tools have been changed): + + cheyenne - + + python testing (if python code has changed; see instructions in python/README.md; document testing done): + + (any machine) - + + [If python code has changed and you are NOT running aux_clm (e.g., because the only changes are in python + code) then also run the clm_pymods test suite; this is a small subset of aux_clm that runs the system + tests impacted by python changes. The best way to do this, if you expect no changes from the last tag in + either model output or namelists, is: create sym links pointing to the last tag's baseline directory, + named with the upcoming tag; then run the clm_pymods test suite comparing against these baselines but NOT + doing their own baseline generation. If you are already running the full aux_clm then you do NOT need to + separately run the clm_pymods test suite, and you can remove the following line.] + + clm_pymods test suite on cheyenne - + + regular tests (aux_clm: https://github.com/ESCOMP/CTSM/wiki/System-Testing-Guide#pre-merge-system-testing): + + cheyenne ---- + izumi ------- + + fates tests: (give name of baseline if different from CTSM tagname, normally fates baselines are fates--) + cheyenne ---- + izumi ------- + + any other testing (give details below): + +If the tag used for baseline comparisons was NOT the previous tag, note that here: + + +Answer changes +-------------- + +Changes answers relative to baseline: + YES + + Summarize any changes to answers, i.e., + - what code configurations: All + - what platforms/compilers: All + - nature of change: larger than roundoff; new climate? + + If this tag changes climate describe the run(s) done to evaluate the new + climate (put details of the simulations in the experiment database) + - casename: + + URL for LMWG diagnostics output used to validate new climate: + + +Other details +------------- +Pull Requests that document the changes (include PR ids): + https://github.com/ESCOMP/ctsm/pull/1861 + +=============================================================== +=============================================================== Tag name: ctsm5.1.dev133 Originator(s): adrifoster (Adrianna Foster), glemieux (Gregory Lemieux, LBL/NGEET) Date: Wed Aug 9 22:44:46 MDT 2023 diff --git a/doc/ChangeSum b/doc/ChangeSum index a72e6235ae..4b7b3c47fa 100644 --- a/doc/ChangeSum +++ b/doc/ChangeSum @@ -1,5 +1,6 @@ Tag Who Date Summary ============================================================================================================================ + ctsm5.1.dev13? slevis ??/??/2023 SNICAR snow albedo scheme updates ctsm5.1.dev133 glemieux 08/09/2023 FATES API update to facilitate fates refactor ctsm5.1.dev132 slevis 08/04/2023 Add parameterization to allow excess ice in soil and subsidence ctsm5.1.dev131 samrabin 07/27/2023 Enable prescribed crop calendars From 093e54c1babee332483a4f0e7a8fd1ad7520bc6e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 11 Aug 2023 15:16:05 -0600 Subject: [PATCH 36/62] Update to the ChangeLog --- doc/ChangeLog | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index cfed3b83f3..e2d894e242 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev13? Originator(s): @cenlinhe (Cenlin He,UCAR/RAL), slevis (Samuel Levis,UCAR/TSS,303-665-1310) -Date: Fri Aug 11 14:39:06 MDT 2023 +Date: Fri Aug 11 15:07:55 MDT 2023 One-line Summary: SNICAR snow albedo scheme updates Purpose and description of changes @@ -48,11 +48,11 @@ Does this tag change answers significantly for any of the following physics conf [X] clm5_1 -[ ] clm5_0 +[X] clm5_0 -[ ] ctsm5_0-nwp +[X] ctsm5_0-nwp -[ ] clm4_5 +[X] clm4_5 Bugs fixed or introduced @@ -74,8 +74,8 @@ Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): do_sno_oc, default .false., already appeared in previous code but in caps snicar_aerforc_diag, default .false., existed before as use_snicar_frc - fsnowoptics now points to an updated 5-band file and has an option for a - 480-band file, as well + fsnowoptics now points to an updated 5-band file and gives the option for a + 480-band file Substantial timing or memory changes: [e.g., check PFS test in the test suite and look at timings, if you @@ -140,6 +140,11 @@ Changes answers relative to baseline: - what platforms/compilers: All - nature of change: larger than roundoff; new climate? + Namelist defaults are such that phys="clm5.0" and phys="clm4.5" give different + answers only due to the changed fsnowoptics file. + Namelist defaults are such that phys="clm5.1" changes answers as a result of + new parameterizations. + If this tag changes climate describe the run(s) done to evaluate the new climate (put details of the simulations in the experiment database) - casename: From f0b6d605344b4a6b97208a5f0f5bb16026653ccd Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 11 Aug 2023 17:16:24 -0600 Subject: [PATCH 37/62] Update2 to the ChangeLog --- doc/ChangeLog | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/doc/ChangeLog b/doc/ChangeLog index e2d894e242..fdef172382 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -1,7 +1,7 @@ =============================================================== Tag name: ctsm5.1.dev13? Originator(s): @cenlinhe (Cenlin He,UCAR/RAL), slevis (Samuel Levis,UCAR/TSS,303-665-1310) -Date: Fri Aug 11 15:07:55 MDT 2023 +Date: Fri Aug 11 17:09:18 MDT 2023 One-line Summary: SNICAR snow albedo scheme updates Purpose and description of changes @@ -12,12 +12,9 @@ Purpose and description of changes A few substantial changes in the SNICAR module for the following updated snow albedo calculation features: - Updated ice optical properties from Flanner et al. (2021), with multiple types - for ice refractive indices. The updated SNICAR database files are: - /glade/work/cenlinhe/NOAA_CPT_snowAER/CLM_SNICAR_data/snicar_optics_480bnd_c012422.nc - /glade/work/cenlinhe/NOAA_CPT_snowAER/CLM_SNICAR_data/snicar_optics_5bnd_c013122.nc + for ice refractive indices. - Updated aerosol optical properties from Flanner et al. (2021) with multiple - dust types & new BC and OC optics (the updated data are in the new SNICAR - database files shown above). + dust types & new BC and OC optics. - Updated downward solar spectra from Flanner et al. (2021) for multiple condition types. - More accurate radiative transfer solver (adding-doubling) from Dang et al. (2019). @@ -31,7 +28,11 @@ Purpose and description of changes Specific notes - Code contributors: Cenlin He (NCAR/RAL) with advice from Dave Lawrence (NCAR/CGD) and Mark Flanner (UMich). - - The manuscript to report this update is in preparation (He et al, 2022 JAMES in prep) + - The manuscript to report this update is + Cenlin He, Mark Flanner, David M Lawrence, Yu Gu: New features and + enhancements in Community Land Model (CLM5) snow albedo modeling: description, + sensitivity, and evaluation. Authorea. June 08, 2023. + DOI:10.22541/essoar.168626390.01530324/v1 - These updates will change the snow and surface albedo results along with other surface fluxes changes. - There are a few new namelist options related to SNICAR scheme added to the From 1b0f7a25151c3ea95d435a8b989eb9e09b4eccab Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 22 Sep 2023 09:27:49 -0600 Subject: [PATCH 38/62] Rm Defaults from snicar vars in namelist_definition --- bld/namelist_files/namelist_definition_ctsm.xml | 8 -------- 1 file changed, 8 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index ea01092da9..6691d4a1ff 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -153,49 +153,41 @@ of soil column (nlevsoi). number of wavelength bands used in SNICAR snow albedo calculation -Default: 5 type of downward solar radiation spectrum for SNICAR snow albedo calculation -Default: "mid_latitude_winter" dust optics type for SNICAR snow albedo calculation -Default: "sahara" snow grain shape used in SNICAR snow albedo calculation -Default: "hexagonal_plate" Toggle to turn on/off aerosol deposition flux in snow in SNICAR -Default: .true. option to activate BC-snow internal mixing in SNICAR snow albedo calculation -Default: .false. option to activate dust-snow internal mixing in SNICAR snow albedo calculation -Default: .false. option to activate organic carbon (OC) in SNICAR snow albedo calculation -Default: .false. Date: Fri, 22 Sep 2023 09:31:28 -0600 Subject: [PATCH 39/62] Rm one more Default --- bld/namelist_files/namelist_definition_ctsm.xml | 1 - 1 file changed, 1 deletion(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 6691d4a1ff..731c10acfd 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1193,7 +1193,6 @@ DependsOnLatAndVeg - Arctic vegetation depends on latitude as above, but tempera Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) albedo forcing diagnostics for each aerosol species -Default: .false. Date: Mon, 25 Sep 2023 17:23:52 -0600 Subject: [PATCH 40/62] Add licencing info to subr. piecewise_linear_interp1d --- src/biogeophys/SnowSnicarMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 8453a8670d..51347324df 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -2549,6 +2549,8 @@ subroutine piecewise_linear_interp1d(nd, xd, yd, xi, yi) ! piecewise linear interpolation method for 1-dimensional data ! original author: John Burkardt, Florida State University, 09/22/2012 + ! Licencing: Original code distributed under the GNU LGPL license + ! Original code: https://people.sc.fsu.edu/~jburkardt/f77_src/pwl_interp_1d/pwl_interp_1d.f ! Added and modified by Cenlin He (NCAR), 01/27/2022 implicit none From 05ea928e7c5ae29c9a9332707a7fc81a5f2ffb9b Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Mon, 25 Sep 2023 19:06:41 -0600 Subject: [PATCH 41/62] Add readv argument to call ncd_io in SnowSnicarMod (not tested, yet) --- src/biogeophys/SnowSnicarMod.F90 | 1217 ++++++++++++++++++++---------- 1 file changed, 812 insertions(+), 405 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 51347324df..1ef23c8ee6 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1795,6 +1795,7 @@ subroutine SnowOptics_init( ) character(len=256) :: locfn ! local filename character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name integer :: ier ! error status + logical :: readv ! has variable been read in or not ! ! Initialize optical variables @@ -1844,8 +1845,10 @@ subroutine SnowOptics_init( ) ! mid-latitude winter spectrum case ('mid_latitude_winter') ! flux weights/spectrum - call ncd_io( 'flx_wgt_dir5_mlw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif5_mlw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir5_mlw', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif5_mlw', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ! THIS NOTE APPLIES TO ALL THE call ncd_io LINES BELOW WHERE ! bcphob AND ocphob GET ASSIGNED TO VARIABLES SUFFIXED bc1/oc1: @@ -1866,492 +1869,826 @@ subroutine SnowOptics_init( ) ! snow grain). ! ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io( 'ss_alb_bcphob_dif_mlw', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_mlw', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_mlw', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_mlw', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_mlw', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_mlw', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC - call ncd_io( 'ss_alb_bcphob_dif_mlw', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_mlw', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_mlw', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_mlw', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_mlw', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_mlw', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io( 'ss_alb_ocphob_dif_mlw', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_mlw', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_mlw', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_mlw', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC - call ncd_io( 'ss_alb_ocphob_dif_mlw', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_mlw', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_mlw', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_mlw', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ice refractive index (Picard et al., 2016) - call ncd_io( 'ss_alb_ice_pic16_dir_mlw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_mlw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_mlw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_mlw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ice_pic16_dir_mlw', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dir_mlw',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ss_alb_ice_pic16_dif_mlw', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dif_mlw',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust optical properties select case (snicar_dust_optics) case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_sah_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_sah_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_sah_dif_mlw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_sah_dif_mlw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_sah_dif_mlw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_sah_dif_mlw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_sah_dif_mlw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_sah_dif_mlw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_sah_dif_mlw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_sah_dif_mlw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_sah_dif_mlw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_sah_dif_mlw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_sah_dif_mlw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_sah_dif_mlw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_sah_dif_mlw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_sah_dif_mlw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_sah_dif_mlw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_sah_dif_mlw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_sah_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_sah_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_sah_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_sah_dif_mlw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_sah_dif_mlw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_sah_dif_mlw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_col_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_col_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_col_dif_mlw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_col_dif_mlw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_col_dif_mlw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_col_dif_mlw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_col_dif_mlw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_col_dif_mlw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_col_dif_mlw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_col_dif_mlw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_col_dif_mlw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_col_dif_mlw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_col_dif_mlw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_col_dif_mlw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_col_dif_mlw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_col_dif_mlw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_col_dif_mlw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_col_dif_mlw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_col_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_col_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_col_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_col_dif_mlw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_col_dif_mlw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_col_dif_mlw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_gre_dif_mlw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_gre_dif_mlw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_gre_dif_mlw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_gre_dif_mlw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_gre_dif_mlw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_gre_dif_mlw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_gre_dif_mlw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_gre_dif_mlw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_gre_dif_mlw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_gre_dif_mlw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_gre_dif_mlw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_gre_dif_mlw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_gre_dif_mlw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_gre_dif_mlw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_gre_dif_mlw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_gre_dif_mlw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_gre_dif_mlw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_gre_dif_mlw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_gre_dif_mlw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_gre_dif_mlw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_gre_dif_mlw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_gre_dif_mlw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_gre_dif_mlw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_gre_dif_mlw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select ! mid-latitude summer spectrum case ('mid_latitude_summer') ! flux weights/spectrum - call ncd_io( 'flx_wgt_dir5_mls', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif5_mls', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir5_mls', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif5_mls', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io( 'ss_alb_bcphob_dif_mls', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_mls', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_mls', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_mls', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_mls', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_mls', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC - call ncd_io( 'ss_alb_bcphob_dif_mls', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_mls', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_mls', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_mls', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_mls', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_mls', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io( 'ss_alb_ocphob_dif_mls', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_mls', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_mls', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_mls', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC - call ncd_io( 'ss_alb_ocphob_dif_mls', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_mls', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_mls', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_mls', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ice refractive index (Picard et al., 2016) - call ncd_io( 'ss_alb_ice_pic16_dir_mls', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_mls',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_mls', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_mls',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ice_pic16_dir_mls', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dir_mls',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ss_alb_ice_pic16_dif_mls', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dif_mls',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust optical properties select case (snicar_dust_optics) case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_sah_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_sah_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_sah_dif_mls', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_sah_dif_mls', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_sah_dif_mls', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_sah_dif_mls', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_sah_dif_mls', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_sah_dif_mls', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_sah_dif_mls', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_sah_dif_mls', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_sah_dif_mls', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_sah_dif_mls', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_sah_dif_mls', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_sah_dif_mls', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_sah_dif_mls', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_sah_dif_mls', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_sah_dif_mls', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_sah_dif_mls', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_sah_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_sah_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_sah_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_sah_dif_mls', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_sah_dif_mls', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_sah_dif_mls', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_col_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_col_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_col_dif_mls', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_col_dif_mls', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_col_dif_mls', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_col_dif_mls', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_col_dif_mls', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_col_dif_mls', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_col_dif_mls', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_col_dif_mls', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_col_dif_mls', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_col_dif_mls', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_col_dif_mls', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_col_dif_mls', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_col_dif_mls', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_col_dif_mls', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_col_dif_mls', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_col_dif_mls', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_col_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_col_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_col_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_col_dif_mls', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_col_dif_mls', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_col_dif_mls', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_gre_dif_mls', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_gre_dif_mls', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_gre_dif_mls', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_gre_dif_mls', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_gre_dif_mls', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_gre_dif_mls', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_gre_dif_mls', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_gre_dif_mls', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_gre_dif_mls', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_gre_dif_mls', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_gre_dif_mls', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_gre_dif_mls', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_gre_dif_mls', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_gre_dif_mls', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_gre_dif_mls', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_gre_dif_mls', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_gre_dif_mls', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_gre_dif_mls', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_gre_dif_mls', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_gre_dif_mls', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_gre_dif_mls', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_gre_dif_mls', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_gre_dif_mls', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_gre_dif_mls', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select ! sub-Arctic winter spectrum case ('sub_arctic_winter') - call ncd_io( 'flx_wgt_dir5_saw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif5_saw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir5_saw', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif5_saw', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io( 'ss_alb_bcphob_dif_saw', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_saw', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_saw', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_saw', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_saw', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_saw', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC - call ncd_io( 'ss_alb_bcphob_dif_saw', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_saw', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_saw', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_saw', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_saw', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_saw', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io( 'ss_alb_ocphob_dif_saw', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_saw', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_saw', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_saw', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC - call ncd_io( 'ss_alb_ocphob_dif_saw', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_saw', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_saw', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_saw', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ice refractive index (Picard et al., 2016) - call ncd_io( 'ss_alb_ice_pic16_dir_saw', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_saw',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_saw', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_saw',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ice_pic16_dir_saw', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dir_saw',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ss_alb_ice_pic16_dif_saw', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dif_saw',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust optical properties select case (snicar_dust_optics) case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_sah_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_sah_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_sah_dif_saw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_sah_dif_saw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_sah_dif_saw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_sah_dif_saw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_sah_dif_saw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_sah_dif_saw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_sah_dif_saw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_sah_dif_saw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_sah_dif_saw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_sah_dif_saw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_sah_dif_saw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_sah_dif_saw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_sah_dif_saw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_sah_dif_saw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_sah_dif_saw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_sah_dif_saw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_sah_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_sah_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_sah_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_sah_dif_saw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_sah_dif_saw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_sah_dif_saw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_col_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_col_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_col_dif_saw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_col_dif_saw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_col_dif_saw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_col_dif_saw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_col_dif_saw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_col_dif_saw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_col_dif_saw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_col_dif_saw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_col_dif_saw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_col_dif_saw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_col_dif_saw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_col_dif_saw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_col_dif_saw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_col_dif_saw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_col_dif_saw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_col_dif_saw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_col_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_col_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_col_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_col_dif_saw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_col_dif_saw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_col_dif_saw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_gre_dif_saw', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_gre_dif_saw', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_gre_dif_saw', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_gre_dif_saw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_gre_dif_saw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_gre_dif_saw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_gre_dif_saw', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_gre_dif_saw', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_gre_dif_saw', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_gre_dif_saw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_gre_dif_saw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_gre_dif_saw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_gre_dif_saw', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_gre_dif_saw', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_gre_dif_saw', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_gre_dif_saw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_gre_dif_saw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_gre_dif_saw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_gre_dif_saw', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_gre_dif_saw', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_gre_dif_saw', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_gre_dif_saw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_gre_dif_saw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_gre_dif_saw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select ! sub-Arctic summer spectrum case ('sub_arctic_summer') - call ncd_io( 'flx_wgt_dir5_sas', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif5_sas', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir5_sas', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif5_sas', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io( 'ss_alb_bcphob_dif_sas', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_sas', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_sas', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_sas', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_sas', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_sas', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC - call ncd_io( 'ss_alb_bcphob_dif_sas', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_sas', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_sas', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_sas', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_sas', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_sas', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io( 'ss_alb_ocphob_dif_sas', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_sas', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_sas', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_sas', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC - call ncd_io( 'ss_alb_ocphob_dif_sas', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_sas', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_sas', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_sas', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ice refractive index (Picard et al., 2016) - call ncd_io( 'ss_alb_ice_pic16_dir_sas', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_sas',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_sas', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_sas',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ice_pic16_dir_sas', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dir_sas',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ss_alb_ice_pic16_dif_sas', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dif_sas',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust optical properties select case (snicar_dust_optics) case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_sah_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_sah_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_sah_dif_sas', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_sah_dif_sas', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_sah_dif_sas', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_sah_dif_sas', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_sah_dif_sas', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_sah_dif_sas', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_sah_dif_sas', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_sah_dif_sas', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_sah_dif_sas', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_sah_dif_sas', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_sah_dif_sas', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_sah_dif_sas', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_sah_dif_sas', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_sah_dif_sas', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_sah_dif_sas', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_sah_dif_sas', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_sah_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_sah_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_sah_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_sah_dif_sas', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_sah_dif_sas', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_sah_dif_sas', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_col_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_col_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_col_dif_sas', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_col_dif_sas', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_col_dif_sas', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_col_dif_sas', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_col_dif_sas', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_col_dif_sas', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_col_dif_sas', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_col_dif_sas', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_col_dif_sas', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_col_dif_sas', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_col_dif_sas', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_col_dif_sas', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_col_dif_sas', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_col_dif_sas', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_col_dif_sas', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_col_dif_sas', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_col_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_col_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_col_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_col_dif_sas', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_col_dif_sas', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_col_dif_sas', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_gre_dif_sas', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_gre_dif_sas', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_gre_dif_sas', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_gre_dif_sas', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_gre_dif_sas', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_gre_dif_sas', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_gre_dif_sas', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_gre_dif_sas', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_gre_dif_sas', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_gre_dif_sas', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_gre_dif_sas', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_gre_dif_sas', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_gre_dif_sas', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_gre_dif_sas', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_gre_dif_sas', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_gre_dif_sas', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_gre_dif_sas', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_gre_dif_sas', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_gre_dif_sas', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_gre_dif_sas', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_gre_dif_sas', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_gre_dif_sas', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_gre_dif_sas', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_gre_dif_sas', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select ! Summit,Greenland,summer spectrum case ('summit_greenland_summer') - call ncd_io( 'flx_wgt_dir5_smm', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif5_smm', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir5_smm', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif5_smm', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io( 'ss_alb_bcphob_dif_smm', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_smm', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_smm', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_smm', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_smm', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_smm', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC - call ncd_io( 'ss_alb_bcphob_dif_smm', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_smm', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_smm', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_smm', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_smm', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_smm', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io( 'ss_alb_ocphob_dif_smm', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_smm', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_smm', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_smm', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC - call ncd_io( 'ss_alb_ocphob_dif_smm', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_smm', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_smm', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_smm', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ice refractive index (Picard et al., 2016) - call ncd_io( 'ss_alb_ice_pic16_dir_smm', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_smm',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_smm', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_smm',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ice_pic16_dir_smm', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dir_smm',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ss_alb_ice_pic16_dif_smm', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dif_smm',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust optical properties select case (snicar_dust_optics) case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_sah_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_sah_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_sah_dif_smm', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_sah_dif_smm', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_sah_dif_smm', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_sah_dif_smm', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_sah_dif_smm', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_sah_dif_smm', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_sah_dif_smm', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_sah_dif_smm', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_sah_dif_smm', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_sah_dif_smm', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_sah_dif_smm', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_sah_dif_smm', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_sah_dif_smm', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_sah_dif_smm', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_sah_dif_smm', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_sah_dif_smm', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_sah_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_sah_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_sah_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_sah_dif_smm', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_sah_dif_smm', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_sah_dif_smm', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_col_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_col_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_col_dif_smm', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_col_dif_smm', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_col_dif_smm', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_col_dif_smm', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_col_dif_smm', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_col_dif_smm', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_col_dif_smm', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_col_dif_smm', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_col_dif_smm', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_col_dif_smm', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_col_dif_smm', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_col_dif_smm', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_col_dif_smm', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_col_dif_smm', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_col_dif_smm', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_col_dif_smm', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_col_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_col_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_col_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_col_dif_smm', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_col_dif_smm', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_col_dif_smm', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_gre_dif_smm', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_gre_dif_smm', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_gre_dif_smm', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_gre_dif_smm', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_gre_dif_smm', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_gre_dif_smm', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_gre_dif_smm', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_gre_dif_smm', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_gre_dif_smm', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_gre_dif_smm', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_gre_dif_smm', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_gre_dif_smm', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_gre_dif_smm', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_gre_dif_smm', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_gre_dif_smm', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_gre_dif_smm', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_gre_dif_smm', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_gre_dif_smm', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_gre_dif_smm', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_gre_dif_smm', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_gre_dif_smm', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_gre_dif_smm', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_gre_dif_smm', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_gre_dif_smm', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select ! High Mountain summer spectrum case ('high_mountain_summer') - call ncd_io( 'flx_wgt_dir5_hmn', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif5_hmn', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir5_hmn', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif5_hmn', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io( 'ss_alb_bcphob_dif_hmn', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_hmn', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_hmn', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_hmn', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_hmn', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_hmn', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC - call ncd_io( 'ss_alb_bcphob_dif_hmn', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob_dif_hmn', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob_dif_hmn', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob_dif_hmn', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob_dif_hmn', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob_dif_hmn', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io( 'ss_alb_ocphob_dif_hmn', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_hmn', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_hmn', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_hmn', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC - call ncd_io( 'ss_alb_ocphob_dif_hmn', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob_dif_hmn', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob_dif_hmn', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob_dif_hmn', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ice refractive index (Picard et al., 2016) - call ncd_io( 'ss_alb_ice_pic16_dir_hmn', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dir_hmn',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16_dif_hmn', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16_dif_hmn',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ice_pic16_dir_hmn', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dir_hmn',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ss_alb_ice_pic16_dif_hmn', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16_dif_hmn',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust optical properties select case (snicar_dust_optics) case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_sah_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_sah_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_sah_dif_hmn', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_sah_dif_hmn', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_sah_dif_hmn', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_sah_dif_hmn', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_sah_dif_hmn', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_sah_dif_hmn', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_sah_dif_hmn', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_sah_dif_hmn', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_sah_dif_hmn', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_sah_dif_hmn', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_sah_dif_hmn', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_sah_dif_hmn', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_sah_dif_hmn', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_sah_dif_hmn', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_sah_dif_hmn', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_sah_dif_hmn', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_sah_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_sah_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_sah_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_sah_dif_hmn', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_sah_dif_hmn', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_sah_dif_hmn', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_col_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_col_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_col_dif_hmn', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_col_dif_hmn', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_col_dif_hmn', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_col_dif_hmn', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_col_dif_hmn', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_col_dif_hmn', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_col_dif_hmn', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_col_dif_hmn', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_col_dif_hmn', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_col_dif_hmn', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_col_dif_hmn', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_col_dif_hmn', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_col_dif_hmn', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_col_dif_hmn', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_col_dif_hmn', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_col_dif_hmn', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_col_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_col_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_col_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_col_dif_hmn', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_col_dif_hmn', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_col_dif_hmn', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_gre_dif_hmn', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_gre_dif_hmn', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_gre_dif_hmn', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_gre_dif_hmn', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_gre_dif_hmn', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_gre_dif_hmn', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_gre_dif_hmn', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_gre_dif_hmn', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_gre_dif_hmn', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_gre_dif_hmn', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_gre_dif_hmn', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_gre_dif_hmn', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_gre_dif_hmn', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_gre_dif_hmn', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_gre_dif_hmn', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_gre_dif_hmn', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_gre_dif_hmn', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_gre_dif_hmn', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_gre_dif_hmn', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_gre_dif_hmn', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_gre_dif_hmn', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_gre_dif_hmn', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_gre_dif_hmn', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_gre_dif_hmn', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select end select @@ -2359,106 +2696,172 @@ subroutine SnowOptics_init( ) case (480) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io( 'ss_alb_bcphob', ss_alb_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob', asm_prm_bc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC - call ncd_io( 'ss_alb_bcphob', ss_alb_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_bcphob', asm_prm_bc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_bcphob', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_bcphob', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io( 'ss_alb_ocphob', ss_alb_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob', asm_prm_oc1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC - call ncd_io( 'ss_alb_ocphob', ss_alb_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ocphob', asm_prm_oc2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ocphob', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ocphob', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! 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 (Picard et al., 2016) - call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_drc, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_ice_pic16', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust optical properties select case (snicar_dust_optics) case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_sah', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_sah', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_sah', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_sah', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_sah', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_sah', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_sah', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_sah', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_sah', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_sah', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_sah', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_sah', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_sah', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_sah', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_sah', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_sah', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_sah', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_sah', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_sah', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_sah', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_sah', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_sah', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_sah', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_sah', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_col', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_col', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_col', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_col', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_col', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_col', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_col', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_col', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_col', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_col', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_col', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_col', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_col', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_col', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_col', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_col', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_col', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_col', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_col', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_col', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_col', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_col', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_col', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_col', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) ! dust species 1 Mie parameters - call ncd_io( 'ss_alb_dust01_gre', ss_alb_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust01_gre', asm_prm_dst1, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust01_gre', ext_cff_mss_dst1, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust01_gre', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust01_gre', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust01_gre', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 2 Mie parameters - call ncd_io( 'ss_alb_dust02_gre', ss_alb_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust02_gre', asm_prm_dst2, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust02_gre', ext_cff_mss_dst2, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust02_gre', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust02_gre', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust02_gre', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 3 Mie parameters - call ncd_io( 'ss_alb_dust03_gre', ss_alb_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust03_gre', asm_prm_dst3, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust03_gre', ext_cff_mss_dst3, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust03_gre', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust03_gre', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust03_gre', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! dust species 4 Mie parameters - call ncd_io( 'ss_alb_dust04_gre', ss_alb_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'asm_prm_dust04_gre', asm_prm_dst4, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'ext_cff_mss_dust04_gre', ext_cff_mss_dst4, 'read', ncid, posNOTonfile=.true.) + call ncd_io('ss_alb_dust04_gre', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('asm_prm_dust04_gre', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('ext_cff_mss_dust04_gre', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select ! downward solar radiation spectral weights for 480-band select case (snicar_solarspec) case ('mid_latitude_winter') - call ncd_io( 'flx_wgt_dir480_mlw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_mlw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir480_mlw', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif480_mlw', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('mid_latitude_summer') - call ncd_io( 'flx_wgt_dir480_mls', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_mls', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir480_mls', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif480_mls', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('sub_arctic_winter') - call ncd_io( 'flx_wgt_dir480_saw', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_saw', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir480_saw', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif480_saw', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('sub_arctic_summer') - call ncd_io( 'flx_wgt_dir480_sas', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_sas', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir480_sas', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif480_sas', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('summit_greenland_summer') - call ncd_io( 'flx_wgt_dir480_smm', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_smm', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir480_smm', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif480_smm', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) case ('high_mountain_summer') - call ncd_io( 'flx_wgt_dir480_hmn', flx_wgt_dir, 'read', ncid, posNOTonfile=.true.) - call ncd_io( 'flx_wgt_dif480_hmn', flx_wgt_dif, 'read', ncid, posNOTonfile=.true.) + call ncd_io('flx_wgt_dir480_hmn', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('flx_wgt_dif480_hmn', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select end select @@ -2514,6 +2917,7 @@ subroutine SnowAge_init( ) character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name integer :: varid ! netCDF id's integer :: ier ! error status + logical :: readv ! has variable been read in or not ! Open snow aging (effective radius evolution) file: allocate(snowage_tau(idx_rhos_max,idx_Tgrd_max,idx_T_max)) @@ -2527,9 +2931,12 @@ subroutine SnowAge_init( ) ! snow aging parameters - call ncd_io('tau', snowage_tau, 'read', ncid, posNOTonfile=.true.) - call ncd_io('kappa', snowage_kappa, 'read', ncid, posNOTonfile=.true.) - call ncd_io('drdsdt0', snowage_drdt0, 'read', ncid, posNOTonfile=.true.) + call ncd_io('tau', snowage_tau, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('kappa', snowage_kappa, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + call ncd_io('drdsdt0', snowage_drdt0, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) call ncd_pio_closefile(ncid) if (masterproc) then From 8cf2c70f11eaf15d0632a8771b9fff223c0dc874 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 26 Sep 2023 15:47:06 -0600 Subject: [PATCH 42/62] Updates to last commit for test to PASS Tested with ERI_D_Ld9.T31_g37.I2000Clm50Sp.cheyenne_intel.clm-SNICARFRC Ran with this commit's modifications versus without this and the last commits' modifications and got bfb same answers. --- src/biogeophys/SnowSnicarMod.F90 | 1266 ++++++------------------------ 1 file changed, 259 insertions(+), 1007 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 1ef23c8ee6..a18eda4d7f 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1796,6 +1796,10 @@ subroutine SnowOptics_init( ) character(len= 32) :: subname = 'SnowOptics_init' ! subroutine name integer :: ier ! error status logical :: readv ! has variable been read in or not + character(len=100) :: errCode = '-Error reading fsnowoptics file:' + character(len=100) :: tString ! temp. var for reading + character(len=3) :: short_case_dust_opt ! subset of tString + character(len=3) :: short_case_solarspec ! subset of tString ! ! Initialize optical variables @@ -1837,1032 +1841,275 @@ subroutine SnowOptics_init( ) call ncd_pio_openfile(ncid, locfn, 0) if(masterproc) write(iulog,*) subname,trim(fsnowoptics) + select case (snicar_solarspec) + case ('mid_latitude_winter') ! mid-latitude winter spectrum + short_case_solarspec = 'mlw' + case ('mid_latitude_summer') ! mid-latitude summer spectrum + short_case_solarspec = 'mls' + case ('sub_arctic_winter') ! sub-Arctic winter spectrum + short_case_solarspec = 'saw' + case ('sub_arctic_summer') ! sub-Arctic summer spectrum + short_case_solarspec = 'sas' + case ('summit_greenland_summer') ! Summit,Greenland,summer spectrum + short_case_solarspec = 'smm' + case ('high_mountain_summer') ! High Mountain summer spectrum + short_case_solarspec = 'hmn' + end select + + select case (snicar_dust_optics) ! dust optical properties + case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) + short_case_dust_opt = 'sah' + case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) + short_case_dust_opt = 'col' + case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) + short_case_dust_opt = 'gre' + end select + !--------------------- for 5-band data select case (snicar_numrad_snw) case (5) ! 5-band case - select case (snicar_solarspec) - ! mid-latitude winter spectrum - case ('mid_latitude_winter') - ! flux weights/spectrum - call ncd_io('flx_wgt_dir5_mlw', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif5_mlw', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! - ! THIS NOTE APPLIES TO ALL THE call ncd_io LINES BELOW WHERE - ! bcphob AND ocphob GET ASSIGNED TO VARIABLES SUFFIXED bc1/oc1: - ! - ! Assumption (1) applies here, in the input section. - ! Assumption (2) applies later, in the snicar code. - ! - ! 1) In this section, hydrophillic particles behave like hydrophobic - ! particles. We assume bc1/oc1 to have the same optics as bc2/oc2 - ! because sulfate coating on the bc1/oc1 surface is assumed to be - ! dissolved into the hydrometeo (i.e, snow grain here) during the - ! deposition process. This is different from the assumption made in - ! prior model versions, where bc1/oc1 was coated by undissolved - ! sulfate. - ! 2) Later, in the snicar code, if the bc-snow internal mixing option - ! is on, bc1/oc1 (internally mixed within the snow grain) will be - ! treated differently than bc2/oc2 (mixed externally or outside the - ! snow grain). - ! - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io('ss_alb_bcphob_dif_mlw', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_mlw', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_mlw', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 2 Mie parameters, uncoated BC - call ncd_io('ss_alb_bcphob_dif_mlw', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_mlw', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_mlw', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io('ss_alb_ocphob_dif_mlw', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_mlw', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 2 Mie parameters, uncoated OC - call ncd_io('ss_alb_ocphob_dif_mlw', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_mlw', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_mlw', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! ice refractive index (Picard et al., 2016) - call ncd_io('ss_alb_ice_pic16_dir_mlw', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dir_mlw',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dir_mlw', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ss_alb_ice_pic16_dif_mlw', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dif_mlw',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dif_mlw', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust optical properties - select case (snicar_dust_optics) - case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_sah_dif_mlw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_sah_dif_mlw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_sah_dif_mlw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_sah_dif_mlw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_sah_dif_mlw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_sah_dif_mlw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_sah_dif_mlw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_sah_dif_mlw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_sah_dif_mlw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_sah_dif_mlw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_sah_dif_mlw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_sah_dif_mlw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_col_dif_mlw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_col_dif_mlw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_col_dif_mlw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_col_dif_mlw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_col_dif_mlw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_col_dif_mlw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_col_dif_mlw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_col_dif_mlw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_col_dif_mlw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_col_dif_mlw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_col_dif_mlw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_col_dif_mlw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_gre_dif_mlw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_gre_dif_mlw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_gre_dif_mlw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_gre_dif_mlw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_gre_dif_mlw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_gre_dif_mlw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_gre_dif_mlw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_gre_dif_mlw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_gre_dif_mlw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_gre_dif_mlw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_gre_dif_mlw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_gre_dif_mlw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - end select - - ! mid-latitude summer spectrum - case ('mid_latitude_summer') - ! flux weights/spectrum - call ncd_io('flx_wgt_dir5_mls', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif5_mls', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io('ss_alb_bcphob_dif_mls', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_mls', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_mls', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 2 Mie parameters, uncoated BC - call ncd_io('ss_alb_bcphob_dif_mls', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_mls', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_mls', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io('ss_alb_ocphob_dif_mls', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_mls', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 2 Mie parameters, uncoated OC - call ncd_io('ss_alb_ocphob_dif_mls', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_mls', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_mls', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! ice refractive index (Picard et al., 2016) - call ncd_io('ss_alb_ice_pic16_dir_mls', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dir_mls',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dir_mls', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ss_alb_ice_pic16_dif_mls', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dif_mls',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dif_mls', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust optical properties - select case (snicar_dust_optics) - case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_sah_dif_mls', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_sah_dif_mls', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_sah_dif_mls', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_sah_dif_mls', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_sah_dif_mls', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_sah_dif_mls', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_sah_dif_mls', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_sah_dif_mls', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_sah_dif_mls', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_sah_dif_mls', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_sah_dif_mls', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_sah_dif_mls', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_col_dif_mls', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_col_dif_mls', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_col_dif_mls', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_col_dif_mls', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_col_dif_mls', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_col_dif_mls', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_col_dif_mls', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_col_dif_mls', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_col_dif_mls', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_col_dif_mls', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_col_dif_mls', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_col_dif_mls', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_gre_dif_mls', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_gre_dif_mls', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_gre_dif_mls', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_gre_dif_mls', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_gre_dif_mls', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_gre_dif_mls', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_gre_dif_mls', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_gre_dif_mls', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_gre_dif_mls', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_gre_dif_mls', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_gre_dif_mls', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_gre_dif_mls', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - end select - - ! sub-Arctic winter spectrum - case ('sub_arctic_winter') - call ncd_io('flx_wgt_dir5_saw', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif5_saw', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io('ss_alb_bcphob_dif_saw', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_saw', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_saw', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 2 Mie parameters, uncoated BC - call ncd_io('ss_alb_bcphob_dif_saw', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_saw', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_saw', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io('ss_alb_ocphob_dif_saw', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_saw', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 2 Mie parameters, uncoated OC - call ncd_io('ss_alb_ocphob_dif_saw', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_saw', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_saw', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! ice refractive index (Picard et al., 2016) - call ncd_io('ss_alb_ice_pic16_dir_saw', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dir_saw',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dir_saw', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ss_alb_ice_pic16_dif_saw', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dif_saw',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dif_saw', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust optical properties - select case (snicar_dust_optics) - case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_sah_dif_saw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_sah_dif_saw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_sah_dif_saw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_sah_dif_saw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_sah_dif_saw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_sah_dif_saw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_sah_dif_saw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_sah_dif_saw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_sah_dif_saw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_sah_dif_saw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_sah_dif_saw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_sah_dif_saw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_col_dif_saw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_col_dif_saw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_col_dif_saw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_col_dif_saw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_col_dif_saw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_col_dif_saw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_col_dif_saw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_col_dif_saw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_col_dif_saw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_col_dif_saw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_col_dif_saw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_col_dif_saw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_gre_dif_saw', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_gre_dif_saw', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_gre_dif_saw', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_gre_dif_saw', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_gre_dif_saw', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_gre_dif_saw', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_gre_dif_saw', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_gre_dif_saw', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_gre_dif_saw', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_gre_dif_saw', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_gre_dif_saw', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_gre_dif_saw', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - end select - - ! sub-Arctic summer spectrum - case ('sub_arctic_summer') - call ncd_io('flx_wgt_dir5_sas', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif5_sas', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io('ss_alb_bcphob_dif_sas', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_sas', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_sas', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 2 Mie parameters, uncoated BC - call ncd_io('ss_alb_bcphob_dif_sas', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_sas', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_sas', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io('ss_alb_ocphob_dif_sas', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_sas', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 2 Mie parameters, uncoated OC - call ncd_io('ss_alb_ocphob_dif_sas', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_sas', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_sas', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! ice refractive index (Picard et al., 2016) - call ncd_io('ss_alb_ice_pic16_dir_sas', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dir_sas',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dir_sas', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ss_alb_ice_pic16_dif_sas', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dif_sas',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dif_sas', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust optical properties - select case (snicar_dust_optics) - case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_sah_dif_sas', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_sah_dif_sas', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_sah_dif_sas', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_sah_dif_sas', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_sah_dif_sas', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_sah_dif_sas', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_sah_dif_sas', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_sah_dif_sas', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_sah_dif_sas', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_sah_dif_sas', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_sah_dif_sas', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_sah_dif_sas', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_col_dif_sas', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_col_dif_sas', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_col_dif_sas', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_col_dif_sas', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_col_dif_sas', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_col_dif_sas', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_col_dif_sas', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_col_dif_sas', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_col_dif_sas', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_col_dif_sas', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_col_dif_sas', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_col_dif_sas', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_gre_dif_sas', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_gre_dif_sas', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_gre_dif_sas', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_gre_dif_sas', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_gre_dif_sas', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_gre_dif_sas', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_gre_dif_sas', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_gre_dif_sas', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_gre_dif_sas', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_gre_dif_sas', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_gre_dif_sas', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_gre_dif_sas', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - end select - - ! Summit,Greenland,summer spectrum - case ('summit_greenland_summer') - call ncd_io('flx_wgt_dir5_smm', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif5_smm', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io('ss_alb_bcphob_dif_smm', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_smm', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_smm', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 2 Mie parameters, uncoated BC - call ncd_io('ss_alb_bcphob_dif_smm', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_smm', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_smm', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io('ss_alb_ocphob_dif_smm', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_smm', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 2 Mie parameters, uncoated OC - call ncd_io('ss_alb_ocphob_dif_smm', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_smm', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_smm', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! ice refractive index (Picard et al., 2016) - call ncd_io('ss_alb_ice_pic16_dir_smm', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dir_smm',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dir_smm', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ss_alb_ice_pic16_dif_smm', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dif_smm',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dif_smm', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust optical properties - select case (snicar_dust_optics) - case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_sah_dif_smm', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_sah_dif_smm', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_sah_dif_smm', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_sah_dif_smm', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_sah_dif_smm', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_sah_dif_smm', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_sah_dif_smm', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_sah_dif_smm', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_sah_dif_smm', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_sah_dif_smm', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_sah_dif_smm', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_sah_dif_smm', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_col_dif_smm', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_col_dif_smm', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_col_dif_smm', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_col_dif_smm', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_col_dif_smm', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_col_dif_smm', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_col_dif_smm', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_col_dif_smm', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_col_dif_smm', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_col_dif_smm', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_col_dif_smm', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_col_dif_smm', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_gre_dif_smm', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_gre_dif_smm', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_gre_dif_smm', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_gre_dif_smm', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_gre_dif_smm', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_gre_dif_smm', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_gre_dif_smm', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_gre_dif_smm', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_gre_dif_smm', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_gre_dif_smm', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_gre_dif_smm', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_gre_dif_smm', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - end select - - ! High Mountain summer spectrum - case ('high_mountain_summer') - call ncd_io('flx_wgt_dir5_hmn', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif5_hmn', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io('ss_alb_bcphob_dif_hmn', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_hmn', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_hmn', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! BC species 2 Mie parameters, uncoated BC - call ncd_io('ss_alb_bcphob_dif_hmn', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob_dif_hmn', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob_dif_hmn', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io('ss_alb_ocphob_dif_hmn', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_hmn', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 2 Mie parameters, uncoated OC - call ncd_io('ss_alb_ocphob_dif_hmn', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob_dif_hmn', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob_dif_hmn', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! ice refractive index (Picard et al., 2016) - call ncd_io('ss_alb_ice_pic16_dir_hmn', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dir_hmn',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dir_hmn', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ss_alb_ice_pic16_dif_hmn', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16_dif_hmn',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16_dif_hmn', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust optical properties - select case (snicar_dust_optics) - case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_sah_dif_hmn', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_sah_dif_hmn', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_sah_dif_hmn', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_sah_dif_hmn', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_sah_dif_hmn', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_sah_dif_hmn', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_sah_dif_hmn', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_sah_dif_hmn', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_sah_dif_hmn', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_sah_dif_hmn', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_sah_dif_hmn', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_sah_dif_hmn', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_col_dif_hmn', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_col_dif_hmn', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_col_dif_hmn', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_col_dif_hmn', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_col_dif_hmn', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_col_dif_hmn', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_col_dif_hmn', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_col_dif_hmn', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_col_dif_hmn', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_col_dif_hmn', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_col_dif_hmn', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_col_dif_hmn', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_gre_dif_hmn', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_gre_dif_hmn', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_gre_dif_hmn', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_gre_dif_hmn', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_gre_dif_hmn', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_gre_dif_hmn', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_gre_dif_hmn', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_gre_dif_hmn', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_gre_dif_hmn', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_gre_dif_hmn', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_gre_dif_hmn', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_gre_dif_hmn', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - end select - end select + ! flux weights/spectrum + tString = 'flx_wgt_dir5_'//short_case_solarspec + call ncd_io(trim(tString), flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'flx_wgt_dif5_'//short_case_solarspec + call ncd_io(trim(tString), flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! + ! THIS NOTE APPLIES TO ALL THE call ncd_io LINES BELOW WHERE + ! bcphob AND ocphob GET ASSIGNED TO VARIABLES SUFFIXED bc1/oc1: + ! + ! Assumption (1) applies here, in the input section. + ! Assumption (2) applies later, in the snicar code. + ! + ! 1) In this section, hydrophillic particles behave like hydrophobic + ! particles. We assume bc1/oc1 to have the same optics as bc2/oc2 + ! because sulfate coating on the bc1/oc1 surface is assumed to be + ! dissolved into the hydrometeo (i.e, snow grain here) during the + ! deposition process. This is different from the assumption made in + ! prior model versions, where bc1/oc1 was coated by undissolved + ! sulfate. + ! 2) Later, in the snicar code, if the bc-snow internal mixing option + ! is on, bc1/oc1 (internally mixed within the snow grain) will be + ! treated differently than bc2/oc2 (mixed externally or outside the + ! snow grain). + ! + ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + tString = 'ss_alb_bcphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_bcphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_bcphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! BC species 2 Mie parameters, uncoated BC + tString = 'ss_alb_bcphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_bcphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_bcphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + tString = 'ss_alb_ocphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_ocphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_ocphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! OC species 2 Mie parameters, uncoated OC + tString = 'ss_alb_ocphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_ocphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_ocphob_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! ice refractive index (Picard et al., 2016) + tString = 'ss_alb_ice_pic16_dir_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_ice_pic16_dir_'//short_case_solarspec + call ncd_io(trim(tString),asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_ice_pic16_dir_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ss_alb_ice_pic16_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_ice_pic16_dif_'//short_case_solarspec + call ncd_io(trim(tString),asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_ice_pic16_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + + ! dust species 1 Mie parameters + tString = 'ss_alb_dust01_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_dust01_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_dust01_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! dust species 2 Mie parameters + tString = 'ss_alb_dust02_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_dust02_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_dust02_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! dust species 3 Mie parameters + tString = 'ss_alb_dust03_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_dust03_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_dust03_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! dust species 4 Mie parameters + tString = 'ss_alb_dust04_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_dust04_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_dust04_'//short_case_dust_opt//'_dif_'//short_case_solarspec + call ncd_io(trim(tString), ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) !-------------------- for 480-band data case (480) ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing - call ncd_io('ss_alb_bcphob', ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'ss_alb_bcphob' + call ncd_io(trim(tString), ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob', asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'asm_prm_bcphob' + call ncd_io(trim(tString), asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob', ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'ext_cff_mss_bcphob' + call ncd_io(trim(tString), ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC - call ncd_io('ss_alb_bcphob', ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'ss_alb_bcphob' + call ncd_io(trim(tString), ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_bcphob', asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'asm_prm_bcphob' + call ncd_io(trim(tString), asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_bcphob', ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'ext_cff_mss_bcphob' + call ncd_io(trim(tString), ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing - call ncd_io('ss_alb_ocphob', ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'ss_alb_ocphob' + call ncd_io(trim(tString), ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob', asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'asm_prm_ocphob' + call ncd_io(trim(tString), asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob', ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'ext_cff_mss_ocphob' + call ncd_io(trim(tString), ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC - call ncd_io('ss_alb_ocphob', ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ocphob', asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ocphob', ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - - ! 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 (Picard et al., 2016) - call ncd_io('ss_alb_ice_pic16', ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16',asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16', ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ss_alb_ice_pic16', ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_ice_pic16',asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_ice_pic16', ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - - ! dust optical properties - select case (snicar_dust_optics) - case ('sahara') ! Saharan dust (Balkanski et al., 2007, central hematite) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_sah', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_sah', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_sah', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_sah', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_sah', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_sah', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_sah', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_sah', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_sah', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_sah', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_sah', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_sah', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('san_juan_mtns_colorado') ! San Juan Mountains, CO (Skiles et al, 2017) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_col', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_col', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_col', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_col', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_col', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_col', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_col', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_col', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_col', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_col', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_col', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_col', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) - ! dust species 1 Mie parameters - call ncd_io('ss_alb_dust01_gre', ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust01_gre', asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust01_gre', ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 2 Mie parameters - call ncd_io('ss_alb_dust02_gre', ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust02_gre', asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust02_gre', ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 3 Mie parameters - call ncd_io('ss_alb_dust03_gre', ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust03_gre', asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust03_gre', ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! dust species 4 Mie parameters - call ncd_io('ss_alb_dust04_gre', ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('asm_prm_dust04_gre', asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('ext_cff_mss_dust04_gre', ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - end select + tString = 'ss_alb_ocphob' + call ncd_io(trim(tString), ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_ocphob' + call ncd_io(trim(tString), asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_ocphob' + call ncd_io(trim(tString), ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + + ! 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 (Picard et al., 2016) + tString = 'ss_alb_ice_pic16' + call ncd_io(trim(tString), ss_alb_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_ice_pic16' + call ncd_io(trim(tString), asm_prm_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_ice_pic16' + call ncd_io(trim(tString), ext_cff_mss_snw_drc, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ss_alb_ice_pic16' + call ncd_io(trim(tString), ss_alb_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_ice_pic16' + call ncd_io(trim(tString), asm_prm_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_ice_pic16' + call ncd_io(trim(tString), ext_cff_mss_snw_dfs, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + + ! dust optical properties + ! dust species 1 Mie parameters + tString = 'ss_alb_dust01_'//short_case_dust_opt + call ncd_io(trim(tString), ss_alb_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_dust01_'//short_case_dust_opt + call ncd_io(trim(tString), asm_prm_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_dust01_'//short_case_dust_opt + call ncd_io(trim(tString), ext_cff_mss_dst1, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! dust species 2 Mie parameters + tString = 'ss_alb_dust02_'//short_case_dust_opt + call ncd_io(trim(tString), ss_alb_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_dust02_'//short_case_dust_opt + call ncd_io(trim(tString), asm_prm_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_dust02_'//short_case_dust_opt + call ncd_io(trim(tString), ext_cff_mss_dst2, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! dust species 3 Mie parameters + tString = 'ss_alb_dust03_'//short_case_dust_opt + call ncd_io(trim(tString), ss_alb_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_dust03_'//short_case_dust_opt + call ncd_io(trim(tString), asm_prm_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_dust03_'//short_case_dust_opt + call ncd_io(trim(tString), ext_cff_mss_dst3, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + ! dust species 4 Mie parameters + tString = 'ss_alb_dust04_'//short_case_dust_opt + call ncd_io(trim(tString), ss_alb_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'asm_prm_dust04_'//short_case_dust_opt + call ncd_io(trim(tString), asm_prm_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'ext_cff_mss_dust04_'//short_case_dust_opt + call ncd_io(trim(tString), ext_cff_mss_dst4, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! downward solar radiation spectral weights for 480-band - select case (snicar_solarspec) - case ('mid_latitude_winter') - call ncd_io('flx_wgt_dir480_mlw', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif480_mlw', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('mid_latitude_summer') - call ncd_io('flx_wgt_dir480_mls', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif480_mls', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('sub_arctic_winter') - call ncd_io('flx_wgt_dir480_saw', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif480_saw', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('sub_arctic_summer') - call ncd_io('flx_wgt_dir480_sas', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif480_sas', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('summit_greenland_summer') - call ncd_io('flx_wgt_dir480_smm', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif480_smm', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - case ('high_mountain_summer') - call ncd_io('flx_wgt_dir480_hmn', flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('flx_wgt_dif480_hmn', flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) - if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - end select + ! downward solar radiation spectral weights for 480-band + tString = 'flx_wgt_dir480_'//short_case_solarspec + call ncd_io(trim(tString), flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + tString = 'flx_wgt_dif480_'//short_case_solarspec + call ncd_io(trim(tString), flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) + if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) end select @@ -2918,6 +2165,8 @@ subroutine SnowAge_init( ) integer :: varid ! netCDF id's integer :: ier ! error status logical :: readv ! has variable been read in or not + character(len=100) :: errCode = '-Error reading snow aging parameters:' + character(len=100) :: tString ! temp. var for reading ! Open snow aging (effective radius evolution) file: allocate(snowage_tau(idx_rhos_max,idx_Tgrd_max,idx_T_max)) @@ -2931,11 +2180,14 @@ subroutine SnowAge_init( ) ! snow aging parameters - call ncd_io('tau', snowage_tau, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'tau' + call ncd_io(trim(tString), snowage_tau, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('kappa', snowage_kappa, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'kappa' + call ncd_io(trim(tString), snowage_kappa, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - call ncd_io('drdsdt0', snowage_drdt0, 'read', ncid, readv, posNOTonfile=.true.) + tString = 'drdsdt0' + call ncd_io(trim(tString), snowage_drdt0, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) call ncd_pio_closefile(ncid) From ffc8eaeb181b1079a66f7adf6759d8f53028fa8d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 27 Sep 2023 10:54:27 -0600 Subject: [PATCH 43/62] Replace 3600 with secsphr --- src/biogeophys/SnowSnicarMod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index a18eda4d7f..b9028b12a9 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1499,7 +1499,7 @@ subroutine SnowAge_grain(bounds, & ! !USES: use clm_time_manager , only : get_step_size_real, get_nstep use clm_varpar , only : nlevsno - use clm_varcon , only : spval + use clm_varcon, only: spval, secsphr use shr_const_mod , only : SHR_CONST_RHOICE, SHR_CONST_PI ! ! !ARGUMENTS: @@ -1634,7 +1634,7 @@ subroutine SnowAge_grain(bounds, & ! change in snow effective radius, using best-fit parameters dr_fresh = snw_rds(c_idx,i)-snw_rds_min - dr = (bst_drdt0 * (bst_tau / (dr_fresh + bst_tau))**(1._r8 / bst_kappa)) * (dtime / 3600._r8) + dr = (bst_drdt0 * (bst_tau / (dr_fresh + bst_tau))**(1._r8 / bst_kappa)) * (dtime / secsphr) ! !********** 2. WET SNOW AGING *********** From 55ad1990362fa9569c09b988ed3e39b7d6268dd1 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 27 Sep 2023 12:20:29 -0600 Subject: [PATCH 44/62] Replace indices 1, 2 with ivis, inir where appropriate --- src/biogeochem/DryDepVelocity.F90 | 1 - src/biogeophys/SnowSnicarMod.F90 | 38 +++++++++++++++---------------- 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/src/biogeochem/DryDepVelocity.F90 b/src/biogeochem/DryDepVelocity.F90 index f50e218e1b..f5968c9aa8 100644 --- a/src/biogeochem/DryDepVelocity.F90 +++ b/src/biogeochem/DryDepVelocity.F90 @@ -285,7 +285,6 @@ subroutine depvel_compute( bounds, & if ( n_drydep == 0 ) return associate( & - forc_solai => atm2lnd_inst%forc_solai_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (visible only) forc_solad => atm2lnd_inst%forc_solad_grc , & ! Input: [real(r8) (:,:) ] direct beam radiation (visible only) forc_t => atm2lnd_inst%forc_t_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric temperature (Kelvin) forc_q => wateratm2lndbulk_inst%forc_q_downscaled_col , & ! Input: [real(r8) (:) ] downscaled atmospheric specific humidity (kg/kg) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index b9028b12a9..422d65df84 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -217,7 +217,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! spectral snow albedo ! ! !USES: - use clm_varpar , only : nlevsno, numrad + use clm_varpar , only : nlevsno, numrad, ivis, inir use clm_time_manager , only : get_nstep use shr_const_mod , only : SHR_CONST_PI ! @@ -708,8 +708,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! Set spectral underlying surface albedos to their corresponding VIS or NIR albedos - albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,1) - albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,2) + albsfc_lcl(1:(nir_bnd_bgn-1)) = albsfc(c_idx,ivis) + albsfc_lcl(nir_bnd_bgn:nir_bnd_end) = albsfc(c_idx,inir) ! Error check for snow grain size: @@ -1189,11 +1189,11 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! set the underlying ground albedo == albedo of near-IR ! unless bnd_idx < nir_bnd_bgn, for visible - rupdir(snl_btm_itf) = albsfc(c_idx,2) - rupdif(snl_btm_itf) = albsfc(c_idx,2) + rupdir(snl_btm_itf) = albsfc(c_idx,inir) + rupdif(snl_btm_itf) = albsfc(c_idx,inir) if (bnd_idx < nir_bnd_bgn) then - rupdir(snl_btm_itf) = albsfc(c_idx,1) - rupdif(snl_btm_itf) = albsfc(c_idx,1) + rupdir(snl_btm_itf) = albsfc(c_idx,ivis) + rupdif(snl_btm_itf) = albsfc(c_idx,ivis) endif do i=snl_btm,snl_top,-1 @@ -1385,14 +1385,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & select case (snicar_numrad_snw) case (5) ! 5-band case ! VIS band - albout(c_idx,1) = albout_lcl(1) + albout(c_idx,ivis) = albout_lcl(ivis) case (480) ! 480-band case ! average for VIS band flx_sum = 0._r8 do bnd_idx= 1, (nir_bnd_bgn-1) flx_sum = flx_sum + flx_wgt(bnd_idx)*albout_lcl(bnd_idx) end do - albout(c_idx,1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + albout(c_idx,ivis) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) end select ! average for NIR band (5 or 480-band case) @@ -1400,7 +1400,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & do bnd_idx = nir_bnd_bgn, nir_bnd_end flx_sum = flx_sum + flx_wgt(bnd_idx) * albout_lcl(bnd_idx) end do - albout(c_idx,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + albout(c_idx,inir) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately select case (snicar_numrad_snw) @@ -1414,7 +1414,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & do bnd_idx= 1,(nir_bnd_bgn-1) flx_sum = flx_sum + flx_wgt(bnd_idx)*flx_abs_lcl(i,bnd_idx) enddo - flx_abs(c_idx,i,1) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) + flx_abs(c_idx,i,ivis) = flx_sum / sum(flx_wgt(1:(nir_bnd_bgn-1))) end do end select @@ -1424,7 +1424,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & do bnd_idx = nir_bnd_bgn, nir_bnd_end flx_sum = flx_sum + flx_wgt(bnd_idx) * flx_abs_lcl(i,bnd_idx) end do - flx_abs(c_idx,i,2) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + flx_abs(c_idx,i,inir) = flx_sum / sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) end do ! high solar zenith angle adjustment for Adding-doubling solver results @@ -1435,21 +1435,21 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & sza_c1 = sza_a0 + sza_a1 * mu_not + sza_a2 * (mu_not * mu_not) sza_c0 = sza_b0 + sza_b1 * mu_not + sza_b2 * (mu_not * mu_not) sza_factor = sza_c1 * (log10(snw_rds_lcl(snl_top) * c1) - c6) + sza_c0 - flx_sza_adjust = albout(c_idx,2) * (sza_factor-c1) * sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) - albout(c_idx,2) = albout(c_idx,2) * sza_factor - flx_abs(c_idx,snl_top,2) = flx_abs(c_idx,snl_top,2) - flx_sza_adjust + flx_sza_adjust = albout(c_idx,inir) * (sza_factor-c1) * sum(flx_wgt(nir_bnd_bgn:nir_bnd_end)) + albout(c_idx,inir) = albout(c_idx,inir) * sza_factor + flx_abs(c_idx,snl_top,inir) = flx_abs(c_idx,snl_top,inir) - flx_sza_adjust endif ! If snow < minimum_snow, but > 0, and there is sun, set albedo to underlying surface albedo elseif ( (coszen(c_idx) > 0._r8) .and. (h2osno_lcl < min_snw) .and. (h2osno_lcl > 0._r8) ) then - albout(c_idx,1) = albsfc(c_idx,1) - albout(c_idx,2) = albsfc(c_idx,2) + albout(c_idx,ivis) = albsfc(c_idx,ivis) + albout(c_idx,inir) = albsfc(c_idx,inir) ! There is either zero snow, or no sun else - albout(c_idx,1) = 0._r8 - albout(c_idx,2) = 0._r8 + albout(c_idx,ivis) = 0._r8 + albout(c_idx,inir) = 0._r8 endif ! if column has snow and coszen > 0 enddo ! loop over all columns From 33c8524a3beb80e7fad859bbca64c2531a24441b Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 27 Sep 2023 12:30:44 -0600 Subject: [PATCH 45/62] Replace 1e5 with enh_omg_max parameter --- src/biogeophys/SnowSnicarMod.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 422d65df84..5ee0301aa8 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -516,6 +516,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8) :: tot_dst_snw_conc ! total dust content in snow across all size bins (ppm=ug/g) integer :: idb ! loop index + real(r8), parameter :: enh_omg_max = 1.e5_r8 ! reasonable maximum value for enh_omg_[bc,dst]int_intp2 + !----------------------------------------------------------------------- ! Enforce expected array sizes @@ -971,7 +973,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & call piecewise_linear_interp1d(16,bcint_wvl_ct,enh_omg_bcint_tmp2,wvl_doint,enh_omg_bcint_intp) ! update snow single-scattering albedo enh_omg_bcint_intp2 = 10._r8 ** enh_omg_bcint_intp - enh_omg_bcint_intp2 = min(1.0E5_r8, max(enh_omg_bcint_intp2,1._r8)) ! constrain enhancement to a reasonable range + enh_omg_bcint_intp2 = min(enh_omg_max, max(enh_omg_bcint_intp2, 1._r8)) ! constrain enhancement to a reasonable range ss_alb_snw_lcl(i) = 1._r8 - (1._r8 - ss_alb_snw_lcl(i)) * enh_omg_bcint_intp2 ss_alb_snw_lcl(i) = max(0.5_r8, min(ss_alb_snw_lcl(i),1._r8)) ! reset hydrophilic BC property to 0 since it is accounted by updated snow ss_alb above @@ -998,7 +1000,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & call piecewise_linear_interp1d(6,dstint_wvl_ct,enh_omg_dstint_tmp2,wvl_doint,enh_omg_dstint_intp) ! update snow single-scattering albedo enh_omg_dstint_intp2 = 10._r8 ** enh_omg_dstint_intp - enh_omg_dstint_intp2 = min(1.0E5_r8, max(enh_omg_dstint_intp2,1._r8)) ! constrain enhancement to a reasonable range + enh_omg_dstint_intp2 = min(enh_omg_max, max(enh_omg_dstint_intp2, 1._r8)) ! constrain enhancement to a reasonable range ss_alb_snw_lcl(i) = 1._r8 - (1._r8 - ss_alb_snw_lcl(i)) * enh_omg_dstint_intp2 ss_alb_snw_lcl(i) = max(0.5_r8, min(ss_alb_snw_lcl(i),1._r8)) ! reset all dust optics to zero since it is accounted by updated snow ss_alb above From eb103359008bca492d856299ab123c6f7e2a2060 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 27 Sep 2023 16:43:44 -0600 Subject: [PATCH 46/62] Replace hardwired numbers with parameters and other clean-up --- src/biogeophys/SnowSnicarMod.F90 | 72 ++++++++++++++++---------------- 1 file changed, 37 insertions(+), 35 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 5ee0301aa8..f874263e0d 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -487,8 +487,12 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8) :: bcint_d0(1:16) ! Parameterization coefficients at each band center wavelength real(r8) :: bcint_d1(1:16) ! Parameterization coefficients at each band center wavelength real(r8) :: bcint_d2(1:16) ! Parameterization coefficients at each band center wavelength - real(r8) :: den_bc = 1.49_r8 ! target BC particle density (g/cm3) used in BC MAC adjustment - real(r8) :: Re_bc = 0.045 ! target BC effective radius (um) used in BC MAC adjustment + real(r8), parameter :: kg_to_ug = 1.e9_r8 ! unit conversion of kg to micrograms + real(r8), parameter :: den_bc = 1.7_r8 ! BC particle density (g/cm3) + real(r8), parameter :: den_bc_target = 1.49_r8 ! target BC particle density (g/cm3) used in BC MAC adjustment + real(r8), parameter :: Re_bc = 0.045_r8 ! target BC effective radius (um) used in BC MAC adjustment + real(r8), parameter :: radius_1 = 0.1_r8 ! used with Re_bc (um) + real(r8), parameter :: radius_2 = 0.05_r8 ! used with Re_bc (um) real(r8) :: bcint_m(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix real(r8) :: bcint_n(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix real(r8) :: bcint_m_tmp ! temporary of bcint_m @@ -884,7 +888,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & 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_r8) asm_prm_snw_lcl(i) = 0.99_r8 !avoid unreasonable values (rarely occur in large-size spheroid cases) + asm_prm_snw_lcl(i) = min(0.99_r8, asm_prm_snw_lcl(i)) !avoid unreasonable values (rarely occur in large-size spheroid cases) enddo ! snow layer loop @@ -892,66 +896,64 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) asm_prm_aer_lcl(2) = asm_prm_bc2(bnd_idx) ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc2(bnd_idx) - ! aerosol species 3 optical properties, hydrophilic OC ss_alb_aer_lcl(3) = ss_alb_oc1(bnd_idx) asm_prm_aer_lcl(3) = asm_prm_oc1(bnd_idx) ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc1(bnd_idx) - ! aerosol species 4 optical properties, hydrophobic OC ss_alb_aer_lcl(4) = ss_alb_oc2(bnd_idx) asm_prm_aer_lcl(4) = asm_prm_oc2(bnd_idx) ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) + ! Optics for BC/dust-snow external mixing: + ! aerosol species 1 optical properties, hydrophilic BC + ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) + asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) + ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) + ! aerosol species 5 optical properties, dust size1 + ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) + asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) + ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) + ! aerosol species 6 optical properties, dust size2 + ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) + asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) + ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) + ! aerosol species 7 optical properties, dust size3 + ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) + asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) + ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) + ! aerosol species 8 optical properties, dust size4 + ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) + asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) + ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) + ! 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) + wvl_doint = wvl_ct(bnd_idx) + ! Weighted Mie parameters of each layer do i=snl_top,snl_btm,1 - ! Optics for BC/dust-snow external mixing: - ! aerosol species 1 optical properties, hydrophilic BC - ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) - asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) - ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) - ! aerosol species 5 optical properties, dust size1 - ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) - asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) - ext_cff_mss_aer_lcl(5) = ext_cff_mss_dst1(bnd_idx) - ! aerosol species 6 optical properties, dust size2 - ss_alb_aer_lcl(6) = ss_alb_dst2(bnd_idx) - asm_prm_aer_lcl(6) = asm_prm_dst2(bnd_idx) - ext_cff_mss_aer_lcl(6) = ext_cff_mss_dst2(bnd_idx) - ! aerosol species 7 optical properties, dust size3 - ss_alb_aer_lcl(7) = ss_alb_dst3(bnd_idx) - asm_prm_aer_lcl(7) = asm_prm_dst3(bnd_idx) - ext_cff_mss_aer_lcl(7) = ext_cff_mss_dst3(bnd_idx) - ! aerosol species 8 optical properties, dust size4 - ss_alb_aer_lcl(8) = ss_alb_dst4(bnd_idx) - asm_prm_aer_lcl(8) = asm_prm_dst4(bnd_idx) - ext_cff_mss_aer_lcl(8) = ext_cff_mss_dst4(bnd_idx) - ! Start BC/dust-snow internal mixing for wavelength<=1.2um - wvl_doint = wvl_ct(bnd_idx) - if (wvl_doint <= 1.2_r8) then ! BC-snow internal mixing applied to hydrophilic BC if activated ! BC-snow internal mixing primarily affect snow single-scattering albedo if ( snicar_snobc_intmix .and. (mss_cnc_aer_lcl(i,1) > 0._r8) ) 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. + ! MAC=6.81 m2/g (@550 nm) & BC density=1.7g/cm3 (den_bc). ! 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). + ! (2) We tune BC density from 1.7 to 1.49 g/cm3 (den_bc_target) (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_r8*1.7_r8/den_bc + bcint_d2(ibb)) **bcint_d1(ibb) ) + ( (mss_cnc_aer_lcl(i,1) * kg_to_ug * den_bc / den_bc_target + 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_m_tmp = bcint_m(1) @@ -963,9 +965,9 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & bcint_m_tmp = bcint_m(3) bcint_n_tmp = bcint_n(3) endif - bcint_dd = (Re_bc * 20.0_r8)**bcint_m_tmp - bcint_dd2 = (0.1_r8 * 20.0_r8)**bcint_m_tmp - bcint_f = (Re_bc * 10.0_r8)**bcint_n_tmp + bcint_dd = (Re_bc / radius_2)**bcint_m_tmp + bcint_dd2 = (radius_1 / radius_2)**bcint_m_tmp + bcint_f = (Re_bc / radius_1)**bcint_n_tmp enh_omg_bcint_tmp2(ibb)=LOG10(max(1._r8,bcint_dd*((enh_omg_bcint_tmp(ibb)/bcint_dd2)**bcint_f))) enddo From 3f0fe626013eefcb206d684b42990dcf3bd0cbde Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Wed, 27 Sep 2023 18:07:11 -0600 Subject: [PATCH 47/62] Changed many constants to parameters and other minor clean-up --- src/biogeophys/SnowSnicarMod.F90 | 119 ++++++++++++++++--------------- 1 file changed, 60 insertions(+), 59 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index f874263e0d..5c879b6f0c 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -404,32 +404,42 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8):: smr ! accumulator for rdif gaussian integration real(r8):: smt ! accumulator for tdif gaussian integration real(r8):: exp_min ! minimum exponential value - real(r8), allocatable :: difgauspt(:) ! Gaussian integration angle - real(r8), allocatable :: difgauswt(:) ! Gaussian integration coefficients/weights - integer :: ng ! gaussian integration index - integer :: ngmax = 8 ! max gaussian integration index + + integer :: ng ! gaussian integration index + integer, parameter :: ngmax = 8 ! max gaussian integration index + real(r8), parameter :: difgauspt(ngmax) = & ! Gaussian integration angles (radians) + (/ 0.9894009_r8, 0.9445750_r8, & + 0.8656312_r8, 0.7554044_r8, & + 0.6178762_r8, 0.4580168_r8, & + 0.2816036_r8, 0.0950125_r8/) + real(r8), parameter :: difgauswt(ngmax) = & ! Gaussian integration coefficients/weights + (/ 0.0271525_r8, 0.0622535_r8, & + 0.0951585_r8, 0.1246290_r8, & + 0.1495960_r8, 0.1691565_r8, & + 0.1826034_r8, 0.1894506_r8/) + integer :: snl_btm_itf ! index of bottom snow layer interfaces (1) [idx] ! constants used in algorithm - real(r8):: c0 = 0.0_r8 - real(r8):: c1 = 1.0_r8 - real(r8):: c3 = 3.0_r8 - real(r8):: c4 = 4.0_r8 - real(r8):: c6 = 6.0_r8 - real(r8):: cp01 = 0.01_r8 - real(r8):: cp5 = 0.5_r8 - real(r8):: cp75 = 0.75_r8 - real(r8):: c1p5 = 1.5_r8 - real(r8):: trmin = 0.001_r8 - real(r8):: argmax = 10.0_r8 ! maximum argument of exponential - ! cconstant and coefficients used for SZA parameterization - real(r8):: sza_a0 = 0.085730_r8 - real(r8):: sza_a1 = -0.630883_r8 - real(r8):: sza_a2 = 1.303723_r8 - real(r8):: sza_b0 = 1.467291_r8 - real(r8):: sza_b1 = -3.338043_r8 - real(r8):: sza_b2 = 6.807489_r8 - real(r8):: puny = 1.0e-11_r8 - real(r8):: mu_75 = 0.2588_r8 ! cosine of 75 degree + real(r8), parameter :: c0 = 0.0_r8 + real(r8), parameter :: c1 = 1.0_r8 + real(r8), parameter :: c3 = 3.0_r8 + real(r8), parameter :: c4 = 4.0_r8 + real(r8), parameter :: c6 = 6.0_r8 + real(r8), parameter :: cp01 = 0.01_r8 + real(r8), parameter :: cp5 = 0.5_r8 + real(r8), parameter :: cp75 = 0.75_r8 + real(r8), parameter :: c1p5 = 1.5_r8 + real(r8), parameter :: trmin = 0.001_r8 + real(r8), parameter :: argmax = 10.0_r8 ! maximum argument of exponential + ! constants and coefficients used for SZA parameterization + real(r8), parameter :: sza_a0 = 0.085730_r8 + real(r8), parameter :: sza_a1 = -0.630883_r8 + real(r8), parameter :: sza_a2 = 1.303723_r8 + real(r8), parameter :: sza_b0 = 1.467291_r8 + real(r8), parameter :: sza_b1 = -3.338043_r8 + real(r8), parameter :: sza_b2 = 6.807489_r8 + real(r8), parameter :: puny = 1.0e-11_r8 + real(r8), parameter :: mu_75 = 0.2588_r8 ! cosine of 75 degree real(r8):: sza_c1 ! coefficient, SZA parameteirzation real(r8):: sza_c0 ! coefficient, SZA parameterization real(r8):: sza_factor ! factor used to adjust NIR direct albedo @@ -466,10 +476,15 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8), allocatable :: wvl_ct(:) ! band center wavelength (um) for 5 or 480-band case real(r8) :: diam_ice ! effective snow grain diameter (SSA-equivalent) unit: microns real(r8) :: fs_sphd ! shape factor for spheroid snow + real(r8), parameter :: fs_sphd_default = 0.929_r8 ! default; He et al. (2017), Table 1 real(r8) :: fs_hex ! shape factor for reference hexagonal snow real(r8) :: fs_hex0 ! shape factor for hexagonal plate + real(r8), parameter :: fs_hex_ref = 0.788_r8 ! reference shape factor real(r8) :: fs_koch ! shape factor for Koch snowflake + real(r8), parameter :: fs_koch_default = 0.712_r8 ! default; He et al. (2017), Table 1 real(r8) :: AR_tmp ! aspect ratio temporary + real(r8), parameter :: AR_tmp_default_1 = 0.5_r8 ! default; He et al. (2017), Table 1 + real(r8), parameter :: AR_tmp_default_2 = 2.5_r8 ! default; He et al. (2017), Table 1 real(r8) :: g_ice_Cg_tmp(1:7) ! temporary asymmetry factor correction coeff real(r8) :: gg_ice_F07_tmp(1:7) ! temporary asymmetry factor related to geometric reflection & refraction real(r8) :: g_Cg_intp ! interpolated asymmetry factor correction coeff to target bands @@ -549,20 +564,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & end select nir_bnd_end = snicar_numrad_snw - ! initialize for adding-doubling solver - allocate(difgauspt(ngmax)) - allocate(difgauswt(ngmax)) - difgauspt(:) = & ! gaussian angles (radians) - (/ 0.9894009_r8, 0.9445750_r8, & - 0.8656312_r8, 0.7554044_r8, & - 0.6178762_r8, 0.4580168_r8, & - 0.2816036_r8, 0.0950125_r8/) - difgauswt(:) = & ! gaussian weights - (/ 0.0271525_r8, 0.0622535_r8, & - 0.0951585_r8, 0.1246290_r8, & - 0.1495960_r8, 0.1691565_r8, & - 0.1826034_r8, 0.1894506_r8/) - ! initialize for nonspherical snow grains sno_shp(:) = snicar_snw_shape ! currently only assuming same shapes for all snow layers sno_fs(:) = 0._r8 @@ -824,13 +825,13 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & case ('spheroid') diam_ice = 2._r8 * snw_rds_lcl(i) ! unit: microns if (sno_fs(i) == 0._r8) then - fs_sphd = 0.929_r8 ! default; He et al. (2017), Table 1 + fs_sphd = fs_sphd_default ! default; He et al. (2017), Table 1 else fs_sphd = sno_fs(i) ! user specified value endif - fs_hex = 0.788_r8 ! reference shape factor + fs_hex = fs_hex_ref ! reference shape factor if (sno_AR(i) == 0._r8) then - AR_tmp = 0.5_r8 ! default; He et al. (2017), Table 1 + AR_tmp = AR_tmp_default_1 ! default; He et al. (2017), Table 1 else AR_tmp = sno_AR(i) ! user specified value endif @@ -842,13 +843,13 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & case ('hexagonal_plate') diam_ice = 2._r8 * snw_rds_lcl(i) ! unit: microns if (sno_fs(i) == 0._r8) then - fs_hex0 = 0.788_r8 ! default; He et al. (2017), Table 1 + fs_hex0 = fs_hex_ref ! default; He et al. (2017), Table 1 else fs_hex0 = sno_fs(i) ! user specified value endif - fs_hex = 0.788_r8 ! reference shape factor + fs_hex = fs_hex_ref ! reference shape factor if (sno_AR(i) == 0._r8) then - AR_tmp = 2.5_r8 ! default; He et al. (2017), Table 1 + AR_tmp = AR_tmp_default_2 ! default; He et al. (2017), Table 1 else AR_tmp = sno_AR(i) ! user specified value endif @@ -860,13 +861,13 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & case ('koch_snowflake') diam_ice = 2._r8 * snw_rds_lcl(i) / 0.544_r8 ! unit: microns if (sno_fs(i) == 0._r8) then - fs_koch = 0.712_r8 ! default; He et al. (2017), Table 1 + fs_koch = fs_koch_default ! default; He et al. (2017), Table 1 else fs_koch = sno_fs(i) ! user specified value endif - fs_hex = 0.788_r8 ! reference shape factor + fs_hex = fs_hex_ref ! reference shape factor if (sno_AR(i) == 0._r8) then - AR_tmp = 2.5_r8 ! default; He et al. (2017), Table 1 + AR_tmp = AR_tmp_default_2 ! default; He et al. (2017), Table 1 else AR_tmp = sno_AR(i) ! user specified value endif @@ -893,23 +894,23 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & enddo ! snow layer loop ! aerosol species 2 optical properties, hydrophobic BC - ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) - asm_prm_aer_lcl(2) = asm_prm_bc2(bnd_idx) - ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc2(bnd_idx) + ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) + asm_prm_aer_lcl(2) = asm_prm_bc2(bnd_idx) + ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc2(bnd_idx) ! aerosol species 3 optical properties, hydrophilic OC - ss_alb_aer_lcl(3) = ss_alb_oc1(bnd_idx) - asm_prm_aer_lcl(3) = asm_prm_oc1(bnd_idx) - ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc1(bnd_idx) + ss_alb_aer_lcl(3) = ss_alb_oc1(bnd_idx) + asm_prm_aer_lcl(3) = asm_prm_oc1(bnd_idx) + ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc1(bnd_idx) ! aerosol species 4 optical properties, hydrophobic OC - ss_alb_aer_lcl(4) = ss_alb_oc2(bnd_idx) - asm_prm_aer_lcl(4) = asm_prm_oc2(bnd_idx) - ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) + ss_alb_aer_lcl(4) = ss_alb_oc2(bnd_idx) + asm_prm_aer_lcl(4) = asm_prm_oc2(bnd_idx) + ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) ! Optics for BC/dust-snow external mixing: ! aerosol species 1 optical properties, hydrophilic BC - ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) - asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) - ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) + ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) + asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) + ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) ! aerosol species 5 optical properties, dust size1 ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) From 00493ef50d3dd6dc1d971eb5eb3ce9d1edce5617 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 28 Sep 2023 17:36:55 -0600 Subject: [PATCH 48/62] Change some arrays to parameters --- src/biogeophys/SnowSnicarMod.F90 | 72 ++++++++++++++++---------------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 5c879b6f0c..9ebb976d53 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -460,18 +460,39 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! others(0.11.2um, no BC-snow int mixing effect) @@ -883,8 +883,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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 - call piecewise_linear_interp1d(7, g_wvl_ct, g_ice_Cg_tmp, wvl_ct(bnd_idx), g_Cg_intp) - call piecewise_linear_interp1d(7, g_wvl_ct, gg_ice_F07_tmp, wvl_ct(bnd_idx), gg_F07_intp) + call piecewise_linear_interp1d(ngmax-1, g_wvl_ct, g_ice_Cg_tmp, wvl_ct(bnd_idx), g_Cg_intp) + call piecewise_linear_interp1d(ngmax-1, g_wvl_ct, gg_ice_F07_tmp, wvl_ct(bnd_idx), gg_F07_intp) g_ice_F07 = gg_F07_intp + 0.5_r8 * (1._r8 - gg_F07_intp) / ss_alb_snw_lcl(i) ! Eq.2.2 in Fu (2007) asm_prm_snw_lcl(i) = g_ice_F07 * g_Cg_intp ! Eq.6, He et al. (2017) endif From ed2a177593c1b74f883834f63424a45d1b1cd919 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 29 Sep 2023 12:28:27 -0600 Subject: [PATCH 49/62] Change more arrays to parameters --- src/biogeophys/SnowSnicarMod.F90 | 142 ++++++++++++++++--------------- 1 file changed, 74 insertions(+), 68 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 9ebb976d53..60f9bc7d9f 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -52,11 +52,11 @@ module SnowSnicarMod ! !PRIVATE DATA MEMBERS: integer, parameter :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx] - integer, parameter :: idx_T_max = 11 ! maxiumum temperature index used in aging lookup table [idx] + integer, parameter :: idx_T_max = 11 ! maximum temperature index used in aging lookup table [idx] integer, parameter :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx] - integer, parameter :: idx_Tgrd_max = 31 ! maxiumum temperature gradient index used in aging lookup table [idx] + integer, parameter :: idx_Tgrd_max = 31 ! maximum temperature gradient index used in aging lookup table [idx] integer, parameter :: idx_Tgrd_min = 1 ! minimum temperature gradient index used in aging lookup table [idx] - integer, parameter :: idx_rhos_max = 8 ! maxiumum snow density index used in aging lookup table [idx] + integer, parameter :: idx_rhos_max = 8 ! maximum snow density index used in aging lookup table [idx] integer, parameter :: idx_rhos_min = 1 ! minimum snow density index used in aging lookup table [idx] integer, parameter :: snw_rds_max_tbl = 1500 ! maximum effective radius defined in Mie lookup table [microns] @@ -460,36 +460,37 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! others(0.11.2um, no BC-snow int mixing effect) + real(r8), parameter :: bcint_wvl(sixteen_bands+1) = & ! Parameterization band (0.2-1.2um) for BC-induced enhancement in snow 1-omega + (/ 0.20_r8, 0.25_r8, 0.30_r8, 0.33_r8, 0.36_r8, 0.40_r8, 0.44_r8, 0.48_r8, & + 0.52_r8, 0.57_r8, 0.64_r8, 0.69_r8, 0.75_r8, 0.78_r8, 0.87_r8, 1._r8, 1.2_r8 /) + real(r8), parameter :: bcint_d0(sixteen_bands) = & ! Parameterization coefficients at each band center wavelength + (/ 2.48045_r8 , 4.70305_r8 , 4.68619_r8 , 4.67369_r8 , 4.65040_r8 , & + 2.40364_r8 , 7.95408E-1_r8, 2.92745E-1_r8, 8.63396E-2_r8, 2.76299E-2_r8, & + 1.40864E-2_r8, 8.65705E-3_r8, 6.12971E-3_r8, 4.45697E-3_r8, 3.06648E-2_r8, & + 7.96544E-1_r8 /) + real(r8), parameter :: bcint_d1(sixteen_bands) = & ! Parameterization coefficients at each band center wavelength + (/ 9.77209E-1_r8, 9.73317E-1_r8, 9.79650E-1_r8, 9.84579E-1_r8, 9.93537E-1_r8, & + 9.95955E-1_r8, 9.95218E-1_r8, 9.74284E-1_r8, 9.81193E-1_r8, 9.81239E-1_r8, & + 9.55515E-1_r8, 9.10491E-1_r8, 8.74196E-1_r8, 8.27238E-1_r8, 4.82870E-1_r8, & + 4.36649E-2_r8 /) + real(r8), parameter :: bcint_d2(sixteen_bands) = & ! Parameterization coefficients at each band center wavelength + (/ 3.95960E-1_r8, 2.04820E-1_r8, 2.07410E-1_r8, 2.09390E-1_r8, 2.13030E-1_r8, & + 4.18570E-1_r8, 1.29682_r8 , 3.75514_r8 , 1.27372E+1_r8, 3.93293E+1_r8, & + 8.78918E+1_r8, 1.86969E+2_r8, 3.45600E+2_r8, 7.08637E+2_r8, 1.41067E+3_r8, & + 2.57288E+2_r8 /) real(r8), parameter :: den_bc = 1.7_r8 ! BC particle density (g/cm3) real(r8), parameter :: den_bc_target = 1.49_r8 ! target BC particle density (g/cm3) used in BC MAC adjustment real(r8), parameter :: Re_bc = 0.045_r8 ! target BC effective radius (um) used in BC MAC adjustment @@ -544,13 +561,21 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & !----------------------------------------------------------------------- ! variables used for dust-snow internal mixing (He et al. 2019 JAMES): real(r8) :: enh_omg_dstint ! dust-induced enhancement in snow single-scattering co-albedo (1-omega) - real(r8) :: enh_omg_dstint_tmp(1:6) ! temporary dust-induced enhancement in snow 1-omega - real(r8) :: enh_omg_dstint_tmp2(1:6) ! temporary dust-induced enhancement in snow 1-omega - real(r8) :: dstint_wvl(1:7) ! Parameterization band (0.2-1.2um) for dust-induced enhancement in snow 1-omega - real(r8) :: dstint_wvl_ct(1:6) ! Parameterization band center wavelength (um) - real(r8) :: dstint_a1(1:6) ! Parameterization coefficients at each band center wavelength - real(r8) :: dstint_a2(1:6) ! Parameterization coefficients at each band center wavelength - real(r8) :: dstint_a3(1:6) ! Parameterization coefficients at each band center wavelength + integer, parameter :: size_bins = 6 + real(r8) :: enh_omg_dstint_tmp(size_bins) ! temporary dust-induced enhancement in snow 1-omega + real(r8) :: enh_omg_dstint_tmp2(size_bins) ! temporary dust-induced enhancement in snow 1-omega + real(r8) :: dstint_wvl_ct(size_bins) ! Parameterization band center wavelength (um) + ! 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) + real(r8), parameter :: dstint_wvl(size_bins+1) = & ! Parameterization band (0.2-1.2um) for dust-induced enhancement in snow 1-omega + (/ 0.2_r8, 0.2632_r8, 0.3448_r8, 0.4415_r8, 0.625_r8, 0.7782_r8, 1.2422_r8/) + real(r8), parameter :: dstint_a1(size_bins) = & ! Parameterization coefficients at each band center wavelength + (/ -2.1307E+1_r8, -1.5815E+1_r8, -9.2880_r8 , 1.1115_r8 , 1.0307_r8 , 1.0185_r8 /) + real(r8), parameter :: dstint_a2(size_bins) = & ! Parameterization coefficients at each band center wavelength + (/ 1.1746E+2_r8, 9.3241E+1_r8, 4.0605E+1_r8, 3.7389E-1_r8, 1.4800E-2_r8, 2.8921E-4_r8 /) + real(r8), parameter :: dstint_a3(size_bins) = & ! Parameterization coefficients at each band center wavelength + (/ 9.9701E-1_r8, 9.9781E-1_r8, 9.9848E-1_r8, 1.0035_r8 , 1.0024_r8 , 1.0356_r8 /) + real(r8) :: enh_omg_dstint_intp ! dust-induced enhancement in snow 1-omega (logscale) interpolated to CLM wavelength real(r8) :: enh_omg_dstint_intp2 ! dust-induced enhancement in snow 1-omega interpolated to CLM wavelength real(r8) :: tot_dst_snw_conc ! total dust content in snow across all size bins (ppm=ug/g) @@ -558,6 +583,10 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8), parameter :: enh_omg_max = 1.e5_r8 ! reasonable maximum value for enh_omg_[bc,dst]int_intp2 + ! unit conversions + real(r8), parameter :: kg_kg_to_ppm = 1.e6_r8 ! kg/kg to ppm + real(r8), parameter :: kg_to_ug = 1.e9_r8 ! kg to micrograms + !----------------------------------------------------------------------- ! Enforce expected array sizes @@ -590,37 +619,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & sno_fs(:) = 0._r8 sno_AR(:) = 0._r8 - g_wvl_ct(1:ngmax-1) = g_wvl(2:ngmax) * 0.5_r8 + g_wvl(1:ngmax-1) * 0.5_r8 - - ! 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_r8, 0.25_r8, 0.30_r8, 0.33_r8, 0.36_r8, 0.40_r8, 0.44_r8, 0.48_r8, & - 0.52_r8, 0.57_r8, 0.64_r8, 0.69_r8, 0.75_r8, 0.78_r8, 0.87_r8, 1._r8, 1.2_r8 /) - bcint_wvl_ct(1:16) = bcint_wvl(2:17) * 0.5_r8 + bcint_wvl(1:16) * 0.5_r8 - bcint_d0(1:16) = (/ 2.48045_r8 , 4.70305_r8 , 4.68619_r8 , 4.67369_r8 , 4.65040_r8 , & - 2.40364_r8 , 7.95408E-1_r8, 2.92745E-1_r8, 8.63396E-2_r8, 2.76299E-2_r8, & - 1.40864E-2_r8, 8.65705E-3_r8, 6.12971E-3_r8, 4.45697E-3_r8, 3.06648E-2_r8, & - 7.96544E-1_r8 /) - bcint_d1(1:16) = (/ 9.77209E-1_r8, 9.73317E-1_r8, 9.79650E-1_r8, 9.84579E-1_r8, 9.93537E-1_r8, & - 9.95955E-1_r8, 9.95218E-1_r8, 9.74284E-1_r8, 9.81193E-1_r8, 9.81239E-1_r8, & - 9.55515E-1_r8, 9.10491E-1_r8, 8.74196E-1_r8, 8.27238E-1_r8, 4.82870E-1_r8, & - 4.36649E-2_r8 /) - bcint_d2(1:16) = (/ 3.95960E-1_r8, 2.04820E-1_r8, 2.07410E-1_r8, 2.09390E-1_r8, 2.13030E-1_r8, & - 4.18570E-1_r8, 1.29682_r8 , 3.75514_r8 , 1.27372E+1_r8, 3.93293E+1_r8, & - 8.78918E+1_r8, 1.86969E+2_r8, 3.45600E+2_r8, 7.08637E+2_r8, 1.41067E+3_r8, & - 2.57288E+2_r8 /) + g_wvl_ct(1:seven_bands) = g_wvl(2:seven_bands+1) * 0.5_r8 + g_wvl(1:seven_bands) * 0.5_r8 + dstint_wvl_ct(1:size_bins) = dstint_wvl(2:size_bins+1) * 0.5_r8 + dstint_wvl(1:size_bins) * 0.5_r8 + bcint_wvl_ct(1:sixteen_bands) = bcint_wvl(2:sixteen_bands+1) * 0.5_r8 + bcint_wvl(1:sixteen_bands) * 0.5_r8 + ! Eq. 1a,1b and Table S1 in He et al. 2018 GRL bcint_m(1:3) = (/ -0.8724_r8, -0.1866_r8, -0.0046_r8 /) bcint_n(1:3) = (/ -0.0072_r8, -0.1918_r8, -0.5177_r8 /) - ! 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_r8, 0.2632_r8, 0.3448_r8, 0.4415_r8, 0.625_r8, 0.7782_r8, 1.2422_r8/) - dstint_wvl_ct(1:6) = dstint_wvl(2:7) * 0.5_r8 + dstint_wvl(1:6) * 0.5_r8 - dstint_a1(1:6) = (/ -2.1307E+1_r8, -1.5815E+1_r8, -9.2880_r8 , 1.1115_r8 , 1.0307_r8 , 1.0185_r8 /) - dstint_a2(1:6) = (/ 1.1746E+2_r8, 9.3241E+1_r8, 4.0605E+1_r8, 3.7389E-1_r8, 1.4800E-2_r8, 2.8921E-4_r8 /) - dstint_a3(1:6) = (/ 9.9701E-1_r8, 9.9781E-1_r8, 9.9848E-1_r8, 1.0035_r8 , 1.0024_r8 , 1.0356_r8 /) - ! SNICAR/CLM snow band center wavelength (um) allocate(wvl_ct(snicar_numrad_snw)) select case (snicar_numrad_snw) @@ -835,7 +841,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & else AR_tmp = sno_AR(i) ! user specified value endif - do igb = 1,7 + do igb = 1, seven_bands 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 * AR_tmp) ! Eqn. 3.1 in Fu (2007) enddo @@ -853,7 +859,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & else AR_tmp = sno_AR(i) ! user specified value endif - do igb = 1,7 + do igb = 1, seven_bands 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) * log(AR_tmp)) ! Eqn. 3.3 in Fu (2007) enddo @@ -871,7 +877,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & else AR_tmp = sno_AR(i) ! user specified value endif - do igb = 1,7 + do igb = 1, seven_bands 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) * log(AR_tmp)) ! Eqn. 3.3 in Fu (2007) enddo @@ -883,8 +889,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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 - call piecewise_linear_interp1d(ngmax-1, g_wvl_ct, g_ice_Cg_tmp, wvl_ct(bnd_idx), g_Cg_intp) - call piecewise_linear_interp1d(ngmax-1, g_wvl_ct, gg_ice_F07_tmp, wvl_ct(bnd_idx), gg_F07_intp) + call piecewise_linear_interp1d(seven_bands, g_wvl_ct, g_ice_Cg_tmp, wvl_ct(bnd_idx), g_Cg_intp) + call piecewise_linear_interp1d(seven_bands, g_wvl_ct, gg_ice_F07_tmp, wvl_ct(bnd_idx), gg_F07_intp) g_ice_F07 = gg_F07_intp + 0.5_r8 * (1._r8 - gg_F07_intp) / ss_alb_snw_lcl(i) ! Eq.2.2 in Fu (2007) asm_prm_snw_lcl(i) = g_ice_F07 * g_Cg_intp ! Eq.6, He et al. (2017) endif @@ -952,7 +958,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! (2) We tune BC density from 1.7 to 1.49 g/cm3 (den_bc_target) (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 + do ibb=1,sixteen_bands enh_omg_bcint_tmp(ibb) = bcint_d0(ibb) * & ( (mss_cnc_aer_lcl(i,1) * kg_to_ug * den_bc / den_bc_target + 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) @@ -973,7 +979,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & enh_omg_bcint_tmp2(ibb)=LOG10(max(1._r8,bcint_dd*((enh_omg_bcint_tmp(ibb)/bcint_dd2)**bcint_f))) enddo ! piecewise linear interpolate into targeted SNICAR bands in a logscale space - call piecewise_linear_interp1d(16,bcint_wvl_ct,enh_omg_bcint_tmp2,wvl_doint,enh_omg_bcint_intp) + call piecewise_linear_interp1d(sixteen_bands,bcint_wvl_ct,enh_omg_bcint_tmp2,wvl_doint,enh_omg_bcint_intp) ! update snow single-scattering albedo enh_omg_bcint_intp2 = 10._r8 ** enh_omg_bcint_intp enh_omg_bcint_intp2 = min(enh_omg_max, max(enh_omg_bcint_intp2, 1._r8)) ! constrain enhancement to a reasonable range @@ -993,14 +999,14 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & ! 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)) * 1.0E6_r8 !kg/kg->ppm + mss_cnc_aer_lcl(i,7) + mss_cnc_aer_lcl(i,8)) * kg_kg_to_ppm if ( snicar_snodst_intmix .and. (tot_dst_snw_conc > 0._r8) ) then - do idb=1,6 + do idb=1, size_bins 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._r8)) enddo ! piecewise linear interpolate into targeted SNICAR bands in a logscale space - call piecewise_linear_interp1d(6,dstint_wvl_ct,enh_omg_dstint_tmp2,wvl_doint,enh_omg_dstint_intp) + call piecewise_linear_interp1d(size_bins,dstint_wvl_ct,enh_omg_dstint_tmp2,wvl_doint,enh_omg_dstint_intp) ! update snow single-scattering albedo enh_omg_dstint_intp2 = 10._r8 ** enh_omg_dstint_intp enh_omg_dstint_intp2 = min(enh_omg_max, max(enh_omg_dstint_intp2, 1._r8)) ! constrain enhancement to a reasonable range From eddb844188fe4b9b3ddadac5ba6c65709aa1f05d Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 29 Sep 2023 13:59:00 -0600 Subject: [PATCH 50/62] Add case default lines and corresponding error messages --- src/biogeophys/SnowSnicarMod.F90 | 35 +++++++++++++++++++++----------- 1 file changed, 23 insertions(+), 12 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 60f9bc7d9f..ada6735a1f 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -587,6 +587,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8), parameter :: kg_kg_to_ppm = 1.e6_r8 ! kg/kg to ppm real(r8), parameter :: kg_to_ug = 1.e9_r8 ! kg to micrograms + character(len=*), parameter :: subname = 'SNICAR_RT' !----------------------------------------------------------------------- ! Enforce expected array sizes @@ -605,12 +606,21 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & frac_sno => waterdiagnosticbulk_inst%frac_sno_eff_col & ! Input: [real(r8) (:)] fraction of ground covered by snow (0 to 1) ) - ! initialize parameter + ! initialize parameter and + ! SNICAR/CLM snow band center wavelength (um) + allocate(wvl_ct(snicar_numrad_snw)) select case (snicar_numrad_snw) case (5) nir_bnd_bgn = 2 + wvl_ct(:) = (/ 0.5_r8, 0.85_r8, 1.1_r8, 1.35_r8, 3.25_r8 /) ! 5-band case (480) nir_bnd_bgn = 51 + do igb = 1, snicar_numrad_snw + wvl_ct(igb) = 0.205_r8 + 0.01_r8 * (igb - 1._r8) ! 480-band + enddo + case default + write(iulog,*) subname//' ERROR: unknown snicar_numrad_snw value: ', snicar_numrad_snw + call endrun(msg=errMsg(sourcefile, __LINE__)) end select nir_bnd_end = snicar_numrad_snw @@ -627,17 +637,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & bcint_m(1:3) = (/ -0.8724_r8, -0.1866_r8, -0.0046_r8 /) bcint_n(1:3) = (/ -0.0072_r8, -0.1918_r8, -0.5177_r8 /) - ! SNICAR/CLM snow band center wavelength (um) - allocate(wvl_ct(snicar_numrad_snw)) - select case (snicar_numrad_snw) - case (5) - wvl_ct(:) = (/ 0.5_r8, 0.85_r8, 1.1_r8, 1.35_r8, 3.25_r8 /) ! 5-band - case (480) - do igb = 1, snicar_numrad_snw - wvl_ct(igb) = 0.205_r8 + 0.01_r8 * (igb - 1._r8) ! 480-band - enddo - end select - ! Define constants pi = SHR_CONST_PI @@ -882,6 +881,9 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & gg_ice_F07_tmp(igb) = g_F07_p0(igb) + g_F07_p1(igb) * log(AR_tmp) + g_F07_p2(igb) * (log(AR_tmp) * log(AR_tmp)) ! Eqn. 3.3 in Fu (2007) enddo + case default + write(iulog,*) subname//' ERROR: unknown sno_shp for i: ', sno_shp(i), i + call endrun(msg=errMsg(sourcefile, __LINE__)) end select ! compute nonspherical snow asymmetry factor @@ -1865,6 +1867,9 @@ subroutine SnowOptics_init( ) short_case_solarspec = 'smm' case ('high_mountain_summer') ! High Mountain summer spectrum short_case_solarspec = 'hmn' + case default + write(iulog,*) subname//' ERROR: unknown snicar_solarspec: ', snicar_solarspec + call endrun(msg=errMsg(sourcefile, __LINE__)) end select select case (snicar_dust_optics) ! dust optical properties @@ -1874,6 +1879,9 @@ subroutine SnowOptics_init( ) short_case_dust_opt = 'col' case ('greenland') ! Greenland (Polashenski et al., 2015, central absorptivity) short_case_dust_opt = 'gre' + case default + write(iulog,*) subname//' ERROR: unknown snicar_dust_optics: ', snicar_dust_optics + call endrun(msg=errMsg(sourcefile, __LINE__)) end select !--------------------- for 5-band data @@ -2122,6 +2130,9 @@ subroutine SnowOptics_init( ) call ncd_io(trim(tString), flx_wgt_dif, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) + case default + write(iulog,*) subname//' ERROR: unknown snicar_numrad_snw: ', snicar_numrad_snw + call endrun(msg=errMsg(sourcefile, __LINE__)) end select call ncd_pio_closefile(ncid) From d6b92eccc822345ee48a534a4cb2e116a619bd5c Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 29 Sep 2023 14:44:13 -0600 Subject: [PATCH 51/62] Change two more arrays to parameters --- src/biogeophys/SnowSnicarMod.F90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index ada6735a1f..d19b057659 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -546,8 +546,12 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & real(r8), parameter :: Re_bc = 0.045_r8 ! target BC effective radius (um) used in BC MAC adjustment real(r8), parameter :: radius_1 = 0.1_r8 ! used with Re_bc (um) real(r8), parameter :: radius_2 = 0.05_r8 ! used with Re_bc (um) - real(r8) :: bcint_m(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix - real(r8) :: bcint_n(1:3) ! Parameterization coefficients for BC size adjustment in BC-snow int mix + ! Eq. 1a,1b and Table S1 in He et al. 2018 GRL + ! Parameterization coefficients for BC size adjustment in BC-snow int mix + integer, parameter :: three_bands = 3 + real(r8), parameter :: bcint_m(three_bands) = (/ -0.8724_r8, -0.1866_r8, -0.0046_r8 /) + real(r8), parameter :: bcint_n(three_bands) = (/ -0.0072_r8, -0.1918_r8, -0.5177_r8 /) + real(r8) :: bcint_m_tmp ! temporary of bcint_m real(r8) :: bcint_n_tmp ! temporary of bcint_n real(r8) :: bcint_dd ! intermediate parameter @@ -633,10 +637,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & dstint_wvl_ct(1:size_bins) = dstint_wvl(2:size_bins+1) * 0.5_r8 + dstint_wvl(1:size_bins) * 0.5_r8 bcint_wvl_ct(1:sixteen_bands) = bcint_wvl(2:sixteen_bands+1) * 0.5_r8 + bcint_wvl(1:sixteen_bands) * 0.5_r8 - ! Eq. 1a,1b and Table S1 in He et al. 2018 GRL - bcint_m(1:3) = (/ -0.8724_r8, -0.1866_r8, -0.0046_r8 /) - bcint_n(1:3) = (/ -0.0072_r8, -0.1918_r8, -0.5177_r8 /) - ! Define constants pi = SHR_CONST_PI From 99ee926f7c2f19d4bf3a49b42bc65dc01f82385c Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 29 Sep 2023 15:55:32 -0600 Subject: [PATCH 52/62] Replace suffixes 1 & 2 representing hydrophillic/phobic w hphil/hphob --- src/biogeophys/SnowSnicarMod.F90 | 148 +++++++++++++++---------------- 1 file changed, 74 insertions(+), 74 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index d19b057659..cf3903b6ae 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -94,24 +94,24 @@ module SnowSnicarMod real(r8), pointer :: ext_cff_mss_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) ! hydrophilic BC - real(r8), pointer :: ss_alb_bc1(:) !(numrad_snw) - real(r8), pointer :: asm_prm_bc1(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_bc1(:) !(numrad_snw) + real(r8), pointer :: ss_alb_bc_hphil(:) !(numrad_snw) + real(r8), pointer :: asm_prm_bc_hphil(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_bc_hphil(:) !(numrad_snw) ! hydrophobic BC - real(r8), pointer :: ss_alb_bc2(:) !(numrad_snw) - real(r8), pointer :: asm_prm_bc2(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_bc2(:) !(numrad_snw) + real(r8), pointer :: ss_alb_bc_hphob(:) !(numrad_snw) + real(r8), pointer :: asm_prm_bc_hphob(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_bc_hphob(:) !(numrad_snw) ! hydrophilic OC - real(r8), pointer :: ss_alb_oc1(:) !(numrad_snw) - real(r8), pointer :: asm_prm_oc1(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_oc1(:) !(numrad_snw) + real(r8), pointer :: ss_alb_oc_hphil(:) !(numrad_snw) + real(r8), pointer :: asm_prm_oc_hphil(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_oc_hphil(:) !(numrad_snw) ! hydrophobic OC - real(r8), pointer :: ss_alb_oc2(:) !(numrad_snw) - real(r8), pointer :: asm_prm_oc2(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_oc2(:) !(numrad_snw) + real(r8), pointer :: ss_alb_oc_hphob(:) !(numrad_snw) + real(r8), pointer :: asm_prm_oc_hphob(:) !(numrad_snw) + real(r8), pointer :: ext_cff_mss_oc_hphob(:) !(numrad_snw) ! dust species 1: real(r8), pointer :: ss_alb_dst1(:) !(numrad_snw) @@ -902,23 +902,23 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & enddo ! snow layer loop ! aerosol species 2 optical properties, hydrophobic BC - ss_alb_aer_lcl(2) = ss_alb_bc2(bnd_idx) - asm_prm_aer_lcl(2) = asm_prm_bc2(bnd_idx) - ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc2(bnd_idx) + ss_alb_aer_lcl(2) = ss_alb_bc_hphob(bnd_idx) + asm_prm_aer_lcl(2) = asm_prm_bc_hphob(bnd_idx) + ext_cff_mss_aer_lcl(2) = ext_cff_mss_bc_hphob(bnd_idx) ! aerosol species 3 optical properties, hydrophilic OC - ss_alb_aer_lcl(3) = ss_alb_oc1(bnd_idx) - asm_prm_aer_lcl(3) = asm_prm_oc1(bnd_idx) - ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc1(bnd_idx) + ss_alb_aer_lcl(3) = ss_alb_oc_hphil(bnd_idx) + asm_prm_aer_lcl(3) = asm_prm_oc_hphil(bnd_idx) + ext_cff_mss_aer_lcl(3) = ext_cff_mss_oc_hphil(bnd_idx) ! aerosol species 4 optical properties, hydrophobic OC - ss_alb_aer_lcl(4) = ss_alb_oc2(bnd_idx) - asm_prm_aer_lcl(4) = asm_prm_oc2(bnd_idx) - ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc2(bnd_idx) + ss_alb_aer_lcl(4) = ss_alb_oc_hphob(bnd_idx) + asm_prm_aer_lcl(4) = asm_prm_oc_hphob(bnd_idx) + ext_cff_mss_aer_lcl(4) = ext_cff_mss_oc_hphob(bnd_idx) ! Optics for BC/dust-snow external mixing: ! aerosol species 1 optical properties, hydrophilic BC - ss_alb_aer_lcl(1) = ss_alb_bc1(bnd_idx) - asm_prm_aer_lcl(1) = asm_prm_bc1(bnd_idx) - ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc1(bnd_idx) + ss_alb_aer_lcl(1) = ss_alb_bc_hphil(bnd_idx) + asm_prm_aer_lcl(1) = asm_prm_bc_hphil(bnd_idx) + ext_cff_mss_aer_lcl(1) = ext_cff_mss_bc_hphil(bnd_idx) ! aerosol species 5 optical properties, dust size1 ss_alb_aer_lcl(5) = ss_alb_dst1(bnd_idx) asm_prm_aer_lcl(5) = asm_prm_dst1(bnd_idx) @@ -1822,18 +1822,18 @@ subroutine SnowOptics_init( ) allocate(ss_alb_snw_dfs(idx_Mie_snw_mx,snicar_numrad_snw)) allocate(asm_prm_snw_dfs(idx_Mie_snw_mx,snicar_numrad_snw)) allocate(ext_cff_mss_snw_dfs(idx_Mie_snw_mx,snicar_numrad_snw)) - allocate(ss_alb_bc1(snicar_numrad_snw)) - allocate(asm_prm_bc1(snicar_numrad_snw)) - allocate(ext_cff_mss_bc1(snicar_numrad_snw)) - allocate(ss_alb_bc2(snicar_numrad_snw)) - allocate(asm_prm_bc2(snicar_numrad_snw)) - allocate(ext_cff_mss_bc2(snicar_numrad_snw)) - allocate(ss_alb_oc1(snicar_numrad_snw)) - allocate(asm_prm_oc1(snicar_numrad_snw)) - allocate(ext_cff_mss_oc1(snicar_numrad_snw)) - allocate(ss_alb_oc2(snicar_numrad_snw)) - allocate(asm_prm_oc2(snicar_numrad_snw)) - allocate(ext_cff_mss_oc2(snicar_numrad_snw)) + allocate(ss_alb_bc_hphil(snicar_numrad_snw)) + allocate(asm_prm_bc_hphil(snicar_numrad_snw)) + allocate(ext_cff_mss_bc_hphil(snicar_numrad_snw)) + allocate(ss_alb_bc_hphob(snicar_numrad_snw)) + allocate(asm_prm_bc_hphob(snicar_numrad_snw)) + allocate(ext_cff_mss_bc_hphob(snicar_numrad_snw)) + allocate(ss_alb_oc_hphil(snicar_numrad_snw)) + allocate(asm_prm_oc_hphil(snicar_numrad_snw)) + allocate(ext_cff_mss_oc_hphil(snicar_numrad_snw)) + allocate(ss_alb_oc_hphob(snicar_numrad_snw)) + allocate(asm_prm_oc_hphob(snicar_numrad_snw)) + allocate(ext_cff_mss_oc_hphob(snicar_numrad_snw)) allocate(ss_alb_dst1(snicar_numrad_snw)) allocate(asm_prm_dst1(snicar_numrad_snw)) allocate(ext_cff_mss_dst1(snicar_numrad_snw)) @@ -1897,62 +1897,62 @@ subroutine SnowOptics_init( ) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ! THIS NOTE APPLIES TO ALL THE call ncd_io LINES BELOW WHERE - ! bcphob AND ocphob GET ASSIGNED TO VARIABLES SUFFIXED bc1/oc1: + ! bcphob AND ocphob GET ASSIGNED TO VARIABLES SUFFIXED bc_hphil/oc_hphil: ! ! Assumption (1) applies here, in the input section. ! Assumption (2) applies later, in the snicar code. ! ! 1) In this section, hydrophillic particles behave like hydrophobic - ! particles. We assume bc1/oc1 to have the same optics as bc2/oc2 - ! because sulfate coating on the bc1/oc1 surface is assumed to be + ! particles. We assume bc_hphil/oc_hphil to have the same optics as bc_hphob/oc_hphob + ! because sulfate coating on the bc_hphil/oc_hphil surface is assumed to be ! dissolved into the hydrometeo (i.e, snow grain here) during the ! deposition process. This is different from the assumption made in - ! prior model versions, where bc1/oc1 was coated by undissolved + ! prior model versions, where bc_hphil/oc_hphil was coated by undissolved ! sulfate. ! 2) Later, in the snicar code, if the bc-snow internal mixing option - ! is on, bc1/oc1 (internally mixed within the snow grain) will be - ! treated differently than bc2/oc2 (mixed externally or outside the + ! is on, bc_hphil/oc_hphil (internally mixed within the snow grain) will be + ! treated differently than bc_hphob/oc_hphob (mixed externally or outside the ! snow grain). ! - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + ! BC species 1 Mie parameters, uncoated BC, same as bc_hphob before BC-snow internal mixing tString = 'ss_alb_bcphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ss_alb_bc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'asm_prm_bcphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), asm_prm_bc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'ext_cff_mss_bcphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ext_cff_mss_bc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC tString = 'ss_alb_bcphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ss_alb_bc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'asm_prm_bcphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), asm_prm_bc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'ext_cff_mss_bcphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ext_cff_mss_bc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + ! OC species 1 Mie parameters, uncoated OC, same as oc_hphob before OC-snow internal mixing tString = 'ss_alb_ocphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ss_alb_oc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'asm_prm_ocphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), asm_prm_oc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'ext_cff_mss_ocphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ext_cff_mss_oc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC tString = 'ss_alb_ocphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ss_alb_oc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'asm_prm_ocphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), asm_prm_oc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'ext_cff_mss_ocphob_dif_'//short_case_solarspec - call ncd_io(trim(tString), ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ext_cff_mss_oc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! ice refractive index (Picard et al., 2016) tString = 'ss_alb_ice_pic16_dir_'//short_case_solarspec @@ -2018,45 +2018,45 @@ subroutine SnowOptics_init( ) !-------------------- for 480-band data case (480) - ! BC species 1 Mie parameters, uncoated BC, same as bc2 before BC-snow internal mixing + ! BC species 1 Mie parameters, uncoated BC, same as bc_hphob before BC-snow internal mixing tString = 'ss_alb_bcphob' - call ncd_io(trim(tString), ss_alb_bc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ss_alb_bc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'asm_prm_bcphob' - call ncd_io(trim(tString), asm_prm_bc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), asm_prm_bc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'ext_cff_mss_bcphob' - call ncd_io(trim(tString), ext_cff_mss_bc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ext_cff_mss_bc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! BC species 2 Mie parameters, uncoated BC tString = 'ss_alb_bcphob' - call ncd_io(trim(tString), ss_alb_bc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ss_alb_bc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'asm_prm_bcphob' - call ncd_io(trim(tString), asm_prm_bc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), asm_prm_bc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'ext_cff_mss_bcphob' - call ncd_io(trim(tString), ext_cff_mss_bc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ext_cff_mss_bc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) - ! OC species 1 Mie parameters, uncoated OC, same as oc2 before OC-snow internal mixing + ! OC species 1 Mie parameters, uncoated OC, same as oc_hphob before OC-snow internal mixing tString = 'ss_alb_ocphob' - call ncd_io(trim(tString), ss_alb_oc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ss_alb_oc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'asm_prm_ocphob' - call ncd_io(trim(tString), asm_prm_oc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), asm_prm_oc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'ext_cff_mss_ocphob' - call ncd_io(trim(tString), ext_cff_mss_oc1, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ext_cff_mss_oc_hphil, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! OC species 2 Mie parameters, uncoated OC tString = 'ss_alb_ocphob' - call ncd_io(trim(tString), ss_alb_oc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ss_alb_oc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'asm_prm_ocphob' - call ncd_io(trim(tString), asm_prm_oc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), asm_prm_oc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) tString = 'ext_cff_mss_ocphob' - call ncd_io(trim(tString), ext_cff_mss_oc2, 'read', ncid, readv, posNOTonfile=.true.) + call ncd_io(trim(tString), ext_cff_mss_oc_hphob, 'read', ncid, readv, posNOTonfile=.true.) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) ! snow optical properties derived from different ice refractive index dataset @@ -2152,14 +2152,14 @@ subroutine SnowOptics_init( ) write (iulog,*) 'SNICAR: Excluding OC aerosols from snow radiative transfer calculations' endif write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic BC: ', & - ss_alb_bc1(1), ss_alb_bc1(2), ss_alb_bc1(3), ss_alb_bc1(4), ss_alb_bc1(5) + ss_alb_bc_hphil(1), ss_alb_bc_hphil(2), ss_alb_bc_hphil(3), ss_alb_bc_hphil(4), ss_alb_bc_hphil(5) write (iulog,*) '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) + ss_alb_bc_hphob(1), ss_alb_bc_hphob(2), ss_alb_bc_hphob(3), ss_alb_bc_hphob(4), ss_alb_bc_hphob(5) if (do_sno_oc) then write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophillic OC: ', & - ss_alb_oc1(1), ss_alb_oc1(2), ss_alb_oc1(3), ss_alb_oc1(4), ss_alb_oc1(5) + ss_alb_oc_hphil(1), ss_alb_oc_hphil(2), ss_alb_oc_hphil(3), ss_alb_oc_hphil(4), ss_alb_oc_hphil(5) write (iulog,*) 'SNICAR: Mie single scatter albedos for hydrophobic OC: ', & - ss_alb_oc2(1), ss_alb_oc2(2), ss_alb_oc2(3), ss_alb_oc2(4), ss_alb_oc2(5) + ss_alb_oc_hphob(1), ss_alb_oc_hphob(2), ss_alb_oc_hphob(3), ss_alb_oc_hphob(4), ss_alb_oc_hphob(5) endif write (iulog,*) '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) From 94846be9125db892136ae89d69ea0153bdaf0165 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 29 Sep 2023 16:35:49 -0600 Subject: [PATCH 53/62] Replace pointers with allocatables --- src/biogeophys/SnowSnicarMod.F90 | 70 ++++++++++++++++---------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index cf3903b6ae..1d72870173 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -84,67 +84,67 @@ module SnowSnicarMod ! (idx_Mie_snw_mx is number of snow radii with defined parameters (i.e. from 30um to 1500um)) ! direct-beam weighted ice optical properties - real(r8), pointer :: ss_alb_snw_drc(:,:) !(idx_Mie_snw_mx,numrad_snw) - real(r8), pointer :: asm_prm_snw_drc(:,:) !(idx_Mie_snw_mx,numrad_snw) - real(r8), pointer :: ext_cff_mss_snw_drc(:,:) !(idx_Mie_snw_mx,numrad_snw) + real(r8), allocatable :: ss_alb_snw_drc(:,:) ! (idx_Mie_snw_mx, numrad_snw) + real(r8), allocatable :: asm_prm_snw_drc(:,:) + real(r8), allocatable :: ext_cff_mss_snw_drc(:,:) ! diffuse radiation weighted ice optical properties - real(r8), pointer :: ss_alb_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) - real(r8), pointer :: asm_prm_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) - real(r8), pointer :: ext_cff_mss_snw_dfs(:,:) !(idx_Mie_snw_mx,numrad_snw) + real(r8), allocatable :: ss_alb_snw_dfs(:,:) ! (idx_Mie_snw_mx, numrad_snw) + real(r8), allocatable :: asm_prm_snw_dfs(:,:) + real(r8), allocatable :: ext_cff_mss_snw_dfs(:,:) ! hydrophilic BC - real(r8), pointer :: ss_alb_bc_hphil(:) !(numrad_snw) - real(r8), pointer :: asm_prm_bc_hphil(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_bc_hphil(:) !(numrad_snw) + real(r8), allocatable :: ss_alb_bc_hphil(:) ! (numrad_snw) + real(r8), allocatable :: asm_prm_bc_hphil(:) + real(r8), allocatable :: ext_cff_mss_bc_hphil(:) ! hydrophobic BC - real(r8), pointer :: ss_alb_bc_hphob(:) !(numrad_snw) - real(r8), pointer :: asm_prm_bc_hphob(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_bc_hphob(:) !(numrad_snw) + real(r8), allocatable :: ss_alb_bc_hphob(:) ! (numrad_snw) + real(r8), allocatable :: asm_prm_bc_hphob(:) + real(r8), allocatable :: ext_cff_mss_bc_hphob(:) ! hydrophilic OC - real(r8), pointer :: ss_alb_oc_hphil(:) !(numrad_snw) - real(r8), pointer :: asm_prm_oc_hphil(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_oc_hphil(:) !(numrad_snw) + real(r8), allocatable :: ss_alb_oc_hphil(:) ! (numrad_snw) + real(r8), allocatable :: asm_prm_oc_hphil(:) + real(r8), allocatable :: ext_cff_mss_oc_hphil(:) ! hydrophobic OC - real(r8), pointer :: ss_alb_oc_hphob(:) !(numrad_snw) - real(r8), pointer :: asm_prm_oc_hphob(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_oc_hphob(:) !(numrad_snw) + real(r8), allocatable :: ss_alb_oc_hphob(:) ! (numrad_snw) + real(r8), allocatable :: asm_prm_oc_hphob(:) + real(r8), allocatable :: ext_cff_mss_oc_hphob(:) ! dust species 1: - real(r8), pointer :: ss_alb_dst1(:) !(numrad_snw) - real(r8), pointer :: asm_prm_dst1(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_dst1(:) !(numrad_snw) + real(r8), allocatable :: ss_alb_dst1(:) ! (numrad_snw) + real(r8), allocatable :: asm_prm_dst1(:) + real(r8), allocatable :: ext_cff_mss_dst1(:) ! dust species 2: - real(r8), pointer :: ss_alb_dst2(:) !(numrad_snw) - real(r8), pointer :: asm_prm_dst2(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_dst2(:) !(numrad_snw) + real(r8), allocatable :: ss_alb_dst2(:) ! (numrad_snw) + real(r8), allocatable :: asm_prm_dst2(:) + real(r8), allocatable :: ext_cff_mss_dst2(:) ! dust species 3: - real(r8), pointer :: ss_alb_dst3(:) !(numrad_snw) - real(r8), pointer :: asm_prm_dst3(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_dst3(:) !(numrad_snw) + real(r8), allocatable :: ss_alb_dst3(:) ! (numrad_snw) + real(r8), allocatable :: asm_prm_dst3(:) + real(r8), allocatable :: ext_cff_mss_dst3(:) ! dust species 4: - real(r8), pointer :: ss_alb_dst4(:) !(numrad_snw) - real(r8), pointer :: asm_prm_dst4(:) !(numrad_snw) - real(r8), pointer :: ext_cff_mss_dst4(:) !(numrad_snw) + real(r8), allocatable :: ss_alb_dst4(:) ! (numrad_snw) + real(r8), allocatable :: asm_prm_dst4(:) + real(r8), allocatable :: ext_cff_mss_dst4(:) ! downward solar radiation spectral weights for 5-band or 480-band - real(r8), pointer :: flx_wgt_dir(:) !(numrad_snw) ! direct - real(r8), pointer :: flx_wgt_dif(:) !(numrad_snw) ! diffuse + real(r8), allocatable :: flx_wgt_dir(:) ! (numrad_snw) ! direct + real(r8), allocatable :: flx_wgt_dif(:) ! (numrad_snw) ! diffuse ! best-fit parameters for snow aging defined over: ! 11 temperatures from 225 to 273 K ! 31 temperature gradients from 0 to 300 K/m ! 8 snow densities from 0 to 350 kg/m3 ! (arrays declared here, but are set in iniTimeConst) - real(r8), pointer :: snowage_tau(:,:,:) ! (idx_rhos_max,idx_Tgrd_max,idx_T_max) - real(r8), pointer :: snowage_kappa(:,:,:) ! (idx_rhos_max,idx_Tgrd_max,idx_T_max) - real(r8), pointer :: snowage_drdt0(:,:,:) ! idx_rhos_max,idx_Tgrd_max,idx_T_max) + real(r8), allocatable :: snowage_tau(:,:,:) ! (idx_rhos_max, idx_Tgrd_max, idx_T_max) + real(r8), allocatable :: snowage_kappa(:,:,:) + real(r8), allocatable :: snowage_drdt0(:,:,:) ! ! !REVISION HISTORY: ! Created by Mark Flanner (Univ. of Michigan) From b892252f0902d5872572a6525e5b15bb26f912d1 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 5 Oct 2023 16:42:48 -0600 Subject: [PATCH 54/62] Improve error checks and comments --- bld/CLMBuildNamelist.pm | 55 +++++++++++++++++- .../namelist_definition_ctsm.xml | 58 +++++++++++-------- src/biogeophys/SnowSnicarMod.F90 | 2 + src/main/controlMod.F90 | 29 ++++++---- 4 files changed, 108 insertions(+), 36 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 8d5618bf34..1667b13b10 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1995,6 +1995,60 @@ sub setup_logic_snicar_methods { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_use_aerosol' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_aerforc_diag' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'do_sno_oc' ); + # Error checking + my $opt1 = 'snicar_snw_shape'; + my $var1 = $nl->get_value($opt1); + my $sup1a = "'sphere'"; # supported value for this option + my $sup1b = "'hexagonal_plate'"; # supported value for this option + if (($var1 ne $sup1a) && ($var1 ne $sup1b)) { + $log->warning("$opt1=$sup1a and $sup1b are supported; $var1 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + my $opt2 = 'snicar_solarspec'; + my $var2 = $nl->get_value($opt2); + my $sup2 = "'mid_latitude_winter'"; # supported value for this option + if ($var2 ne $sup2) { + $log->warning("$opt2=$sup2 is the supported option; $var2 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + my $opt3 = 'snicar_dust_optics'; + my $var3 = $nl->get_value($opt3); + my $sup3 = "'sahara'"; # supported value for this option + if ($var3 ne $sup3) { + $log->warning("$opt3=$sup3 is the supported option; $var3 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + my $opt4 = 'snicar_numrad_snw'; + my $var4 = $nl->get_value($opt4); + my $sup4 = '5'; # supported value for this option + if ($var4 ne $sup4) { + $log->warning("$opt4=$sup4 is the supported option; $var4 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + my $opt5 = 'snicar_snobc_intmix'; + my $var5 = $nl->get_value($opt5); + my $sup5 = '.false.'; # supported value for this option + if ($var5 ne $sup5) { + $log->warning("$opt5=$sup5 is the supported option; $var5 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + my $opt6 = 'snicar_snodst_intmix'; + my $var6 = $nl->get_value($opt6); + my $sup6 = '.false.'; # supported value for this option + if ($var6 ne $sup6) { + $log->warning("$opt6=$sup6 is the supported option; $var6 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + my $opt7 = 'snicar_use_aerosol'; + my $var7 = $nl->get_value($opt7); + my $sup7 = '.true.'; # supported value for this option + if ($var7 ne $sup7) { + $log->warning("$opt7=$sup7 is the supported option; $var7 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + my $opt8 = 'do_sno_oc'; + my $var8 = $nl->get_value($opt8); + my $sup8 = '.false.'; # supported value for this option + if ($var8 ne $sup8) { + $log->warning("$opt8=$sup8 is the supported option; $var8 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + # snicar_snobc_intmix and snicar_snodst_intmix cannot both be true + if (($var5 eq $var6) && ($var5 ne $sup5)) { + $log->warning("$opt5 = $var5 and $opt6 = $var6 do not work together!"); + } } #------------------------------------------------------------------------------- @@ -4482,7 +4536,6 @@ sub write_output_files { push @groups, "ch4finundated"; push @groups, "exice_streams"; push @groups, "soilbgc_decomp"; - push @groups, "snicar_inparm"; push @groups, "clm_canopy_inparm"; if (remove_leading_and_trailing_quotes($nl->get_value('snow_cover_fraction_method')) eq 'SwensonLawrence2012') { push @groups, "scf_swenson_lawrence_2012_inparm"; diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 731c10acfd..793d79d242 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -151,43 +151,51 @@ of soil column (nlevsoi). + group="clm_inparm" valid_values="5,480" value="5" > number of wavelength bands used in SNICAR snow albedo calculation +(snicar_numrad_snw=5 is the only supported option; others are EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) + group="clm_inparm" valid_values="mid_latitude_winter,mid_latitude_summer,sub_arctic_winter,sub_arctic_summer,summit_greenland_summer,high_mountain_summer" value="mid_latitude_winter" > type of downward solar radiation spectrum for SNICAR snow albedo calculation +(snicar_solarspec='mid_latitude_winter' is the only supported option; others are EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) + group="clm_inparm" valid_values="sahara,san_juan_mtns_colorado,greenland" value="sahara" > dust optics type for SNICAR snow albedo calculation +(snicar_dust_optics='sahara' is the only supported option; others are EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) + group="clm_inparm" valid_values="sphere,spheroid,hexagonal_plate,koch_snowflake" value="hexagonal_plate" > snow grain shape used in SNICAR snow albedo calculation +(snicar_dust_optics='hexagonal_plate' is supported in ctsm5.1 and 'sphere' in older model versions; others are EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) + group="clm_inparm" value=".true."> Toggle to turn on/off aerosol deposition flux in snow in SNICAR +(snicar_use_aerosol='.false.' is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) + group="clm_inparm" value=".false." > option to activate BC-snow internal mixing in SNICAR snow albedo calculation +(snicar_snobc_intmix='.true.' is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) + group="clm_inparm" value=".false." > option to activate dust-snow internal mixing in SNICAR snow albedo calculation +(snicar_snodst_intmix='.true.' is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) + group="clm_inparm" value=".false." > option to activate organic carbon (OC) in SNICAR snow albedo calculation +(do_sno_oc='.true.' is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) Toggle to use 25 lake layers instead of 10 -(extralaklayers=".true." is EXPERIMENTAL NOT SUPPORTED! Nor is it Tested!) +(extralaklayers=".true." is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) Toggle to turn on the VIC hydrologic parameterizations -(vichydro=".true." is EXPERIMENTAL NOT SUPPORTED!) +(vichydro=".true." is EXPERIMENTAL, UNSUPPORTED!) + group="clm_inparm" value=".false."> Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) albedo forcing diagnostics for each aerosol species @@ -1761,7 +1769,7 @@ to hydrologic variables (either TWS or ZWT) -Toggle to turn on use of input prescribed soil moisture streams rather than have CLM prognose it (EXPERIMENTAL) +Toggle to turn on use of input prescribed soil moisture streams rather than have CLM prognose it (EXPERIMENTAL, UNSUPPORTED!) Toggle to turn on use of LAI streams in place of the LAI on the surface dataset when using Satellite Phenology mode. -(EXPERIMENTAL and NOT tested) +(EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) If true, no denitrification or nitrification in frozen soil layers. -(EXPERIMENTAL and NOT tested) +(EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) If TRUE, weight btran (vegetation soil moisture availability) by unfrozen layers only, assuming that vegetation will allocate roots preferentially to the active layer. -(EXPERIMENTAL and NOT tested) +(EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) If TRUE, weight btran (vegetation soil moisture availability) by the active layer, as defined by the greatest thaw depth over the current and prior years. -(EXPERIMENTAL and NOT tested) +(EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) @@ -2384,7 +2392,7 @@ How much Carbon to initialize vegetation pools (leafc/frootc and storage) to whe Flexible CN ratio used for Phenology -(EXPERIMENTAL and NOT tested) +(EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) Vcmax calculation for Photosynthesis - vcmax_opt = 4 As for vcmax_opt=0, but using leafN, and exponential if tree (EXPERIMENTAL NOT TESTED!) + vcmax_opt = 4 As for vcmax_opt=0, but using leafN, and exponential if tree (EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) vcmax_opt = 3 Based on leafN and VCAD (used with Luna for crop and C4 vegetation) vcmax_opt = 0 Based on canopy top and foilage Nitrogen limitation factor from params file (clm4.5) @@ -2404,13 +2412,13 @@ Vcmax calculation for Photosynthesis Evergreen phenology option for CNPhenology -(EXPERIMENTAL and NOT tested) +(EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) Carbon respiration option to burn off carbon when CN ratio is too high (do NOT use when FUN is on) -(EXPERIMENTAL and NOT tested) +(EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) @@ -2468,7 +2476,7 @@ then don't fix aere (see ch4Mod.F90). If TRUE, turn on methane biogeochemistry model for lake columns, using a simplified version of the CH4 submodel. -(EXPERIMENTAL) +(EXPERIMENTAL, UNSUPPORTED!) If TRUE, use the fine root carbon predicted by CN when calculating the aerenchyma area, rather than the parametrization based on annual NPP, aboveground NPP fraction, and LAI. -(EXPERIMENTAL and NOT tested) +(EXPERIMENTAL, UNSUPPORTED, and UNTESTED!) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 1d72870173..61373759e6 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -881,6 +881,8 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & gg_ice_F07_tmp(igb) = g_F07_p0(igb) + g_F07_p1(igb) * log(AR_tmp) + g_F07_p2(igb) * (log(AR_tmp) * log(AR_tmp)) ! Eqn. 3.3 in Fu (2007) enddo + case ('sphere') + ! DO NOTHING case default write(iulog,*) subname//' ERROR: unknown sno_shp for i: ', sno_shp(i), i call endrun(msg=errMsg(sourcefile, __LINE__)) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 372949eee2..30174dc0bc 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -202,9 +202,6 @@ subroutine control_init(dtime) soil_layerstruct_userdefined_nlevsoi, use_subgrid_fluxes, snow_cover_fraction_method, & irrigate, run_zero_weight_urban, all_active, & crop_fsat_equals_zero, for_testing_run_ncdiopio_tests, & - snicar_numrad_snw, snicar_solarspec, snicar_dust_optics, & - snicar_use_aerosol, snicar_snw_shape, snicar_snobc_intmix,& - snicar_snodst_intmix,do_sno_oc, & for_testing_use_second_grain_pool, for_testing_use_repr_structure_pool, & for_testing_no_crop_seed_replenishment, & z0param_method, use_z0m_snowmelt @@ -286,9 +283,14 @@ subroutine control_init(dtime) namelist /clm_inparm/ & use_lch4, use_nitrif_denitrif, use_extralakelayers, & use_vichydro, use_cn, use_cndv, use_crop, use_fertilizer, & - use_grainproduct, snicar_aerforc_diag, use_vancouver, use_mexicocity, use_noio, & + use_grainproduct, use_vancouver, use_mexicocity, use_noio, & use_nguardrail + ! SNICAR + namelist /clm_inparm/ & + snicar_numrad_snw, snicar_solarspec, snicar_dust_optics, & + snicar_use_aerosol, snicar_snw_shape, snicar_snobc_intmix, & + snicar_snodst_intmix, snicar_aerforc_diag, do_sno_oc ! ---------------------------------------------------------------------- ! Default values @@ -604,18 +606,24 @@ subroutine control_init(dtime) errMsg(sourcefile, __LINE__)) end if - ! check on snow albedo wavelength bands - if ( (snicar_numrad_snw /= 5) .and. (snicar_numrad_snw /= 480) ) then - call endrun(msg=' ERROR: snicar_numrad_snw is out of a reasonable range (5, 480)'//& - errMsg(sourcefile, __LINE__)) - end if - ! check on SNICAR BC-snow and dust-snow internal mixing if ( snicar_snobc_intmix .and. snicar_snodst_intmix ) then call endrun(msg=' ERROR: currently dust-snow and BC-snow internal mixing cannot be activated together'//& errMsg(sourcefile, __LINE__)) end if + ! other SNICAR warnings + if ((snicar_snw_shape /= 'sphere' .and. snicar_snw_shape /= 'hexagonal_plate') .or. & + snicar_solarspec /= 'mid_latitude_winter' .or. & + snicar_dust_optics /= 'sahara' .or. & + snicar_numrad_snw /= 5 .or. & + snicar_snobc_intmix .or. snicar_snodst_intmix .or. & + not(snicar_use_aerosol) .or. & + do_sno_oc) then + call endrun(msg=' ERROR: You have selected an option that is EXPERIMENTAL, UNSUPPORTED, and UNTESTED. For guidance see namelist_defaults_ctsm.xml'//& + errMsg(sourcefile, __LINE__)) + end if + ! Consistency settings for nrevsn if (nsrest == nsrStartup ) nrevsn = ' ' @@ -1027,6 +1035,7 @@ subroutine control_print () else write(iulog,'(a)') ' snow aging parameters file = '//trim(fsnowaging) endif + write(iulog,*) ' SNICAR: downward solar radiation spectrum type =', snicar_solarspec write(iulog,*) ' SNICAR: dust optics type = ', snicar_dust_optics write(iulog,*) ' SNICAR: number of bands in snow albedo calculation =', snicar_numrad_snw From 20ce1eadf32f8aaa9d5268957e46958a60cc7816 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 5 Oct 2023 17:08:48 -0600 Subject: [PATCH 55/62] Remove option of running this copy of snicar in csim --- src/biogeophys/SnowSnicarMod.F90 | 72 ++++++++++------------------- src/biogeophys/SurfaceAlbedoMod.F90 | 22 ++++----- 2 files changed, 35 insertions(+), 59 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 61373759e6..3fcdca19cb 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -181,7 +181,7 @@ subroutine readParams( ncid ) end subroutine readParams !----------------------------------------------------------------------- - subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & coszen, flg_slr_in, h2osno_liq, h2osno_ice, h2osno_total, snw_rds, & mss_cnc_aer_in, albsfc, albout, flx_abs, waterdiagnosticbulk_inst) ! @@ -222,7 +222,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & use shr_const_mod , only : SHR_CONST_PI ! ! !ARGUMENTS: - integer , intent(in) :: flg_snw_ice ! flag: =1 when called from CLM, =2 when called from CSIM type (bounds_type), intent(in) :: bounds integer , intent(in) :: num_nourbanc ! number of columns in non-urban filter integer , intent(in) :: filter_nourbanc(:) ! column filter for non-urban points @@ -647,7 +646,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & nstep = get_nstep() ! Loop over all non-urban columns - ! (when called from CSIM, there is only one column) do fc = 1,num_nourbanc c_idx = filter_nourbanc(fc) @@ -658,11 +656,7 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & enddo ! set snow/ice mass to be used for RT: - if (flg_snw_ice == 1) then - h2osno_lcl = h2osno_total(c_idx) - else - h2osno_lcl = h2osno_ice(c_idx,0) - endif + h2osno_lcl = h2osno_total(c_idx) ! Qualifier for computing snow RT: ! 1) sunlight from atmosphere model @@ -671,46 +665,31 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & if ((coszen(c_idx) > 0._r8) .and. (h2osno_lcl > min_snw)) then ! Set variables specific to CLM - if (flg_snw_ice == 1) 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 (snl(c_idx) > -1) then - flg_nosnl = 1 - snl_lcl = -1 - h2osno_ice_lcl(0) = h2osno_lcl - h2osno_liq_lcl(0) = 0._r8 - snw_rds_lcl(0) = snw_rds_min_int - else - flg_nosnl = 0 - snl_lcl = snl(c_idx) - h2osno_liq_lcl(:) = h2osno_liq(c_idx,:) - h2osno_ice_lcl(:) = h2osno_ice(c_idx,:) - snw_rds_lcl(:) = snw_rds(c_idx,:) - endif - - snl_btm = 0 - snl_top = snl_lcl+1 + ! 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 (snl(c_idx) > -1) then + flg_nosnl = 1 + snl_lcl = -1 + h2osno_ice_lcl(0) = h2osno_lcl + h2osno_liq_lcl(0) = 0._r8 + snw_rds_lcl(0) = snw_rds_min_int + else + flg_nosnl = 0 + snl_lcl = snl(c_idx) + h2osno_liq_lcl(:) = h2osno_liq(c_idx,:) + h2osno_ice_lcl(:) = h2osno_ice(c_idx,:) + snw_rds_lcl(:) = snw_rds(c_idx,:) + endif - ! for debugging only - l_idx = col%landunit(c_idx) - g_idx = col%gridcell(c_idx) - sfctype = lun%itype(l_idx) - lat_coord = grc%latdeg(g_idx) - lon_coord = grc%londeg(g_idx) + snl_btm = 0 + snl_top = snl_lcl+1 - ! Set variables specific to CSIM - else - flg_nosnl = 0 - snl_lcl = -1 - h2osno_liq_lcl(:) = h2osno_liq(c_idx,:) - h2osno_ice_lcl(:) = h2osno_ice(c_idx,:) - snw_rds_lcl(:) = snw_rds(c_idx,:) - snl_btm = 0 - snl_top = 0 - sfctype = -1 - lat_coord = -90 - lon_coord = 0 - endif ! end if flg_snw_ice == 1 + ! for debugging only + l_idx = col%landunit(c_idx) + g_idx = col%gridcell(c_idx) + sfctype = lun%itype(l_idx) + lat_coord = grc%latdeg(g_idx) + lon_coord = grc%londeg(g_idx) ! Set local aerosol array @@ -729,7 +708,6 @@ subroutine SNICAR_RT (flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & if ((snw_rds_lcl(i) < snw_rds_min_tbl) .or. (snw_rds_lcl(i) > snw_rds_max_tbl)) then write (iulog,*) "SNICAR ERROR: snow grain radius of ", snw_rds_lcl(i), " out of bounds." write (iulog,*) "NSTEP= ", nstep - write (iulog,*) "flg_snw_ice= ", flg_snw_ice write (iulog,*) "column: ", c_idx, " level: ", i, " snl(c)= ", snl_lcl write (iulog,*) "lat= ", lat_coord, " lon= ", lon_coord write (iulog,*) "h2osno_total(c)= ", h2osno_lcl diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index e9830f7fb9..d48ba3f063 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -297,7 +297,6 @@ subroutine SurfaceAlbedo(bounds,nc, & real(r8) :: laisum ! sum of canopy layer lai for error check real(r8) :: saisum ! sum of canopy layer sai for error check integer :: flg_slr ! flag for SNICAR (=1 if direct, =2 if diffuse) - integer :: flg_snw_ice ! flag for SNICAR (=1 when called from CLM, =2 when called from sea-ice) integer :: num_vegsol ! number of vegetated patches where coszen>0 integer :: num_novegsol ! number of vegetated patches where coszen>0 integer :: filter_vegsol (bounds%endp-bounds%begp+1) ! patch filter where vegetated and coszen>0 @@ -524,7 +523,6 @@ subroutine SurfaceAlbedo(bounds,nc, & ! set variables to pass to SNICAR. - flg_snw_ice = 1 ! calling from CLM, not CSIM do c=bounds%begc,bounds%endc albsfc(c,:) = albsoi(c,:) h2osno_liq(c,:) = h2osoi_liq(c,-nlevsno+1:0) @@ -587,7 +585,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! BC FORCING CALCULATIONS flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -601,7 +599,7 @@ subroutine SurfaceAlbedo(bounds,nc, & waterdiagnosticbulk_inst) flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -626,7 +624,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! OC FORCING CALCULATIONS flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -640,7 +638,7 @@ subroutine SurfaceAlbedo(bounds,nc, & waterdiagnosticbulk_inst) flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -665,7 +663,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! DUST FORCING CALCULATIONS flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -679,7 +677,7 @@ subroutine SurfaceAlbedo(bounds,nc, & waterdiagnosticbulk_inst) flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -695,7 +693,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! 4. ALL AEROSOL FORCING CALCULATION ! (pure snow albedo) flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -709,7 +707,7 @@ subroutine SurfaceAlbedo(bounds,nc, & waterdiagnosticbulk_inst) flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -725,7 +723,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! CLIMATE FEEDBACK CALCULATIONS, ALL AEROSOLS: flg_slr = 1; ! direct-beam - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & @@ -739,7 +737,7 @@ subroutine SurfaceAlbedo(bounds,nc, & waterdiagnosticbulk_inst) flg_slr = 2; ! diffuse - call SNICAR_RT(flg_snw_ice, bounds, num_nourbanc, filter_nourbanc, & + call SNICAR_RT(bounds, num_nourbanc, filter_nourbanc, & coszen_col(bounds%begc:bounds%endc), & flg_slr, & h2osno_liq(bounds%begc:bounds%endc, :), & From f952e50e534eb4b8ac9c54171a40468c606b3cb9 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 5 Oct 2023 17:26:56 -0600 Subject: [PATCH 56/62] Replace hardwired numbers with parameters --- src/biogeophys/SnowSnicarMod.F90 | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index 3fcdca19cb..eda055a2a7 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -51,6 +51,11 @@ module SnowSnicarMod logical, public, parameter :: DO_SNO_AER = .true. ! parameter to include aerosols in snowpack radiative calculations ! !PRIVATE DATA MEMBERS: + integer, parameter :: default_number_bands = 5 ! currently the only alternative is 480 bands + integer, parameter :: highest_default_band = 5 + integer, parameter :: sec_highest_default_band = 4 + integer, parameter :: high_number_bands = 480 + integer, parameter :: idx_Mie_snw_mx = 1471 ! number of effective radius indices used in Mie lookup table [idx] integer, parameter :: idx_T_max = 11 ! maximum temperature index used in aging lookup table [idx] integer, parameter :: idx_T_min = 1 ! minimum temperature index used in aging lookup table [idx] @@ -613,10 +618,10 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & ! SNICAR/CLM snow band center wavelength (um) allocate(wvl_ct(snicar_numrad_snw)) select case (snicar_numrad_snw) - case (5) + case (default_number_bands) nir_bnd_bgn = 2 wvl_ct(:) = (/ 0.5_r8, 0.85_r8, 1.1_r8, 1.35_r8, 3.25_r8 /) ! 5-band - case (480) + case (high_number_bands) nir_bnd_bgn = 51 do igb = 1, snicar_numrad_snw wvl_ct(igb) = 0.205_r8 + 0.01_r8 * (igb - 1._r8) ! 480-band @@ -770,11 +775,11 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & ! 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 ( (snicar_numrad_snw == 5).and.((bnd_idx == 5).or.(bnd_idx == 4)) ) then + if (snicar_numrad_snw == default_number_bands .and. (bnd_idx == highest_default_band .or. bnd_idx == sec_highest_default_band)) then mss_cnc_aer_lcl(:,:) = 0._r8 endif - if ( (snicar_numrad_snw == 480).and.(bnd_idx > 100) ) then ! >1.2um + if ( (snicar_numrad_snw == high_number_bands).and.(bnd_idx > 100) ) then ! >1.2um mss_cnc_aer_lcl(:,:) = 0._r8 endif @@ -1376,10 +1381,10 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & ! Weight output NIR albedo appropriately select case (snicar_numrad_snw) - case (5) ! 5-band case + case (default_number_bands) ! 5-band case ! VIS band albout(c_idx,ivis) = albout_lcl(ivis) - case (480) ! 480-band case + case (high_number_bands) ! 480-band case ! average for VIS band flx_sum = 0._r8 do bnd_idx= 1, (nir_bnd_bgn-1) @@ -1397,10 +1402,10 @@ subroutine SNICAR_RT (bounds, num_nourbanc, filter_nourbanc, & ! Weight output NIR absorbed layer fluxes (flx_abs) appropriately select case (snicar_numrad_snw) - case (5) ! 5-band case + case (default_number_bands) ! 5-band case ! VIS band flx_abs(c_idx,:,1) = flx_abs_lcl(:,1) - case (480) ! 480-band case + case (high_number_bands) ! 480-band case ! average for VIS band do i=snl_top,1,1 flx_sum = 0._r8 @@ -1866,7 +1871,7 @@ subroutine SnowOptics_init( ) !--------------------- for 5-band data select case (snicar_numrad_snw) - case (5) ! 5-band case + case (default_number_bands) ! 5-band case ! flux weights/spectrum tString = 'flx_wgt_dir5_'//short_case_solarspec @@ -1996,7 +2001,7 @@ subroutine SnowOptics_init( ) if ( .not. readv ) call endrun(msg=trim(errCode)//trim(tString)//errMsg(sourcefile, __LINE__)) !-------------------- for 480-band data - case (480) + case (high_number_bands) ! BC species 1 Mie parameters, uncoated BC, same as bc_hphob before BC-snow internal mixing tString = 'ss_alb_bcphob' From eeba54fe0d2856e14a5da62396622cae6f5bac10 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 6 Oct 2023 16:55:44 -0600 Subject: [PATCH 57/62] Add comment explaining posNOTonfile=.true. --- src/biogeophys/SnowSnicarMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/biogeophys/SnowSnicarMod.F90 b/src/biogeophys/SnowSnicarMod.F90 index eda055a2a7..9a95188232 100644 --- a/src/biogeophys/SnowSnicarMod.F90 +++ b/src/biogeophys/SnowSnicarMod.F90 @@ -1873,6 +1873,8 @@ subroutine SnowOptics_init( ) select case (snicar_numrad_snw) case (default_number_bands) ! 5-band case + ! The argument posNOTonfile=.true. is used here because this is a non-spatial file. + ! This argument is relevant when running single_column. ! flux weights/spectrum tString = 'flx_wgt_dir5_'//short_case_solarspec call ncd_io(trim(tString), flx_wgt_dir, 'read', ncid, readv, posNOTonfile=.true.) From 3838cebc3b95c9753a17a35555a9795700aef87e Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Fri, 6 Oct 2023 17:27:50 -0600 Subject: [PATCH 58/62] Correct syntax error --- src/main/controlMod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 634b341400..244a34bb8c 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -626,7 +626,7 @@ subroutine control_init(dtime) snicar_dust_optics /= 'sahara' .or. & snicar_numrad_snw /= 5 .or. & snicar_snobc_intmix .or. snicar_snodst_intmix .or. & - not(snicar_use_aerosol) .or. & + .not. snicar_use_aerosol .or. & do_sno_oc) then call endrun(msg=' ERROR: You have selected an option that is EXPERIMENTAL, UNSUPPORTED, and UNTESTED. For guidance see namelist_defaults_ctsm.xml'//& errMsg(sourcefile, __LINE__)) From 6adba3d3b88d120d3a653004cb07bd93895d3369 Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 17 Oct 2023 16:36:48 -0600 Subject: [PATCH 59/62] Remove a bit of redundant code and change a comment --- bld/namelist_files/namelist_definition_ctsm.xml | 2 +- src/biogeophys/UrbanAlbedoMod.F90 | 10 +--------- 2 files changed, 2 insertions(+), 10 deletions(-) diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 8856754511..10da4ccde7 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1769,7 +1769,7 @@ to hydrologic variables (either TWS or ZWT) -Toggle to turn on use of input prescribed soil moisture streams rather than have CLM prognose it (EXPERIMENTAL, UNSUPPORTED!) +Toggle to turn on use of input prescribed soil moisture streams rather than have CLM prognose it (EXPERIMENTAL) shr_log_errMsg use decompMod , only : bounds_type, subgrid_level_landunit use clm_varpar , only : numrad - use clm_varcon , only : isecspday, degpsec, spval + use clm_varcon , only : isecspday, degpsec use clm_varctl , only : iulog use abortutils , only : endrun use UrbanParamsType , only : urbanparams_type @@ -187,10 +187,6 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & c = filter_urbanc(fc) albgrd(c,ib) = 0._r8 albgri(c,ib) = 0._r8 -! add new snicar output variables for history files - albgrd_hst(c,ib) = spval - albgri_hst(c,ib) = spval -! end add new snicar end do do fp = 1,num_urbanp @@ -212,10 +208,6 @@ subroutine UrbanAlbedo (bounds, num_urbanl, filter_urbanl, & albd(p,ib) = 1._r8 albi(p,ib) = 1._r8 endif -! add new snicar output variables for history files - albd_hst(p,ib) = spval - albi_hst(p,ib) = spval -! end add new snicar fabd(p,ib) = 0._r8 fabd_sun(p,ib) = 0._r8 fabd_sha(p,ib) = 0._r8 From a2370a0426e4a8878e343a381acca046cc305d5b Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 17 Oct 2023 18:26:51 -0600 Subject: [PATCH 60/62] CLMBuildNamelist.pm: Put most snicar error checks in loop --- bld/CLMBuildNamelist.pm | 77 ++++++++++++++--------------------------- 1 file changed, 26 insertions(+), 51 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index a17fdea155..088bbe9ef0 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1995,59 +1995,34 @@ sub setup_logic_snicar_methods { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_use_aerosol' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_aerforc_diag' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'do_sno_oc' ); - # Error checking - my $opt1 = 'snicar_snw_shape'; - my $var1 = $nl->get_value($opt1); - my $sup1a = "'sphere'"; # supported value for this option - my $sup1b = "'hexagonal_plate'"; # supported value for this option - if (($var1 ne $sup1a) && ($var1 ne $sup1b)) { - $log->warning("$opt1=$sup1a and $sup1b are supported; $var1 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); - } - my $opt2 = 'snicar_solarspec'; - my $var2 = $nl->get_value($opt2); - my $sup2 = "'mid_latitude_winter'"; # supported value for this option - if ($var2 ne $sup2) { - $log->warning("$opt2=$sup2 is the supported option; $var2 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); - } - my $opt3 = 'snicar_dust_optics'; - my $var3 = $nl->get_value($opt3); - my $sup3 = "'sahara'"; # supported value for this option - if ($var3 ne $sup3) { - $log->warning("$opt3=$sup3 is the supported option; $var3 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); - } - my $opt4 = 'snicar_numrad_snw'; - my $var4 = $nl->get_value($opt4); - my $sup4 = '5'; # supported value for this option - if ($var4 ne $sup4) { - $log->warning("$opt4=$sup4 is the supported option; $var4 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); - } - my $opt5 = 'snicar_snobc_intmix'; - my $var5 = $nl->get_value($opt5); - my $sup5 = '.false.'; # supported value for this option - if ($var5 ne $sup5) { - $log->warning("$opt5=$sup5 is the supported option; $var5 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); - } - my $opt6 = 'snicar_snodst_intmix'; - my $var6 = $nl->get_value($opt6); - my $sup6 = '.false.'; # supported value for this option - if ($var6 ne $sup6) { - $log->warning("$opt6=$sup6 is the supported option; $var6 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); - } - my $opt7 = 'snicar_use_aerosol'; - my $var7 = $nl->get_value($opt7); - my $sup7 = '.true.'; # supported value for this option - if ($var7 ne $sup7) { - $log->warning("$opt7=$sup7 is the supported option; $var7 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); - } - my $opt8 = 'do_sno_oc'; - my $var8 = $nl->get_value($opt8); - my $sup8 = '.false.'; # supported value for this option - if ($var8 ne $sup8) { - $log->warning("$opt8=$sup8 is the supported option; $var8 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + + # Error checking in loop + my %supportedSettings = ( 'snicar_solarspec' => "'mid_latitude_winter'", 'snicar_dust_optics' => "'sahara'", 'snicar_numrad_snw' => '5', 'snicar_snobc_intmix' => '.false.', 'snicar_snodst_intmix' => '.false.', 'snicar_use_aerosol' => '.true.', 'do_sno_oc' => '.false.' ); + keys %supportedSettings; + while ( my ($key, $val) = each %supportedSettings ) { + my $var = $nl->get_value($key); + if ( $var ne $val ) { + $log->warning("$key=$val is the supported option; $var is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } } + + # Error checking not in loop + my $key1 = 'snicar_snw_shape'; + my $var1 = $nl->get_value($key1); + my $val1a = "'sphere'"; # supported value for this option + my $val1b = "'hexagonal_plate'"; # supported value for this option + if (($var1 ne $val1a) && ($var1 ne $val1b)) { + $log->warning("$key1=$val1a and $val1b are supported; $var1 is EXPERIMENTAL, UNSUPPORTED, and UNTESTED!"); + } + # snicar_snobc_intmix and snicar_snodst_intmix cannot both be true - if (($var5 eq $var6) && ($var5 ne $sup5)) { - $log->warning("$opt5 = $var5 and $opt6 = $var6 do not work together!"); + my $key1 = 'snicar_snobc_intmix'; + my $key2 = 'snicar_snodst_intmix'; + my $var1 = $nl->get_value($key1); + my $var2 = $nl->get_value($key2); + my $val1 = $supportedSettings{$key1}; # supported value for this option + if (($var1 eq $var2) && ($var1 ne $val1)) { + $log->warning("$key1 = $var1 and $key2 = $var2 do not work together!"); } } From f0260cfaf8fd923c237cc336b34fc1b0ff5bc14f Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Tue, 17 Oct 2023 18:29:25 -0600 Subject: [PATCH 61/62] Revert snicar_aerforc_diag to original use_snicar_frc --- bld/CLMBuildNamelist.pm | 2 +- bld/namelist_files/namelist_defaults_ctsm.xml | 2 +- bld/namelist_files/namelist_definition_ctsm.xml | 2 +- .../testmods_dirs/clm/SNICARFRC/user_nl_clm | 2 +- doc/ChangeLog | 2 +- src/biogeophys/SurfaceAlbedoMod.F90 | 6 +++--- src/biogeophys/SurfaceAlbedoType.F90 | 15 ++++++--------- src/biogeophys/SurfaceRadiationMod.F90 | 10 +++++----- src/main/clm_varctl.F90 | 2 +- src/main/controlMod.F90 | 8 ++++---- 10 files changed, 24 insertions(+), 27 deletions(-) diff --git a/bld/CLMBuildNamelist.pm b/bld/CLMBuildNamelist.pm index 088bbe9ef0..f32b1b29b4 100755 --- a/bld/CLMBuildNamelist.pm +++ b/bld/CLMBuildNamelist.pm @@ -1993,7 +1993,7 @@ sub setup_logic_snicar_methods { add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snobc_intmix' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_snodst_intmix' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_use_aerosol' ); - add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'snicar_aerforc_diag' ); + add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'use_snicar_frc' ); add_default($opts, $nl_flags->{'inputdata_rootdir'}, $definition, $defaults, $nl, 'do_sno_oc' ); # Error checking in loop diff --git a/bld/namelist_files/namelist_defaults_ctsm.xml b/bld/namelist_files/namelist_defaults_ctsm.xml index a47b920f78..e94cdba456 100644 --- a/bld/namelist_files/namelist_defaults_ctsm.xml +++ b/bld/namelist_files/namelist_defaults_ctsm.xml @@ -1566,7 +1566,7 @@ use_crop=".true.">lnd/clm2/surfdata_map/ctsm5.1.dev052/landuse.timeseries_mpasa1 sphere sphere -.false. +.false. mid_latitude_winter sahara .false. diff --git a/bld/namelist_files/namelist_definition_ctsm.xml b/bld/namelist_files/namelist_definition_ctsm.xml index 10da4ccde7..16231b3c01 100644 --- a/bld/namelist_files/namelist_definition_ctsm.xml +++ b/bld/namelist_files/namelist_definition_ctsm.xml @@ -1198,7 +1198,7 @@ DependsOnLatAndVeg - Arctic vegetation depends on latitude as above, but tempera (only used when CN is on) - Toggle to turn on calculation of SNow and Ice Aerosol Radiation model (SNICAR) albedo forcing diagnostics for each aerosol species diff --git a/cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm b/cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm index 449f749457..d03efa953b 100644 --- a/cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm +++ b/cime_config/testdefs/testmods_dirs/clm/SNICARFRC/user_nl_clm @@ -1 +1 @@ - snicar_aerforc_diag = .true. + use_snicar_frc = .true. diff --git a/doc/ChangeLog b/doc/ChangeLog index fae28d1378..ecd91fdc38 100644 --- a/doc/ChangeLog +++ b/doc/ChangeLog @@ -74,7 +74,7 @@ Changes to CTSM's user interface (e.g., new/renamed XML or namelist variables): activate bc-snow and dust-snow internal mixing do_sno_oc, default .false., already appeared in previous code but in caps - snicar_aerforc_diag, default .false., existed before as use_snicar_frc + use_snicar_frc, default .false., existed before fsnowoptics now points to an updated 5-band file and gives the option for a 480-band file diff --git a/src/biogeophys/SurfaceAlbedoMod.F90 b/src/biogeophys/SurfaceAlbedoMod.F90 index d48ba3f063..d23320d5e7 100644 --- a/src/biogeophys/SurfaceAlbedoMod.F90 +++ b/src/biogeophys/SurfaceAlbedoMod.F90 @@ -259,7 +259,7 @@ subroutine SurfaceAlbedo(bounds,nc, & use shr_orb_mod use clm_time_manager , only : get_nstep use abortutils , only : endrun - use clm_varctl , only : use_subgrid_fluxes, snicar_aerforc_diag, use_fates + use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, use_fates use CLMFatesInterfaceMod, only : hlm_fates_interface_type ! !ARGUMENTS: @@ -571,7 +571,7 @@ subroutine SurfaceAlbedo(bounds,nc, & ! If radiative forcing is being calculated, first estimate clean-snow albedo - if (snicar_aerforc_diag) then + if (use_snicar_frc) then ! 1. BC input array: ! set dust and (optionally) OC concentrations, so BC_FRC=[(BC+OC+dust)-(OC+dust)] mss_cnc_aer_in_frc_bc(bounds%begc:bounds%endc,:,5) = mss_cnc_dst1(bounds%begc:bounds%endc,:) @@ -761,7 +761,7 @@ subroutine SurfaceAlbedo(bounds,nc, & albgri(c,ib) = albsoi(c,ib)*(1._r8-frac_sno(c)) + albsni(c,ib)*frac_sno(c) ! albedos for radiative forcing calculations: - if (snicar_aerforc_diag) then + if (use_snicar_frc) then ! BC forcing albedo albgrd_bc(c,ib) = albsod(c,ib)*(1.-frac_sno(c)) + albsnd_bc(c,ib)*frac_sno(c) albgri_bc(c,ib) = albsoi(c,ib)*(1.-frac_sno(c)) + albsni_bc(c,ib)*frac_sno(c) diff --git a/src/biogeophys/SurfaceAlbedoType.F90 b/src/biogeophys/SurfaceAlbedoType.F90 index a35d99e478..a8b645b84a 100644 --- a/src/biogeophys/SurfaceAlbedoType.F90 +++ b/src/biogeophys/SurfaceAlbedoType.F90 @@ -7,7 +7,7 @@ module SurfaceAlbedoType use decompMod , only : bounds_type use clm_varpar , only : numrad, nlevcan, nlevsno use abortutils , only : endrun - use clm_varctl , only : use_SSRE, snicar_aerforc_diag + use clm_varctl , only : use_SSRE, use_snicar_frc ! ! !PUBLIC TYPES: implicit none @@ -255,7 +255,7 @@ subroutine InitHistory(this, bounds) ptr_patch=this%albi_patch, default=defaultoutput, c2l_scale_type='urbanf') ! add new snicar output variables for albedo for history files only - if (snicar_aerforc_diag) then + use_snicar_frc_if: if (use_snicar_frc) then this%albd_hst_patch(begp:endp,:) = spval call hist_addfld2d (fname='ALBD_HIST', units='proportion', type2d='numrad', & @@ -327,7 +327,7 @@ subroutine InitHistory(this, bounds) avgflag='A', long_name='snow albedo (diffuse)', & ptr_col=this%albsni_hst2_col, default='inactive') - end if ! end of snicar_aerforc_diag + end if use_snicar_frc_if ! end add new snicar end subroutine InitHistory @@ -390,7 +390,7 @@ subroutine Restart(this, bounds, ncid, flag, & ! Read/Write module information to/from restart file. ! ! !USES: - use clm_varctl , only : snicar_aerforc_diag, iulog + use clm_varctl , only : use_snicar_frc, iulog use spmdMod , only : masterproc use decompMod , only : bounds_type use abortutils , only : endrun @@ -562,7 +562,7 @@ subroutine Restart(this, bounds, ncid, flag, & this%vcmaxcintsha_patch(begp:endp) = 1._r8 end if - if (snicar_aerforc_diag) then + use_snicar_frc_if: if (use_snicar_frc) then call restartvar(ncid=ncid, flag=flag, varname='albgrd_bc', xtype=ncd_double, & dim1name='column', dim2name='numrad', switchdim=.true., & @@ -652,10 +652,7 @@ subroutine Restart(this, bounds, ncid, flag, & this%albgri_dst_col(begc:endc,:) = this%albgri_col(begc:endc,:) end if - end if ! end of if-snicar_aerforc_diag - ! add new snicar output variables for albedo for history files only - if (snicar_aerforc_diag) then call restartvar(ncid=ncid, flag=flag, varname='albd_hist', xtype=ncd_double, & dim1name='pft', dim2name='numrad', switchdim=.true., & @@ -741,7 +738,7 @@ subroutine Restart(this, bounds, ncid, flag, & scale_by_thickness=.false., & interpinic_flag='interp', readvar=readvar, data=this%albgri_dst_hst_col) - end if ! end of if-snicar_aerforc_diag + end if use_snicar_frc_if ! end add new snicar ! patch type physical state variable - fabd diff --git a/src/biogeophys/SurfaceRadiationMod.F90 b/src/biogeophys/SurfaceRadiationMod.F90 index 97f3b12eab..03557c6476 100644 --- a/src/biogeophys/SurfaceRadiationMod.F90 +++ b/src/biogeophys/SurfaceRadiationMod.F90 @@ -7,7 +7,7 @@ module SurfaceRadiationMod ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use shr_log_mod , only : errMsg => shr_log_errMsg - use clm_varctl , only : snicar_aerforc_diag, use_fates + use clm_varctl , only : use_snicar_frc, use_fates use decompMod , only : bounds_type, subgrid_level_column use atm2lndType , only : atm2lnd_type use WaterDiagnosticBulkType , only : waterdiagnosticbulk_type @@ -173,7 +173,7 @@ subroutine InitHistory(this, bounds) begp = bounds%begp; endp = bounds%endp begc = bounds%begc; endc = bounds%endc - if (snicar_aerforc_diag) then + if (use_snicar_frc) then this%sfc_frc_aer_patch(begp:endp) = spval call hist_addfld1d (fname='SNOAERFRCL', units='W/m^2', & avgflag='A', long_name='surface forcing of all aerosols in snow (land) ', & @@ -477,7 +477,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & use clm_varpar , only : numrad, nlevsno use clm_varcon , only : spval use landunit_varcon , only : istsoil, istcrop - use clm_varctl , only : use_subgrid_fluxes, snicar_aerforc_diag, iulog, use_SSRE, do_sno_oc + use clm_varctl , only : use_subgrid_fluxes, use_snicar_frc, iulog, use_SSRE, do_sno_oc use clm_time_manager , only : get_step_size_real, is_near_local_noon use abortutils , only : endrun ! @@ -719,7 +719,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & sabg_soil(p) = sabg(p) endif - if (snicar_aerforc_diag) then + if (use_snicar_frc) then ! Solar radiation absorbed by ground surface without BC absrad_bc = trd(p,ib)*(1._r8-albgrd_bc(c,ib)) + tri(p,ib)*(1._r8-albgri_bc(c,ib)) sabg_bc(p) = sabg_bc(p) + absrad_bc @@ -849,7 +849,7 @@ subroutine SurfaceRadiation(bounds, num_nourbanp, filter_nourbanp, & sabg_pen(p) = sabg(p) - sabg_lyr(p, snl(c)+1) end if - if (snicar_aerforc_diag) then + if (use_snicar_frc) then ! BC aerosol forcing (patch-level): sfc_frc_bc(p) = sabg(p) - sabg_bc(p) diff --git a/src/main/clm_varctl.F90 b/src/main/clm_varctl.F90 index 7fc0676b78..8ebc8fb08d 100644 --- a/src/main/clm_varctl.F90 +++ b/src/main/clm_varctl.F90 @@ -457,7 +457,7 @@ module clm_varctl logical, public :: use_cndv = .false. logical, public :: use_grainproduct = .false. logical, public :: use_fertilizer = .false. - logical, public :: snicar_aerforc_diag = .false. + logical, public :: use_snicar_frc = .false. logical, public :: use_vancouver = .false. logical, public :: use_mexicocity = .false. logical, public :: use_noio = .false. diff --git a/src/main/controlMod.F90 b/src/main/controlMod.F90 index 244a34bb8c..f19f135cb9 100644 --- a/src/main/controlMod.F90 +++ b/src/main/controlMod.F90 @@ -283,14 +283,14 @@ subroutine control_init(dtime) namelist /clm_inparm/ & use_lch4, use_nitrif_denitrif, use_extralakelayers, & use_vichydro, use_cn, use_cndv, use_crop, use_fertilizer, & - use_grainproduct, use_vancouver, use_mexicocity, use_noio, & + use_grainproduct, use_snicar_frc, use_vancouver, use_mexicocity, use_noio, & use_nguardrail ! SNICAR namelist /clm_inparm/ & snicar_numrad_snw, snicar_solarspec, snicar_dust_optics, & snicar_use_aerosol, snicar_snw_shape, snicar_snobc_intmix, & - snicar_snodst_intmix, snicar_aerforc_diag, do_sno_oc + snicar_snodst_intmix, do_sno_oc ! ---------------------------------------------------------------------- ! Default values @@ -694,7 +694,7 @@ subroutine control_spmd() call mpi_bcast (use_fertilizer, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_grainproduct, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (o3_veg_stress_method, len(o3_veg_stress_method), MPI_CHARACTER, 0, mpicom, ier) - call mpi_bcast (snicar_aerforc_diag, 1, MPI_LOGICAL, 0, mpicom, ier) + call mpi_bcast (use_snicar_frc, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_vancouver, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_mexicocity, 1, MPI_LOGICAL, 0, mpicom, ier) call mpi_bcast (use_noio, 1, MPI_LOGICAL, 0, mpicom, ier) @@ -954,7 +954,7 @@ subroutine control_print () write(iulog,*) ' use_fertilizer = ', use_fertilizer write(iulog,*) ' use_grainproduct = ', use_grainproduct write(iulog,*) ' o3_veg_stress_method = ', o3_veg_stress_method - write(iulog,*) ' snicar_aerforc_diag = ', snicar_aerforc_diag + write(iulog,*) ' use_snicar_frc = ', use_snicar_frc write(iulog,*) ' snicar_use_aerosol = ',snicar_use_aerosol write(iulog,*) ' use_vancouver = ', use_vancouver write(iulog,*) ' use_mexicocity = ', use_mexicocity From 189086595734910995067e54eb7948b64eb19f9a Mon Sep 17 00:00:00 2001 From: Samuel Levis Date: Thu, 19 Oct 2023 11:13:25 -0600 Subject: [PATCH 62/62] Removing duplicate lines of code #2129 #2107 --- src/biogeochem/CNVegCarbonStateType.F90 | 1 - src/biogeophys/BareGroundFluxesMod.F90 | 4 ---- 2 files changed, 5 deletions(-) diff --git a/src/biogeochem/CNVegCarbonStateType.F90 b/src/biogeochem/CNVegCarbonStateType.F90 index 7515051d38..8ce278c166 100644 --- a/src/biogeochem/CNVegCarbonStateType.F90 +++ b/src/biogeochem/CNVegCarbonStateType.F90 @@ -1612,7 +1612,6 @@ subroutine Restart ( this, bounds, ncid, flag, carbon_type, reseed_dead_plants, this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c3_r2 else this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c4_r2 - this%leafc_storage_patch(i) = c12_cnveg_carbonstate_inst%leafc_storage_patch(i) * c4_r2 endif end do end if diff --git a/src/biogeophys/BareGroundFluxesMod.F90 b/src/biogeophys/BareGroundFluxesMod.F90 index 645b908157..7dfa83820d 100644 --- a/src/biogeophys/BareGroundFluxesMod.F90 +++ b/src/biogeophys/BareGroundFluxesMod.F90 @@ -306,10 +306,6 @@ subroutine BareGroundFluxes(bounds, num_noexposedvegp, filter_noexposedvegp, & ulrad(p) = 0._r8 dhsdt_canopy(p) = 0._r8 eflx_sh_stem(p) = 0._r8 - z0mv(p) = 0._r8 - z0hv(p) = 0._r8 - z0qv(p) = 0._r8 - ur(p) = max(params_inst%wind_min,sqrt(forc_u(g)*forc_u(g)+forc_v(g)*forc_v(g))) dth(p) = thm(p)-t_grnd(c)