diff --git a/.github/workflows/test-icepack.yml b/.github/workflows/test-icepack.yml index 883031a00..fe8dc1946 100644 --- a/.github/workflows/test-icepack.yml +++ b/.github/workflows/test-icepack.yml @@ -115,7 +115,7 @@ jobs: - name: run suite run: | cd $HOME/icepack - ./icepack.setup -m conda -e ${{ matrix.envdef }} --suite travis_suite --testid ${{ matrix.os }} + ./icepack.setup -m conda -e ${{ matrix.envdef }} --suite travis_suite,io_suite --testid ${{ matrix.os }} - name: write output run: | cd $HOME/icepack diff --git a/.travis.yml b/.travis.yml index bcbcd0382..12608ff0e 100644 --- a/.travis.yml +++ b/.travis.yml @@ -31,7 +31,7 @@ script: - "./icepack.setup --case trcase --mach travisCI --env gnu --pes 1x1 -s diag1 && sleep 4" - "./icepack.setup --test smoke --testid trtest --mach travisCI --env gnu --pes 1x1 -s diag1 && sleep 4" - - "./icepack.setup --suite travis_suite --testid travisCItest + - "./icepack.setup --suite travis_suite,io_suite --testid travisCItest --mach travisCI --env gnu && cd testsuite.travisCItest && ./results.csh" diff --git a/columnphysics/icepack_algae.F90 b/columnphysics/icepack_algae.F90 index 90a4376aa..c22fa8d1d 100644 --- a/columnphysics/icepack_algae.F90 +++ b/columnphysics/icepack_algae.F90 @@ -332,6 +332,7 @@ subroutine zbio (dt, nblyr, & if (icepack_warnings_aborted(subname)) return call merge_bgc_fluxes (dt, nblyr, & + nslyr, & bio_index, n_algae, & nbtrcr, aicen, & vicen, vsnon, & diff --git a/columnphysics/icepack_flux.F90 b/columnphysics/icepack_flux.F90 index a1029379a..19864e46a 100644 --- a/columnphysics/icepack_flux.F90 +++ b/columnphysics/icepack_flux.F90 @@ -58,8 +58,9 @@ subroutine merge_fluxes (aicen, & fswthru_idr, fswthru_idf,& melttn, meltsn, meltbn, congeln, snoicen, & meltt, melts, & - meltb, & + meltb, dsnow, dsnown,& congel, snoice, & + meltsliq, meltsliqn, & Uref, Urefn, & Qref_iso, Qrefn_iso, & fiso_ocn, fiso_ocnn, & @@ -95,6 +96,8 @@ subroutine merge_fluxes (aicen, & melttn , & ! top ice melt (m) meltbn , & ! bottom ice melt (m) meltsn , & ! snow melt (m) + meltsliqn,& ! mass of snow melt (kg/m^2) + dsnown , & ! change in snow depth (m) congeln , & ! congelation ice growth (m) snoicen ! snow-ice growth (m) @@ -125,6 +128,8 @@ subroutine merge_fluxes (aicen, & meltt , & ! top ice melt (m) meltb , & ! bottom ice melt (m) melts , & ! snow melt (m) + meltsliq, & ! mass of snow melt (kg/m^2) + dsnow , & ! change in snow depth (m) congel , & ! congelation ice growth (m) snoice ! snow-ice growth (m) @@ -212,6 +217,8 @@ subroutine merge_fluxes (aicen, & meltt = meltt + melttn * aicen meltb = meltb + meltbn * aicen melts = melts + meltsn * aicen + meltsliq = meltsliq + meltsliqn * aicen + dsnow = dsnow + dsnown * aicen congel = congel + congeln * aicen snoice = snoice + snoicen * aicen diff --git a/columnphysics/icepack_intfc.F90 b/columnphysics/icepack_intfc.F90 index ee75fd49b..ac4766d44 100644 --- a/columnphysics/icepack_intfc.F90 +++ b/columnphysics/icepack_intfc.F90 @@ -82,6 +82,8 @@ module icepack_intfc use icepack_wavefracspec, only: icepack_init_wave use icepack_wavefracspec, only: icepack_step_wavefracture + use icepack_snow, only: icepack_step_snow + use icepack_shortwave, only: icepack_prep_radiation use icepack_shortwave, only: icepack_step_radiation @@ -114,6 +116,8 @@ module icepack_intfc use icepack_mushy_physics , only: icepack_mushy_liquid_fraction use icepack_mushy_physics , only: icepack_mushy_temperature_mush + use icepack_snow, only: icepack_init_snow + use icepack_warnings, only: icepack_warnings_clear use icepack_warnings, only: icepack_warnings_print use icepack_warnings, only: icepack_warnings_flush diff --git a/columnphysics/icepack_itd.F90 b/columnphysics/icepack_itd.F90 index 4b9ef197d..0c98b7ecf 100644 --- a/columnphysics/icepack_itd.F90 +++ b/columnphysics/icepack_itd.F90 @@ -28,11 +28,10 @@ module icepack_itd use icepack_kinds use icepack_parameters, only: c0, c1, c2, c3, c15, c25, c100, p1, p01, p001, p5, puny use icepack_parameters, only: Lfresh, rhos, ice_ref_salinity, hs_min, cp_ice, Tocnfrz, rhoi - use icepack_parameters, only: rhosi, sk_l, hs_ssl, min_salin + use icepack_parameters, only: rhosi, sk_l, hs_ssl, min_salin, rsnw_fall use icepack_tracers, only: nt_Tsfc, nt_qice, nt_qsno, nt_aero, nt_isosno, nt_isoice use icepack_tracers, only: nt_apnd, nt_hpnd, nt_fbri, tr_brine, nt_bgc_S, bio_index - use icepack_tracers, only: n_iso - use icepack_tracers, only: tr_iso + use icepack_tracers, only: n_iso, tr_iso, tr_snow, nt_smice, nt_rsnw, nt_rhos use icepack_tracers, only: icepack_compute_tracers use icepack_parameters, only: solve_zsal, skl_bgc, z_tracers use icepack_parameters, only: kcatbound, kitd @@ -1230,11 +1229,15 @@ subroutine zap_small_areas (dt, ntrcr, & if (ntrcr >= 2) then do it = 2, ntrcr - if (tr_brine .and. it == nt_fbri) then - trcrn(it,n) = c1 - else - trcrn(it,n) = c0 - endif + trcrn(it,n) = c0 + enddo + endif + if (tr_brine) trcrn(nt_fbri,n) = c1 + if (tr_snow) then + do k = 1, nslyr + trcrn(nt_rhos +k-1,n) = rhos + trcrn(nt_smice+k-1,n) = rhos + trcrn(nt_rsnw +k-1,n) = rsnw_fall enddo endif first_ice(n) = .true. @@ -1424,14 +1427,14 @@ subroutine zap_snow(dt, nslyr, & endif ! tr_iso if (z_tracers) then - dvssl = min(p5*vsnon, hs_ssl*aicen) !snow surface layer - dvint = vsnon- dvssl !snow interior - - do it = 1, nbtrcr - xtmp = (trcrn(bio_index(it)+nblyr+1)*dvssl + & - trcrn(bio_index(it)+nblyr+2)*dvint)/dt - dflux_bio(it) = dflux_bio(it) + xtmp - enddo ! it + dvssl = min(p5*vsnon/real(nslyr,kind=dbl_kind), hs_ssl*aicen) ! snow surface layer + dvint = vsnon - dvssl ! snow interior + + do it = 1, nbtrcr + xtmp = (trcrn(bio_index(it)+nblyr+1)*dvssl + & + trcrn(bio_index(it)+nblyr+2)*dvint)/dt + dflux_bio(it) = dflux_bio(it) + xtmp + enddo ! it endif ! z_tracers diff --git a/columnphysics/icepack_meltpond_cesm.F90 b/columnphysics/icepack_meltpond_cesm.F90 index 54e5ad7ad..d7756aa3b 100644 --- a/columnphysics/icepack_meltpond_cesm.F90 +++ b/columnphysics/icepack_meltpond_cesm.F90 @@ -16,7 +16,7 @@ module icepack_meltpond_cesm use icepack_kinds use icepack_parameters, only: c0, c1, c2, p01, puny - use icepack_parameters, only: rhofresh, rhoi, rhos, Timelt + use icepack_parameters, only: rhofresh, rhoi, rhos, Timelt, pndaspect, use_smliq_pnd use icepack_warnings, only: warnstr, icepack_warnings_add use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted @@ -32,19 +32,19 @@ module icepack_meltpond_cesm !======================================================================= subroutine compute_ponds_cesm(dt, hi_min, & - pndaspect, & rfrac, meltt, & melts, frain, & - aicen, vicen, & - Tsfcn, apnd, hpnd) + aicen, vicen, & + Tsfcn, apnd, hpnd, & + meltsliqn) real (kind=dbl_kind), intent(in) :: & dt, & ! time step (s) - hi_min, & ! minimum ice thickness allowed for thermo (m) - pndaspect ! ratio of pond depth to pond fraction + hi_min ! minimum ice thickness allowed for thermo (m) real (kind=dbl_kind), intent(in) :: & - rfrac, & ! water fraction retained for melt ponds + meltsliqn, & ! liquid input from snow liquid tracer + rfrac, & ! water fraction retained for melt ponds meltt, & melts, & frain, & @@ -104,11 +104,18 @@ subroutine compute_ponds_cesm(dt, hi_min, & !----------------------------------------------------------- ! Update pond volume !----------------------------------------------------------- - volpn = volpn & - + rfrac/rhofresh*(meltt*rhoi & - + melts*rhos & - + frain* dt)& - * aicen + if (use_smliq_pnd) then + volpn = volpn & + + rfrac/rhofresh*(meltt*rhoi & + + meltsliqn) & + * aicen + else + volpn = volpn & + + rfrac/rhofresh*(meltt*rhoi & + + melts*rhos & + + frain* dt)& + * aicen + endif !----------------------------------------------------------- ! Shrink pond volume under freezing conditions diff --git a/columnphysics/icepack_meltpond_lvl.F90 b/columnphysics/icepack_meltpond_lvl.F90 index c624ffcba..11a9da1f1 100644 --- a/columnphysics/icepack_meltpond_lvl.F90 +++ b/columnphysics/icepack_meltpond_lvl.F90 @@ -17,7 +17,7 @@ module icepack_meltpond_lvl use icepack_kinds use icepack_parameters, only: c0, c1, c2, c10, p01, p5, puny use icepack_parameters, only: viscosity_dyn, rhoi, rhos, rhow, Timelt, Tffresh, Lfresh - use icepack_parameters, only: gravit, depressT, rhofresh, kice + use icepack_parameters, only: gravit, depressT, rhofresh, kice, pndaspect, use_smliq_pnd use icepack_warnings, only: warnstr, icepack_warnings_add use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted @@ -35,14 +35,15 @@ module icepack_meltpond_lvl subroutine compute_ponds_lvl(dt, nilyr, & ktherm, & hi_min, dpscale, & - frzpnd, pndaspect, & + frzpnd, & rfrac, meltt, melts, & frain, Tair, fsurfn,& dhs, ffrac, & aicen, vicen, vsnon, & qicen, sicen, & Tsfcn, alvl, & - apnd, hpnd, ipnd) + apnd, hpnd, ipnd, & + meltsliqn) integer (kind=int_kind), intent(in) :: & nilyr, & ! number of ice layers @@ -51,8 +52,7 @@ subroutine compute_ponds_lvl(dt, nilyr, & real (kind=dbl_kind), intent(in) :: & dt, & ! time step (s) hi_min, & ! minimum ice thickness allowed for thermo (m) - dpscale, & ! alter e-folding time scale for flushing - pndaspect ! ratio of pond depth to pond fraction + dpscale ! alter e-folding time scale for flushing character (len=char_len), intent(in) :: & frzpnd ! pond refreezing parameterization @@ -69,7 +69,8 @@ subroutine compute_ponds_lvl(dt, nilyr, & fsurfn,& ! atm-ice surface heat flux (W/m2) aicen, & ! ice area fraction vicen, & ! ice volume (m) - vsnon ! snow volume (m) + vsnon, & ! snow volume (m) + meltsliqn ! liquid contribution to meltponds in dt (kg/m^2) real (kind=dbl_kind), & intent(inout) :: & @@ -154,9 +155,14 @@ subroutine compute_ponds_lvl(dt, nilyr, & ! update pond volume !----------------------------------------------------------- ! add melt water - dvn = rfrac/rhofresh*(meltt*rhoi & - + melts*rhos & - + frain* dt)*aicen + if (use_smliq_pnd) then + dvn = rfrac/rhofresh*(meltt*rhoi & + + meltsliqn)*aicen + else + dvn = rfrac/rhofresh*(meltt*rhoi & + + melts*rhos & + + frain* dt)*aicen + endif ! shrink pond volume under freezing conditions if (trim(frzpnd) == 'cesm') then diff --git a/columnphysics/icepack_parameters.F90 b/columnphysics/icepack_parameters.F90 index ad571ab87..6191de996 100644 --- a/columnphysics/icepack_parameters.F90 +++ b/columnphysics/icepack_parameters.F90 @@ -7,7 +7,8 @@ module icepack_parameters use icepack_kinds - use icepack_warnings, only: icepack_warnings_aborted + use icepack_warnings, only: icepack_warnings_aborted, & + icepack_warnings_add, icepack_warnings_setabort implicit none private @@ -316,13 +317,51 @@ module icepack_parameters real (kind=dbl_kind), public :: & hp1 = 0.01_dbl_kind ! critical pond lid thickness for topo ponds +!----------------------------------------------------------------------- +! Parameters for snow redistribution, metamorphosis +!----------------------------------------------------------------------- + + character (len=char_len), public :: & + snwredist = 'none', & ! type of snow redistribution + snw_aging_table = 'test' ! lookup table: 'snicar' or 'test' or 'file' + + logical (kind=log_kind), public :: & + use_smliq_pnd = .false. , & ! use liquid in snow for ponds + snwgrain = .false. ! snow metamorphosis + + real (kind=dbl_kind), public :: & + rsnw_fall = 54.526_dbl_kind, & ! radius of new snow (10^-6 m) + rsnw_tmax = 1500.0_dbl_kind, & ! maximum snow radius (10^-6 m) + rhosnew = 100.0_dbl_kind, & ! new snow density (kg/m^3) + rhosmin = 100.0_dbl_kind, & ! minimum snow density (kg/m^3) + rhosmax = 450.0_dbl_kind, & ! maximum snow density (kg/m^3) + windmin = 10.0_dbl_kind, & ! minimum wind speed to compact snow (m/s) + drhosdwind = 27.3_dbl_kind, & ! wind compaction factor for snow (kg s/m^4) + snwlvlfac = 0.3_dbl_kind ! fractional increase in snow + ! depth for bulk redistribution + ! indices for aging lookup table + integer (kind=int_kind), public :: & + isnw_T, & ! maximum temperature index + isnw_Tgrd, & ! maximum temperature gradient index + isnw_rhos ! maximum snow density index + + ! dry snow aging parameters + real (kind=dbl_kind), dimension(:), allocatable, public :: & + snowage_rhos, & ! snowage table dimension data for rhos (kg/m^3) + snowage_Tgrd, & ! snowage table dimension data for temp gradient (deg K/m) + snowage_T ! snowage table dimension data for temperature (deg K) + real (kind=dbl_kind), dimension(:,:,:), allocatable, public :: & + snowage_tau, & ! snowage table 3D data for tau (10^-6 m) + snowage_kappa, & ! snowage table 3D data for kappa (10^-6 m) + snowage_drdt0 ! snowage table 3D data for drdt0 (10^-6 m/hr) + !----------------------------------------------------------------------- ! Parameters for biogeochemistry !----------------------------------------------------------------------- character(char_len), public :: & ! skl biology parameters - bgc_flux_type = 'Jin2006' ! type of ocean-ice poston velocity (or 'constant') + bgc_flux_type = 'Jin2006' ! type of ocean-ice piston velocity (or 'constant') logical (kind=log_kind), public :: & z_tracers = .false., & ! if .true., bgc or aerosol tracers are vertically resolved @@ -421,7 +460,13 @@ subroutine icepack_init_parameters( & fr_dFe_in, k_nitrif_in, t_iron_conv_in, max_loss_in, & max_dfe_doc1_in, fr_resp_s_in, conserv_check_in, & y_sk_DMS_in, t_sk_conv_in, t_sk_ox_in, frazil_scav_in, & - sw_redist_in, sw_frac_in, sw_dtemp_in) + sw_redist_in, sw_frac_in, sw_dtemp_in, snwgrain_in, & + snwredist_in, use_smliq_pnd_in, rsnw_fall_in, rsnw_tmax_in, & + rhosnew_in, rhosmin_in, rhosmax_in, windmin_in, drhosdwind_in, & + snwlvlfac_in, isnw_T_in, isnw_Tgrd_in, isnw_rhos_in, & + snowage_rhos_in, snowage_Tgrd_in, snowage_T_in, & + snowage_tau_in, snowage_kappa_in, snowage_drdt0_in, & + snw_aging_table_in) !----------------------------------------------------------------- ! parameter constants @@ -479,7 +524,7 @@ subroutine icepack_init_parameters( & ! 1 = Bitz and Lipscomb 1999 ! 2 = mushy layer theory - character (char_len), intent(in), optional :: & + character (len=*), intent(in), optional :: & conduct_in, & ! 'MU71' or 'bubbly' fbot_xfer_type_in ! transfer coefficient type for ice-ocean heat flux @@ -504,7 +549,7 @@ subroutine icepack_init_parameters( & phi_c_slow_mode_in , & ! liquid fraction porosity cutoff for slow mode phi_i_mushy_in ! liquid fraction of congelation ice - character(len=char_len), intent(in), optional :: & + character(len=*), intent(in), optional :: & tfrz_option_in ! form of ocean freezing temperature ! 'minus1p8' = -1.8 C ! 'linear_salt' = -depressT * sss @@ -527,7 +572,7 @@ subroutine icepack_init_parameters( & awtvdf_in, & ! visible, diffuse awtidf_in ! near IR, diffuse - character (len=char_len), intent(in), optional :: & + character (len=*), intent(in), optional :: & shortwave_in, & ! shortwave method, 'ccsm3' or 'dEdd' albedo_type_in ! albedo parameterization, 'ccsm3' or 'constant' ! shortwave='dEdd' overrides this parameter @@ -600,7 +645,7 @@ subroutine icepack_init_parameters( & qqqocn_in, & ! for qsat over ocn TTTocn_in ! for qsat over ocn - character (len=char_len), intent(in), optional :: & + character (len=*), intent(in), optional :: & atmbndy_in ! atmo boundary method, 'default' ('ccsm3') or 'constant' logical (kind=log_kind), intent(in), optional :: & @@ -640,14 +685,14 @@ subroutine icepack_init_parameters( & logical (kind=log_kind), intent(in), optional :: & wave_spec_in ! if true, use wave forcing - character (len=char_len), intent(in), optional :: & + character (len=*), intent(in), optional :: & wave_spec_type_in ! type of wave spectrum forcing !----------------------------------------------------------------------- ! Parameters for biogeochemistry !----------------------------------------------------------------------- - character(char_len), intent(in), optional :: & + character (len=*), intent(in), optional :: & bgc_flux_type_in ! type of ocean-ice piston velocity ! 'constant', 'Jin2006' @@ -708,7 +753,7 @@ subroutine icepack_init_parameters( & hs0_in ! snow depth for transition to bare sea ice (m) ! level-ice ponds - character (len=char_len), intent(in), optional :: & + character (len=*), intent(in), optional :: & frzpnd_in ! pond refreezing parameterization real (kind=dbl_kind), intent(in), optional :: & @@ -722,6 +767,43 @@ subroutine icepack_init_parameters( & real (kind=dbl_kind), intent(in), optional :: & hp1_in ! critical parameter for pond ice thickness +!----------------------------------------------------------------------- +! Parameters for snow redistribution, metamorphosis +!----------------------------------------------------------------------- + + character (len=*), intent(in), optional :: & + snwredist_in, & ! type of snow redistribution + snw_aging_table_in ! snow aging lookup table + + logical (kind=log_kind), intent(in), optional :: & + use_smliq_pnd_in, &! use liquid in snow for ponds + snwgrain_in ! snow metamorphosis + + real (kind=dbl_kind), intent(in), optional :: & + rsnw_fall_in, & ! radius of new snow (10^-6 m) + rsnw_tmax_in, & ! maximum snow radius (10^-6 m) + rhosnew_in, & ! new snow density (kg/m^3) + rhosmin_in, & ! minimum snow density (kg/m^3) + rhosmax_in, & ! maximum snow density (kg/m^3) + windmin_in, & ! minimum wind speed to compact snow (m/s) + drhosdwind_in, & ! wind compaction factor (kg s/m^4) + snwlvlfac_in ! fractional increase in snow depth + + integer (kind=int_kind), intent(in), optional :: & + isnw_T_in, & ! maxiumum temperature index + isnw_Tgrd_in, & ! maxiumum temperature gradient index + isnw_rhos_in ! maxiumum snow density index + + real (kind=dbl_kind), dimension(:), intent(in), optional :: & + snowage_rhos_in, & ! snowage dimension data + snowage_Tgrd_in, & ! + snowage_T_in ! + + real (kind=dbl_kind), dimension(:,:,:), intent(in), optional :: & + snowage_tau_in, & ! (10^-6 m) + snowage_kappa_in, &! + snowage_drdt0_in ! (10^-6 m/hr) + !autodocument_end character(len=*),parameter :: subname='(icepack_init_parameters)' @@ -840,6 +922,124 @@ subroutine icepack_init_parameters( & if (present(pndaspect_in) ) pndaspect = pndaspect_in if (present(hs1_in) ) hs1 = hs1_in if (present(hp1_in) ) hp1 = hp1_in + if (present(snwredist_in) ) snwredist = snwredist_in + if (present(snw_aging_table_in) ) snw_aging_table = snw_aging_table_in + if (present(snwgrain_in) ) snwgrain = snwgrain_in + if (present(use_smliq_pnd_in) ) use_smliq_pnd = use_smliq_pnd_in + if (present(rsnw_fall_in) ) rsnw_fall = rsnw_fall_in + if (present(rsnw_tmax_in) ) rsnw_tmax = rsnw_tmax_in + if (present(rhosnew_in) ) rhosnew = rhosnew_in + if (present(rhosmin_in) ) rhosmin = rhosmin_in + if (present(rhosmax_in) ) rhosmax = rhosmax_in + if (present(windmin_in) ) windmin = windmin_in + if (present(drhosdwind_in) ) drhosdwind = drhosdwind_in + if (present(snwlvlfac_in) ) snwlvlfac = snwlvlfac_in + if (present(isnw_T_in) ) isnw_T = isnw_T_in + if (present(isnw_Tgrd_in) ) isnw_Tgrd = isnw_Tgrd_in + if (present(isnw_rhos_in) ) isnw_rhos = isnw_rhos_in + + ! check array sizes and re/allocate if necessary + if (present(snowage_rhos_in) ) then + if (size(snowage_rhos_in) /= isnw_rhos) then + call icepack_warnings_add(subname//' incorrect size of snowage_rhos_in') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + elseif (.not.allocated(snowage_rhos)) then + allocate(snowage_rhos(isnw_rhos)) + snowage_rhos = snowage_rhos_in + elseif (size(snowage_rhos) /= isnw_rhos) then + deallocate(snowage_rhos) + allocate(snowage_rhos(isnw_rhos)) + snowage_rhos = snowage_rhos_in + else + snowage_rhos = snowage_rhos_in + endif + endif + + ! check array sizes and re/allocate if necessary + if (present(snowage_Tgrd_in) ) then + if (size(snowage_Tgrd_in) /= isnw_Tgrd) then + call icepack_warnings_add(subname//' incorrect size of snowage_Tgrd_in') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + elseif (.not.allocated(snowage_Tgrd)) then + allocate(snowage_Tgrd(isnw_Tgrd)) + snowage_Tgrd = snowage_Tgrd_in + elseif (size(snowage_Tgrd) /= isnw_Tgrd) then + deallocate(snowage_Tgrd) + allocate(snowage_Tgrd(isnw_Tgrd)) + snowage_Tgrd = snowage_Tgrd_in + else + snowage_Tgrd = snowage_Tgrd_in + endif + endif + + ! check array sizes and re/allocate if necessary + if (present(snowage_T_in) ) then + if (size(snowage_T_in) /= isnw_T) then + call icepack_warnings_add(subname//' incorrect size of snowage_T_in') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + elseif (.not.allocated(snowage_T)) then + allocate(snowage_T(isnw_T)) + snowage_T = snowage_T_in + elseif (size(snowage_T) /= isnw_T) then + deallocate(snowage_T) + allocate(snowage_T(isnw_T)) + snowage_T = snowage_T_in + else + snowage_T = snowage_T_in + endif + endif + + ! check array sizes and re/allocate if necessary + if (present(snowage_tau_in) ) then + if (size(snowage_tau_in) /= isnw_T*isnw_Tgrd*isnw_rhos) then + call icepack_warnings_add(subname//' incorrect size of snowage_tau_in') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + elseif (.not.allocated(snowage_tau)) then + allocate(snowage_tau(isnw_T,isnw_Tgrd,isnw_rhos)) + snowage_tau = snowage_tau_in + elseif (size(snowage_tau) /= isnw_T*isnw_Tgrd*isnw_rhos) then + deallocate(snowage_tau) + allocate(snowage_tau(isnw_T,isnw_Tgrd,isnw_rhos)) + snowage_tau = snowage_tau_in + else + snowage_tau = snowage_tau_in + endif + endif + + ! check array sizes and re/allocate if necessary + if (present(snowage_kappa_in) ) then + if (size(snowage_kappa_in) /= isnw_T*isnw_Tgrd*isnw_rhos) then + call icepack_warnings_add(subname//' incorrect size of snowage_kappa_in') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + elseif (.not.allocated(snowage_kappa)) then + allocate(snowage_kappa(isnw_T,isnw_Tgrd,isnw_rhos)) + snowage_kappa = snowage_kappa_in + elseif (size(snowage_kappa) /= isnw_T*isnw_Tgrd*isnw_rhos) then + deallocate(snowage_kappa) + allocate(snowage_kappa(isnw_T,isnw_Tgrd,isnw_rhos)) + snowage_kappa = snowage_kappa_in + else + snowage_kappa = snowage_kappa_in + endif + endif + + ! check array sizes and re/allocate if necessary + if (present(snowage_drdt0_in) ) then + if (size(snowage_drdt0_in) /= isnw_T*isnw_Tgrd*isnw_rhos) then + call icepack_warnings_add(subname//' incorrect size of snowage_drdt0_in') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + elseif (.not.allocated(snowage_drdt0)) then + allocate(snowage_drdt0(isnw_T,isnw_Tgrd,isnw_rhos)) + snowage_drdt0 = snowage_drdt0_in + elseif (size(snowage_drdt0) /= isnw_T*isnw_Tgrd*isnw_rhos) then + deallocate(snowage_drdt0) + allocate(snowage_drdt0(isnw_T,isnw_Tgrd,isnw_rhos)) + snowage_drdt0 = snowage_drdt0_in + else + snowage_drdt0 = snowage_drdt0_in + endif + endif + if (present(bgc_flux_type_in) ) bgc_flux_type = bgc_flux_type_in if (present(z_tracers_in) ) z_tracers = z_tracers_in if (present(scale_bgc_in) ) scale_bgc = scale_bgc_in @@ -931,7 +1131,13 @@ subroutine icepack_query_parameters( & fr_mort2min_out, fr_resp_s_out, fr_dFe_out, & k_nitrif_out, t_iron_conv_out, max_loss_out, max_dfe_doc1_out, & y_sk_DMS_out, t_sk_conv_out, t_sk_ox_out, frazil_scav_out, & - sw_redist_out, sw_frac_out, sw_dtemp_out) + sw_redist_out, sw_frac_out, sw_dtemp_out, snwgrain_out, & + snwredist_out, use_smliq_pnd_out, rsnw_fall_out, rsnw_tmax_out, & + rhosnew_out, rhosmin_out, rhosmax_out, windmin_out, drhosdwind_out, & + snwlvlfac_out, isnw_T_out, isnw_Tgrd_out, isnw_rhos_out, & + snowage_rhos_out, snowage_Tgrd_out, snowage_T_out, & + snowage_tau_out, snowage_kappa_out, snowage_drdt0_out, & + snw_aging_table_out) !----------------------------------------------------------------- ! parameter constants @@ -998,7 +1204,7 @@ subroutine icepack_query_parameters( & ! 1 = Bitz and Lipscomb 1999 ! 2 = mushy layer theory - character (char_len), intent(out), optional :: & + character (len=*), intent(out), optional :: & conduct_out, & ! 'MU71' or 'bubbly' fbot_xfer_type_out ! transfer coefficient type for ice-ocean heat flux @@ -1023,7 +1229,7 @@ subroutine icepack_query_parameters( & phi_c_slow_mode_out , & ! liquid fraction porosity cutoff for slow mode phi_i_mushy_out ! liquid fraction of congelation ice - character(len=char_len), intent(out), optional :: & + character(len=*), intent(out), optional :: & tfrz_option_out ! form of ocean freezing temperature ! 'minus1p8' = -1.8 C ! 'linear_salt' = -depressT * sss @@ -1046,7 +1252,7 @@ subroutine icepack_query_parameters( & awtvdf_out, & ! visible, diffuse awtidf_out ! near IR, diffuse - character (len=char_len), intent(out), optional :: & + character (len=*), intent(out), optional :: & shortwave_out, & ! shortwave method, 'ccsm3' or 'dEdd' albedo_type_out ! albedo parameterization, 'ccsm3' or 'constant' ! shortwave='dEdd' overrides this parameter @@ -1119,7 +1325,7 @@ subroutine icepack_query_parameters( & qqqocn_out, & ! for qsat over ocn TTTocn_out ! for qsat over ocn - character (len=char_len), intent(out), optional :: & + character (len=*), intent(out), optional :: & atmbndy_out ! atmo boundary method, 'default' ('ccsm3') or 'constant' logical (kind=log_kind), intent(out), optional :: & @@ -1159,15 +1365,15 @@ subroutine icepack_query_parameters( & logical (kind=log_kind), intent(out), optional :: & wave_spec_out ! if true, use wave forcing - character (len=char_len), intent(out), optional :: & + character (len=*), intent(out), optional :: & wave_spec_type_out ! type of wave spectrum forcing !----------------------------------------------------------------------- ! Parameters for biogeochemistry !----------------------------------------------------------------------- - character(char_len), intent(out), optional :: & - bgc_flux_type_out ! type of ocean-ice piston velocity + character (len=*), intent(out), optional :: & + bgc_flux_type_out ! type of ocean-ice piston velocity ! 'constant', 'Jin2006' logical (kind=log_kind), intent(out), optional :: & @@ -1227,7 +1433,7 @@ subroutine icepack_query_parameters( & hs0_out ! snow depth for transition to bare sea ice (m) ! level-ice ponds - character (len=char_len), intent(out), optional :: & + character (len=*), intent(out), optional :: & frzpnd_out ! pond refreezing parameterization real (kind=dbl_kind), intent(out), optional :: & @@ -1241,6 +1447,42 @@ subroutine icepack_query_parameters( & real (kind=dbl_kind), intent(out), optional :: & hp1_out ! critical parameter for pond ice thickness +!----------------------------------------------------------------------- +! Parameters for snow redistribution, metamorphosis +!----------------------------------------------------------------------- + + character (len=*), intent(out), optional :: & + snwredist_out, & ! type of snow redistribution + snw_aging_table_out ! snow aging lookup table + + logical (kind=log_kind), intent(out), optional :: & + use_smliq_pnd_out, &! use liquid in snow for ponds + snwgrain_out ! snow metamorphosis + + real (kind=dbl_kind), intent(out), optional :: & + rsnw_fall_out, & ! radius of new snow (10^-6 m) + rsnw_tmax_out, & ! maximum snow radius (10^-6 m) + rhosnew_out, & ! new snow density (kg/m^3) + rhosmin_out, & ! minimum snow density (kg/m^3) + rhosmax_out, & ! maximum snow density (kg/m^3) + windmin_out, & ! minimum wind speed to compact snow (m/s) + drhosdwind_out, & ! wind compaction factor (kg s/m^4) + snwlvlfac_out ! fractional increase in snow depth + + integer (kind=int_kind), intent(out), optional :: & + isnw_T_out, & ! maxiumum temperature index + isnw_Tgrd_out, & ! maxiumum temperature gradient index + isnw_rhos_out ! maxiumum snow density index + + real (kind=dbl_kind), dimension(:), intent(out), optional :: & + snowage_rhos_out, & ! snowage dimension data + snowage_Tgrd_out, & ! + snowage_T_out ! + + real (kind=dbl_kind), dimension(:,:,:), intent(out), optional :: & + snowage_tau_out, & ! (10^-6 m) + snowage_kappa_out, &! + snowage_drdt0_out ! (10^-6 m/hr) !autodocument_end character(len=*),parameter :: subname='(icepack_query_parameters)' @@ -1400,6 +1642,27 @@ subroutine icepack_query_parameters( & if (present(pndaspect_out) ) pndaspect_out = pndaspect if (present(hs1_out) ) hs1_out = hs1 if (present(hp1_out) ) hp1_out = hp1 + if (present(snwredist_out) ) snwredist_out = snwredist + if (present(snw_aging_table_out) ) snw_aging_table_out = snw_aging_table + if (present(snwgrain_out) ) snwgrain_out = snwgrain + if (present(use_smliq_pnd_out) ) use_smliq_pnd_out= use_smliq_pnd + if (present(rsnw_fall_out) ) rsnw_fall_out = rsnw_fall + if (present(rsnw_tmax_out) ) rsnw_tmax_out = rsnw_tmax + if (present(rhosnew_out) ) rhosnew_out = rhosnew + if (present(rhosmin_out) ) rhosmin_out = rhosmin + if (present(rhosmax_out) ) rhosmax_out = rhosmax + if (present(windmin_out) ) windmin_out = windmin + if (present(drhosdwind_out) ) drhosdwind_out = drhosdwind + if (present(snwlvlfac_out) ) snwlvlfac_out = snwlvlfac + if (present(isnw_T_out) ) isnw_T_out = isnw_T + if (present(isnw_Tgrd_out) ) isnw_Tgrd_out = isnw_Tgrd + if (present(isnw_rhos_out) ) isnw_rhos_out = isnw_rhos + if (present(snowage_rhos_out) ) snowage_rhos_out = snowage_rhos + if (present(snowage_Tgrd_out) ) snowage_Tgrd_out = snowage_Tgrd + if (present(snowage_T_out) ) snowage_T_out = snowage_T + if (present(snowage_tau_out) ) snowage_tau_out = snowage_tau + if (present(snowage_kappa_out) ) snowage_kappa_out= snowage_kappa + if (present(snowage_drdt0_out) ) snowage_drdt0_out= snowage_drdt0 if (present(bgc_flux_type_out) ) bgc_flux_type_out= bgc_flux_type if (present(z_tracers_out) ) z_tracers_out = z_tracers if (present(scale_bgc_out) ) scale_bgc_out = scale_bgc @@ -1583,6 +1846,27 @@ subroutine icepack_write_parameters(iounit) write(iounit,*) " pndaspect = ", pndaspect write(iounit,*) " hs1 = ", hs1 write(iounit,*) " hp1 = ", hp1 + write(iounit,*) " snwredist = ", snwredist + write(iounit,*) " snw_aging_table = ", snw_aging_table + write(iounit,*) " snwgrain = ", snwgrain + write(iounit,*) " use_smliq_pnd = ", use_smliq_pnd + write(iounit,*) " rsnw_fall = ", rsnw_fall + write(iounit,*) " rsnw_tmax = ", rsnw_tmax + write(iounit,*) " rhosnew = ", rhosnew + write(iounit,*) " rhosmin = ", rhosmin + write(iounit,*) " rhosmax = ", rhosmax + write(iounit,*) " windmin = ", windmin + write(iounit,*) " drhosdwind = ", drhosdwind + write(iounit,*) " snwlvlfac = ", snwlvlfac + write(iounit,*) " isnw_T = ", isnw_T + write(iounit,*) " isnw_Tgrd = ", isnw_Tgrd + write(iounit,*) " isnw_rhos = ", isnw_rhos + write(iounit,*) " snowage_rhos = ", snowage_rhos(1) + write(iounit,*) " snowage_Tgrd = ", snowage_Tgrd(1) + write(iounit,*) " snowage_T = ", snowage_T(1) + write(iounit,*) " snowage_tau = ", snowage_tau(1,1,1) + write(iounit,*) " snowage_kappa = ", snowage_kappa(1,1,1) + write(iounit,*) " snowage_drdt0 = ", snowage_drdt0(1,1,1) write(iounit,*) " bgc_flux_type = ", bgc_flux_type write(iounit,*) " z_tracers = ", z_tracers write(iounit,*) " scale_bgc = ", scale_bgc diff --git a/columnphysics/icepack_shortwave.F90 b/columnphysics/icepack_shortwave.F90 index 9033e487b..d1d86621e 100644 --- a/columnphysics/icepack_shortwave.F90 +++ b/columnphysics/icepack_shortwave.F90 @@ -44,8 +44,8 @@ module icepack_shortwave use icepack_parameters, only: c0, c1, c1p5, c2, c3, c4, c10 use icepack_parameters, only: p01, p1, p15, p25, p5, p75, puny use icepack_parameters, only: albocn, Timelt, snowpatch, awtvdr, awtidr, awtvdf, awtidf - use icepack_parameters, only: kappav, hs_min, rhofresh, rhos, nspint - use icepack_parameters, only: hi_ssl, hs_ssl, min_bgc, sk_l + use icepack_parameters, only: kappav, hs_min, rhofresh, rhos, nspint, rsnw_fall, snwredist, rsnw_tmax + use icepack_parameters, only: hi_ssl, hs_ssl, min_bgc, sk_l, snwlvlfac, snwgrain use icepack_parameters, only: z_tracers, skl_bgc, calc_tsfc, shortwave, kalg, heat_capacity use icepack_parameters, only: r_ice, r_pnd, r_snw, dt_mlt, rsnw_mlt, hs0, hs1, hp1 use icepack_parameters, only: pndaspect, albedo_type, albicev, albicei, albsnowv, albsnowi, ahmax @@ -804,6 +804,7 @@ subroutine run_dEdd(dt, ncat, & albpndn, apeffn, & snowfracn, & dhsn, ffracn, & + rsnow, & l_print_point, & initonly) @@ -906,6 +907,7 @@ subroutine run_dEdd(dt, ncat, & fswthrun_idf ! nir dif SW through ice to ocean (W/m^2) real(kind=dbl_kind), dimension(:,:), intent(inout) :: & + rsnow , & ! snow grain radius tracer (10^-6 m) Sswabsn , & ! SW radiation absorbed in snow layers (W m-2) Iswabsn , & ! SW radiation absorbed in ice layers (W m-2) fswpenln ! visible SW entering ice layers (W m-2) @@ -922,7 +924,10 @@ subroutine run_dEdd(dt, ncat, & ! snow variables for Delta-Eddington shortwave real (kind=dbl_kind) :: & fsn , & ! snow horizontal fraction - hsn ! snow depth (m) + hsn , & ! snow depth (m) + hsnlvl , & ! snow depth over level ice (m) + vsn , & ! snow volume + alvl ! area fraction of level ice real (kind=dbl_kind), dimension (nslyr) :: & rhosnwn , & ! snow density (kg/m3) @@ -934,7 +939,8 @@ subroutine run_dEdd(dt, ncat, & hpn ! actual pond depth (m) integer (kind=int_kind) :: & - n ! thickness category index + n , & ! thickness category index + k ! snow layer index real (kind=dbl_kind) :: & ipn , & ! refrozen pond ice thickness (m), mean over ice fraction @@ -945,6 +951,7 @@ subroutine run_dEdd(dt, ncat, & hmx , & ! maximum available snow infiltration equivalent depth dhs , & ! local difference in snow depth on sea ice and pond ice spn , & ! snow depth on refrozen pond (m) + rnslyr , & ! 1/nslyr tmp ! 0 or 1 logical (kind=log_kind) :: & @@ -981,7 +988,7 @@ subroutine run_dEdd(dt, ncat, & do n = 1, ncat - ! note that rhoswn, rsnw, fp, hp and Sswabs ARE NOT dimensioned with ncat + ! note that rhosnwn, rsnw, fp, hp and Sswabs ARE NOT dimensioned with ncat ! BPB 19 Dec 2006 ! set snow properties @@ -989,8 +996,8 @@ subroutine run_dEdd(dt, ncat, & hsn = c0 rhosnwn(:) = c0 rsnwn(:) = c0 - apeffn(n) = c0 ! for history - snowfracn(n) = c0 ! for history + apeffn(n) = c0 ! for history + snowfracn(n) = c0 ! for history if (aicen(n) > puny) then @@ -999,7 +1006,8 @@ subroutine run_dEdd(dt, ncat, & aicen(n), vsnon(n), & Tsfcn(n), fsn, & hs0, hsn, & - rhosnwn, rsnwn) + rhosnwn, rsnwn, & + rsnow(:,n)) if (icepack_warnings_aborted(subname)) return ! set pond properties @@ -1019,6 +1027,28 @@ subroutine run_dEdd(dt, ncat, & fsn = min(fsn, c1-fpn) apeffn(n) = fpn ! for history elseif (tr_pond_lvl) then + hsnlvl = hsn ! initialize + if (trim(snwredist) == 'bulk') then + hsnlvl = hsn / (c1 + snwlvlfac*(c1-alvln(n))) + ! snow volume over level ice + alvl = aicen(n) * alvln(n) + if (alvl > puny) then + vsn = hsnlvl * alvl + else + vsn = vsnon(n) + alvl = aicen(n) + endif + ! set snow properties over level ice + call shortwave_dEdd_set_snow(nslyr, R_snw, & + dT_mlt, rsnw_mlt, & + alvl, vsn, & + Tsfcn(n), fsn, & + hs0, hsnlvl, & + rhosnwn(:), rsnwn(:), & + rsnow(:,n)) + if (icepack_warnings_aborted(subname)) return + endif ! snwredist + fpn = c0 ! fraction of ice covered in pond hpn = c0 ! pond depth over fpn ! refrozen pond lid thickness avg over ice @@ -1027,8 +1057,8 @@ subroutine run_dEdd(dt, ncat, & dhs = dhsn(n) ! snow depth difference, sea ice - pond if (.not. linitonly .and. ipn > puny .and. & dhs < puny .and. fsnow*dt > hs_min) & - dhs = hsn - fsnow*dt ! initialize dhs>0 - spn = hsn - dhs ! snow depth on pond ice + dhs = hsnlvl - fsnow*dt ! initialize dhs>0 + spn = hsnlvl - dhs ! snow depth on pond ice if (.not. linitonly .and. ipn*spn < puny) dhs = c0 dhsn(n) = dhs ! save: constant until reset to 0 @@ -1053,7 +1083,7 @@ subroutine run_dEdd(dt, ncat, & ! infiltrate snow hp = hpn if (hp > puny) then - hs = hsn + hs = hsnlvl rp = rhofresh*hp/(rhofresh*hp + rhos*hs) if (rp < p15) then fpn = c0 @@ -1063,7 +1093,7 @@ subroutine run_dEdd(dt, ncat, & tmp = max(c0, sign(c1, hp-hmx)) ! 1 if hp>=hmx, else 0 hp = (rhofresh*hp + rhos*hs*tmp) & / (rhofresh - rhos*(c1-tmp)) - hsn = hs - hp*fpn*(c1-tmp) + hsn = hsn - hp*fpn*(c1-tmp) hpn = hp * tmp fpn = fpn * tmp endif @@ -1135,10 +1165,10 @@ subroutine run_dEdd(dt, ncat, & alidrn(n), alidfn(n), & fswsfcn(n), fswintn(n), & fswthru=fswthrun(n), & - fswthru_vdr=l_fswthrun_vdr(n), & - fswthru_vdf=l_fswthrun_vdf(n), & - fswthru_idr=l_fswthrun_idr(n), & - fswthru_idf=l_fswthrun_idf(n), & + fswthru_vdr=l_fswthrun_vdr(n), & + fswthru_vdf=l_fswthrun_vdf(n), & + fswthru_idr=l_fswthrun_idr(n), & + fswthru_idf=l_fswthrun_idf(n), & Sswabs=Sswabsn(:,n), & Iswabs=Iswabsn(:,n), & albice=albicen(n), & @@ -1150,6 +1180,12 @@ subroutine run_dEdd(dt, ncat, & if (icepack_warnings_aborted(subname)) return + if (.not. snwgrain) then + do k = 1,nslyr + rsnow(k,n) = rsnwn(k) ! for history + enddo + endif + endif ! aicen > puny enddo ! ncat @@ -3569,7 +3605,8 @@ subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & aice, vsno, & Tsfc, fs, & hs0, hs, & - rhosnw, rsnw) + rhosnw, rsnw, & + rsnow) integer (kind=int_kind), intent(in) :: & nslyr ! number of snow layers @@ -3589,6 +3626,9 @@ subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & fs , & ! horizontal coverage of snow hs ! snow depth + real (kind=dbl_kind), dimension (:), intent(in) :: & + rsnow ! snow grain radius tracer (micro-meters) + real (kind=dbl_kind), dimension (:), intent(out) :: & rhosnw , & ! density in snow layer (kg/m3) rsnw ! grain radius in snow layer (micro-meters) @@ -3605,7 +3645,6 @@ subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & real (kind=dbl_kind), parameter :: & ! units for the following are 1.e-6 m (micro-meters) - rsnw_fresh = 100._dbl_kind, & ! freshly-fallen snow grain radius rsnw_nonmelt = 500._dbl_kind, & ! nonmelt snow grain radius rsnw_sig = 250._dbl_kind ! assumed sigma for snow grain radius @@ -3621,23 +3660,35 @@ subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & if (hs0 > puny) fs = min(hs/hs0, c1) endif - ! bare ice, temperature dependence - dTs = Timelt - Tsfc - fT = -min(dTs/dT_mlt-c1,c0) - ! tune nonmelt snow grain radius if desired: note that - ! the sign is negative so that if R_snw is 1, then the - ! snow grain radius is reduced and thus albedo increased. - rsnw_nm = rsnw_nonmelt - R_snw*rsnw_sig - rsnw_nm = max(rsnw_nm, rsnw_fresh) - rsnw_nm = min(rsnw_nm, rsnw_mlt) - do ks = 1, nslyr - ! snow density ccsm3 constant value - rhosnw(ks) = rhos - ! snow grain radius between rsnw_nonmelt and rsnw_mlt - rsnw(ks) = rsnw_nm + (rsnw_mlt-rsnw_nm)*fT - rsnw(ks) = max(rsnw(ks), rsnw_fresh) - rsnw(ks) = min(rsnw(ks), rsnw_mlt) - enddo ! ks + if (snwgrain) then ! use snow grain tracer + + do ks = 1, nslyr + rsnw(ks) = max(rsnw_fall,rsnow(ks)) + rsnw(ks) = min(rsnw_tmax,rsnow(ks)) + rhosnw(ks) = rhos + enddo + + else + + ! bare ice, temperature dependence + dTs = Timelt - Tsfc + fT = -min(dTs/dT_mlt-c1,c0) + ! tune nonmelt snow grain radius if desired: note that + ! the sign is negative so that if R_snw is 1, then the + ! snow grain radius is reduced and thus albedo increased. + rsnw_nm = rsnw_nonmelt - R_snw*rsnw_sig + rsnw_nm = max(rsnw_nm, rsnw_fall) + rsnw_nm = min(rsnw_nm, rsnw_mlt) + do ks = 1, nslyr + ! snow density ccsm3 constant value + rhosnw(ks) = rhos + ! snow grain radius between rsnw_nonmelt and rsnw_mlt + rsnw(ks) = rsnw_nm + (rsnw_mlt-rsnw_nm)*fT + rsnw(ks) = max(rsnw(ks), rsnw_fall) + rsnw(ks) = min(rsnw(ks), rsnw_mlt) + enddo ! ks + + endif ! snwgrain end subroutine shortwave_dEdd_set_snow @@ -4010,7 +4061,8 @@ subroutine icepack_step_radiation (dt, ncat, & albpndn, apeffn, & snowfracn, & dhsn, ffracn, & - l_print_point, & + rsnow, & + l_print_point, & initonly) integer (kind=int_kind), intent(in) :: & @@ -4113,6 +4165,9 @@ subroutine icepack_step_radiation (dt, ncat, & dEdd_algae , & ! .true. use prognostic chla in dEdd modal_aero ! .true. use modal aerosol optical treatment + real (kind=dbl_kind), dimension(:,:), intent(inout), optional :: & + rsnow ! snow grain radius tracer (10^-6 m) + logical (kind=log_kind), optional :: & initonly ! flag to indicate init only, default is false @@ -4136,6 +4191,9 @@ subroutine icepack_step_radiation (dt, ncat, & l_fswthrun_idr , & ! nir dir SW through ice to ocean (W/m^2) l_fswthrun_idf ! nir dif SW through ice to ocean (W/m^2) + real (kind=dbl_kind), dimension(:,:), allocatable :: & + l_rsnow ! snow grain radius tracer (10^-6 m) + character(len=*),parameter :: subname='(icepack_step_radiation)' allocate(l_fswthrun_vdr(ncat)) @@ -4143,12 +4201,16 @@ subroutine icepack_step_radiation (dt, ncat, & allocate(l_fswthrun_idr(ncat)) allocate(l_fswthrun_idf(ncat)) - hin = c0 - hbri = c0 - linitonly = .false. - if (present(initonly)) then - linitonly = initonly - endif + hin = c0 + hbri = c0 + linitonly = .false. + if (present(initonly)) then + linitonly = initonly + endif + + allocate(l_rsnow (nslyr,ncat)) + l_rsnow = c0 + if (present(rsnow)) l_rsnow = rsnow ! Initialize do n = 1, ncat @@ -4234,6 +4296,7 @@ subroutine icepack_step_radiation (dt, ncat, & snowfracn=snowfracn, & dhsn=dhsn, & ffracn=ffracn, & + rsnow=l_rsnow, & l_print_point=l_print_point, & initonly=linitonly) if (icepack_warnings_aborted(subname)) return @@ -4320,6 +4383,7 @@ subroutine icepack_step_radiation (dt, ncat, & deallocate(l_fswthrun_vdf) deallocate(l_fswthrun_idr) deallocate(l_fswthrun_idf) + deallocate(l_rsnow) end subroutine icepack_step_radiation diff --git a/columnphysics/icepack_snow.F90 b/columnphysics/icepack_snow.F90 new file mode 100644 index 000000000..b0952b01b --- /dev/null +++ b/columnphysics/icepack_snow.F90 @@ -0,0 +1,1203 @@ +!======================================================================= +! +! snow redistribution and metamorphism +! +! authors Elizabeth Hunke, LANL +! Nicole Jeffery, LANL +! + module icepack_snow + + use icepack_kinds + use icepack_parameters, only: puny, p1, p5, c0, c1, c4, c10, c100, pi + use icepack_parameters, only: rhos, rhow, rhoi, rhofresh, snwgrain + use icepack_parameters, only: snwlvlfac, Tffresh, cp_ice, Lfresh + use icepack_parameters, only: snwredist, rsnw_fall, rsnw_tmax, rhosnew + use icepack_parameters, only: rhosmin, rhosmax, windmin, drhosdwind + use icepack_parameters, only: isnw_T, isnw_Tgrd, isnw_rhos + use icepack_parameters, only: snowage_rhos, snowage_Tgrd, snowage_T + use icepack_parameters, only: snowage_tau, snowage_kappa, snowage_drdt0 + use icepack_parameters, only: snw_aging_table + + use icepack_warnings, only: icepack_warnings_add, icepack_warnings_setabort + use icepack_warnings, only: icepack_warnings_aborted + + implicit none + private + + public :: icepack_step_snow, drain_snow, icepack_init_snow + + real (kind=dbl_kind), parameter, public :: & + S_r = 0.033_dbl_kind, & ! irreducible saturation (Anderson 1976) + S_wet= 4.22e-5_dbl_kind ! (um^3/s) wet metamorphism parameters + + real (kind=dbl_kind) :: & + min_rhos, & ! snowtable axis data, assumes linear data + del_rhos, & + min_Tgrd, & + del_Tgrd, & + min_T , & + del_T + + logical (kind=log_kind) :: & + lin_rhos = .false., & ! flag to specify whether the snowtable dimensions are linear + lin_Tgrd = .false., & ! this will allow quick lookup + lin_T = .false. + +!======================================================================= + + contains + +!======================================================================= +!autodocument_start icepack_init_snow +! Updates snow tracers +! +! authors: Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine icepack_init_snow + +!autodocument_end + + ! local variables + + integer (kind=int_kind) :: n + + character (len=*),parameter :: subname='(icepack_init_snow)' + + !----------------------------------------------------------------- + ! Snow metamorphism lookup table + !----------------------------------------------------------------- + + ! if snw_aging_table = 'snicar' + ! best-fit parameters are read from a table (netcdf) + ! snowage_tau, snowage_kappa, snowage_drdt0 + ! 11 temperatures from 223.15 to 273.15 K by 5.0 + ! 31 temperature gradients from 0 to 300 K/m by 10 + ! 8 snow densities from 50 to 400 kg/m3 by 50 + + ! if snw_aging_table = 'test' + ! for testing Icepack without netcdf, + ! use a subsampled, hard-coded table + ! 5 temperatures from 243.15 by 5.0 K + ! 5 temperature gradients from 0 to 40 K/m by 10 + ! 1 snow density at 300 kg/m3 + + ! if snw_aging_table = 'file' + ! all data has to be passed into icepack_parameters + + if (snwgrain) then + if (trim(snw_aging_table) == 'snicar') then ! read netcdf file + isnw_rhos = 8 ! maxiumum snow density index + isnw_Tgrd = 31 ! maxiumum temperature gradient index + isnw_T = 11 ! maxiumum temperature index + min_rhos = 50.0_dbl_kind ! snowtable dimension data + del_rhos = 50.0_dbl_kind + lin_rhos = .true. + min_Tgrd = 0.0_dbl_kind + del_Tgrd = 10.0_dbl_kind + lin_Tgrd = .true. + min_T = 223.15_dbl_kind + del_T = 5.0_dbl_kind + lin_T = .true. + allocate (snowage_tau (isnw_rhos,isnw_Tgrd,isnw_T)) + allocate (snowage_kappa(isnw_rhos,isnw_Tgrd,isnw_T)) + allocate (snowage_drdt0(isnw_rhos,isnw_Tgrd,isnw_T)) + allocate (snowage_rhos (isnw_rhos)) + allocate (snowage_Tgrd (isnw_Tgrd)) + allocate (snowage_T (isnw_T)) + do n = 1, isnw_rhos + snowage_rhos(n) = min_rhos + real((n-1),dbl_kind)*del_rhos + enddo + do n = 1, isnw_Tgrd + snowage_Tgrd(n) = min_Tgrd + real((n-1),dbl_kind)*del_Tgrd + enddo + do n = 1, isnw_T + snowage_T(n) = min_T + real((n-1),dbl_kind)*del_T + enddo + + elseif (trim(snw_aging_table) == 'file') then + isnw_rhos = -1 ! maxiumum snow density index + isnw_Tgrd = -1 ! maxiumum temperature gradient index + isnw_T = -1 ! maxiumum temperature index + + elseif (trim(snw_aging_table) == 'test') then + isnw_rhos = 1 ! maxiumum snow density index + isnw_Tgrd = 5 ! maxiumum temperature gradient index + isnw_T = 5 ! maxiumum temperature index + min_rhos = 300.0_dbl_kind ! snowtable dimension data + del_rhos = 50.0_dbl_kind + lin_rhos = .true. + min_Tgrd = 0.0_dbl_kind + del_Tgrd = 10.0_dbl_kind + lin_Tgrd = .true. + min_T = 243.15_dbl_kind + del_T = 5.0_dbl_kind + lin_T = .true. + allocate (snowage_tau (isnw_rhos,isnw_Tgrd,isnw_T)) + allocate (snowage_kappa(isnw_rhos,isnw_Tgrd,isnw_T)) + allocate (snowage_drdt0(isnw_rhos,isnw_Tgrd,isnw_T)) + allocate (snowage_rhos (isnw_rhos)) + allocate (snowage_Tgrd (isnw_Tgrd)) + allocate (snowage_T (isnw_T)) + do n = 1, isnw_rhos + snowage_rhos(n) = min_rhos + real((n-1),dbl_kind)*del_rhos + enddo + do n = 1, isnw_Tgrd + snowage_Tgrd(n) = min_Tgrd + real((n-1),dbl_kind)*del_Tgrd + enddo + do n = 1, isnw_T + snowage_T(n) = min_T + real((n-1),dbl_kind)*del_T + enddo + + ! Subset of dry snow aging parameters + snowage_tau = reshape((/ & + 3.34947394_dbl_kind, 4.02124159_dbl_kind, 4.03328223_dbl_kind, & + 3.02686921_dbl_kind, 2.14125851_dbl_kind, 3.97008737_dbl_kind, & + 4.72725821_dbl_kind, 3.65313459_dbl_kind, 2.41198936_dbl_kind, & + 2.53065623e-1_dbl_kind, 4.60286630_dbl_kind, 4.99721440_dbl_kind, & + 3.29168191_dbl_kind, 2.66426779e-1_dbl_kind, 9.15830596e-5_dbl_kind, & + 5.33186128_dbl_kind, 4.90833452_dbl_kind, 1.55269141_dbl_kind, & + 1.31225526e-3_dbl_kind, 9.36078196e-4_dbl_kind, 6.25428631_dbl_kind, & + 5.04394794_dbl_kind, 2.92857366e-3_dbl_kind, 9.01488751e-3_dbl_kind, & + 1.19037046e-2_dbl_kind/), & + (/isnw_rhos,isnw_Tgrd,isnw_T/)) + + snowage_kappa = reshape((/ & + 0.60824438, 0.56442972, 0.5527807, 0.64299537, 0.77672359, & + 0.57105932, 0.52791041, 0.59868076, 0.7487191, 1.57946877, & + 0.54236508, 0.52458285, 0.65520877, 1.52356017, 4.37789838, & + 0.51449138, 0.54494334, 0.91628508, 3.28847035, 3.64418487, & + 0.48538708, 0.55386601, 2.81247103, 2.72445522, 2.8230216/), & + (/isnw_rhos,isnw_Tgrd,isnw_T/)) + + snowage_drdt0 = reshape((/ & + 1.26597871, 1.26602416, 1.26613263, 1.26620414, 1.26629424, & + 1.92418877, 1.92430063, 1.92445964, 1.92451557, 1.92469806, & + 2.79086547, 2.79147315, 2.79137562, 2.79150846, 2.79216439, & + 3.85605846, 3.85668001, 3.85844559, 3.86073682, 3.863199, & + 5.0861907, 5.08765668, 5.09200195, 5.09665276, 5.10079895/), & + (/isnw_rhos,isnw_Tgrd,isnw_T/)) + else + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//'ERROR: snw_aging_table value') + return + endif + endif + + end subroutine icepack_init_snow + +!======================================================================= +!autodocument_start icepack_step_snow +! Updates snow tracers +! +! authors: Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine icepack_step_snow(dt, nilyr, & + nslyr, ncat, & + wind, aice, & + aicen, vicen, & + vsnon, Tsfc, & + zqin1, zSin1, & + zqsn, & + alvl, vlvl, & + smice, smliq, & + rsnw, rhos_cmpn, & + fresh, fhocn, & + fsloss, fsnow) + + use icepack_therm_shared, only: icepack_ice_temperature + + integer (kind=int_kind), intent(in) :: & + nslyr, & ! number of snow layers + nilyr, & ! number of ice layers + ncat ! number of thickness categories + + real (kind=dbl_kind), intent(in) :: & + dt , & ! time step + wind , & ! wind speed (m/s) + fsnow , & ! snowfall rate (kg m-2 s-1) + aice ! ice area fraction + + real (kind=dbl_kind), dimension(:), intent(in) :: & + aicen, & ! ice area fraction + vicen, & ! ice volume (m) + Tsfc , & ! surface temperature (C) + zqin1, & ! ice upper layer enthalpy + zSin1, & ! ice upper layer salinity + alvl, & ! level ice area tracer + vlvl ! level ice volume tracer + + real (kind=dbl_kind), intent(inout) :: & + fresh , & ! fresh water flux to ocean (kg/m^2/s) + fhocn , & ! net heat flux to ocean (W/m^2) + fsloss ! rate of snow loss to leads (kg/m^2/s) + + real (kind=dbl_kind), dimension(:), intent(inout) :: & + vsnon ! snow volume (m) + + real (kind=dbl_kind), dimension(:,:), intent(inout) :: & + zqsn , & ! snow enthalpy (J/m^3) + smice , & ! tracer for mass of ice in snow (kg/m^3) + smliq , & ! tracer for mass of liquid in snow (kg/m^3) + rsnw , & ! snow grain radius (10^-6 m) + rhos_cmpn ! effective snow density: compaction (kg/m^3) + +!autodocument_end + + ! local variables + + integer (kind=int_kind) :: k, n + + real (kind=dbl_kind), dimension(ncat) :: & + zTin1, & ! ice upper layer temperature (C) + hsn , & ! snow thickness (m) + hin ! ice thickness + + real (kind=dbl_kind) :: & + vsno, & ! snow volume (m) + tmp1, tmp2 + + character (len=*),parameter :: subname='(icepack_step_snow)' + + !----------------------------------------------------------------- + ! Initialize effective snow density (compaction) for new snow + !----------------------------------------------------------------- + + if (trim(snwredist) /= 'none') then + do n = 1, ncat + do k = 1, nslyr + if (rhos_cmpn(k,n) < rhosmin) rhos_cmpn(k,n) = rhosnew + enddo + enddo + else + rhos_cmpn(:,:) = rhos + endif + + !----------------------------------------------------------------- + ! Redistribute snow based on wind + !----------------------------------------------------------------- + + vsno = c0 + do n = 1, ncat + vsno = vsno + vsnon(n) + enddo + tmp1 = rhos*vsno + fresh*dt + + if (snwredist(1:3) == 'ITD' .and. aice > puny) then + call snow_redist(dt, & + nslyr, ncat, & + wind, aicen(:), & + vicen(:), vsnon(:), & + zqsn(:,:), & + alvl(:), vlvl(:), & + fresh, fhocn, & + fsloss, rhos_cmpn, & + fsnow) + if (icepack_warnings_aborted(subname)) return + endif + + vsno = c0 + do n = 1, ncat + vsno = vsno + vsnon(n) + enddo + tmp2 = rhos*vsno + fresh*dt + + ! check conservation + if (abs(tmp1-tmp2)>puny) then + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//'ERROR: snow redistribution') + endif + + !----------------------------------------------------------------- + ! Adjust snow grain radius + !----------------------------------------------------------------- + + if (snwgrain) then + do n = 1, ncat + zTin1(n) = c0 + hsn (n) = c0 + hin (n) = c0 + if (aicen(n) > puny) then + zTin1(n) = icepack_ice_temperature(zqin1(n), zSin1(n)) + hsn(n) = vsnon(n)/aicen(n) + hin(n) = vicen(n)/aicen(n) + endif + enddo + + call update_snow_radius (dt, ncat, & + nslyr, nilyr, & + rsnw, hin, & + Tsfc, zTin1, & + hsn, zqsn, & + smice, smliq) + if (icepack_warnings_aborted(subname)) return + endif + + end subroutine icepack_step_snow + +!======================================================================= + +! Snow redistribution by wind, based on O. Lecomte Ph.D. (2014). +! The original formulation: +! Snow in suspension depends on wind speed, density and the standard +! deviation of the ice thickness distribution. Snow is redistributed +! among ice categories proportionally to the category areas. +! +! Namelist option snwredist = 'ITDrdg' modifies the approach to use +! the level and ridged ice tracers: +! As above, but use the standard deviation of the level and ridged +! ice thickness distribution for snow in suspension, and redistribute +! based on ridged ice area. +! +! convention: +! volume, mass and energy include factor of ain +! thickness does not + + subroutine snow_redist(dt, nslyr, ncat, wind, ain, vin, vsn, zqsn, & + alvl, vlvl, fresh, fhocn, fsloss, rhos_cmpn, fsnow) + + use icepack_therm_shared, only: adjust_enthalpy + + integer (kind=int_kind), intent(in) :: & + nslyr , & ! number of snow layers + ncat ! number of thickness categories + + real (kind=dbl_kind), intent(in) :: & + dt , & ! time step (s) + wind , & ! wind speed (m/s) + fsnow ! snowfall rate (kg m-2 s-1) + + real (kind=dbl_kind), dimension(:), intent(in) :: & + ain , & ! ice area fraction + vin , & ! ice volume (m) + alvl , & ! level ice area tracer + vlvl ! level ice volume tracer + + real (kind=dbl_kind), intent(inout) :: & + fresh , & ! fresh water flux to ocean (kg/m^2/s) + fhocn , & ! net heat flux to ocean (W/m^2) + fsloss ! rate of snow loss to leads (kg/m^2/s) + + real (kind=dbl_kind), dimension(:), intent(inout) :: & + vsn ! snow volume (m) + + real (kind=dbl_kind), dimension(:,:), intent(inout) :: & + zqsn , & ! snow enthalpy (J/m^3) + rhos_cmpn ! effective snow density: compaction (kg/m^3) + + ! local variables + + integer (kind=int_kind) :: & + n , & ! category index + k ! layer index + + integer (kind=int_kind), dimension(ncat) :: & + klyr ! layer index + + real (kind=dbl_kind), parameter :: & + refsd = c1 , & ! standard deviation reference + gamma = 1.e-5_dbl_kind ! tuning coefficient + + real (kind=dbl_kind) :: & + Vseas , & ! critical seasonal wind speed (m/s) + ITDsd , & ! standard deviation of ITD + flost , & ! fraction of snow lost in leads + alost , & ! effective lead area for snow lost in leads + suma , & ! sum of ice area over categories + sumv , & ! sum of ice volume over categories (m) + summ , & ! sum of snow mass over categories (kg/m^2) + sumq , & ! sum of snow enthalpy over categories (kg/m^2) + msusp , & ! potential mass of snow in suspension (kg/m^2) + msnw_susp , & ! mass of snow in suspension (kg/m^2) + esnw_susp , & ! energy of snow in suspension (J/m^2) + asnw_lvl , & ! mass of snow redeposited on level ice (kg/m^2) + e_redeptmp, & ! redeposited energy (J/m^2) + dhsn , & ! change in snow depth (m) + dmp , & ! mass difference in previous layer (kg/m^2) + hslyr , & ! snow layer thickness (m) + hslab , & ! new snow thickness (m) + drhos , & ! change in snow density due to compaction (kg/m^3) + mlost , & ! mass of suspended snow lost in leads (kg/m^2) + elost , & ! energy of suspended snow lost in leads (J/m^2) + de , & ! change in energy (J/m^2) + al, ar , & ! areas of level and ridged ice + hlvl, hrdg, & ! thicknesses of level and ridged ice + tmp1, tmp2, & ! temporary values + tmp3, tmp4, & ! temporary values + tmp5 , & ! temporary values + work ! temporary value + + real (kind=dbl_kind), dimension(ncat) :: & + sfac , & ! temporary for snwlvlfac + ardg , & ! ridged ice area tracer + m_erosion , & ! eroded mass (kg/m^2) + e_erosion , & ! eroded energy (J/m^2) + m_redep , & ! redeposited mass (kg/m^2) + e_redep , & ! redeposited energy (J/m^2) + vsn_init , & ! initial volume (m) + esn_init , & ! initial energy (J/m^2) + esn_final , & ! final energy (J/m^2) + atmp , & ! temporary variable for ain, for debugging convenience + hin , & ! ice thickness (m) + hsn , & ! snow depth (m) + hsn_new ! new snow depth (m) + + real (kind=dbl_kind), dimension (nslyr) :: & + dzs ! snow layer thickness after redistribution (m) + + real (kind=dbl_kind), dimension (nslyr+1) :: & + zs1 , & ! depth of snow layer boundaries (m) + zs2 ! adjusted depths, with equal hslyr (m) + + character (len=*),parameter :: subname='(snow_redist)' + + !----------------------------------------------------------------- + ! Conservation checks + !----------------------------------------------------------------- + + tmp1 = c0 + tmp3 = c0 + do n = 1, ncat + ! mass conservation check + tmp1 = tmp1 + vsn(n) + vsn_init(n) = vsn(n) + esn_init(n) = c0 + ! energy conservation check + do k = 1, nslyr + tmp3 = tmp3 + vsn(n)*zqsn(k,n)/nslyr + esn_init(n) = esn_init(n) + vsn(n)*zqsn(k,n)/nslyr + enddo + enddo + + !----------------------------------------------------------------- + ! category thickness and sums + !----------------------------------------------------------------- + + hin(:) = c0 + hsn(:) = c0 + suma = c0 + sumv = c0 + do n = 1, ncat + atmp(n) = ain(n) + if (atmp(n) > puny) then + hin(n) = vin(n)/atmp(n) + hsn(n) = vsn(n)/atmp(n) + endif + hsn_new(n) = hsn(n) + suma = suma + atmp(n) + sumv = sumv + vin(n) + ! maintain positive definite enthalpy + do k = 1, nslyr + zqsn(k,n) = min(zqsn(k,n) + Lfresh*rhos, c0) + enddo + enddo ! ncat + + !----------------------------------------------------------------- + ! standard deviation of ice thickness distribution + !----------------------------------------------------------------- + + work = c0 + asnw_lvl = c0 + if (trim(snwredist) == 'ITDrdg') then ! use level and ridged ice + do n = 1, ncat + ardg(n) = c1 - alvl(n) ! ridged ice tracer + al = alvl(n) * atmp(n) ! level + ar = ardg(n) * atmp(n) ! ridged + hlvl = c0 + hrdg = c0 + if (al > puny) hlvl = vin(n)*vlvl(n)/al + if (ar > puny) hrdg = vin(n)*(c1-vlvl(n))/ar + work = work + al*(hlvl - sumv)**2 + ar*(hrdg - sumv)**2 + + ! for redeposition of snow on level ice + sfac(n) = snwlvlfac + if (ardg(n) > c0) sfac(n) = min(snwlvlfac, alvl(n)/ardg(n)) + asnw_lvl = asnw_lvl + al - sfac(n)*ar + enddo + asnw_lvl = asnw_lvl/suma +! else ! snwredist = 'ITDsd' ! use standard ITD +! do n = 1, ncat +! work = work + atmp(n)*(hin(n) - sumv)**2 +! enddo + endif + ITDsd = sqrt(work) + + !----------------------------------------------------------------- + ! fraction of suspended snow lost in leads + !----------------------------------------------------------------- + + flost = (c1 - suma) * exp(-ITDsd/refsd) +! flost = c0 ! echmod for testing + alost = c1 - suma * (c1-flost) + + !----------------------------------------------------------------- + ! suspended snow + !----------------------------------------------------------------- + + msusp = c0 + do n = 1, ncat + ! critical seasonal wind speed needed to compact snow to density rhos + Vseas = (rhos_cmpn(1,n) - 44.6_dbl_kind)/174.0_dbl_kind ! use top layer + Vseas = max(Vseas, c0) + ! maximum mass per unit area of snow in suspension (kg/m^2) + if (ITDsd > puny) & + msusp = msusp + atmp(n)*gamma*dt*max(wind-Vseas,c0) & + * (rhosmax-rhos_cmpn(1,n))/(rhosmax*ITDsd) + enddo + + !----------------------------------------------------------------- + ! erosion + !----------------------------------------------------------------- + + msnw_susp = c0 + esnw_susp = c0 + klyr(:) = 1 + do n = 1, ncat + m_erosion(n) = c0 ! mass + e_erosion(n) = c0 ! energy + if (atmp(n) > puny) then + m_erosion(n) = min(msusp, rhos*vsn(n)) + if (m_erosion(n) > puny) then + summ = c0 + dmp = m_erosion(n) + do k = 1, nslyr + if (dmp > c0) then + dhsn = min(hsn(n)/nslyr, dmp/(rhos*atmp(n))) + msnw_susp = msnw_susp + dhsn*rhos*atmp(n) ! total mass in suspension + hsn_new(n) = hsn_new(n) - dhsn + e_erosion(n) = e_erosion(n) + dhsn*zqsn(k,n)*atmp(n) + klyr(n) = k ! number of affected layers + summ = summ + rhos*vsn(n)/nslyr ! mass, partial sum + dmp = max(m_erosion(n) - summ, c0) + endif ! dmp + enddo + esnw_susp = esnw_susp + e_erosion(n) ! total energy in suspension + endif + endif + enddo + + !----------------------------------------------------------------- + ! redeposition + !----------------------------------------------------------------- + + do n = 1, ncat + if (trim(snwredist) == 'ITDrdg') then ! use level and ridged ice + work = atmp(n)*(c1-flost)*(ardg(n)*(c1+sfac(n)) + asnw_lvl) + else ! use standard ITD + work = atmp(n)*(c1-flost) + endif + m_redep(n) = msnw_susp*work ! mass + e_redep(n) = c0 + e_redeptmp = esnw_susp*work ! energy + + ! change in snow depth + dhsn = c0 + if (atmp(n) > puny) then + dhsn = m_redep(n) / (rhos*atmp(n)) + + if (abs(dhsn) > c0) then + + e_redep(n) = e_redeptmp + vsn(n) = (hsn_new(n)+dhsn)*atmp(n) + + ! change in snow energy + de = e_redeptmp / klyr(n) + ! spread among affected layers + sumq = c0 + do k = 1, klyr(n) + zqsn(k,n) = (atmp(n)*hsn_new(n)*zqsn(k,n) + de) & + / (vsn(n)) ! factor of nslyr cancels out + + if (zqsn(k,n) > c0) then + sumq = sumq + zqsn(k,n) + zqsn(k,n) = c0 + endif + + enddo ! klyr + zqsn(klyr(n),n) = min(zqsn(klyr(n),n) + sumq, c0) ! may lose energy here + + !----------------------------------------------------------------- + ! Conserving energy, compute the enthalpy of the new equal layers + !----------------------------------------------------------------- + + if (nslyr > 1) then + + dzs(:) = hsn(n) / real(nslyr,kind=dbl_kind) ! old layer thickness + do k = 1, klyr(n) + dzs(k) = dzs(k) + dhsn / klyr(n) ! old layer thickness (updated) + enddo + hsn_new(n) = hsn_new(n) + dhsn + hslyr = hsn_new(n) / real(nslyr,kind=dbl_kind) ! new layer thickness + + zs1(1) = c0 + zs1(1+nslyr) = hsn_new(n) + + zs2(1) = c0 + zs2(1+nslyr) = hsn_new(n) + + do k = 1, nslyr-1 + zs1(k+1) = zs1(k) + dzs(k) ! old layer depths (unequal thickness) + zs2(k+1) = zs2(k) + hslyr ! new layer depths (equal thickness) + enddo + + call adjust_enthalpy (nslyr, & + zs1(:), zs2(:), & + hslyr, hsn_new(n), & + zqsn(:,n)) + if (icepack_warnings_aborted(subname)) return + endif ! nslyr > 1 + endif ! |dhsn| > puny + endif ! ain > puny + + ! maintain positive definite enthalpy + do k = 1, nslyr + zqsn(k,n) = zqsn(k,n) - Lfresh*rhos + enddo + enddo ! ncat + + !----------------------------------------------------------------- + ! mass of suspended snow lost in leads + !----------------------------------------------------------------- + mlost = msnw_susp*alost + fsloss = fsloss + mlost / dt + + !----------------------------------------------------------------- + ! mass conservation check + !----------------------------------------------------------------- + + tmp2 = c0 + do n = 1, ncat + tmp2 = tmp2 + vsn(n) + enddo + + if (tmp2 > tmp1) then ! correct roundoff error + vsn(:) = vsn(:) * tmp1/tmp2 + tmp2 = c0 + do n = 1, ncat + tmp2 = tmp2 + vsn(n) + enddo + endif + + if (tmp2 < tmp1) fresh = fresh + rhos*(tmp1-tmp2)/dt + + tmp2 = tmp2 + (mlost/rhos) + + if (abs(tmp1-tmp2) > puny) then + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//'ERROR: snow redistribution mass conservation error') +! write(warning,*)'mass conservation error in snow_redist', tmp1, tmp2 +! write(warning,*)'klyr',klyr +! write(warning,*)'ain',atmp(:) +! write(warning,*)'vsn final',vsn(:) +! write(warning,*)'vsn init',vsn_init(:) +! write(warning,*)'rhos*vsn init',rhos*vsn_init(:) +! write(warning,*)'m_erosion',m_erosion(:) +! write(warning,*)'m_redep',m_redep(:) +! write(warning,*)'mlost',mlost +! write(warning,*)'v_erosion',m_erosion(:)/rhos +! write(warning,*)'v_redep',m_redep(:)/rhos +! write(warning,*)'v lost',mlost/rhos +! write(warning,*)'hsn',hsn(:) +! write(warning,*)'hsn_new',hsn_new(:) +! write(warning,*)'vsn_new',hsn_new(:)*atmp(:) +! write(warning,*)'lost',suma,flost,alost,msnw_susp + endif + + !----------------------------------------------------------------- + ! energy conservation check + !----------------------------------------------------------------- + + tmp4 = c0 + tmp5 = c0 + esn_final(:) = c0 + do n = 1, ncat + do k = 1, nslyr + tmp4 = tmp4 + vsn(n)*zqsn(k,n)/nslyr + esn_final(n) = esn_final(n) + vsn(n)*zqsn(k,n)/nslyr + enddo + tmp5 = tmp5 - e_erosion(n) + e_redep(n) + enddo + tmp5 = tmp5 + esnw_susp*alost + + !----------------------------------------------------------------- + ! energy of suspended snow lost in leads + !----------------------------------------------------------------- + elost = tmp3 - tmp4 + fhocn = fhocn + elost / dt + + if (abs(tmp5) > nslyr*Lfresh*puny) then + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//'ERROR: snow redistribution energy conservation error') +! write(warning,*)'energy conservation error in snow_redist', tmp3, tmp4, tmp5 +! write(warning,*)'klyr',klyr +! write(warning,*)'ain',atmp(:) +! write(warning,*)'vsn final',vsn(:) +! write(warning,*)'vsn init',vsn_init(:) +! write(warning,*)'rhos*vsn init',rhos*vsn_init(:) +! write(warning,*)'m_erosion',m_erosion(:) +! write(warning,*)'m_redep',m_redep(:) +! write(warning,*)'mlost',mlost +! write(warning,*)'v_erosion',m_erosion(:)/rhos +! write(warning,*)'v_redep',m_redep(:)/rhos +! write(warning,*)'v lost',mlost/rhos +! write(warning,*)'hsn',hsn(:) +! write(warning,*)'hsn_new',hsn_new(:) +! write(warning,*)'vsn_new',hsn_new(:)*atmp(:) +! write(warning,*)'lost',suma,flost,alost,msnw_susp +! write(warning,*)'tmp3(1)', (vsn(1)*zqsn(k,1)/nslyr,k=1,nslyr) +! write(warning,*)'esn init',esn_init(:) +! write(warning,*)'esn final',esn_final(:) +! write(warning,*)'e_erosion',e_erosion(:) +! write(warning,*)'e_redep',e_redep(:) +! write(warning,*)'elost',elost,esnw_susp*alost,Lfresh*mlost +! write(warning,*)'esnw_susp',esnw_susp + endif + + !----------------------------------------------------------------- + ! wind compaction + !----------------------------------------------------------------- + + do n = 1, ncat + if (vsn(n) > puny) then + ! compact freshly fallen or redistributed snow + drhos = drhosdwind * max(wind - windmin, c0) + hslab = c0 + if (fsnow > c0) & + hslab = max(min(fsnow*dt/(rhos+drhos), hsn_new(n)-hsn(n)), c0) + hslyr = hsn_new(n) / real(nslyr,kind=dbl_kind) + do k = 1, nslyr + work = hslab - hslyr * real(k-1,kind=dbl_kind) + work = max(c0, min(hslyr, work)) + rhos_cmpn(k,n) = rhos_cmpn(k,n) + drhos*work/hslyr + rhos_cmpn(k,n) = min(rhos_cmpn(k,n), rhosmax) + enddo + endif + enddo + + end subroutine snow_redist + +!======================================================================= + +! Snow grain metamorphism + + subroutine update_snow_radius (dt, ncat, nslyr, nilyr, rsnw, hin, & + Tsfc, zTin, hsn, zqsn, smice, smliq) + + integer (kind=int_kind), intent(in) :: & + ncat , & ! number of categories + nslyr , & ! number of snow layers + nilyr ! number of ice layers + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + real (kind=dbl_kind), dimension(ncat), intent(in) :: & + zTin , & ! surface ice temperature (oC) + Tsfc , & ! surface temperature (oC) + hin , & ! ice thickness (m) + hsn ! snow thickness (m) + + real (kind=dbl_kind), dimension(nslyr,ncat), intent(in) :: & + zqsn ! enthalpy of snow (J m-3) + + real (kind=dbl_kind), dimension(nslyr,ncat), intent(inout) :: & + rsnw ! snow grain radius + + real (kind=dbl_kind), dimension(nslyr,ncat), intent(inout) :: & + smice , & ! tracer for mass of ice in snow (kg/m^3) + smliq ! tracer for mass of liquid in snow (kg/m^3) + + ! local temporary variables + + integer (kind=int_kind) :: k, n + + real (kind=dbl_kind), dimension(nslyr) :: & + drsnw_wet, & ! wet metamorphism (10^-6 m) + drsnw_dry ! dry (temperature gradient) metamorphism (10^-6 m) + + character (len=*),parameter :: subname='(update_snow_radius)' + + do n = 1, ncat + + if (hsn(n) > puny .and. hin(n) > puny) then + + drsnw_dry(:) = c0 + drsnw_wet(:) = c0 + + !----------------------------------------------------------------- + ! dry metamorphism + !----------------------------------------------------------------- + call snow_dry_metamorph (nslyr, nilyr, dt, rsnw(:,n), & + drsnw_dry, zqsn(:,n), Tsfc(n), & + zTin(n), hsn(n), hin(n)) + if (icepack_warnings_aborted(subname)) return + + !----------------------------------------------------------------- + ! wet metamorphism + !----------------------------------------------------------------- + do k = 1,nslyr + call snow_wet_metamorph (dt, drsnw_wet(k), rsnw(k,n), & + smice(k,n), smliq(k,n)) + if (icepack_warnings_aborted(subname)) return + rsnw(k,n) = min(rsnw_tmax, rsnw(k,n) + drsnw_dry(k) + drsnw_wet(k)) + enddo + + else ! hsn or hin < puny + do k = 1,nslyr + ! rsnw_fall < rsnw < rsnw_tmax + rsnw (k,n) = max(rsnw_fall, min(rsnw_tmax, rsnw(k,n))) + smice(k,n) = rhos + smliq(k,n) = c0 + enddo + endif ! hsn, hin + enddo + + end subroutine update_snow_radius + +!======================================================================= + +! Snow grain metamorphism + + subroutine snow_dry_metamorph (nslyr,nilyr, dt, rsnw, drsnw_dry, zqsn, & + Tsfc, zTin1, hsn, hin) + + ! Vapor redistribution: Method is to retrieve 3 best-fit parameters that + ! depend on snow temperature, temperature gradient, and density, + ! that are derived from the microphysical model described in: + ! Flanner and Zender (2006), Linking snowpack microphysics and albedo + ! evolution, J. Geophys. Res., 111, D12208, doi:10.1029/2005JD006834. + ! The parametric equation has the form: + ! dr/dt = drdt_0*(tau/(dr_fresh+tau))^(1/kappa), where: + ! r is the effective radius, + ! tau and kappa are best-fit parameters, + ! drdt_0 is the initial rate of change of effective radius, and + ! dr_fresh is the difference between the current and fresh snow states + ! (r_current - r_fresh). + + integer (kind=int_kind), intent(in) :: & + nslyr, & ! number of snow layers + nilyr ! number of ice layers + + real (kind=dbl_kind), intent(in) :: & + dt ! time step (s) + + real (kind=dbl_kind), dimension(nslyr), & + intent(in) :: & + rsnw, & ! snow grain radius (10^-6 m) + zqsn ! snow enthalpy (J m-3) + + real (kind=dbl_kind), dimension(nslyr), & + intent(inout) :: & + drsnw_dry ! change due to snow aging (10^-6 m) + + real (kind=dbl_kind), intent(in) :: & + Tsfc, & ! surface temperature (C) + zTin1, & ! top ice layer temperature (C) + hsn, & ! snow thickness (m) + hin ! ice thickness (m) + + ! local temporary variables + + integer (kind=int_kind) :: k + + integer (kind=int_kind) :: & + T_idx, & ! temperature index + Tgrd_idx, & ! temperature gradient index + rhos_idx ! density index + + real (kind=dbl_kind), dimension(nslyr):: & + zdTdz, & ! temperature gradient (K/s) + zTsn ! snow temperature (C) + + real (kind=dbl_kind) :: & + bst_tau, & ! snow aging parameter retrieved from lookup table [hour] + bst_kappa, & ! snow aging parameter retrieved from lookup table [unitless] + bst_drdt0, & ! snow aging parameter retrieved from lookup table [um hr-1] + dr_fresh, & ! change in snow radius from fresh (10^-6 m) + dzs, & ! snow layer thickness (m) + dzi, & ! ice layer thickness (m) + dz ! dzs + dzi (m) + + logical (kind=log_kind) :: & + first_call = .true. ! first call flag + + character (char_len) :: & + string ! generic string for writing messages + + character (len=*),parameter :: subname='(snow_dry_metamorph)' + + !----------------------------------------------------------------- + ! On the first call, check that the table is setup properly + ! Check sizes of 1D and 3D data + ! Check that the 1D data is regularly spaced and set min, del, and lin values + ! for each 1D variable. This info will be used later for the table lookup. + !----------------------------------------------------------------- + + if (first_call) then + if (isnw_rhos < 1 .or. isnw_Tgrd < 1 .or. isnw_T < 1 .or. & + size(snowage_rhos) /= isnw_rhos .or. & + size(snowage_Tgrd) /= isnw_Tgrd .or. & + size(snowage_T) /= isnw_T .or. & + size(snowage_tau) /= isnw_rhos*isnw_Tgrd*isnw_T .or. & + size(snowage_kappa) /= isnw_rhos*isnw_Tgrd*isnw_T .or. & + size(snowage_drdt0) /= isnw_rhos*isnw_Tgrd*isnw_T) then + write(string,'(a,3i4)') subname//' snowtable size1 = ',isnw_rhos, isnw_Tgrd, isnw_T + call icepack_warnings_add(string) + write(string,'(a,3i4)') subname//' snowtable size2 = ',size(snowage_rhos),size(snowage_Tgrd),size(snowage_T) + call icepack_warnings_add(string) + write(string,'(a,3i9)') subname//' snowtable size3 = ',size(snowage_tau),size(snowage_kappa),size(snowage_drdt0) + call icepack_warnings_add(string) + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//'ERROR: arrays sizes error') + return + endif + call snowtable_check_dimension(snowage_rhos, min_rhos, del_rhos, lin_rhos) + if (icepack_warnings_aborted(subname)) return + call snowtable_check_dimension(snowage_Tgrd, min_Tgrd, del_Tgrd, lin_Tgrd) + if (icepack_warnings_aborted(subname)) return + call snowtable_check_dimension(snowage_T , min_T , del_T , lin_T ) + if (icepack_warnings_aborted(subname)) return + endif + + !----------------------------------------------------------------- + ! Needed for variable snow density not currently modeled + ! calculate density based on liquid and ice content of snow + !----------------------------------------------------------------- + + drsnw_dry(:) = c0 + zTsn(:) = c0 + zdTdz(:) = c0 + + dzs = hsn/real(nslyr,kind=dbl_kind) + dzi = hin/real(nilyr,kind=dbl_kind) + dz = dzs + dzi + + zTsn(1) = (Lfresh + zqsn(1)/rhos)/cp_ice + if (nslyr == 1) then + zdTdz(1) = min(c10*isnw_Tgrd, & +!ech refactored abs((zTsn(1)*dzi+zTin1*dzs)/(dzs+dzi+puny) - Tsfc)/(hsn+puny)) + abs(zTsn(1)*dzi + zTin1*dzs - Tsfc*dz)/(dz*hsn+puny)) + else + do k = 2, nslyr + zTsn(k) = (Lfresh + zqsn(k)/rhos)/cp_ice + if (k == 2) then + zdTdz(k-1) = abs((zTsn(k-1)+zTsn(k))*p5 - Tsfc)/(dzs+puny) + else + zdTdz(k-1) = abs (zTsn(k-2)-zTsn(k))*p5 /(dzs+puny) + endif + zdTdz(k-1) = min(c10*isnw_Tgrd,zdTdz(k-1)) + enddo +!ech refactored zdTdz(nslyr) = abs((zTsn(nslyr)*dzi + zTin1*dzs)/(dzs + dzi+puny) & +!ech refactored - (zTsn(nslyr) + zTsn(nslyr-1))*p5) / (dzs+puny) + zdTdz(nslyr) = abs((zTsn(nslyr)*dzi + zTin1*dzs) & + - (zTsn(nslyr) + zTsn(nslyr-1))*p5*dz) / (dz*dzs+puny) + zdTdz(nslyr) = min(c10*isnw_Tgrd, zdTdz(nslyr)) + endif + + do k = 1, nslyr + + !----------------------------------------------------------------- + ! best-fit table indices: + ! Will abort if 1D data is not regularly spaced (lin_* flag must be true) + ! Leave option for doing a search into non regularly spaced 1D data in the future + ! via a binary search or similar. + !----------------------------------------------------------------- + + if (lin_rhos) then + rhos_idx = nint( (rhos - min_rhos) / del_rhos, kind=int_kind) + 1 + else + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//'ERROR: nonlinear lookup table for rhos not supported yet') + return + endif + + if (lin_Tgrd) then + Tgrd_idx = nint( (zdTdz(k) - min_Tgrd) / del_Tgrd, kind=int_kind) + 1 + else + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//'ERROR: nonlinear lookup table for Tgrd not supported yet') + return + endif + + if (lin_T) then + T_idx = nint(abs(zTsn(k)+ Tffresh - min_T ) / del_T , kind=int_kind) + 1 + else + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//'ERROR: nonlinear lookup table for T not supported yet') + return + endif + + ! boundary check: + rhos_idx = min(isnw_rhos, max(1,rhos_idx)) + Tgrd_idx = min(isnw_Tgrd, max(1,Tgrd_idx)) + T_idx = min(isnw_T , max(1,T_idx )) + + bst_tau = snowage_tau (rhos_idx,Tgrd_idx,T_idx) + bst_kappa = snowage_kappa(rhos_idx,Tgrd_idx,T_idx) + bst_drdt0 = snowage_drdt0(rhos_idx,Tgrd_idx,T_idx) + + ! change in snow effective radius, using best-fit parameters + dr_fresh = max(c0,rsnw(k)-rsnw_fall) + drsnw_dry(k) = (bst_drdt0*(bst_tau/(dr_fresh+bst_tau))**(1/bst_kappa))& + * (dt/3600.0_dbl_kind) + enddo + + first_call = .false. + + end subroutine snow_dry_metamorph + +!======================================================================= + +! Snow grain metamorphism + + subroutine snow_wet_metamorph (dt, dr_wet, rsnw, smice, smliq) + ! + ! Liquid water redistribution: Apply the grain growth function from: + ! Brun, E. (1989), Investigation of wet-snow metamorphism in respect of + ! liquid-water content, Annals of Glaciology, 13, 22-26. + ! There are two parameters that describe the grain growth rate as + ! a function of snow liquid water content (LWC). The "LWC=0" parameter + ! is zeroed here because we are accounting for dry snowing with a + ! different representation + ! + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + real (kind=dbl_kind), intent(in) :: & + rsnw , & ! snow grain radius (10^-6 m) + smice, & ! snow ice density (kg/m^3) + smliq ! snow liquid density (kg/m^3) + + real (kind=dbl_kind), intent(inout) :: & + dr_wet + + real (kind=dbl_kind) :: & + fliq ! liquid mass fraction + + character (len=*),parameter :: subname='(snow_wet_metamorph)' + + dr_wet = c0 + fliq = c1 + if (smice + smliq > c0 .and. rsnw > c0) then + fliq = min(smliq/(smice + smliq),p1)*c100 + dr_wet = S_wet * fliq**3*dt/(c4*pi*rsnw**2) + endif + + end subroutine snow_wet_metamorph + +!======================================================================= + +! Analyze 1D array for regular spacing for snow table lookup +! and set the min, del, and lin values. +! Tolerance for regular spacing set at 1.0e-8 * typical array value + + subroutine snowtable_check_dimension(array, min_fld, del_fld, lin_fld) + + real (kind=dbl_kind), intent(in), dimension(:) :: & + array ! array to check + + real (kind=dbl_kind), intent(inout) :: & + min_fld, & ! min value if linear + del_fld ! delta value if linear + + logical (kind=log_kind), intent(inout) :: & + lin_fld ! linear flag + + ! local temporary variables + + integer (kind=int_kind) :: n, asize + + real (kind=dbl_kind) :: tolerance ! tolerance for linear checking + + character (len=*),parameter :: subname='(snowtable_check_dimension)' + + asize = size(array) + + if (asize == 1) then + min_fld = array(1) + del_fld = array(1) ! arbitrary + lin_fld = .true. + else + lin_fld = .true. + min_fld = array(1) + del_fld = array(2) - array(1) + tolerance = 1.0e-08_dbl_kind * max(abs(array(1)),abs(array(2))) ! relative to typical value + do n = 3,asize + if (abs(array(n) - array(n-1) - del_fld) > tolerance) lin_fld = .false. + enddo + endif + + end subroutine snowtable_check_dimension + +!======================================================================= + +! Conversions between ice mass, liquid water mass in snow + + subroutine drain_snow (nslyr, vsnon, aicen, & + massice, massliq, meltsliq) + + integer (kind=int_kind), intent(in) :: & + nslyr ! number of snow layers + + real (kind=dbl_kind), intent(in) :: & + vsnon, & ! snow volume (m) + aicen ! aice area fraction + + real (kind=dbl_kind), intent(inout) :: & + meltsliq ! total liquid content (kg/m^2) + + real (kind=dbl_kind), dimension(nslyr), & + intent(in) :: & + massice ! mass of ice in snow (kg/m^2) + + real (kind=dbl_kind), dimension(nslyr), & + intent(inout) :: & + massliq ! mass of liquid in snow (kg/m^2) + + ! local temporary variables + + integer (kind=int_kind) :: k + + real (kind=dbl_kind) :: & + hslyr, & ! snow layer thickness (m) + hsn ! snow thickness (m) + + real (kind=dbl_kind), dimension(nslyr) :: & + dlin , & ! liquid mass into the layer from above (kg/m^2) + dlout , & ! liquid mass out of the layer (kg/m^2) + phi_liq , & ! volumetric liquid fraction + phi_ice ! volumetric ice fraction + + character (len=*), parameter :: subname='(drain_snow)' + + hsn = c0 + if (aicen > c0) hsn = vsnon/aicen + if (hsn > puny) then + dlin (:) = c0 + dlout(:) = c0 + hslyr = hsn / real(nslyr,kind=dbl_kind) + meltsliq = c0 + do k = 1, nslyr + massliq(k) = massliq(k) + dlin(k) ! add liquid in from layer above + phi_ice(k) = min(c1, massice(k) / (rhoi *hslyr)) + phi_liq(k) = massliq(k) / (rhofresh*hslyr) + dlout(k) = max(c0, (phi_liq(k) - S_r*(c1-phi_ice(k))) / rhofresh*hslyr) + massliq(k) = massliq(k) - dlout(k) + if (k < nslyr) then + dlin(k+1) = dlout(k) + else + meltsliq = dlout(nslyr) ! this (re)initializes meltsliq + endif + enddo + else + meltsliq = meltsliq ! computed in thickness_changes + endif + + end subroutine drain_snow + +!======================================================================= + + end module icepack_snow + +!======================================================================= diff --git a/columnphysics/icepack_therm_itd.F90 b/columnphysics/icepack_therm_itd.F90 index c0ddc965e..77e9b536b 100644 --- a/columnphysics/icepack_therm_itd.F90 +++ b/columnphysics/icepack_therm_itd.F90 @@ -24,16 +24,16 @@ module icepack_therm_itd use icepack_parameters, only: p001, p1, p333, p5, p666, puny, bignum use icepack_parameters, only: rhos, rhoi, Lfresh, ice_ref_salinity use icepack_parameters, only: phi_init, dsin0_frazil, hs_ssl, salt_loss - use icepack_parameters, only: rhosi, conserv_check + use icepack_parameters, only: rhosi, conserv_check, rhosmin use icepack_parameters, only: kitd, ktherm, heat_capacity use icepack_parameters, only: z_tracers, solve_zsal, hfrazilmin use icepack_tracers, only: ntrcr, nbtrcr use icepack_tracers, only: nt_qice, nt_qsno, nt_fbri, nt_sice use icepack_tracers, only: nt_apnd, nt_hpnd, nt_aero, nt_isosno, nt_isoice - use icepack_tracers, only: nt_Tsfc, nt_iage, nt_FY, nt_fsd + use icepack_tracers, only: nt_Tsfc, nt_iage, nt_FY, nt_fsd, nt_rhos use icepack_tracers, only: nt_alvl, nt_vlvl - use icepack_tracers, only: tr_pond_cesm, tr_pond_lvl, tr_pond_topo + use icepack_tracers, only: tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_snow use icepack_tracers, only: tr_iage, tr_FY, tr_lvl, tr_aero, tr_iso, tr_brine, tr_fsd use icepack_tracers, only: n_aero, n_iso use icepack_tracers, only: bio_index @@ -569,6 +569,15 @@ subroutine linear_itd (ncat, hin_max, & trcrn(k,n) = trcrn(k,n) + rhos*Lfresh enddo enddo + ! maintain rhos_cmp positive definiteness + if (tr_snow) then + do n = 1, ncat + do k = nt_rhos, nt_rhos+nslyr-1 + trcrn(k,n) = max(trcrn(k,n)-rhosmin, c0) +! trcrn(k,n) = trcrn(k,n) - rhosmin + enddo + enddo + endif call shift_ice (ntrcr, ncat, & trcr_depend, & @@ -587,6 +596,14 @@ subroutine linear_itd (ncat, hin_max, & trcrn(k,n) = trcrn(k,n) - rhos*Lfresh enddo enddo + ! maintain rhos_cmp positive definiteness + if (tr_snow) then + do n = 1, ncat + do k = nt_rhos, nt_rhos+nslyr-1 + trcrn(k,n) = trcrn(k,n) + rhosmin + enddo + enddo + endif !----------------------------------------------------------------- ! Make sure hice(1) >= minimum ice thickness hi_min. @@ -1195,8 +1212,8 @@ subroutine lateral_melt (dt, ncat, & !----------------------------------------------------------------- if (z_tracers) then ! snow tracers - dvssl = min(p5*vsnon(n), hs_ssl*aicen(n)) !snow surface layer - dvint = vsnon(n)- dvssl !snow interior + dvssl = min(p5*vsnon(n)/real(nslyr,kind=dbl_kind), hs_ssl*aicen(n)) ! snow surface layer + dvint = vsnon(n) - dvssl ! snow interior do k = 1, nbtrcr flux_bio(k) = flux_bio(k) & + (trcrn(bio_index(k)+nblyr+1,n)*dvssl & diff --git a/columnphysics/icepack_therm_mushy.F90 b/columnphysics/icepack_therm_mushy.F90 index c50aff2db..54a228ca3 100644 --- a/columnphysics/icepack_therm_mushy.F90 +++ b/columnphysics/icepack_therm_mushy.F90 @@ -1,12 +1,12 @@ !======================================================================= -module icepack_therm_mushy + module icepack_therm_mushy use icepack_kinds use icepack_parameters, only: c0, c1, c2, c8, c10 use icepack_parameters, only: p01, p05, p1, p2, p5, pi, bignum, puny use icepack_parameters, only: viscosity_dyn, rhow, rhoi, rhos, cp_ocn, cp_ice, Lfresh, gravit - use icepack_parameters, only: hs_min + use icepack_parameters, only: hs_min, snwgrain use icepack_parameters, only: a_rapid_mode, Rac_rapid_mode use icepack_parameters, only: aspect_rapid_mode, dSdt_slow_mode, phi_c_slow_mode use icepack_parameters, only: sw_redist, sw_frac, sw_dtemp @@ -35,7 +35,7 @@ module icepack_therm_mushy !======================================================================= -contains + contains !======================================================================= @@ -56,7 +56,8 @@ subroutine temperature_changes_salinity(dt, & fsensn, flatn, & flwoutn, fsurfn, & fcondtop, fcondbot, & - fadvheat, snoice) + fadvheat, snoice, & + smice, smliq) ! solve the enthalpy and bulk salinity of the ice for a single column @@ -89,7 +90,9 @@ subroutine temperature_changes_salinity(dt, & real (kind=dbl_kind), dimension (:), intent(inout) :: & Sswabs , & ! SW radiation absorbed in snow layers (W m-2) - Iswabs ! SW radiation absorbed in ice layers (W m-2) + Iswabs , & ! SW radiation absorbed in ice layers (W m-2) + smice , & ! ice mass tracer in snow (kg/m^3) + smliq ! liquid water mass tracer in snow (kg/m^3) real (kind=dbl_kind), intent(inout):: & fsurfn , & ! net flux to top surface, excluding fcondtopn @@ -344,6 +347,7 @@ subroutine temperature_changes_salinity(dt, & phi, dt, & zSin, Sbr, & sss, qocn, & + smice, smliq, & snoice, fadvheat) if (icepack_warnings_aborted(subname)) return @@ -481,7 +485,6 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & Spond, sss, & q, dSdt, & w ) - if (icepack_warnings_aborted(subname)) return ! halt if solver failed if (icepack_warnings_aborted(subname)) return @@ -527,7 +530,6 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & Spond, sss, & q, dSdt, & w ) - if (icepack_warnings_aborted(subname)) return ! halt if solver failed if (icepack_warnings_aborted(subname)) return @@ -582,7 +584,6 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & q, dSdt, & w ) - if (icepack_warnings_aborted(subname)) return ! halt if solver failed if (icepack_warnings_aborted(subname)) return @@ -631,7 +632,6 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & Spond, sss, & q, dSdt, & w ) - if (icepack_warnings_aborted(subname)) return ! halt if solver failed if (icepack_warnings_aborted(subname)) return @@ -794,7 +794,6 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & Spond, sss, & q, dSdt, & w ) - if (icepack_warnings_aborted(subname)) return ! halt if solver failed if (icepack_warnings_aborted(subname)) return @@ -3200,6 +3199,7 @@ subroutine flood_ice(hsn, hin, & phi, dt, & zSin, Sbr, & sss, qocn, & + smice, smliq, & snoice, fadvheat) ! given upwards flushing brine flow calculate amount of snow ice and @@ -3220,7 +3220,9 @@ subroutine flood_ice(hsn, hin, & zqsn , & ! snow layer enthalpy (J m-2) zqin , & ! ice layer enthalpy (J m-2) zSin , & ! ice layer bulk salinity (ppt) - phi ! ice liquid fraction + phi , & ! ice liquid fraction + smice , & ! ice mass tracer in snow (kg/m^3) + smliq ! liquid water mass tracer in snow (kg/m^3) real(kind=dbl_kind), dimension(:), intent(in) :: & Sbr ! ice layer brine salinity (ppt) @@ -3248,6 +3250,7 @@ subroutine flood_ice(hsn, hin, & zqsn_snowice , & ! snow enthalpy of snow thats becoming snowice (J m-2) freeboard_density , & ! negative of ice surface freeboard times the ocean density (kg m-2) ice_mass , & ! mass of the ice (kg m-2) + snow_mass , & ! mass of the ice (kg m-2) rho_ocn , & ! density of the ocean (kg m-3) ice_density , & ! density of ice layer (kg m-3) hadded , & ! thickness rate of water used from ocean (m/s) @@ -3277,23 +3280,42 @@ subroutine flood_ice(hsn, hin, & enddo ! k ice_mass = ice_mass * hilyr - ! negative freeboard times ocean density - freeboard_density = max(ice_mass + hsn * rhos - hin * rho_ocn, c0) - - ! check if have flooded ice - if (freeboard_density > c0) then - - ! sea ice fraction of newly formed snow ice - phi_snowice = (c1 - rhos / rhoi) - - ! density of newly formed snowice - rho_snowice = phi_snowice * rho_ocn + (c1 - phi_snowice) * rhoi +! for now, do not use variable snow density +! snow_mass = c0 +! if (snwgrain) then +! do k = 1,nslyr +! snow_mass = snow_mass + (smice(k) + smliq(k)) * hslyr +! enddo + +! ! negative freeboard times ocean density +! freeboard_density = max(ice_mass + snow_mass - hin * rho_ocn, c0) ! may not be BFB + +! if (freeboard_density > c0) then ! ice is flooded +! phi_snowice = (c1 - snow_mass / hsn / rhoi) ! sea ice fraction of newly formed snow-ice +! ! density of newly formed snowice +! ! use rhos instead of (c1-phi_snowice)*rhoi to conserve ice and liquid +! ! snow tracers when rhos = smice + smliq +! rho_snowice = phi_snowice * rho_ocn + (c1 - phi_snowice) * rhoi +! endif +! else + ! snow_mass = rhos * hsn + ! negative freeboard times ocean density + freeboard_density = max(ice_mass + hsn * rhos - hin * rho_ocn, c0) + + if (freeboard_density > c0) then ! ice is flooded + phi_snowice = (c1 - rhos / rhoi) ! sea ice fraction of newly formed snow-ice + ! density of newly formed snow-ice + rho_snowice = phi_snowice * rho_ocn + (c1 - phi_snowice) * rhoi + endif ! freeboard_density > c0 +! endif ! tr_snow + + if (freeboard_density > c0) then ! ice is flooded ! calculate thickness of new ice added dh = freeboard_density / (rho_ocn - rho_snowice + rhos) dh = max(min(dh,hsn),c0) - ! enthalpy of snow that becomes snowice + ! enthalpy of snow that becomes snow-ice call enthalpy_snow_snowice(nslyr, dh, hsn, zqsn, zqsn_snowice) if (icepack_warnings_aborted(subname)) return @@ -3312,6 +3334,12 @@ subroutine flood_ice(hsn, hin, & call update_vertical_tracers_snow(nslyr, zqsn, hslyr, hslyr2) if (icepack_warnings_aborted(subname)) return + if (snwgrain .and. hslyr2 > puny) then + call update_vertical_tracers_snow(nslyr, smice, hslyr, hslyr2) + call update_vertical_tracers_snow(nslyr, smliq, hslyr, hslyr2) + if (icepack_warnings_aborted(subname)) return + endif + ! change ice properties call update_vertical_tracers_ice(nilyr, zqin, hilyr, hilyr2, & hin, hin2, zqin_snowice) @@ -3541,6 +3569,6 @@ end subroutine update_vertical_tracers_ice !======================================================================= -end module icepack_therm_mushy + end module icepack_therm_mushy !======================================================================= diff --git a/columnphysics/icepack_therm_shared.F90 b/columnphysics/icepack_therm_shared.F90 index 553328cac..621fd1e56 100644 --- a/columnphysics/icepack_therm_shared.F90 +++ b/columnphysics/icepack_therm_shared.F90 @@ -8,7 +8,7 @@ module icepack_therm_shared use icepack_kinds - use icepack_parameters, only: c0, c1, c2, c4, p5, pi + use icepack_parameters, only: c0, c1, c2, c4, p5, pi, puny use icepack_parameters, only: cp_ocn, cp_ice, rhoi, rhos, Tffresh, TTTice, qqqice use icepack_parameters, only: stefan_boltzmann, emissivity, Lfresh, Tsmelt use icepack_parameters, only: saltmax, min_salin, depressT @@ -35,7 +35,8 @@ module icepack_therm_shared icepack_snow_temperature, & icepack_liquidus_temperature, & icepack_sea_freezing_temperature, & - icepack_enthalpy_snow + icepack_enthalpy_snow, & + adjust_enthalpy real (kind=dbl_kind), parameter, public :: & ferrmax = 1.0e-3_dbl_kind ! max allowed energy flux error (W m-2) @@ -473,6 +474,89 @@ function icepack_enthalpy_snow(zTsn) result(qsn) end function icepack_enthalpy_snow +!======================================================================= +! +! Conserving energy, compute the new enthalpy of equal-thickness ice +! or snow layers. +! +! authors William H. Lipscomb, LANL +! C. M. Bitz, UW + + subroutine adjust_enthalpy (nlyr, & + z1, z2, & + hlyr, hn, & + qn) + + integer (kind=int_kind), intent(in) :: & + nlyr ! number of layers (nilyr or nslyr) + + real (kind=dbl_kind), dimension (:), intent(in) :: & + z1 , & ! interface depth for old, unequal layers (m) + z2 ! interface depth for new, equal layers (m) + + real (kind=dbl_kind), intent(in) :: & + hlyr ! new layer thickness (m) + + real (kind=dbl_kind), intent(in) :: & + hn ! total thickness (m) + + real (kind=dbl_kind), dimension (:), intent(inout) :: & + qn ! layer quantity (enthalpy, salinity...) + + ! local variables + + integer (kind=int_kind) :: & + k, k1, k2 ! vertical indices + + real (kind=dbl_kind) :: & + hovlp ! overlap between old and new layers (m) + + real (kind=dbl_kind) :: & + rhlyr ! 1./hlyr + + real (kind=dbl_kind), dimension (nlyr) :: & + hq ! h * q for a layer + + character(len=*),parameter :: subname='(adjust_enthalpy)' + + !----------------------------------------------------------------- + ! Compute reciprocal layer thickness. + !----------------------------------------------------------------- + + rhlyr = c0 + if (hn > puny) rhlyr = c1 / hlyr + + !----------------------------------------------------------------- + ! Compute h*q for new layers (k2) given overlap with old layers (k1) + !----------------------------------------------------------------- + + do k2 = 1, nlyr + hq(k2) = c0 + enddo ! k + k1 = 1 + k2 = 1 + do while (k1 <= nlyr .and. k2 <= nlyr) + hovlp = min (z1(k1+1), z2(k2+1)) & + - max (z1(k1), z2(k2)) + hovlp = max (hovlp, c0) + hq(k2) = hq(k2) + hovlp*qn(k1) + if (z1(k1+1) > z2(k2+1)) then + k2 = k2 + 1 + else + k1 = k1 + 1 + endif + enddo ! while + + !----------------------------------------------------------------- + ! Compute new enthalpies. + !----------------------------------------------------------------- + + do k = 1, nlyr + qn(k) = hq(k) * rhlyr + enddo ! k + + end subroutine adjust_enthalpy + !======================================================================= end module icepack_therm_shared diff --git a/columnphysics/icepack_therm_vertical.F90 b/columnphysics/icepack_therm_vertical.F90 index 45db195d9..42cc66b85 100644 --- a/columnphysics/icepack_therm_vertical.F90 +++ b/columnphysics/icepack_therm_vertical.F90 @@ -23,10 +23,10 @@ module icepack_therm_vertical use icepack_parameters, only: c0, c1, p001, p5, puny use icepack_parameters, only: pi, depressT, Lvap, hs_min, cp_ice, min_salin use icepack_parameters, only: cp_ocn, rhow, rhoi, rhos, Lfresh, rhofresh, ice_ref_salinity - use icepack_parameters, only: ktherm, heat_capacity, calc_Tsfc + use icepack_parameters, only: ktherm, heat_capacity, calc_Tsfc, rsnw_fall, rsnw_tmax use icepack_parameters, only: ustar_min, fbot_xfer_type, formdrag, calc_strair - use icepack_parameters, only: rfracmin, rfracmax, pndaspect, dpscale, frzpnd - use icepack_parameters, only: phi_i_mushy, floeshape, floediam + use icepack_parameters, only: rfracmin, rfracmax, dpscale, frzpnd, snwgrain, snwlvlfac + use icepack_parameters, only: phi_i_mushy, floeshape, floediam, use_smliq_pnd, snwredist use icepack_tracers, only: tr_iage, tr_FY, tr_aero, tr_pond, tr_fsd, tr_iso use icepack_tracers, only: tr_pond_cesm, tr_pond_lvl, tr_pond_topo @@ -35,6 +35,7 @@ module icepack_therm_vertical use icepack_therm_shared, only: ferrmax, l_brine use icepack_therm_shared, only: calculate_tin_from_qin, Tmin use icepack_therm_shared, only: hi_min + use icepack_therm_shared, only: adjust_enthalpy use icepack_therm_bl99, only: temperature_changes use icepack_therm_0layer, only: zerolayer_temperature use icepack_therm_mushy, only: temperature_changes_salinity @@ -55,6 +56,7 @@ module icepack_therm_vertical use icepack_meltpond_cesm, only: compute_ponds_cesm use icepack_meltpond_lvl, only: compute_ponds_lvl use icepack_meltpond_topo, only: compute_ponds_topo + use icepack_snow, only: drain_snow implicit none @@ -81,12 +83,12 @@ subroutine thermo_vertical (nilyr, nslyr, & Tsf, zSin, & zqin, zqsn, & apond, hpond, & - tr_pond_topo,& flw, potT, & Qa, rhoa, & fsnow, fpond, & fbot, Tbot, & - Tsnice, sss, & + Tsnice, sss, & + rsnw, & lhcoef, shcoef, & fswsfc, fswint, & Sswabs, Iswabs, & @@ -96,8 +98,11 @@ subroutine thermo_vertical (nilyr, nslyr, & flwoutn, evapn, & evapsn, evapin, & freshn, fsaltn, & - fhocnn, meltt, & - melts, meltb, & + fhocnn, frain, & + meltt, melts, & + meltb, meltsliq, & + smice, massice, & + smliq, massliq, & congel, snoice, & mlt_onset, frz_onset, & yday, dsnow, & @@ -108,7 +113,8 @@ subroutine thermo_vertical (nilyr, nslyr, & nslyr ! number of snow layers real (kind=dbl_kind), intent(in) :: & - dt ! time step + dt , & ! time step + frain ! rainfall rate (kg/m2/s) ! ice state variables real (kind=dbl_kind), intent(inout) :: & @@ -123,16 +129,18 @@ subroutine thermo_vertical (nilyr, nslyr, & hpond ! melt pond depth (m) ! iage ! ice age (s) - logical (kind=log_kind), intent(in) :: & - tr_pond_topo ! if .true., use melt pond tracer - logical (kind=log_kind), intent(in), optional :: & prescribed_ice ! if .true., use prescribed ice instead of computed real (kind=dbl_kind), dimension (:), intent(inout) :: & zqsn , & ! snow layer enthalpy, zqsn < 0 (J m-3) zqin , & ! ice layer enthalpy, zqin < 0 (J m-3) - zSin ! internal ice layer salinities + zSin , & ! internal ice layer salinities + rsnw , & ! snow grain radius (10^-6 m) + smice , & ! ice mass tracer in snow (kg/m^3) + smliq , & ! liquid water mass tracer in snow (kg/m^3) + massice , & ! ice mass in snow (kg/m^2) + massliq ! liquid water mass in snow (kg/m^2) ! input from atmosphere real (kind=dbl_kind), & @@ -185,9 +193,10 @@ subroutine thermo_vertical (nilyr, nslyr, & ! diagnostic fields real (kind=dbl_kind), & intent(inout):: & - Tsnice , & ! snow ice interface temperature (deg C) + Tsnice , & ! snow ice interface temperature (deg C) meltt , & ! top ice melt (m/step-->cm/day) melts , & ! snow melt (m/step-->cm/day) + meltsliq , & ! snow melt mass (kg/m^2/step-->kg/m^2/day) meltb , & ! basal ice melt (m/step-->cm/day) congel , & ! basal ice growth (m/step-->cm/day) snoice , & ! snow-ice formation (m/step-->cm/day) @@ -242,8 +251,8 @@ subroutine thermo_vertical (nilyr, nslyr, & flwoutn = c0 evapn = c0 - evapsn = c0 - evapin = c0 + evapsn = c0 + evapin = c0 freshn = c0 fsaltn = c0 fhocnn = c0 @@ -257,6 +266,7 @@ subroutine thermo_vertical (nilyr, nslyr, & dsnow = c0 zTsn(:) = c0 zTin(:) = c0 + meltsliq= c0 if (calc_Tsfc) then fsensn = c0 @@ -309,10 +319,17 @@ subroutine thermo_vertical (nilyr, nslyr, & sss, & fsensn, flatn, & flwoutn, fsurfn, & - fcondtopn, fcondbotn, & - fadvocn, snoice) + fcondtopn, fcondbotn, & + fadvocn, snoice, & + smice, smliq) if (icepack_warnings_aborted(subname)) return + ! reinitialize mass in case of snow-ice formation + if (snwgrain) then + massice(:) = smice(:) * hslyr + massliq(:) = smliq(:) * hslyr + endif + else ! ktherm call temperature_changes(dt, & @@ -397,18 +414,21 @@ subroutine thermo_vertical (nilyr, nslyr, & hin, hilyr, & hsn, hslyr, & zqin, zqsn, & + smice, massice, & + smliq, massliq, & fbot, Tbot, & flatn, fsurfn, & - fcondtopn, fcondbotn, & + fcondtopn, fcondbotn, & fsnow, hsn_new, & fhocnn, evapn, & evapsn, evapin, & meltt, melts, & - meltb, & + meltsliq, frain, & + meltb, & congel, snoice, & mlt_onset, frz_onset, & zSin, sss, & - dsnow) + dsnow, rsnw) if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- @@ -469,10 +489,6 @@ subroutine thermo_vertical (nilyr, nslyr, & vicen, vsnon) if (icepack_warnings_aborted(subname)) return - !----------------------------------------------------------------- - ! Reload passive tracer array - !----------------------------------------------------------------- - end subroutine thermo_vertical !======================================================================= @@ -922,65 +938,53 @@ subroutine init_vertical_profile(nilyr, nslyr, & !----------------------------------------------------------------- if (tice_high .and. heat_capacity) then - - if (l_brine) then - Tmax = Tmlts(k) - else ! fresh ice - Tmax = -zqin(k)*puny/(rhos*cp_ice*vicen) - endif - - if (zTin(k) > Tmax) then - write(warnstr,*) ' ' - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'Starting thermo, T > Tmax, layer', k - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'k:', k - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'zTin =',zTin(k),', Tmax=',Tmax - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'zSin =',zSin(k) - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'hin =',hin - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'zqin =',zqin(k) - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'qmlt=',enthalpy_of_melting(zSin(k)) - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'Tmlt=',Tmlts(k) - call icepack_warnings_add(warnstr) + write(warnstr,*) ' ' + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'Starting thermo, zTin > Tmax, layer', k + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'k:', k + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'zTin =',zTin(k),', Tmax=',Tmax + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'zSin =',zSin(k) + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'hin =',hin + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'zqin =',zqin(k) + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'qmlt=',enthalpy_of_melting(zSin(k)) + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'Tmlt=',Tmlts(k) + call icepack_warnings_add(warnstr) - if (ktherm == 2) then - zqin(k) = enthalpy_of_melting(zSin(k)) - c1 - zTin(k) = icepack_mushy_temperature_mush(zqin(k),zSin(k)) - write(warnstr,*) subname, 'Corrected quantities' - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'zqin=',zqin(k) - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'zTin=',zTin(k) - call icepack_warnings_add(warnstr) - else - call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, T > Tmax, layer" ) - return - endif - endif - endif ! tice_high - - if (tice_low .and. heat_capacity) then - - if (zTin(k) < Tmin) then - write(warnstr,*) ' ' - call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'Starting thermo T < Tmin, layer', k + if (ktherm == 2) then + zqin(k) = enthalpy_of_melting(zSin(k)) - c1 + zTin(k) = icepack_mushy_temperature_mush(zqin(k),zSin(k)) + write(warnstr,*) subname, 'Corrected quantities' call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'zTin =', zTin(k) + write(warnstr,*) subname, 'zqin=',zqin(k) call icepack_warnings_add(warnstr) - write(warnstr,*) subname, 'Tmin =', Tmin + write(warnstr,*) subname, 'zTin=',zTin(k) call icepack_warnings_add(warnstr) + else call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, T < Tmin, layer" ) + call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, zTin > Tmax, layer" ) return endif + endif ! tice_high + + if (tice_low .and. heat_capacity) then + write(warnstr,*) ' ' + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'Starting thermo T < Tmin, layer', k + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'zTin =', zTin(k) + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, 'Tmin =', Tmin + call icepack_warnings_add(warnstr) + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, zTin < Tmin, layer" ) + return endif ! tice_low !----------------------------------------------------------------- @@ -1028,6 +1032,8 @@ subroutine thickness_changes (nilyr, nslyr, & hin, hilyr, & hsn, hslyr, & zqin, zqsn, & + smice, massice, & + smliq, massliq, & fbot, Tbot, & flatn, fsurfn, & fcondtopn, fcondbotn, & @@ -1035,11 +1041,12 @@ subroutine thickness_changes (nilyr, nslyr, & fhocnn, evapn, & evapsn, evapin, & meltt, melts, & + meltsliq, frain, & meltb, & congel, snoice, & mlt_onset, frz_onset,& zSin, sss, & - dsnow) + dsnow, rsnw) integer (kind=int_kind), intent(in) :: & nilyr , & ! number of ice layers @@ -1055,14 +1062,20 @@ subroutine thickness_changes (nilyr, nslyr, & fsnow , & ! snowfall rate (kg m-2 s-1) flatn , & ! surface downward latent heat (W m-2) fsurfn , & ! net flux to top surface, excluding fcondtopn - fcondtopn ! downward cond flux at top surface (W m-2) + fcondtopn , & ! downward cond flux at top surface (W m-2) + frain ! rainfall rate (kg/m2/s) real (kind=dbl_kind), intent(inout) :: & fcondbotn ! downward cond flux at bottom surface (W m-2) real (kind=dbl_kind), dimension (:), intent(inout) :: & zqin , & ! ice layer enthalpy (J m-3) - zqsn ! snow layer enthalpy (J m-3) + zqsn , & ! snow layer enthalpy (J m-3) + rsnw , & ! snow grain radius (10^-6 m) + smice , & ! ice mass tracer in snow (kg/m^3) + smliq , & ! liquid water mass tracer in snow (kg/m^3) + massice , & ! ice mass in snow (kg/m^2) + massliq ! liquid water mass in snow (kg/m^2) real (kind=dbl_kind), intent(inout) :: & hilyr , & ! ice layer thickness (m) @@ -1071,6 +1084,7 @@ subroutine thickness_changes (nilyr, nslyr, & real (kind=dbl_kind), intent(inout) :: & meltt , & ! top ice melt (m/step-->cm/day) melts , & ! snow melt (m/step-->cm/day) + meltsliq , & ! snow melt mass (kg/m^2/step-->kg/m^2/day) meltb , & ! basal ice melt (m/step-->cm/day) congel , & ! basal ice growth (m/step-->cm/day) snoice , & ! snow-ice formation (m/step-->cm/day) @@ -1129,7 +1143,7 @@ subroutine thickness_changes (nilyr, nslyr, & wk1 , & ! temporary variable zqsnew , & ! enthalpy of new snow (J m-3) hstot , & ! snow thickness including new snow (m) - Tmlts ! melting temperature + Tmlts ! melting temperature (deg C) real (kind=dbl_kind), dimension (nilyr+1) :: & zi1 , & ! depth of ice layer boundaries (m) @@ -1140,10 +1154,10 @@ subroutine thickness_changes (nilyr, nslyr, & zs2 ! adjusted depths, with equal hslyr (m) real (kind=dbl_kind), dimension (nilyr) :: & - dzi ! ice layer thickness after growth/melting + dzi ! ice layer thickness after growth/melting (m) real (kind=dbl_kind), dimension (nslyr) :: & - dzs ! snow layer thickness after growth/melting + dzs ! snow layer thickness after growth/melting (m) real (kind=dbl_kind), dimension (nilyr) :: & qm , & ! energy of melting (J m-3) = zqin in BL99 formulation @@ -1152,7 +1166,10 @@ subroutine thickness_changes (nilyr, nslyr, & real (kind=dbl_kind) :: & qbotm , & qbotp , & - qbot0 + qbot0 , & + mass , & ! total mass from snow density tracers (kg/m^2) + massi , & ! ice mass change factor + tmp1 ! temporary scalar character(len=*),parameter :: subname='(thickness_changes)' @@ -1195,7 +1212,15 @@ subroutine thickness_changes (nilyr, nslyr, & Ts = (Lfresh + zqsn(k)/rhos) / cp_ice if (Ts > c0) then dhs = cp_ice*Ts*dzs(k) / Lfresh - dzs(k) = dzs(k) - dhs + + mass = massice(k) + massliq(k) + massi = c0 + if (dzs(k) > puny) massi = max(c0, c1 - dhs/dzs(k)) + massice(k) = massice(k) * massi + massliq(k) = mass - massice(k) ! conserve mass + + dzs(k) = dzs(k) - dhs ! dhs > 0 + melts = melts + dhs zqsn(k) = -rhos*Lfresh endif enddo @@ -1234,12 +1259,19 @@ subroutine thickness_changes (nilyr, nslyr, & ! is used for changes in the brine energy (emlt_atm). !-------------------------------------------------------------- - evapn = c0 ! initialize + evapn = c0 ! initialize evapsn = c0 ! initialize evapin = c0 ! initialize if (hsn > puny) then ! add snow with enthalpy zqsn(1) dhs = econ / (zqsn(1) - rhos*Lvap) ! econ < 0, dhs > 0 + + mass = massice(1) + massliq(1) + massi = c0 + if (dzs(1) > puny) massi = c1 + dhs/dzs(1) + massice(1) = massice(1) * massi + massliq(1) = max(c0, mass + rhos*dhs - massice(1)) ! conserve new total mass + dzs(1) = dzs(1) + dhs evapn = evapn + dhs*rhos evapsn = evapsn + dhs*rhos @@ -1320,15 +1352,25 @@ subroutine thickness_changes (nilyr, nslyr, & ! Remove internal snow melt !-------------------------------------------------------------- - if (ktherm == 2 .and. zqsn(k) > -rhos * Lfresh) then +! more efficient formulation using Ts, dhs > 0 (not BFB) +! Ts = (Lfresh + zqsn(k)/rhos) / cp_ice +! if (ktherm == 2 .and. Ts > c0) then +! dhs = -dzs(k) * cp_ice*Ts/Lfresh ! dhs < 0 + if (ktherm == 2 .and. zqsn(k) > -rhos * Lfresh) then dhs = max(-dzs(k), & -((zqsn(k) + rhos*Lfresh) / (rhos*Lfresh)) * dzs(k)) - dzs(k) = dzs(k) + dhs + + mass = massice(k) + massliq(k) + massi = c0 + if (dzs(k) > puny) massi = max(c0, c1 + dhs/dzs(k)) + massice(k) = massice(k) * massi + massliq(k) = mass - massice(k) ! conserve mass + + dzs(k) = dzs(k) + dhs ! dhs < 0 zqsn(k) = -rhos * Lfresh melts = melts - dhs ! delta E = zqsn(k) + rhos * Lfresh - endif !-------------------------------------------------------------- @@ -1337,10 +1379,17 @@ subroutine thickness_changes (nilyr, nslyr, & qsub = zqsn(k) - rhos*Lvap ! qsub < 0 dhs = max (-dzs(k), esub/qsub) ! esub > 0, dhs < 0 + + mass = massice(1) + massliq(1) + massi = c0 + if (dzs(k) > puny) massi = c1 + dhs/dzs(k) + massice(k) = massice(k) * massi + massliq(k) = max(c0, mass + rhos*dhs - massice(k)) ! conserve new total mass + dzs(k) = dzs(k) + dhs esub = esub - dhs*qsub esub = max(esub, c0) ! in case of roundoff error - evapn = evapn + dhs*rhos + evapn = evapn + dhs*rhos evapsn = evapsn + dhs*rhos !-------------------------------------------------------------- @@ -1348,6 +1397,13 @@ subroutine thickness_changes (nilyr, nslyr, & !-------------------------------------------------------------- dhs = max(-dzs(k), etop_mlt/zqsn(k)) + + mass = massice(k) + massliq(k) + massi = c0 + if (dzs(k) > puny) massi = max(c0, c1 + dhs/dzs(k)) + massice(k) = massice(k) * massi + massliq(k) = mass - massice(k) ! conserve mass + dzs(k) = dzs(k) + dhs ! zqsn < 0, dhs < 0 etop_mlt = etop_mlt - dhs*zqsn(k) etop_mlt = max(etop_mlt, c0) ! in case of roundoff error @@ -1425,13 +1481,17 @@ subroutine thickness_changes (nilyr, nslyr, & !-------------------------------------------------------------- dhs = max(-dzs(k), ebot_mlt/zqsn(k)) + + mass = massice(k) + massliq(k) + massi = c0 + if (dzs(k) > puny) massi = max(c0, c1 + dhs/dzs(k)) + massice(k) = massice(k) * massi + massliq(k) = mass - massice(k) ! conserve mass + dzs(k) = dzs(k) + dhs ! zqsn < 0, dhs < 0 ebot_mlt = ebot_mlt - dhs*zqsn(k) ebot_mlt = max(ebot_mlt, c0) - - ! Add this to the snow melt (J. Zhu) melts = melts - dhs - enddo ! nslyr !----------------------------------------------------------------- @@ -1442,32 +1502,34 @@ subroutine thickness_changes (nilyr, nslyr, & fhocnn = fbot & + (esub + etop_mlt + ebot_mlt)/dt -!---!----------------------------------------------------------------- -!---! Add new snowfall at top surface. -!---!----------------------------------------------------------------- - - !---------------------------------------------------------------- + !----------------------------------------------------------------- + ! Add new snowfall at top surface + !---------------------------------------------------------------- ! NOTE: If heat flux diagnostics are to work, new snow should ! have T = 0 (i.e. q = -rhos*Lfresh) and should not be ! converted to rain. !---------------------------------------------------------------- if (fsnow > c0) then - hsn_new = fsnow/rhos * dt zqsnew = -rhos*Lfresh hstot = dzs(1) + hsn_new if (hstot > c0) then - zqsn(1) = (dzs(1) * zqsn(1) & + zqsn(1) = (dzs(1) * zqsn(1) & + hsn_new * zqsnew) / hstot - ! avoid roundoff errors - zqsn(1) = min(zqsn(1), -rhos*Lfresh) - + zqsn(1) = min(zqsn(1), zqsnew) ! avoid roundoff errors dzs(1) = hstot + massice(1) = massice(1) + fsnow*dt endif endif + !----------------------------------------------------------------- + ! Add rain at top surface (only to liquid tracer) + !----------------------------------------------------------------- + + massliq(1) = massliq(1) + frain*dt + !----------------------------------------------------------------- ! Find the new ice and snow thicknesses. !----------------------------------------------------------------- @@ -1481,22 +1543,93 @@ subroutine thickness_changes (nilyr, nslyr, & do k = 1, nslyr hsn = hsn + dzs(k) - dsnow = dsnow + dzs(k) - hslyr + dsnow = dsnow + dzs(k) - hslyr enddo ! k + !------------------------------------------------------------------- + ! Incorporate new snow for snow grain radius in upper layer + !------------------------------------------------------------------- + + if (snwgrain .and. hsn_new > c0) then + tmp1 = max(c0, dzs(1) - hsn_new) + rsnw(1) = (rsnw_fall * hsn_new + rsnw(1) * tmp1) & + / max( hsn_new + tmp1, puny) + rsnw(1) = max(rsnw_fall, min(rsnw_tmax, rsnw(1))) + endif + !------------------------------------------------------------------- ! Convert snow to ice if snow lies below freeboard. !------------------------------------------------------------------- if (ktherm /= 2) & - call freeboard (nslyr, & - snoice, & - hin, hsn, & - zqin, zqsn, & - dzi, dzs, & - dsnow) + call freeboard (nslyr, snoice, & + hin, hsn, & + zqin, zqsn, & + dzi, dzs, & + dsnow, & + massice, massliq) if (icepack_warnings_aborted(subname)) return + !------------------------------------------------------------------- + ! Update snow mass tracers for uneven layers + !------------------------------------------------------------------- + + if (snwgrain) then + + do k = 1, nslyr + meltsliq = meltsliq + massliq(k) ! used in drain_snow when all snow has melted + if (dzs(k) > puny) then + smice(k) = massice(k) / dzs(k) + smliq(k) = massliq(k) / dzs(k) + else + smice(k) = c0 ! reset to rhos below + smliq(k) = c0 + massice(k) = c0 + massliq(k) = c0 + endif + enddo + + !------------------------------------------------------------------- + ! Check for negative snow mass tracers + !------------------------------------------------------------------- + + do k = 1, nslyr + if (massice(k) < c0) then + if (massice(k) > -puny) then + massice(k) = c0 + else + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//" Snow: ice mass tracer error" ) + write(warnstr,*) subname, ' negative massice', k,massice(k) + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, ' dzs, smice', k,dzs(k), smice(k) + call icepack_warnings_add(warnstr) + endif + endif + if (massliq(k) < c0) then + if (massliq(k) > -puny) then + massliq(k) = c0 + else + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//" Snow: liquid mass tracer error" ) + write(warnstr,*) subname, ' negative massliq', k,massliq(k) + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, ' dzs, smliq', k,dzs(k), smliq(k) + call icepack_warnings_add(warnstr) + endif + endif + if (smice(k) > rhofresh) then + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_add(subname//" Snow: large density " ) + write(warnstr,*) subname, ' large massice', k,massice(k) + call icepack_warnings_add(warnstr) + write(warnstr,*) subname, ' dzs, smice', k,dzs(k), smice(k) + call icepack_warnings_add(warnstr) + endif + enddo + + endif ! snwgrain + !---!------------------------------------------------------------------- !---! Repartition the ice and snow into equal-thickness layers, !---! conserving energy. @@ -1581,12 +1714,33 @@ subroutine thickness_changes (nilyr, nslyr, & !----------------------------------------------------------------- ! Conserving energy, compute the enthalpy of the new equal layers. + ! Also adjust snow grain radius, ice content and liquid content. !----------------------------------------------------------------- call adjust_enthalpy (nslyr, & zs1, zs2, & hslyr, hsn, & zqsn) + + if (snwgrain) then + call adjust_enthalpy (nslyr, & + zs1(:), zs2(:), & + hslyr, hsn, & + rsnw(:)) + call adjust_enthalpy (nslyr, & ! need a routine to adjust + zs1(:), zs2(:), & ! mass instead of tracer + hslyr, hsn, & + smice(:)) + call adjust_enthalpy (nslyr, & + zs1(:), zs2(:), & + hslyr, hsn, & + smliq(:)) + ! Update snow mass + do k = 1, nslyr + massice(k) = smice(k) * hslyr + massliq(k) = smliq(k) * hslyr + enddo + endif if (icepack_warnings_aborted(subname)) return endif ! nslyr > 1 @@ -1596,14 +1750,19 @@ subroutine thickness_changes (nilyr, nslyr, & !----------------------------------------------------------------- if (ktherm == 2) then - do k = 1, nslyr - if (hsn <= puny) then + if (hsn <= puny) then + do k = 1, nslyr fhocnn = fhocnn & + zqsn(k)*hsn/(real(nslyr,kind=dbl_kind)*dt) zqsn(k) = -rhos*Lfresh - hslyr = c0 - endif - enddo + if (snwgrain) then + meltsliq = meltsliq + massice(k) ! add to meltponds + smice(k) = rhos + smliq(k) = c0 + endif + enddo + hslyr = c0 + endif endif !----------------------------------------------------------------- @@ -1649,7 +1808,8 @@ subroutine freeboard (nslyr, & hin, hsn, & zqin, zqsn, & dzi, dzs, & - dsnow) + dsnow, & + massice, massliq) integer (kind=int_kind), intent(in) :: & nslyr ! number of snow layers @@ -1672,9 +1832,11 @@ subroutine freeboard (nslyr, & zqsn ! snow layer enthalpy (J m-3) real (kind=dbl_kind), dimension (:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) - dzi , & ! ice layer thicknesses (m) - dzs ! snow layer thicknesses (m) + zqin , & ! ice layer enthalpy (J m-3) + dzi , & ! ice layer thicknesses (m) + dzs , & ! snow layer thicknesses (m) + massice , & ! total ice mass of snow in each layer (kg/m^2) + massliq ! total liquid mass of snow in each layer (kg/m^2) ! local variables @@ -1688,7 +1850,9 @@ subroutine freeboard (nslyr, & real (kind=dbl_kind) :: & wk1 , & ! temporary variable - dhs ! snow to remove from layer (m) + dhs , & ! snow to remove from layer (m) + mass , & ! total snow mass from tracers (kg/m^2) + massi ! mass change factor character(len=*),parameter :: subname='(freeboard)' @@ -1700,7 +1864,7 @@ subroutine freeboard (nslyr, & dhsn = c0 hqs = c0 - wk1 = hsn - hin*(rhow-rhoi)/rhos + wk1 = hsn - hin*(rhow-rhoi)/rhos ! not yet consistent with smice/smliq if (wk1 > puny .and. hsn > puny) then ! snow below freeboard dhsn = min(wk1*rhoi/rhow, hsn) ! snow to remove @@ -1716,7 +1880,17 @@ subroutine freeboard (nslyr, & if (dhin > puny) then dhs = min(dhsn, dzs(k)) ! snow to remove from layer hsn = hsn - dhs - dsnow = dsnow -dhs !new snow addition term + dsnow = dsnow - dhs ! new snow + + ! remove both ice and liquid from snow to add to ice + mass = massice(k) + massliq(k) + massi = c0 + if (dzs(k) > puny) massi = max(c0, c1 - dhs/dzs(k)) + massice(k) = massice(k) * massi + massliq(k) = massliq(k) * massi +! massice(k) = max(c0, massice(k)) ! for roundoff +! massliq(k) = max(c0, massliq(k)) ! for roundoff + dzs(k) = dzs(k) - dhs dhsn = dhsn - dhs dhsn = max(dhsn,c0) @@ -1744,89 +1918,6 @@ subroutine freeboard (nslyr, & end subroutine freeboard -!======================================================================= -! -! Conserving energy, compute the new enthalpy of equal-thickness ice -! or snow layers. -! -! authors William H. Lipscomb, LANL -! C. M. Bitz, UW - - subroutine adjust_enthalpy (nlyr, & - z1, z2, & - hlyr, hn, & - qn) - - integer (kind=int_kind), intent(in) :: & - nlyr ! number of layers (nilyr or nslyr) - - real (kind=dbl_kind), dimension (:), intent(in) :: & - z1 , & ! interface depth for old, unequal layers (m) - z2 ! interface depth for new, equal layers (m) - - real (kind=dbl_kind), intent(in) :: & - hlyr ! new layer thickness (m) - - real (kind=dbl_kind), intent(in) :: & - hn ! total thickness (m) - - real (kind=dbl_kind), dimension (:), intent(inout) :: & - qn ! layer quantity (enthalpy, salinity...) - - ! local variables - - integer (kind=int_kind) :: & - k, k1, k2 ! vertical indices - - real (kind=dbl_kind) :: & - hovlp ! overlap between old and new layers (m) - - real (kind=dbl_kind) :: & - rhlyr ! 1./hlyr - - real (kind=dbl_kind), dimension (nlyr) :: & - hq ! h * q for a layer - - character(len=*),parameter :: subname='(adjust_enthalpy)' - - !----------------------------------------------------------------- - ! Compute reciprocal layer thickness. - !----------------------------------------------------------------- - - rhlyr = c0 - if (hn > puny) rhlyr = c1 / hlyr - - !----------------------------------------------------------------- - ! Compute h*q for new layers (k2) given overlap with old layers (k1) - !----------------------------------------------------------------- - - do k2 = 1, nlyr - hq(k2) = c0 - enddo ! k - k1 = 1 - k2 = 1 - do while (k1 <= nlyr .and. k2 <= nlyr) - hovlp = min (z1(k1+1), z2(k2+1)) & - - max (z1(k1), z2(k2)) - hovlp = max (hovlp, c0) - hq(k2) = hq(k2) + hovlp*qn(k1) - if (z1(k1+1) > z2(k2+1)) then - k2 = k2 + 1 - else - k1 = k1 + 1 - endif - enddo ! while - - !----------------------------------------------------------------- - ! Compute new enthalpies. - !----------------------------------------------------------------- - - do k = 1, nlyr - qn(k) = hq(k) * rhlyr - enddo ! k - - end subroutine adjust_enthalpy - !======================================================================= ! ! Check for energy conservation by comparing the change in energy @@ -2070,7 +2161,7 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & frzmlt , rside , & fside , & fsnow , frain , & - fpond , & + fpond , fsloss , & fsurf , fsurfn , & fcondtop , fcondtopn , & fcondbot , fcondbotn , & @@ -2108,7 +2199,10 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & melts , meltsn , & congel , congeln , & snoice , snoicen , & - dsnown , & + dsnow , dsnown , & + meltsliq , meltsliqn , & + rsnwn , & + smicen , smliqn , & lmask_n , lmask_s , & mlt_onset , frz_onset , & yday , prescribed_ice, & @@ -2207,17 +2301,26 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & frz_onset ! day of year that freezing begins (congel or frazil) real (kind=dbl_kind), intent(inout), optional :: & - fswthru_vdr , & ! vis dir shortwave penetrating to ocean (W/m^2) - fswthru_vdf , & ! vis dif shortwave penetrating to ocean (W/m^2) - fswthru_idr , & ! nir dir shortwave penetrating to ocean (W/m^2) - fswthru_idf ! nir dif shortwave penetrating to ocean (W/m^2) + fswthru_vdr , & ! vis dir shortwave penetrating to ocean (W/m^2) + fswthru_vdf , & ! vis dif shortwave penetrating to ocean (W/m^2) + fswthru_idr , & ! nir dir shortwave penetrating to ocean (W/m^2) + fswthru_idf , & ! nir dif shortwave penetrating to ocean (W/m^2) + dsnow , & ! change in snow depth (m/step-->cm/day) + meltsliq , & ! mass of snow melt (kg/m^2) + fsloss ! rate of snow loss to leads (kg/m^2/s) real (kind=dbl_kind), dimension(:), optional, intent(inout) :: & Qa_iso , & ! isotope specific humidity (kg/kg) Qref_iso , & ! isotope 2m atm reference spec humidity (kg/kg) fiso_atm , & ! isotope deposition rate (kg/m^2 s) fiso_ocn , & ! isotope flux to ocean (kg/m^2/s) - fiso_evap ! isotope evaporation (kg/m^2/s) + fiso_evap , & ! isotope evaporation (kg/m^2/s) + meltsliqn ! mass of snow melt (kg/m^2) + + real (kind=dbl_kind), dimension(:,:), optional, intent(inout) :: & + rsnwn , & ! snow grain radius (10^-6 m) + smicen , & ! tracer for mass of ice in snow (kg/m^3) + smliqn ! tracer for mass of liquid in snow (kg/m^3) real (kind=dbl_kind), optional, intent(in) :: & HDO_ocn , & ! ocean concentration of HDO (kg/kg) @@ -2288,9 +2391,11 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & ! local variables integer (kind=int_kind) :: & + k , & ! layer index n ! category index real (kind=dbl_kind) :: & + rnslyr , & ! 1 / nslyr worka, workb ! temporary variables ! 2D coupler variables (computed for each category, then aggregated) @@ -2313,6 +2418,10 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & lhcoef , & ! transfer coefficient for latent heat rfrac ! water fraction retained for melt ponds + real (kind=dbl_kind), dimension(nslyr,ncat) :: & + massicen , & ! mass of ice in snow (kg/m^2) + massliqn ! mass of liquid in snow (kg/m^2) + real (kind=dbl_kind), dimension(n_iso) :: & Qrefn_iso , & ! isotope air sp hum reference level (kg/kg) fiso_ocnn , & ! isotope flux to ocean (kg/m^2/s) @@ -2327,9 +2436,17 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & l_Qref_iso , & ! local isotope 2m atm reference spec humidity (kg/kg) l_fiso_atm , & ! local isotope deposition rate (kg/m^2 s) l_fiso_ocn , & ! local isotope flux to ocean (kg/m^2/s) - l_fiso_evap ! local isotope evaporation (kg/m^2/s) + l_fiso_evap , & ! local isotope evaporation (kg/m^2/s) + l_meltsliqn ! mass of snow melt (kg/m^2) + + real (kind=dbl_kind), allocatable, dimension(:,:) :: & + l_rsnw , & ! snow grain radius (10^-6 m) + l_smice , & ! tracer for mass of ice in snow (kg/m^3) + l_smliq ! tracer for mass of liquid in snow (kg/m^3) real (kind=dbl_kind) :: & + l_fsloss , & ! rate of snow loss to leads (kg/m^2/s) + l_meltsliq , & ! mass of snow melt (kg/m^2) l_HDO_ocn , & ! local ocean concentration of HDO (kg/kg) l_H2_16O_ocn, & ! local ocean concentration of H2_16O (kg/kg) l_H2_18O_ocn ! local ocean concentration of H2_18O (kg/kg) @@ -2411,6 +2528,9 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & l_fiso_evap = c0 endif + l_fsloss = c0 + if (present(fsloss) ) l_fsloss = fsloss + l_HDO_ocn = c0 if (present(HDO_ocn) ) l_HDO_ocn = HDO_ocn @@ -2420,34 +2540,89 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & l_H2_18O_ocn = c0 if (present(H2_18O_ocn)) l_H2_18O_ocn = H2_18O_ocn - l_fswthru_vdr = c0 - if (present(fswthru_vdr) ) l_fswthru_vdr = fswthru_vdr + l_fswthru_vdr = c0 + if (present(fswthru_vdr)) l_fswthru_vdr = fswthru_vdr - l_fswthru_vdf = c0 - if (present(fswthru_vdf) ) l_fswthru_vdf = fswthru_vdf + l_fswthru_vdf = c0 + if (present(fswthru_vdf)) l_fswthru_vdf = fswthru_vdf - l_fswthru_idr = c0 - if (present(fswthru_idr) ) l_fswthru_idr = fswthru_idr + l_fswthru_idr = c0 + if (present(fswthru_idr)) l_fswthru_idr = fswthru_idr - l_fswthru_idf = c0 - if (present(fswthru_idf) ) l_fswthru_idf = fswthru_idf + l_fswthru_idf = c0 + if (present(fswthru_idf)) l_fswthru_idf = fswthru_idf allocate(l_fswthrun_vdr(ncat)) + l_fswthrun_vdr = c0 + if (present(fswthrun_vdr)) l_fswthrun_vdr = fswthrun_vdr + allocate(l_fswthrun_vdf(ncat)) + l_fswthrun_vdf = c0 + if (present(fswthrun_vdf)) l_fswthrun_vdf = fswthrun_vdf + allocate(l_fswthrun_idr(ncat)) + l_fswthrun_idr = c0 + if (present(fswthrun_idr)) l_fswthrun_idr = fswthrun_idr + allocate(l_fswthrun_idf(ncat)) + l_fswthrun_idf = c0 + if (present(fswthrun_idf)) l_fswthrun_idf = fswthrun_idf + + allocate(l_meltsliqn(ncat)) + l_meltsliqn = c0 + if (present(meltsliqn)) l_meltsliqn = meltsliqn + l_meltsliq = c0 + if (present(meltsliq )) l_meltsliq = meltsliq + + allocate(l_rsnw(nslyr,ncat)) + l_rsnw = rsnw_fall + if (present(rsnwn)) l_rsnw = rsnwn + + allocate(l_smice(nslyr,ncat)) + l_smice = c0 + if (present(smicen)) l_smice = smicen + + allocate(l_smliq(nslyr,ncat)) + l_smliq = c0 + if (present(smliqn)) l_smliq = smliqn + + !----------------------------------------------------------------- + ! Initialize rate of snow loss to leads + !----------------------------------------------------------------- - l_fswthrun_vdr = c0 - if (present(fswthrun_vdr) ) l_fswthrun_vdr = fswthrun_vdr + l_fsloss = fsnow * (c1 - aice) - l_fswthrun_vdf = c0 - if (present(fswthrun_vdf) ) l_fswthrun_vdf = fswthrun_vdf + !----------------------------------------------------------------- + ! snow redistribution using snwlvlfac: precip factor + !----------------------------------------------------------------- - l_fswthrun_idr = c0 - if (present(fswthrun_idr) ) l_fswthrun_idr = fswthrun_idr + if (trim(snwredist) == 'bulk') then + worka = c0 + if (aice > puny) then + do n = 1, ncat + worka = worka + alvl(n)*aicen(n) + enddo + worka = worka * (snwlvlfac/(c1+snwlvlfac)) / aice + endif + l_fsloss = l_fsloss + fsnow* worka + fsnow = fsnow*(c1-worka) + endif ! snwredist + + !----------------------------------------------------------------- + ! solid and liquid components of snow mass + !----------------------------------------------------------------- - l_fswthrun_idf = c0 - if (present(fswthrun_idf) ) l_fswthrun_idf = fswthrun_idf + massicen(:,:) = c0 + massliqn(:,:) = c0 + if (snwgrain) then + rnslyr = c1 / real(nslyr, dbl_kind) + do n = 1, ncat + do k = 1, nslyr + massicen(k,n) = l_smice(k,n) * vsnon(n) * rnslyr ! kg/m^2 + massliqn(k,n) = l_smliq(k,n) * vsnon(n) * rnslyr + enddo + enddo + endif !----------------------------------------------------------------- ! Adjust frzmlt to account for ice-ocean heat fluxes since last @@ -2495,13 +2670,13 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & endif do n = 1, ncat - meltsn (n) = c0 melttn (n) = c0 meltbn (n) = c0 congeln(n) = c0 snoicen(n) = c0 dsnown (n) = c0 + meltsliqn(n) = c0 Trefn = c0 Qrefn = c0 @@ -2594,37 +2769,40 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & if (icepack_warnings_aborted(subname)) return endif - call thermo_vertical(nilyr, nslyr, & - dt, aicen (n), & - vicen (n), vsnon (n), & - Tsfc (n), zSin (:,n), & - zqin (:,n), zqsn (:,n), & - apnd (n), hpnd (n), & - tr_pond_topo, & - flw, potT, & - Qa, rhoa, & - fsnow, fpond, & - fbot, Tbot, & - Tsnice, sss, & - lhcoef, shcoef, & - fswsfcn (n), fswintn (n), & - Sswabsn(:,n), Iswabsn(:,n), & - fsurfn (n), fcondtopn(n), & - fcondbotn(n), & - fsensn (n), flatn (n), & - flwoutn, evapn, & - evapsn, evapin, & - freshn, fsaltn, & - fhocnn, & - melttn (n), meltsn (n), & - meltbn (n), & - congeln (n), snoicen (n), & - mlt_onset, frz_onset, & - yday, dsnown (n), & - prescribed_ice) + call thermo_vertical(nilyr=nilyr, nslyr=nslyr, & + dt=dt, aicen=aicen (n), & + vicen=vicen (n), vsnon=vsnon (n), & + Tsf=Tsfc (n), zSin=zSin (:,n), & + zqin=zqin (:,n), zqsn=zqsn (:,n), & + apond=apnd (n), hpond=hpnd (n), & + flw=flw, potT=potT, & + Qa=Qa, rhoa=rhoa, & + fsnow=fsnow, fpond=fpond, & + fbot=fbot, Tbot=Tbot, & + Tsnice=Tsnice, sss=sss, & + rsnw=l_rsnw (:,n), & + lhcoef=lhcoef, shcoef=shcoef, & + fswsfc=fswsfcn (n), fswint=fswintn (n), & + Sswabs=Sswabsn(:,n), Iswabs=Iswabsn(:,n), & + fsurfn=fsurfn (n), fcondtopn=fcondtopn(n), & + fcondbotn=fcondbotn(n), & + fsensn=fsensn (n), flatn=flatn (n), & + flwoutn=flwoutn, evapn=evapn, & + evapsn=evapsn, evapin=evapin, & + freshn=freshn, fsaltn=fsaltn, & + fhocnn=fhocnn, frain=frain, & + meltt=melttn (n), melts=meltsn (n), & + meltb=meltbn (n), meltsliq=l_meltsliqn(n),& + smice=l_smice (:,n), massice=massicen(:,n), & + smliq=l_smliq (:,n), massliq=massliqn(:,n), & + congel=congeln (n), snoice=snoicen (n), & + mlt_onset=mlt_onset, frz_onset=frz_onset, & + yday=yday, dsnow=dsnown (n), & + prescribed_ice=prescribed_ice) if (icepack_warnings_aborted(subname)) then - call icepack_warnings_add(subname//' ice: Vertical thermo error: ') + write(warnstr,*) subname, ' ice: Vertical thermo error, cat ', n + call icepack_warnings_add(warnstr) return endif @@ -2673,8 +2851,19 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & H2_18O_ocn=l_H2_18O_ocn) if (icepack_warnings_aborted(subname)) return endif + endif ! aicen_init + if (snwgrain .and. use_smliq_pnd) then + call drain_snow (nslyr = nslyr, & + vsnon = vsnon(n), & + aicen = aicen(n), & + massice = massicen(:,n), & + massliq = massliqn(:,n), & + meltsliq = l_meltsliqn(n)) + if (icepack_warnings_aborted(subname)) return + endif + !----------------------------------------------------------------- ! Melt ponds ! If using tr_pond_cesm, the full calculation is performed here. @@ -2687,32 +2876,47 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & if (tr_pond_cesm) then rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) - call compute_ponds_cesm(dt, hi_min, & - pndaspect, rfrac, & - melttn(n), meltsn(n), & - frain, & - aicen (n), vicen (n), & - Tsfc (n), & - apnd (n), hpnd (n)) + call compute_ponds_cesm(dt=dt, & + hi_min=hi_min, & + rfrac=rfrac, & + meltt=melttn(n), & + melts=meltsn(n), & + frain=frain, & + aicen=aicen (n), & + vicen=vicen (n), & + Tsfcn=Tsfc (n), & + apnd=apnd (n), & + hpnd=hpnd (n), & + meltsliqn=l_meltsliqn(n)) if (icepack_warnings_aborted(subname)) return elseif (tr_pond_lvl) then rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) - call compute_ponds_lvl(dt, nilyr, & - ktherm, & - hi_min, & - dpscale, frzpnd, & - pndaspect, rfrac, & - melttn(n), meltsn(n), & - frain, Tair, & - fsurfn(n), & - dhsn (n), ffracn(n), & - aicen (n), vicen (n), & - vsnon (n), & - zqin(:,n), zSin(:,n), & - Tsfc (n), alvl (n), & - apnd (n), hpnd (n), & - ipnd (n)) + call compute_ponds_lvl (dt=dt, & + nilyr=nilyr, & + ktherm=ktherm, & + hi_min=hi_min, & + dpscale=dpscale, & + frzpnd=frzpnd, & + rfrac=rfrac, & + meltt=melttn (n), & + melts=meltsn (n), & + frain=frain, & + Tair=Tair, & + fsurfn=fsurfn(n), & + dhs=dhsn (n), & + ffrac=ffracn (n), & + aicen=aicen (n), & + vicen=vicen (n), & + vsnon=vsnon (n), & + qicen=zqin (:,n), & + sicen=zSin (:,n), & + Tsfcn=Tsfc (n), & + alvl=alvl (n), & + apnd=apnd (n), & + hpnd=hpnd (n), & + ipnd=ipnd (n), & + meltsliqn=l_meltsliqn(n)) if (icepack_warnings_aborted(subname)) return elseif (tr_pond_topo) then @@ -2721,9 +2925,14 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & ! collect liquid water in ponds ! assume salt still runs off rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) - pond = rfrac/rhofresh * (melttn(n)*rhoi & - + meltsn(n)*rhos & - + frain *dt) + if (snwgrain .and. use_smliq_pnd) then + pond = rfrac/rhofresh * (melttn(n)*rhoi & + + l_meltsliqn(n)) + else + pond = rfrac/rhofresh * (melttn(n)*rhoi & + + meltsn(n)*rhos & + + frain *dt) + endif ! if pond does not exist, create new pond over full ice area ! otherwise increase pond depth without changing pond area @@ -2780,10 +2989,12 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & fswthru_idf=l_fswthru_idf, & melttn=melttn (n), meltsn=meltsn(n), & meltbn=meltbn (n), congeln=congeln(n),& - snoicen=snoicen(n), & meltt=meltt, melts=melts, & - meltb=meltb, congel=congel, & - snoice=snoice, & + meltb=meltb, snoicen=snoicen(n),& + dsnow=dsnow, dsnown=dsnown(n), & + congel=congel, snoice=snoice, & + meltsliq=l_meltsliq, & + meltsliqn=l_meltsliqn(n), & Uref=Uref, Urefn=Urefn, & Qref_iso=l_Qref_iso, & Qrefn_iso=Qrefn_iso, & @@ -2796,21 +3007,52 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & enddo ! ncat - if (present(isosno) ) isosno = l_isosno - if (present(isoice) ) isoice = l_isoice - if (present(Qa_iso) ) Qa_iso = l_Qa_iso - if (present(Qref_iso) ) Qref_iso = l_Qref_iso - if (present(fiso_atm) ) fiso_atm = l_fiso_atm - if (present(fiso_ocn) ) fiso_ocn = l_fiso_ocn - if (present(fiso_evap)) fiso_evap= l_fiso_evap - if (present(fswthrun_vdr)) fswthrun_vdr= l_fswthrun_vdr - if (present(fswthrun_vdf)) fswthrun_vdf= l_fswthrun_vdf - if (present(fswthrun_idr)) fswthrun_idr= l_fswthrun_idr - if (present(fswthrun_idf)) fswthrun_idf= l_fswthrun_idf - if (present(fswthru_vdr)) fswthru_vdr= l_fswthru_vdr - if (present(fswthru_vdf)) fswthru_vdf= l_fswthru_vdf - if (present(fswthru_idr)) fswthru_idr= l_fswthru_idr - if (present(fswthru_idf)) fswthru_idf= l_fswthru_idf + !----------------------------------------------------------------- + ! reload snow mass tracers + !----------------------------------------------------------------- + + if (snwgrain) then + do n = 1, ncat + if (vsnon(n) > puny) then + do k = 1, nslyr + l_smice(k,n) = massicen(k,n) / (vsnon(n) * rnslyr) + l_smliq(k,n) = massliqn(k,n) / (vsnon(n) * rnslyr) + worka = l_smice(k,n) + l_smliq(k,n) + if (worka > puny) then + l_smice(k,n) = rhos * l_smice(k,n) / worka + l_smliq(k,n) = rhos * l_smliq(k,n) / worka + endif + enddo + else ! reset to default values + do k = 1, nslyr + l_smice(k,n) = rhos + l_smliq(k,n) = c0 + enddo + endif + enddo + endif + + if (present(isosno )) isosno = l_isosno + if (present(isoice )) isoice = l_isoice + if (present(Qa_iso )) Qa_iso = l_Qa_iso + if (present(Qref_iso )) Qref_iso = l_Qref_iso + if (present(fiso_atm )) fiso_atm = l_fiso_atm + if (present(fiso_ocn )) fiso_ocn = l_fiso_ocn + if (present(fiso_evap )) fiso_evap = l_fiso_evap + if (present(fswthrun_vdr)) fswthrun_vdr = l_fswthrun_vdr + if (present(fswthrun_vdf)) fswthrun_vdf = l_fswthrun_vdf + if (present(fswthrun_idr)) fswthrun_idr = l_fswthrun_idr + if (present(fswthrun_idf)) fswthrun_idf = l_fswthrun_idf + if (present(fswthru_vdr )) fswthru_vdr = l_fswthru_vdr + if (present(fswthru_vdf )) fswthru_vdf = l_fswthru_vdf + if (present(fswthru_idr )) fswthru_idr = l_fswthru_idr + if (present(fswthru_idf )) fswthru_idf = l_fswthru_idf + if (present(fsloss )) fsloss = l_fsloss + if (present(meltsliqn )) meltsliqn = l_meltsliqn + if (present(meltsliq )) meltsliq = l_meltsliq + if (present(rsnwn )) rsnwn = l_rsnw + if (present(smicen )) smicen = l_smice + if (present(smliqn )) smliqn = l_smliq deallocate(l_isosno) deallocate(l_isoice) deallocate(l_Qa_iso) @@ -2822,6 +3064,10 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & deallocate(l_fswthrun_vdf) deallocate(l_fswthrun_idr) deallocate(l_fswthrun_idf) + deallocate(l_meltsliqn) + deallocate(l_rsnw) + deallocate(l_smice) + deallocate(l_smliq) !----------------------------------------------------------------- ! Calculate ponds from the topographic scheme diff --git a/columnphysics/icepack_tracers.F90 b/columnphysics/icepack_tracers.F90 index 6a72498a7..26c535e62 100644 --- a/columnphysics/icepack_tracers.F90 +++ b/columnphysics/icepack_tracers.F90 @@ -7,7 +7,7 @@ module icepack_tracers use icepack_kinds - use icepack_parameters, only: c0, c1, puny, Tocnfrz + use icepack_parameters, only: c0, c1, puny, Tocnfrz, rhos, rsnw_fall use icepack_warnings, only: warnstr, icepack_warnings_add use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted @@ -80,6 +80,10 @@ module icepack_tracers nt_hpnd = 0, & ! melt pond depth nt_ipnd = 0, & ! melt pond refrozen lid thickness nt_fsd = 0, & ! floe size distribution + nt_smice = 0, & ! mass of ice in snow + nt_smliq = 0, & ! mass of liquid water in snow + nt_rhos = 0, & ! snow density + nt_rsnw = 0, & ! snow grain radius nt_isosno = 0, & ! starting index for isotopes in snow nt_isoice = 0, & ! starting index for isotopes in ice nt_aero = 0, & ! starting index for aerosols in ice @@ -102,6 +106,7 @@ module icepack_tracers tr_pond_cesm = .false., & ! if .true., use cesm pond tracer tr_pond_lvl = .false., & ! if .true., use level-ice pond tracer tr_pond_topo = .false., & ! if .true., use explicit topography-based ponds + tr_snow = .false., & ! if .true., use snow metamorphosis tracers tr_iso = .false., & ! if .true., use isotope tracers tr_aero = .false., & ! if .true., use aerosol tracers tr_brine = .false., & ! if .true., brine height differs from ice thickness @@ -201,7 +206,7 @@ module icepack_tracers ! set tracer active flags subroutine icepack_init_tracer_flags(& - tr_iage_in, tr_FY_in, tr_lvl_in, & + tr_iage_in, tr_FY_in, tr_lvl_in, tr_snow_in, & tr_pond_in, tr_pond_cesm_in, tr_pond_lvl_in, tr_pond_topo_in, & tr_fsd_in, tr_aero_in, tr_iso_in, tr_brine_in, tr_zaero_in, & tr_bgc_Nit_in, tr_bgc_N_in, tr_bgc_DON_in, tr_bgc_C_in, tr_bgc_chl_in, & @@ -216,6 +221,7 @@ subroutine icepack_init_tracer_flags(& tr_pond_cesm_in , & ! if .true., use cesm pond tracer tr_pond_lvl_in , & ! if .true., use level-ice pond tracer tr_pond_topo_in , & ! if .true., use explicit topography-based ponds + tr_snow_in , & ! if .true., use snow metamorphosis tracers tr_fsd_in , & ! if .true., use floe size distribution tracers tr_iso_in , & ! if .true., use isotope tracers tr_aero_in , & ! if .true., use aerosol tracers @@ -244,6 +250,7 @@ subroutine icepack_init_tracer_flags(& if (present(tr_pond_cesm_in)) tr_pond_cesm = tr_pond_cesm_in if (present(tr_pond_lvl_in) ) tr_pond_lvl = tr_pond_lvl_in if (present(tr_pond_topo_in)) tr_pond_topo = tr_pond_topo_in + if (present(tr_snow_in) ) tr_snow = tr_snow_in if (present(tr_fsd_in) ) tr_fsd = tr_fsd_in if (present(tr_iso_in) ) tr_iso = tr_iso_in if (present(tr_aero_in) ) tr_aero = tr_aero_in @@ -268,7 +275,7 @@ end subroutine icepack_init_tracer_flags ! query tracer active flags subroutine icepack_query_tracer_flags(& - tr_iage_out, tr_FY_out, tr_lvl_out, & + tr_iage_out, tr_FY_out, tr_lvl_out, tr_snow_out, & tr_pond_out, tr_pond_cesm_out, tr_pond_lvl_out, tr_pond_topo_out, & tr_fsd_out, tr_aero_out, tr_iso_out, tr_brine_out, tr_zaero_out, & tr_bgc_Nit_out, tr_bgc_N_out, tr_bgc_DON_out, tr_bgc_C_out, tr_bgc_chl_out, & @@ -283,6 +290,7 @@ subroutine icepack_query_tracer_flags(& tr_pond_cesm_out , & ! if .true., use cesm pond tracer tr_pond_lvl_out , & ! if .true., use level-ice pond tracer tr_pond_topo_out , & ! if .true., use explicit topography-based ponds + tr_snow_out , & ! if .true., use snow metamorphosis tracers tr_fsd_out , & ! if .true., use floe size distribution tr_iso_out , & ! if .true., use isotope tracers tr_aero_out , & ! if .true., use aerosol tracers @@ -311,6 +319,7 @@ subroutine icepack_query_tracer_flags(& if (present(tr_pond_cesm_out)) tr_pond_cesm_out = tr_pond_cesm if (present(tr_pond_lvl_out) ) tr_pond_lvl_out = tr_pond_lvl if (present(tr_pond_topo_out)) tr_pond_topo_out = tr_pond_topo + if (present(tr_snow_out) ) tr_snow_out = tr_snow if (present(tr_fsd_out) ) tr_fsd_out = tr_fsd if (present(tr_iso_out) ) tr_iso_out = tr_iso if (present(tr_aero_out) ) tr_aero_out = tr_aero @@ -350,6 +359,7 @@ subroutine icepack_write_tracer_flags(iounit) write(iounit,*) " tr_pond_cesm = ",tr_pond_cesm write(iounit,*) " tr_pond_lvl = ",tr_pond_lvl write(iounit,*) " tr_pond_topo = ",tr_pond_topo + write(iounit,*) " tr_snow = ",tr_snow write(iounit,*) " tr_fsd = ",tr_fsd write(iounit,*) " tr_iso = ",tr_iso write(iounit,*) " tr_aero = ",tr_aero @@ -377,6 +387,7 @@ subroutine icepack_init_tracer_indices(& nt_Tsfc_in, nt_qice_in, nt_qsno_in, nt_sice_in, & nt_fbri_in, nt_iage_in, nt_FY_in, & nt_alvl_in, nt_vlvl_in, nt_apnd_in, nt_hpnd_in, nt_ipnd_in, & + nt_smice_in, nt_smliq_in, nt_rhos_in, nt_rsnw_in, & nt_fsd_in, nt_isosno_in, nt_isoice_in, & nt_aero_in, nt_zaero_in, nt_bgc_C_in, & nt_bgc_N_in, nt_bgc_chl_in, nt_bgc_DOC_in, nt_bgc_DON_in, & @@ -397,12 +408,16 @@ subroutine icepack_init_tracer_indices(& nt_sice_in, & ! volume-weighted ice bulk salinity (CICE grid layers) nt_fbri_in, & ! volume fraction of ice with dynamic salt (hinS/vicen*aicen) nt_iage_in, & ! volume-weighted ice age - nt_FY_in, & ! area-weighted first-year ice area + nt_FY_in, & ! area-weighted first-year ice area nt_alvl_in, & ! level ice area fraction nt_vlvl_in, & ! level ice volume fraction nt_apnd_in, & ! melt pond area fraction nt_hpnd_in, & ! melt pond depth nt_ipnd_in, & ! melt pond refrozen lid thickness + nt_smice_in,& ! mass of ice in snow + nt_smliq_in,& ! mass of liquid water in snow + nt_rhos_in, & ! snow density + nt_rsnw_in, & ! snow grain radius nt_fsd_in, & ! floe size distribution nt_isosno_in, & ! starting index for isotopes in snow nt_isoice_in, & ! starting index for isotopes in ice @@ -481,6 +496,10 @@ subroutine icepack_init_tracer_indices(& if (present(nt_hpnd_in)) nt_hpnd = nt_hpnd_in if (present(nt_ipnd_in)) nt_ipnd = nt_ipnd_in if (present(nt_fsd_in) ) nt_fsd = nt_fsd_in + if (present(nt_smice_in) ) nt_smice = nt_smice_in + if (present(nt_smliq_in) ) nt_smliq = nt_smliq_in + if (present(nt_rhos_in) ) nt_rhos = nt_rhos_in + if (present(nt_rsnw_in) ) nt_rsnw = nt_rsnw_in if (present(nt_isosno_in) ) nt_isosno = nt_isosno_in if (present(nt_isoice_in) ) nt_isoice = nt_isoice_in if (present(nt_aero_in) ) nt_aero = nt_aero_in @@ -730,6 +749,7 @@ subroutine icepack_query_tracer_indices(& nt_Tsfc_out, nt_qice_out, nt_qsno_out, nt_sice_out, & nt_fbri_out, nt_iage_out, nt_FY_out, & nt_alvl_out, nt_vlvl_out, nt_apnd_out, nt_hpnd_out, nt_ipnd_out, & + nt_smice_out, nt_smliq_out, nt_rhos_out, nt_rsnw_out, & nt_fsd_out, nt_isosno_out, nt_isoice_out, & nt_aero_out, nt_zaero_out, nt_bgc_C_out, & nt_bgc_N_out, nt_bgc_chl_out, nt_bgc_DOC_out, nt_bgc_DON_out, & @@ -756,6 +776,10 @@ subroutine icepack_query_tracer_indices(& nt_apnd_out, & ! melt pond area fraction nt_hpnd_out, & ! melt pond depth nt_ipnd_out, & ! melt pond refrozen lid thickness + nt_smice_out,& ! mass of ice in snow + nt_smliq_out,& ! mass of liquid water in snow + nt_rhos_out, & ! snow density + nt_rsnw_out, & ! snow grain radius nt_fsd_out, & ! floe size distribution nt_isosno_out, & ! starting index for isotopes in snow nt_isoice_out, & ! starting index for isotopes in ice @@ -832,6 +856,10 @@ subroutine icepack_query_tracer_indices(& if (present(nt_hpnd_out)) nt_hpnd_out = nt_hpnd if (present(nt_ipnd_out)) nt_ipnd_out = nt_ipnd if (present(nt_fsd_out) ) nt_fsd_out = nt_fsd + if (present(nt_smice_out) ) nt_smice_out = nt_smice + if (present(nt_smliq_out) ) nt_smliq_out = nt_smliq + if (present(nt_rhos_out) ) nt_rhos_out = nt_rhos + if (present(nt_rsnw_out) ) nt_rsnw_out = nt_rsnw if (present(nt_isosno_out) ) nt_isosno_out = nt_isosno if (present(nt_isoice_out) ) nt_isoice_out = nt_isoice if (present(nt_aero_out) ) nt_aero_out = nt_aero @@ -907,6 +935,10 @@ subroutine icepack_write_tracer_indices(iounit) write(iounit,*) " nt_hpnd = ",nt_hpnd write(iounit,*) " nt_ipnd = ",nt_ipnd write(iounit,*) " nt_fsd = ",nt_fsd + write(iounit,*) " nt_smice = ",nt_smice + write(iounit,*) " nt_smliq = ",nt_smliq + write(iounit,*) " nt_rhos = ",nt_rhos + write(iounit,*) " nt_rsnw = ",nt_rsnw write(iounit,*) " nt_isosno = ",nt_isosno write(iounit,*) " nt_isoice = ",nt_isoice write(iounit,*) " nt_aero = ",nt_aero @@ -1172,10 +1204,10 @@ end subroutine icepack_write_tracer_sizes ! Given atrcrn = aicen*trcrn (or vicen*trcrn, vsnon*trcrn), compute trcrn. subroutine icepack_compute_tracers (ntrcr, trcr_depend, & - atrcrn, aicen, & - vicen, vsnon, & - trcr_base, n_trcr_strata, & - nt_strata, trcrn) + atrcrn, aicen, & + vicen, vsnon, & + trcr_base, n_trcr_strata, & + nt_strata, trcrn) integer (kind=int_kind), intent(in) :: & ntrcr ! number of tracers in use @@ -1256,13 +1288,19 @@ subroutine icepack_compute_tracers (ntrcr, trcr_depend, & endif enddo endif - if (vicen <= c0 .and. it == nt_fbri) trcrn(it) = c1 endif ! trcr_depend=0 enddo - end subroutine icepack_compute_tracers + if (vicen <= c0 .and. tr_brine) trcrn(nt_fbri) = c1 + if (vsnon <= c0 .and. tr_snow) then + trcrn(nt_rsnw :nt_rsnw +nslyr-1) = rsnw_fall + trcrn(nt_smice:nt_smice+nslyr-1) = rhos + trcrn(nt_rhos :nt_rhos +nslyr-1) = rhos + endif + + end subroutine icepack_compute_tracers !======================================================================= diff --git a/columnphysics/icepack_zbgc_shared.F90 b/columnphysics/icepack_zbgc_shared.F90 index e542b8386..68200b621 100644 --- a/columnphysics/icepack_zbgc_shared.F90 +++ b/columnphysics/icepack_zbgc_shared.F90 @@ -553,6 +553,7 @@ end subroutine regrid_stationary ! for z layer biogeochemistry ! subroutine merge_bgc_fluxes (dt, nblyr, & + nslyr, & bio_index, n_algae, & nbtrcr, aicen, & vicen, vsnon, & @@ -571,8 +572,9 @@ subroutine merge_bgc_fluxes (dt, nblyr, & dt ! timestep (s) integer (kind=int_kind), intent(in) :: & - nblyr, & - n_algae, & ! + nblyr , & ! number of bio layers + nslyr , & ! number of snow layers + n_algae , & ! number of algal tracers nbtrcr ! number of biology tracer tracers integer (kind=int_kind), dimension(:), intent(in) :: & @@ -647,7 +649,7 @@ subroutine merge_bgc_fluxes (dt, nblyr, & !----------------------------------------------------------------- ! Merge fluxes !----------------------------------------------------------------- - dvssl = min(p5*vsnon, hs_ssl*aicen) ! snow surface layer + dvssl = min(p5*vsnon/real(nslyr,kind=dbl_kind), hs_ssl*aicen) ! snow surface layer dvint = vsnon - dvssl ! snow interior snow_bio_net(mm) = snow_bio_net(mm) & + trcrn(bio_index(mm)+nblyr+1)*dvssl & diff --git a/columnphysics/version.txt b/columnphysics/version.txt index 9d36f27cb..7566e8653 100644 --- a/columnphysics/version.txt +++ b/columnphysics/version.txt @@ -1 +1 @@ -ICEPACK 1.2.5 +ICEPACK 1.3.0 diff --git a/configuration/driver/icedrv_InitMod.F90 b/configuration/driver/icedrv_InitMod.F90 index e3e33b0dd..52d2a7f66 100644 --- a/configuration/driver/icedrv_InitMod.F90 +++ b/configuration/driver/icedrv_InitMod.F90 @@ -37,6 +37,7 @@ subroutine icedrv_initialize init_calendar, calendar use icepack_intfc, only: icepack_init_itd, icepack_init_itd_hist use icepack_intfc, only: icepack_init_fsd_bounds + use icepack_intfc, only: icepack_init_snow use icepack_intfc, only: icepack_warnings_flush use icedrv_domain_size, only: ncat, nfsd ! use icedrv_diagnostics, only: icedrv_diagnostics_debug @@ -52,6 +53,7 @@ subroutine icedrv_initialize logical (kind=log_kind) :: & skl_bgc, & ! from icepack z_tracers, & ! from icepack + tr_snow, & ! from icepack tr_aero, & ! from icepack tr_iso, & ! from icepack tr_zaero, & ! from icepack @@ -128,6 +130,7 @@ subroutine icedrv_initialize call icepack_query_parameters(skl_bgc_out=skl_bgc) call icepack_query_parameters(z_tracers_out=z_tracers) call icepack_query_parameters(wave_spec_out=wave_spec) + call icepack_query_tracer_flags(tr_snow_out=tr_snow) call icepack_query_tracer_flags(tr_aero_out=tr_aero) call icepack_query_tracer_flags(tr_iso_out=tr_iso) call icepack_query_tracer_flags(tr_zaero_out=tr_zaero) @@ -140,6 +143,7 @@ subroutine icedrv_initialize if (tr_fsd .and. wave_spec) call get_wave_spec ! wave spectrum in ice call get_forcing(istep1) ! get forcing from data arrays + if (tr_snow) call icepack_init_snow ! snow aging table if (tr_iso) call fiso_default ! default values ! aerosols ! if (tr_aero) call faero_data ! data file diff --git a/configuration/driver/icedrv_RunMod.F90 b/configuration/driver/icedrv_RunMod.F90 index 2687f3a61..5455607d5 100644 --- a/configuration/driver/icedrv_RunMod.F90 +++ b/configuration/driver/icedrv_RunMod.F90 @@ -35,6 +35,7 @@ subroutine icedrv_run use icedrv_forcing, only: get_forcing, get_wave_spec use icedrv_forcing_bgc, only: faero_default, fiso_default, get_forcing_bgc use icedrv_flux, only: init_flux_atm_ocn + use icedrv_history, only: history_cdf, history_close logical (kind=log_kind) :: skl_bgc, z_tracers, tr_aero, tr_zaero, & wave_spec, tr_fsd, tr_iso @@ -61,7 +62,10 @@ subroutine icedrv_run call calendar(time) ! at the end of the timestep - if (stop_now >= 1) exit timeLoop + if (stop_now >= 1) then + if (history_cdf) call history_close() + exit timeLoop + endif call icepack_query_parameters(skl_bgc_out=skl_bgc, z_tracers_out=z_tracers,& wave_spec_out=wave_spec) @@ -97,10 +101,11 @@ subroutine ice_step use icedrv_diagnostics_bgc, only: hbrine_diags, zsal_diags, bgc_diags use icedrv_flux, only: init_history_therm, init_history_bgc, & daidtt, daidtd, dvidtt, dvidtd, dagedtt, dagedtd, init_history_dyn + use icedrv_history, only: history_cdf, history_write use icedrv_restart, only: dumpfile, final_restart use icedrv_restart_bgc, only: write_restart_bgc use icedrv_step, only: prep_radiation, step_therm1, step_therm2, & - update_state, step_dyn_ridge, step_radiation, & + update_state, step_dyn_ridge, step_snow, step_radiation, & biogeochemistry, step_dyn_wave integer (kind=int_kind) :: & @@ -108,7 +113,7 @@ subroutine ice_step logical (kind=log_kind) :: & calc_Tsfc, skl_bgc, solve_zsal, z_tracers, tr_brine, & ! from icepack - tr_fsd, wave_spec + tr_fsd, wave_spec, tr_snow real (kind=dbl_kind) :: & offset ! d(age)/dt time offset @@ -125,7 +130,8 @@ subroutine ice_step call icepack_query_parameters(solve_zsal_out=solve_zsal, & calc_Tsfc_out=calc_Tsfc, & wave_spec_out=wave_spec) - call icepack_query_tracer_flags(tr_brine_out=tr_brine,tr_fsd_out=tr_fsd) + call icepack_query_tracer_flags(tr_brine_out=tr_brine,tr_fsd_out=tr_fsd, & + tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -183,6 +189,17 @@ subroutine ice_step ! call icedrv_diagnostics_debug ('post dynamics') + !----------------------------------------------------------------- + ! snow redistribution and metamorphosis + !----------------------------------------------------------------- + + if (tr_snow) then + call step_snow (dt) + call update_state (dt) ! clean up + endif + +! call icedrv_diagnostics_debug ('post snow redistribution') + !----------------------------------------------------------------- ! albedo, shortwave radiation !----------------------------------------------------------------- @@ -207,6 +224,10 @@ subroutine ice_step if (skl_bgc .or. z_tracers) call bgc_diags if (tr_brine) call hbrine_diags endif + + if (history_cdf) then + call history_write() + endif if (write_restart == 1) then call dumpfile ! core variables for restarting diff --git a/configuration/driver/icedrv_arrays_column.F90 b/configuration/driver/icedrv_arrays_column.F90 index 870a25056..9e3c49bba 100644 --- a/configuration/driver/icedrv_arrays_column.F90 +++ b/configuration/driver/icedrv_arrays_column.F90 @@ -62,6 +62,15 @@ module icedrv_arrays_column character (len=35), public :: c_hi_range(ncat) + ! icepack_snow.F90 + real (kind=dbl_kind), public, & + dimension (nx) :: & + meltsliq ! snow melt mass (kg/m^2/step-->kg/m^2/day) + + real (kind=dbl_kind), & + dimension (nx,ncat), public, save :: & + meltsliqn ! snow melt mass in category n (kg/m^2) + ! icepack_meltpond_lvl.F90 real (kind=dbl_kind), public, & dimension (nx, ncat) :: & diff --git a/configuration/driver/icedrv_calendar.F90 b/configuration/driver/icedrv_calendar.F90 index 126f29e83..dc6642eb4 100644 --- a/configuration/driver/icedrv_calendar.F90 +++ b/configuration/driver/icedrv_calendar.F90 @@ -72,6 +72,7 @@ module icedrv_calendar real (kind=dbl_kind), public :: & dt , & ! thermodynamics timestep (s) dt_dyn , & ! dynamics/transport/ridging timestep (s) + time0 , & ! total elapsed time at istep0 for idate0 (s) time , & ! total elapsed time (s) time_forc , & ! time of last forcing update (s) yday , & ! day of the year @@ -123,6 +124,7 @@ subroutine init_calendar !----------------------------------------------------------------- istep = 0 ! local timestep number + time0=istep0*dt ! start time time=istep0*dt ! s yday=c0 ! absolute day number mday=0 ! day of the month diff --git a/configuration/driver/icedrv_diagnostics.F90 b/configuration/driver/icedrv_diagnostics.F90 index 7472a94b0..d5f6f60ea 100644 --- a/configuration/driver/icedrv_diagnostics.F90 +++ b/configuration/driver/icedrv_diagnostics.F90 @@ -9,7 +9,7 @@ module icedrv_diagnostics use icedrv_kinds use icedrv_constants, only: nu_diag, nu_diag_out use icedrv_domain_size, only: nx - use icedrv_domain_size, only: ncat, nfsd, n_iso + use icedrv_domain_size, only: ncat, nfsd, n_iso, nilyr, nslyr use icepack_intfc, only: c0 use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted use icepack_intfc, only: icepack_query_parameters @@ -66,7 +66,7 @@ subroutine runtime_diags (dt) use icedrv_flux, only: Tair, Qa, fsw, fcondtop use icedrv_flux, only: meltt, meltb, meltl, snoice use icedrv_flux, only: dsnow, congel, sst, sss, Tf, fhocn - use icedrv_state, only: aice, vice, vsno, trcr, trcrn, aicen + use icedrv_state, only: aice, vice, vsno, trcr, trcrn, aicen, vsnon real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -77,13 +77,17 @@ subroutine runtime_diags (dt) n, nc, k logical (kind=log_kind) :: & - calc_Tsfc, tr_fsd, tr_iso + calc_Tsfc, snwgrain + + character (len=char_len) :: & + snwredist ! fields at diagnostic points real (kind=dbl_kind) :: & pTair, pfsnow, pfrain, & paice, hiavg, hsavg, hbravg, psalt, pTsfc, & - pevap, pfhocn, fsdavg + pevap, pfhocn, fsdavg, & + rsnwavg, rhosavg, smicetot, smliqtot, smtot real (kind=dbl_kind), dimension (nx) :: & work1, work2, work3 @@ -91,8 +95,9 @@ subroutine runtime_diags (dt) real (kind=dbl_kind) :: & Tffresh, rhos, rhow, rhoi - logical (kind=log_kind) :: tr_brine + logical (kind=log_kind) :: tr_brine, tr_fsd, tr_iso, tr_snow integer (kind=int_kind) :: nt_fbri, nt_Tsfc, nt_fsd, nt_isosno, nt_isoice + integer (kind=int_kind) :: nt_rsnw, nt_rhos, nt_smice, nt_smliq character(len=*), parameter :: subname='(runtime_diags)' @@ -100,11 +105,14 @@ subroutine runtime_diags (dt) ! query Icepack values !----------------------------------------------------------------- - call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc) + call icepack_query_parameters(calc_Tsfc_out=calc_Tsfc, & + snwredist_out=snwredist, snwgrain_out=snwgrain) call icepack_query_tracer_flags(tr_brine_out=tr_brine, & - tr_fsd_out=tr_fsd,tr_iso_out=tr_iso) + tr_fsd_out=tr_fsd,tr_iso_out=tr_iso,tr_snow_out=tr_snow) call icepack_query_tracer_indices(nt_fbri_out=nt_fbri, nt_Tsfc_out=nt_Tsfc,& - nt_fsd_out=nt_fsd, nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) + nt_fsd_out=nt_fsd, nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & + nt_rsnw_out=nt_rsnw, nt_rhos_out=nt_rhos, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq) call icepack_query_parameters(Tffresh_out=Tffresh, rhos_out=rhos, & rhow_out=rhow, rhoi_out=rhoi) call icepack_warnings_flush(nu_diag) @@ -124,16 +132,21 @@ subroutine runtime_diags (dt) pfrain = frain(n)*dt/rhow ! rainfall paice = aice(n) ! ice area - hiavg = c0 ! avg snow/ice thickness + hiavg = c0 ! avg ice thickness + hsavg = c0 ! avg snow thickness fsdavg = c0 ! FSD rep radius - hsavg = c0 hbravg = c0 ! avg brine thickness + rsnwavg = c0 ! avg snow grain radius + rhosavg = c0 ! avg snow density + smicetot = c0 ! total mass of ice in snow (kg/m2) + smliqtot = c0 ! total mass of liquid in snow (kg/m2) + smtot = c0 ! total mass of snow volume (kg/m2) psalt = c0 if (paice /= c0) then - hiavg = vice(n)/paice - hsavg = vsno(n)/paice - if (tr_brine) hbravg = trcr(n,nt_fbri)* hiavg - if (tr_fsd) then + hiavg = vice(n)/paice + hsavg = vsno(n)/paice + if (tr_brine) hbravg = trcr(n,nt_fbri) * hiavg + if (tr_fsd) then ! avg floe size distribution do nc = 1, ncat do k = 1, nfsd fsdavg = fsdavg & @@ -141,7 +154,24 @@ subroutine runtime_diags (dt) * aicen(n,nc) / paice end do end do - end if + end if + if (tr_snow) then ! snow tracer quantities + do nc = 1, ncat + if (vsnon(n,nc) > c0) then + do k = 1, nslyr + rsnwavg = rsnwavg + trcrn(n,nt_rsnw +k-1,nc) ! snow grain radius + rhosavg = rhosavg + trcrn(n,nt_rhos +k-1,nc) ! compacted snow density + smicetot = smicetot + trcrn(n,nt_smice+k-1,nc) * vsnon(n,nc) + smliqtot = smliqtot + trcrn(n,nt_smliq+k-1,nc) * vsnon(n,nc) + end do + endif + smtot = smtot + rhos * vsnon(n,nc) ! mass of ice in standard density snow + end do + rsnwavg = rsnwavg / real(nslyr*ncat,kind=dbl_kind) ! snow grain radius + rhosavg = rhosavg / real(nslyr*ncat,kind=dbl_kind) ! compacted snow density + smicetot = smicetot / real(nslyr,kind=dbl_kind) ! mass of ice in snow + smliqtot = smliqtot / real(nslyr,kind=dbl_kind) ! mass of liquid in snow + end if endif if (vice(n) /= c0) psalt = work2(n)/vice(n) @@ -188,7 +218,6 @@ subroutine runtime_diags (dt) write(nu_diag_out+n-1,900) 'avg brine thickness (m)= ',hbravg if (tr_fsd) & write(nu_diag_out+n-1,900) 'avg fsd rep radius (m) = ',fsdavg - if (calc_Tsfc) then write(nu_diag_out+n-1,900) 'surface temperature(C) = ',pTsfc ! ice/snow @@ -208,6 +237,21 @@ subroutine runtime_diags (dt) write(nu_diag_out+n-1,900) 'effective dhi (m) = ',pdhi(n) ! ice thickness change write(nu_diag_out+n-1,900) 'effective dhs (m) = ',pdhs(n) ! snow thickness change write(nu_diag_out+n-1,900) 'intnl enrgy chng(W/m^2)= ',pde (n) ! ice/snow energy change + + if (tr_snow) then + if (trim(snwredist) /= 'none') then + write(nu_diag_out+n-1,900) 'avg snow density(kg/m3)= ',rhosavg + endif + if (snwgrain) then + write(nu_diag_out+n-1,900) 'avg snow grain radius = ',rsnwavg + write(nu_diag_out+n-1,900) 'mass ice in snow(kg/m2)= ',smicetot + write(nu_diag_out+n-1,900) 'mass liq in snow(kg/m2)= ',smliqtot + write(nu_diag_out+n-1,900) 'mass ice+liq (kg/m2)= ',smicetot+smliqtot + write(nu_diag_out+n-1,900) 'mass std snow (kg/m2)= ',smtot + write(nu_diag_out+n-1,900) 'max ice+liq (kg/m2)= ',rhow * hsavg + endif + endif + write(nu_diag_out+n-1,*) '----------ocn----------' write(nu_diag_out+n-1,900) 'sst (C) = ',sst(n) ! sea surface temperature write(nu_diag_out+n-1,900) 'sss (ppt) = ',sss(n) ! sea surface salinity @@ -270,7 +314,6 @@ end subroutine init_mass_diags subroutine total_energy (work) - use icedrv_domain_size, only: ncat, nilyr, nslyr use icedrv_state, only: vicen, vsnon, trcrn real (kind=dbl_kind), dimension (nx), intent(out) :: & @@ -331,7 +374,6 @@ end subroutine total_energy subroutine total_salt (work) - use icedrv_domain_size, only: ncat, nilyr use icedrv_state, only: vicen, trcrn real (kind=dbl_kind), dimension (nx), & @@ -397,7 +439,7 @@ subroutine icedrv_diagnostics_debug (plabeld) ! printing info for routine print_state integer (kind=int_kind), parameter :: & - check_step = 1439, & ! begin printing at istep1=check_step + check_step = 1, & ! begin printing at istep1=check_step ip = 3 ! i index if (istep1 >= check_step) then @@ -418,7 +460,6 @@ end subroutine icedrv_diagnostics_debug subroutine print_state(plabel,i) use icedrv_calendar, only: istep1, time - use icedrv_domain_size, only: nilyr, nslyr use icedrv_state, only: aice0, aicen, vicen, vsnon, uvel, vvel, trcrn use icedrv_flux, only: uatm, vatm, potT, Tair, Qa, flw, frain, fsnow use icedrv_flux, only: fsens, flat, evap, flwout @@ -444,8 +485,9 @@ subroutine print_state(plabel,i) integer (kind=int_kind) :: n, k integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, nt_fsd + integer (kind=int_kind) :: nt_smice, nt_smliq - logical (kind=log_kind) :: tr_fsd + logical (kind=log_kind) :: tr_fsd, tr_snow character(len=*), parameter :: subname='(print_state)' @@ -453,9 +495,10 @@ subroutine print_state(plabel,i) ! query Icepack values !----------------------------------------------------------------- - call icepack_query_tracer_flags(tr_fsd_out=tr_fsd) + call icepack_query_tracer_flags(tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & - nt_qsno_out=nt_qsno,nt_fsd_out=nt_fsd) + nt_qsno_out=nt_qsno,nt_fsd_out=nt_fsd, nt_smice_out=nt_smice, & + nt_smliq_out=nt_smliq) call icepack_query_parameters(puny_out=puny, Lfresh_out=Lfresh, cp_ice_out=cp_ice, & rhoi_out=rhoi, rhos_out=rhos) call icepack_warnings_flush(nu_diag) @@ -482,7 +525,9 @@ subroutine print_state(plabel,i) write(nu_diag,*) 'hsn', vsnon(i,n)/aicen(i,n) endif write(nu_diag,*) 'Tsfcn',trcrn(i,nt_Tsfc,n) - if (tr_fsd) write(nu_diag,*) 'afsdn',trcrn(i,nt_fsd,n) ! fsd cat 1 + if (tr_fsd ) write(nu_diag,*) 'afsdn',trcrn(i,nt_fsd,n) ! fsd cat 1 + if (tr_snow) write(nu_diag,*) 'smice',trcrn(i,nt_smice:nt_smice+nslyr-1,n) + if (tr_snow) write(nu_diag,*) 'smliq',trcrn(i,nt_smliq:nt_smliq+nslyr-1,n) write(nu_diag,*) ' ' enddo ! n diff --git a/configuration/driver/icedrv_diagnostics_bgc.F90 b/configuration/driver/icedrv_diagnostics_bgc.F90 index 151a72680..55f2a6e04 100644 --- a/configuration/driver/icedrv_diagnostics_bgc.F90 +++ b/configuration/driver/icedrv_diagnostics_bgc.F90 @@ -764,8 +764,10 @@ subroutine zsal_diags () ! vertical fields of category 1 at diagnostic points for bgc layer model real (kind=dbl_kind), dimension(nblyr+2) :: & pphin, pphin1 + real (kind=dbl_kind), dimension(nilyr) :: & + pSice real (kind=dbl_kind), dimension(nblyr) :: & - pSin, pSice, pSin1 + pSin, pSin1 real (kind=dbl_kind), dimension(nblyr+1) :: & pbTiz, piDin @@ -804,22 +806,24 @@ subroutine zsal_diags () pdh_top1 = c0 pdh_bot1 = c0 pdarcy_V1 = c0 + do nn = 1, ncat psice_rho = psice_rho(n) + sice_rho(n,nn)*aicen(n,nn) enddo if (aice(n) > c0) psice_rho = psice_rho/aice(n) - if (tr_brine .and. aice(n) > c0) & + + if (tr_brine .and. aice(n) > c0) then phinS = trcr(n,nt_fbri)*vice(n)/aice(n) - if (aicen(n,1) > c0) then - if (tr_brine) phinS1 = trcrn(n,nt_fbri,1) & - * vicen(n,1)/aicen(n,1) + phbrn = (c1 - rhosi/rhow)*vice(n)/aice(n) & + - rhos /rhow *vsno(n)/aice(n) + endif + if (tr_brine .and. aicen(n,1) > c0) then + phinS1 = trcrn(n,nt_fbri,1)*vicen(n,1)/aicen(n,1) pdh_top1 = dhbr_top(n,1) pdh_bot1 = dhbr_bot(n,1) pdarcy_V1 = darcy_V(n,1) endif - if (tr_brine .AND. aice(n) > c0) & - phbrn = (c1 - rhosi/rhow)*vice(n)/aice(n) & - - rhos /rhow *vsno(n)/aice(n) + do k = 1, nblyr+1 pbTiz(k) = c0 piDin(k) = c0 @@ -847,6 +851,7 @@ subroutine zsal_diags () pSin (k) = trcr(n,nt_bgc_S+k-1) if (aicen(n,1) > c0) pSin1(k) = trcrn(n,nt_bgc_S+k-1,1) enddo + do k = 1,nilyr pSice(k) = trcr(n,nt_sice+k-1) enddo diff --git a/configuration/driver/icedrv_domain_size.F90 b/configuration/driver/icedrv_domain_size.F90 index 6444c9af5..9f951272a 100644 --- a/configuration/driver/icedrv_domain_size.F90 +++ b/configuration/driver/icedrv_domain_size.F90 @@ -48,6 +48,7 @@ module icedrv_domain_size + TRFY & ! first-year area + TRLVL*2 & ! level/deformed ice + TRPND*3 & ! ponds + + TRSNOW*4*nslyr & ! snow redistribution/metamorphism + n_iso*2 & ! number of isotopes (in ice and snow) + n_aero*4 & ! number of aerosols * 4 aero layers + TRBRI & ! brine height diff --git a/configuration/driver/icedrv_flux.F90 b/configuration/driver/icedrv_flux.F90 index cfa395fb6..9b3a3d32b 100644 --- a/configuration/driver/icedrv_flux.F90 +++ b/configuration/driver/icedrv_flux.F90 @@ -178,6 +178,7 @@ module icedrv_flux fresh , & ! fresh water flux to ocean (kg/m^2/s) fsalt , & ! salt flux to ocean (kg/m^2/s) fhocn , & ! net heat flux to ocean (W/m^2) + fsloss , & ! snow loss to ocean due to wind redistribution (kg/m^2 s) fswthru , & ! shortwave penetrating to ocean (W/m^2) fswthru_vdr , & ! vis dir shortwave penetrating to ocean (W/m^2) fswthru_vdf , & ! vis dif shortwave penetrating to ocean (W/m^2) diff --git a/configuration/driver/icedrv_history.F90 b/configuration/driver/icedrv_history.F90 new file mode 100644 index 000000000..6c30e5f91 --- /dev/null +++ b/configuration/driver/icedrv_history.F90 @@ -0,0 +1,423 @@ +!======================================================================= + +! Diagnostic information output during run +! +! authors: T. Craig + + module icedrv_history + + use icedrv_kinds + use icedrv_constants, only: nu_diag, nu_diag_out + use icedrv_domain_size, only: nx, ncat + use icedrv_diagnostics, only: nx_names + use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted + use icepack_intfc, only: icepack_query_parameters, icepack_query_tracer_sizes + use icepack_intfc, only: icepack_query_tracer_flags, icepack_query_tracer_indices + use icedrv_system, only: icedrv_system_abort + + implicit none + private + public :: history_write, & + history_close + + ! history output file info + + logical (kind=log_kind), public :: history_cdf ! flag to turn on cdf history files + + character (len=char_len_long) :: hist_file ! hist file name + + integer (kind=int_kind) :: ncid ! cdf file id + integer (kind=int_kind) :: nxid, ncatid, ntrcrid, timid ! cdf dim ids + integer (kind=int_kind) :: timcnt ! time counter + +!======================================================================= + + contains + +!======================================================================= + +! Writes history information + + subroutine history_write() + + use icedrv_calendar, only: idate0, days_per_year, use_leap_years + use icedrv_calendar, only: time, time0, secday, istep1, idate, sec + use icedrv_state, only: aice, vice, vsno, uvel, vvel, divu, shear, strength + use icedrv_state, only: trcr, trcrn + use icedrv_state, only: aicen, vicen, vsnon + use icedrv_flux, only: evap, fsnow, frain, frazil + use icedrv_flux, only: fswabs, flw, flwout, fsens, fsurf, flat + use icedrv_flux, only: Tair, Qa, fsw, fcondtop + use icedrv_flux, only: meltt, meltb, meltl, snoice + use icedrv_flux, only: dsnow, congel, sst, sss, Tf, fhocn +#ifdef USE_NETCDF + use netcdf +#endif + + ! local variables + + logical (kind=log_kind), save :: & + first_call = .true. ! first call flag + + integer (kind=int_kind) :: & + n, & ! counters + ntrcr, & ! tracer count from icepack + dimid1(1), dimid2(2), dimid3(3), dimid4(4), & ! cdf dimids + start1(1), start2(2), start3(3), start4(4), & ! cdf start/count arrays + count1(1), count2(2), count3(3), count4(4), & ! cdf start/count arrays + varid, & ! cdf varid + status, & ! cdf status flag + iflag ! history file attributes + + character (len=8) :: & + cdate ! date string + + real (kind=dbl_kind) :: & + value ! temporary + real (kind=dbl_kind),allocatable :: & + value1(:), value2(:,:), value3(:,:,:), value4(:,:,:,:) ! temporary + + integer (kind=dbl_kind), parameter :: num_2d = 32 + character(len=16), parameter :: fld_2d(num_2d) = & + (/ 'aice ', 'vice ', 'vsno ', & + 'uvel ', 'vvel ', 'divu ', & + 'shear ', 'strength ', & + 'evap ', 'fsnow ', 'frazil ', & + 'fswabs ', 'flw ', 'flwout ', & + 'fsens ', 'fsurf ', 'flat ', & + 'frain ', 'Tair ', 'Qa ', & + 'fsw ', 'fcondtop ', 'meltt ', & + 'meltb ', 'meltl ', 'snoice ', & + 'dsnow ', 'congel ', 'sst ', & + 'sss ', 'Tf ', 'fhocn ' /) + + integer (kind=dbl_kind), parameter :: num_3d_ncat = 3 + character(len=16), parameter :: fld_3d_ncat(num_3d_ncat) = & + (/ 'aicen ', 'vicen ', 'vsnon ' /) + + integer (kind=dbl_kind), parameter :: num_3d_ntrcr = 1 + character(len=16), parameter :: fld_3d_ntrcr(num_3d_ntrcr) = & + (/ 'trcr ' /) + + integer (kind=dbl_kind), parameter :: num_4d_ncat_ntrcr = 1 + character(len=16), parameter :: fld_4d_ncat_ntrcr(num_4d_ncat_ntrcr) = & + (/ 'trcrn ' /) + + character (len=char_len_long) :: tmpstr + + character(len=*), parameter :: subname='(history_write)' + +#ifdef USE_NETCDF + call icepack_query_tracer_sizes(ntrcr_out=ntrcr) + if (first_call) then + timcnt = 0 + write(hist_file,'(a,i8.8,a)') './history/icepack.h.',idate,'.nc' + iflag = nf90_clobber + status = nf90_create(trim(hist_file),iflag,ncid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: nf90_create '//trim(hist_file)) + + ! nx columns dimension + status = nf90_def_dim(ncid,'ni',nx,nxid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim ni') + status = nf90_def_var(ncid,'ni',NF90_INT,nxid,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var ni') + do n = 1,nx + write(tmpstr,'(a,i3.3)') 'column_name_',n + status = nf90_put_att(ncid,varid,trim(tmpstr),trim(nx_names(n))) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att columns names') + enddo + + ! ncat category dimension + status = nf90_def_dim(ncid,'ncat',ncat,ncatid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim ncat') + status = nf90_def_var(ncid,'ncat',NF90_INT,ncatid,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var ncat') + + ! ntrcr dimension + status = nf90_def_dim(ncid,'ntrcr',ntrcr,ntrcrid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim ntrcr') + status = nf90_def_var(ncid,'ntrcr',NF90_INT,ntrcrid,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var ntrcr') + + ! time dimension + status = nf90_def_dim(ncid,'time',NF90_UNLIMITED,timid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_dim time') + status = nf90_def_var(ncid,'time',NF90_DOUBLE,timid,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var time') + status = nf90_put_att(ncid,varid,'long_name','model time') + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att time long_name') + write(cdate,'(i8.8)') idate0 + write(tmpstr,'(a,a,a,a,a,a,a,a)') 'days since ', & + cdate(1:4),'-',cdate(5:6),'-',cdate(7:8),' 00:00:00' + status = nf90_put_att(ncid,varid,'units',trim(tmpstr)) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att time units') + if (days_per_year == 360) then + status = nf90_put_att(ncid,varid,'calendar','360_day') + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att calendar 360_day') + elseif (days_per_year == 365 .and. .not.use_leap_years ) then + status = nf90_put_att(ncid,varid,'calendar','NoLeap') + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att calendar noleap') + elseif (use_leap_years) then + status = nf90_put_att(ncid,varid,'calendar','Gregorian') + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_att calendar gregorian') + else + call icedrv_system_abort(string=subname//' ERROR: invalid calendar settings') + endif + status = nf90_def_var(ncid,'timestep',NF90_INT,timid,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var timestep') + status = nf90_def_var(ncid,'date',NF90_DOUBLE,timid,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: def_var date') + + ! 2d fields + + dimid2(1) = nxid + dimid2(2) = timid + + do n = 1,num_2d + status = nf90_def_var(ncid,trim(fld_2d(n)),NF90_DOUBLE,dimid2,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_2d(n))) + enddo + + ! 3d ncat fields + + dimid3(1) = nxid + dimid3(2) = ncatid + dimid3(3) = timid + + do n = 1,num_3d_ncat + status = nf90_def_var(ncid,trim(fld_3d_ncat(n)),NF90_DOUBLE,dimid3,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_3d_ncat(n))) + enddo + + ! 3d ntrcr fields + + dimid3(1) = nxid + dimid3(2) = ntrcrid + dimid3(3) = timid + + do n = 1,num_3d_ntrcr + status = nf90_def_var(ncid,trim(fld_3d_ntrcr(n)),NF90_DOUBLE,dimid3,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_3d_ntrcr(n))) + enddo + + ! 4d ncat ntrcr fields + + dimid4(1) = nxid + dimid4(2) = ncatid + dimid4(3) = ntrcrid + dimid4(4) = timid + + do n = 1,num_4d_ncat_ntrcr + status = nf90_def_var(ncid,trim(fld_4d_ncat_ntrcr(n)),NF90_DOUBLE,dimid4,varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in def_var '//trim(fld_4d_ncat_ntrcr(n))) + enddo + + ! enddef + + status = nf90_enddef(ncid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR in nf90_enddef') + + ! static dimension variables + + status = nf90_inq_varid(ncid,'ni',varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'ni') + status = nf90_put_var(ncid,varid,(/(n,n=1,nx)/)) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'ni') + + status = nf90_inq_varid(ncid,'ncat',varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'ncat') + status = nf90_put_var(ncid,varid,(/(n,n=1,ncat)/)) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'ncat') + + status = nf90_inq_varid(ncid,'ntrcr',varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'ntrcr') + status = nf90_put_var(ncid,varid,(/(n,n=1,ntrcr)/)) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'ntrcr') + + endif + + first_call = .false. + + ! Time + + timcnt = timcnt + 1 + + status = nf90_inq_varid(ncid,'time',varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'time') + value = (time-time0)/secday + status = nf90_put_var(ncid,varid,value,start=(/timcnt/)) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'time') + + status = nf90_inq_varid(ncid,'timestep',varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'timestep') + status = nf90_put_var(ncid,varid,istep1,start=(/timcnt/)) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'timestep') + + status = nf90_inq_varid(ncid,'date',varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//'date') + value = real(idate,kind=dbl_kind) + real(sec,kind=dbl_kind)/(secday) + status = nf90_put_var(ncid,varid,value,start=(/timcnt/)) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//'date') + + ! 2d fields + + start2(1) = 1 + count2(1) = nx + start2(2) = timcnt + count2(2) = 1 + + do n = 1,num_2d + allocate(value2(count2(1),1)) + + value2 = -9999._dbl_kind + if (trim(fld_2d(n)) == 'aice') value2(1:count2(1),1) = aice(1:count2(1)) + if (trim(fld_2d(n)) == 'vice') value2(1:count2(1),1) = vice(1:count2(1)) + if (trim(fld_2d(n)) == 'vsno') value2(1:count2(1),1) = vsno(1:count2(1)) + if (trim(fld_2d(n)) == 'uvel') value2(1:count2(1),1) = uvel(1:count2(1)) + if (trim(fld_2d(n)) == 'vvel') value2(1:count2(1),1) = vvel(1:count2(1)) + if (trim(fld_2d(n)) == 'divu') value2(1:count2(1),1) = divu(1:count2(1)) + if (trim(fld_2d(n)) == 'shear') value2(1:count2(1),1) = shear(1:count2(1)) + if (trim(fld_2d(n)) == 'strength') value2(1:count2(1),1) = strength(1:count2(1)) + if (trim(fld_2d(n)) == 'evap') value2(1:count2(1),1) = evap(1:count2(1)) + if (trim(fld_2d(n)) == 'fsnow') value2(1:count2(1),1) = fsnow(1:count2(1)) + if (trim(fld_2d(n)) == 'frazil') value2(1:count2(1),1) = frazil(1:count2(1)) + if (trim(fld_2d(n)) == 'fswabs') value2(1:count2(1),1) = fswabs(1:count2(1)) + if (trim(fld_2d(n)) == 'flw') value2(1:count2(1),1) = flw(1:count2(1)) + if (trim(fld_2d(n)) == 'flwout') value2(1:count2(1),1) = flwout(1:count2(1)) + if (trim(fld_2d(n)) == 'fsens') value2(1:count2(1),1) = fsens(1:count2(1)) + if (trim(fld_2d(n)) == 'fsurf') value2(1:count2(1),1) = fsurf(1:count2(1)) + if (trim(fld_2d(n)) == 'flat') value2(1:count2(1),1) = flat(1:count2(1)) + if (trim(fld_2d(n)) == 'frain') value2(1:count2(1),1) = frain(1:count2(1)) + if (trim(fld_2d(n)) == 'Tair') value2(1:count2(1),1) = Tair(1:count2(1)) + if (trim(fld_2d(n)) == 'Qa') value2(1:count2(1),1) = Qa(1:count2(1)) + if (trim(fld_2d(n)) == 'fsw') value2(1:count2(1),1) = fsw(1:count2(1)) + if (trim(fld_2d(n)) == 'fcondtop') value2(1:count2(1),1) = fcondtop(1:count2(1)) + if (trim(fld_2d(n)) == 'meltt') value2(1:count2(1),1) = meltt(1:count2(1)) + if (trim(fld_2d(n)) == 'meltb') value2(1:count2(1),1) = meltb(1:count2(1)) + if (trim(fld_2d(n)) == 'meltl') value2(1:count2(1),1) = meltl(1:count2(1)) + if (trim(fld_2d(n)) == 'snoice') value2(1:count2(1),1) = snoice(1:count2(1)) + if (trim(fld_2d(n)) == 'dsnow') value2(1:count2(1),1) = dsnow(1:count2(1)) + if (trim(fld_2d(n)) == 'congel') value2(1:count2(1),1) = congel(1:count2(1)) + if (trim(fld_2d(n)) == 'sst') value2(1:count2(1),1) = sst(1:count2(1)) + if (trim(fld_2d(n)) == 'sss') value2(1:count2(1),1) = sss(1:count2(1)) + if (trim(fld_2d(n)) == 'Tf') value2(1:count2(1),1) = Tf(1:count2(1)) + if (trim(fld_2d(n)) == 'fhocn') value2(1:count2(1),1) = fhocn(1:count2(1)) + + status = nf90_inq_varid(ncid,trim(fld_2d(n)),varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_2d(n))) + status = nf90_put_var(ncid,varid,value2,start=start2,count=count2) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_2d(n))) + + deallocate(value2) + enddo + + ! 3d ncat fields + + start3(1) = 1 + count3(1) = nx + start3(2) = 1 + count3(2) = ncat + start3(3) = timcnt + count3(3) = 1 + + do n = 1,num_3d_ncat + allocate(value3(count3(1),count3(2),1)) + + value3 = -9999._dbl_kind + if (trim(fld_3d_ncat(n)) == 'aicen') value3(1:count3(1),1:count3(2),1) = aicen(1:count3(1),1:count3(2)) + if (trim(fld_3d_ncat(n)) == 'vicen') value3(1:count3(1),1:count3(2),1) = vicen(1:count3(1),1:count3(2)) + if (trim(fld_3d_ncat(n)) == 'vsnon') value3(1:count3(1),1:count3(2),1) = vsnon(1:count3(1),1:count3(2)) + + status = nf90_inq_varid(ncid,trim(fld_3d_ncat(n)),varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_3d_ncat(n))) + status = nf90_put_var(ncid,varid,value3,start=start3,count=count3) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_3d_ncat(n))) + + deallocate(value3) + enddo + + ! 3d ntrcr fields + + start3(1) = 1 + count3(1) = nx + start3(2) = 1 + count3(2) = ntrcr + start3(3) = timcnt + count3(3) = 1 + + do n = 1,num_3d_ntrcr + allocate(value3(count3(1),count3(2),1)) + + value3 = -9999._dbl_kind + if (trim(fld_3d_ntrcr(n)) == 'trcr') value3(1:count3(1),1:count3(2),1) = trcr(1:count3(1),1:count3(2)) + + status = nf90_inq_varid(ncid,trim(fld_3d_ntrcr(n)),varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_3d_ntrcr(n))) + status = nf90_put_var(ncid,varid,value3,start=start3,count=count3) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_3d_ntrcr(n))) + + deallocate(value3) + enddo + + ! 4d ncat ntrcr fields + + start4(1) = 1 + count4(1) = nx + start4(2) = 1 + count4(2) = ncat + start4(3) = 1 + count4(3) = ntrcr + start4(4) = timcnt + count4(4) = 1 + + do n = 1,num_4d_ncat_ntrcr + allocate(value4(count4(1),count4(2),count4(3),1)) + + value4 = -9999._dbl_kind + if (trim(fld_4d_ncat_ntrcr(n)) == 'trcr') value4(1:count4(1),1:count4(2),1:count4(3),1) = trcrn(1:count4(1),1:count4(2),1:count4(3)) + + status = nf90_inq_varid(ncid,trim(fld_4d_ncat_ntrcr(n)),varid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: inq_var '//trim(fld_4d_ncat_ntrcr(n))) + status = nf90_put_var(ncid,varid,value4,start=start4,count=count4) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: put_var '//trim(fld_4d_ncat_ntrcr(n))) + + deallocate(value4) + enddo + +#else + call icedrv_system_abort(string=subname//' ERROR: history requires USE_NETCDF',file=__FILE__,line=__LINE__) +#endif + + end subroutine history_write + +!======================================================================= + +! Close history file + + subroutine history_close() + +#ifdef USE_NETCDF + use netcdf +#endif + + ! local variables + + integer (kind=int_kind) :: & + status ! cdf status flag + + character(len=*), parameter :: subname='(history_close)' + +#ifdef USE_NETCDF + status = nf90_close(ncid) + if (status /= nf90_noerr) call icedrv_system_abort(string=subname//' ERROR: nf90_close') +#else + call icedrv_system_abort(string=subname//' ERROR: history requires USE_NETCDF',file=__FILE__,line=__LINE__) +#endif + + end subroutine history_close + +!======================================================================= + + end module icedrv_history + +!======================================================================= diff --git a/configuration/driver/icedrv_init.F90 b/configuration/driver/icedrv_init.F90 index 781f49b22..c4a2c7a17 100644 --- a/configuration/driver/icedrv_init.F90 +++ b/configuration/driver/icedrv_init.F90 @@ -62,6 +62,7 @@ subroutine input_data use icedrv_calendar, only: year_init, istep0 use icedrv_calendar, only: dumpfreq, diagfreq, dump_last use icedrv_calendar, only: npt, dt, ndtd, days_per_year, use_leap_years + use icedrv_history, only: history_cdf use icedrv_restart_shared, only: restart, restart_dir, restart_file use icedrv_flux, only: update_ocn_f, l_mpond_fresh, cpl_bgc use icedrv_flux, only: default_season @@ -88,16 +89,18 @@ subroutine input_data ahmax, R_ice, R_pnd, R_snw, dT_mlt, rsnw_mlt, ksno, & mu_rdg, hs0, dpscale, rfracmin, rfracmax, pndaspect, hs1, hp1, & a_rapid_mode, Rac_rapid_mode, aspect_rapid_mode, dSdt_slow_mode, & - phi_c_slow_mode, phi_i_mushy, kalg, emissivity, floediam, hfrazilmin + phi_c_slow_mode, phi_i_mushy, kalg, emissivity, floediam, hfrazilmin, & + rsnw_fall, rsnw_tmax, rhosnew, rhosmin, rhosmax, & + windmin, drhosdwind, snwlvlfac integer (kind=int_kind) :: ktherm, kstrength, krdg_partic, krdg_redist, & natmiter, kitd, kcatbound character (len=char_len) :: shortwave, albedo_type, conduct, fbot_xfer_type, & - tfrz_option, frzpnd, atmbndy, wave_spec_type + tfrz_option, frzpnd, atmbndy, wave_spec_type, snwredist, snw_aging_table - logical (kind=log_kind) :: sw_redist - real (kind=dbl_kind) :: sw_frac, sw_dtemp + logical (kind=log_kind) :: sw_redist, use_smliq_pnd, snwgrain + real (kind=dbl_kind) :: sw_frac, sw_dtemp ! Flux convergence tolerance real (kind=dbl_kind) :: atmiter_conv @@ -106,11 +109,12 @@ subroutine input_data logical (kind=log_kind) :: conserv_check integer (kind=int_kind) :: ntrcr - logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond + logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_pond, tr_snow logical (kind=log_kind) :: tr_iso, tr_aero, tr_fsd logical (kind=log_kind) :: tr_pond_cesm, tr_pond_lvl, tr_pond_topo, wave_spec integer (kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno, nt_iage, nt_FY integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & nt_aero, nt_fsd, nt_isosno, nt_isoice real (kind=real_kind) :: rpcesm, rplvl, rptopo @@ -126,7 +130,7 @@ subroutine input_data dt, npt, ndtd, dump_last, & ice_ic, restart, restart_dir, restart_file, & dumpfreq, diagfreq, diag_file, cpl_bgc, & - conserv_check + conserv_check, history_cdf namelist /grid_nml/ & kcatbound @@ -152,6 +156,10 @@ subroutine input_data hs0, dpscale, frzpnd, & rfracmin, rfracmax, pndaspect, hs1, & hp1 + namelist /snow_nml/ & + snwredist, snwgrain, rsnw_fall, rsnw_tmax, & + rhosnew, rhosmin, rhosmax, snwlvlfac, & + windmin, drhosdwind, use_smliq_pnd, snw_aging_table namelist /forcing_nml/ & atmbndy, calc_strair, calc_Tsfc, & @@ -174,6 +182,7 @@ subroutine input_data tr_pond_cesm, & tr_pond_lvl, & tr_pond_topo, & + tr_snow, & tr_aero, & tr_fsd, & tr_iso @@ -210,7 +219,13 @@ subroutine input_data tfrz_option_out=tfrz_option, kalg_out=kalg, & fbot_xfer_type_out=fbot_xfer_type, puny_out=puny, & wave_spec_type_out=wave_spec_type, & - sw_redist_out=sw_redist, sw_frac_out=sw_frac, sw_dtemp_out=sw_dtemp) + sw_redist_out=sw_redist, sw_frac_out=sw_frac, sw_dtemp_out=sw_dtemp, & + snwredist_out=snwredist, use_smliq_pnd_out=use_smliq_pnd, & + snwgrain_out=snwgrain, rsnw_fall_out=rsnw_fall, rsnw_tmax_out=rsnw_tmax, & + rhosnew_out=rhosnew, rhosmin_out = rhosmin, rhosmax_out=rhosmax, & + windmin_out=windmin, drhosdwind_out=drhosdwind, snwlvlfac_out=snwlvlfac, & + snw_aging_table_out=snw_aging_table) + call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) @@ -234,6 +249,7 @@ subroutine input_data restart = .false. ! if true, read restart files for initialization restart_dir = './' ! write to executable dir for default restart_file = 'iced' ! restart file name prefix + history_cdf = .false. ! history netcdf file flag ice_ic = 'default' ! initial conditions are specified in the code ! otherwise, the filename for reading restarts ndtd = 1 ! dynamic time steps per thermodynamic time step @@ -266,7 +282,8 @@ subroutine input_data tr_lvl = .false. ! level ice tr_pond_cesm = .false. ! CESM melt ponds tr_pond_lvl = .false. ! level-ice melt ponds - tr_pond_topo = .false. ! explicit melt ponds (topographic) + tr_pond_topo = .false. ! topographic melt ponds + tr_snow = .false. ! snow tracers (wind redistribution, metamorphosis) tr_aero = .false. ! aerosols tr_fsd = .false. ! floe size distribution tr_iso = .false. ! isotopes @@ -277,49 +294,111 @@ subroutine input_data open (nu_nml, file=nml_filename, status='old',iostat=nml_error) if (nml_error /= 0) then - nml_error = -1 - else - nml_error = 1 + write(ice_stdout,*) 'error opening namelist file '//trim(nml_filename) + call icedrv_system_abort(file=__FILE__,line=__LINE__) endif + close(nu_nml) - do while (nml_error > 0) - print*,'Reading namelist file ',nml_filename + print*,'Reading namelist file ',nml_filename - print*,'Reading setup_nml' + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + nml_error = 1 + print*,'Reading setup_nml' + do while (nml_error > 0) read(nu_nml, nml=setup_nml,iostat=nml_error) - if (nml_error /= 0) exit + end do + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) - print*,'Reading grid_nml' + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + nml_error = 1 + print*,'Reading grid_nml' + do while (nml_error > 0) read(nu_nml, nml=grid_nml,iostat=nml_error) - if (nml_error /= 0) exit + end do + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) - print*,'Reading tracer_nml' + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + nml_error = 1 + print*,'Reading tracer_nml' + do while (nml_error > 0) read(nu_nml, nml=tracer_nml,iostat=nml_error) - if (nml_error /= 0) exit + end do + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) - print*,'Reading thermo_nml' + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + nml_error = 1 + print*,'Reading thermo_nml' + do while (nml_error > 0) read(nu_nml, nml=thermo_nml,iostat=nml_error) - if (nml_error /= 0) exit + end do + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) - print*,'Reading shortwave_nml' + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + nml_error = 1 + print*,'Reading shortwave_nml' + do while (nml_error > 0) read(nu_nml, nml=shortwave_nml,iostat=nml_error) - if (nml_error /= 0) exit + end do + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) - print*,'Reading ponds_nml' + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + nml_error = 1 + print*,'Reading ponds_nml' + do while (nml_error > 0) read(nu_nml, nml=ponds_nml,iostat=nml_error) - if (nml_error /= 0) exit + end do + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) - print*,'Reading forcing_nml' + if (tr_snow) then + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + nml_error = 1 + print*,'Reading snow_nml' + do while (nml_error > 0) + read(nu_nml, nml=snow_nml,iostat=nml_error) + end do + if (nml_error /= 0) then + write(ice_stdout,*) 'error reading namelist' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + close(nu_nml) + endif + + open (nu_nml, file=nml_filename, status='old',iostat=nml_error) + nml_error = 1 + print*,'Reading forcing_nml' + do while (nml_error > 0) read(nu_nml, nml=forcing_nml,iostat=nml_error) - if (nml_error /= 0) exit end do - if (nml_error == 0) close(nu_nml) if (nml_error /= 0) then write(ice_stdout,*) 'error reading namelist' call icedrv_system_abort(file=__FILE__,line=__LINE__) endif close(nu_nml) - + !----------------------------------------------------------------- ! set up diagnostics output and resolve conflicts !----------------------------------------------------------------- @@ -401,6 +480,38 @@ subroutine input_data shortwave = 'dEdd' endif + if (snwredist(1:4) /= 'none' .and. .not. tr_snow) then + write (nu_diag,*) 'WARNING: snwredist on but tr_snow=F' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + if (snwredist(1:4) == 'bulk' .and. .not. tr_lvl) then + write (nu_diag,*) 'WARNING: snwredist=bulk but tr_lvl=F' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + if (snwredist(1:6) == 'ITDrdg' .and. .not. tr_lvl) then + write (nu_diag,*) 'WARNING: snwredist=ITDrdg but tr_lvl=F' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + if (use_smliq_pnd .and. .not. snwgrain) then + write (nu_diag,*) 'WARNING: use_smliq_pnd = T but' + write (nu_diag,*) 'WARNING: snow metamorphosis not used' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + if (use_smliq_pnd .and. .not. tr_snow) then + write (nu_diag,*) 'WARNING: use_smliq_pnd = T but' + write (nu_diag,*) 'WARNING: snow tracers are not active' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + if (snwgrain .and. .not. tr_snow) then + write (nu_diag,*) 'WARNING: snwgrain=T but tr_snow=F' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + if (trim(snw_aging_table) /= 'test') then + write (nu_diag,*) 'WARNING: snw_aging_table /= test' + write (nu_diag,*) 'WARNING: netcdf not available' + call icedrv_system_abort(file=__FILE__,line=__LINE__) + endif + if (tr_iso .and. n_iso==0) then write (nu_diag,*) 'WARNING: isotopes activated but' write (nu_diag,*) 'WARNING: not allocated in tracer array.' @@ -422,6 +533,11 @@ subroutine input_data shortwave = 'dEdd' endif + if (tr_snow .and. trim(shortwave) /= 'dEdd') then + write (nu_diag,*) 'WARNING: snow grain radius activated but' + write (nu_diag,*) 'WARNING: dEdd shortwave is not.' + endif + rfracmin = min(max(rfracmin,c0),c1) rfracmax = min(max(rfracmax,c0),c1) @@ -500,6 +616,7 @@ subroutine input_data trim(restart_dir) write(nu_diag,*) ' restart_file = ', & trim(restart_file) + write(nu_diag,1010) ' history_cdf = ', history_cdf write(nu_diag,*) ' ice_ic = ', & trim(ice_ic) write(nu_diag,1010) ' conserv_check = ', conserv_check @@ -557,6 +674,21 @@ subroutine input_data if (tr_pond .and. .not. tr_pond_lvl) & write(nu_diag,1000) ' pndaspect = ', pndaspect + if (tr_snow) then + write(nu_diag,1030) ' snwredist = ', snwredist + write(nu_diag,1010) ' snwgrain = ', snwgrain + write(nu_diag,1010) ' use_smliq_pnd = ', use_smliq_pnd + write(nu_diag,1030) ' snw_aging_table = ', snw_aging_table + write(nu_diag,1000) ' rsnw_fall = ', rsnw_fall + write(nu_diag,1000) ' rsnw_tmax = ', rsnw_tmax + write(nu_diag,1000) ' rhosnew = ', rhosnew + write(nu_diag,1000) ' rhosmin = ', rhosmin + write(nu_diag,1000) ' rhosmax = ', rhosmax + write(nu_diag,1000) ' windmin = ', windmin + write(nu_diag,1000) ' drhosdwind = ', drhosdwind + write(nu_diag,1000) ' snwlvlfac = ', snwlvlfac + endif + write(nu_diag,1020) ' ktherm = ', ktherm if (ktherm == 1) & write(nu_diag,1030) ' conduct = ', conduct @@ -623,6 +755,7 @@ subroutine input_data write(nu_diag,1010) ' tr_pond_cesm = ', tr_pond_cesm write(nu_diag,1010) ' tr_pond_lvl = ', tr_pond_lvl write(nu_diag,1010) ' tr_pond_topo = ', tr_pond_topo + write(nu_diag,1010) ' tr_snow = ', tr_snow write(nu_diag,1010) ' tr_aero = ', tr_aero write(nu_diag,1010) ' tr_fsd = ', tr_fsd @@ -677,6 +810,21 @@ subroutine input_data endif endif + nt_smice = max_ntrcr + nt_smliq = max_ntrcr + nt_rhos = max_ntrcr + nt_rsnw = max_ntrcr + if (tr_snow) then + nt_smice = ntrcr + 1 + ntrcr = ntrcr + nslyr ! mass of ice in nslyr snow layers + nt_smliq = ntrcr + 1 + ntrcr = ntrcr + nslyr ! mass of liquid in nslyr snow layers + nt_rhos = ntrcr + 1 + ntrcr = ntrcr + nslyr ! snow density in nslyr layers + nt_rsnw = ntrcr + 1 + ntrcr = ntrcr + nslyr ! snow grain radius in nslyr layers + endif + nt_fsd = max_ntrcr if (tr_fsd) then nt_fsd = ntrcr + 1 ! floe size distribution @@ -724,7 +872,7 @@ subroutine input_data write(nu_diag,*)' ' 1000 format (a30,2x,f9.2) ! a30 to align formatted, unformatted statements - 1005 format (a30,2x,f10.6) ! float + 1005 format (a30,2x,f10.6) ! float 1010 format (a30,2x,l6) ! logical 1020 format (a30,2x,i6) ! integer 1030 format (a30, a8) ! character @@ -781,13 +929,18 @@ subroutine input_data tfrz_option_in=tfrz_option, kalg_in=kalg, & fbot_xfer_type_in=fbot_xfer_type, & wave_spec_type_in=wave_spec_type, wave_spec_in=wave_spec, & - sw_redist_in=sw_redist, sw_frac_in=sw_frac, sw_dtemp_in=sw_dtemp) + sw_redist_in=sw_redist, sw_frac_in=sw_frac, sw_dtemp_in=sw_dtemp, & + snwredist_in=snwredist, use_smliq_pnd_in=use_smliq_pnd, & + snw_aging_table_in=snw_aging_table, & + snwgrain_in=snwgrain, rsnw_fall_in=rsnw_fall, rsnw_tmax_in=rsnw_tmax, & + rhosnew_in=rhosnew, rhosmin_in=rhosmin, rhosmax_in=rhosmax, & + windmin_in=windmin, drhosdwind_in=drhosdwind, snwlvlfac_in=snwlvlfac) call icepack_init_tracer_sizes(ntrcr_in=ntrcr, & ncat_in=ncat, nilyr_in=nilyr, nslyr_in=nslyr, nblyr_in=nblyr, & nfsd_in=nfsd, n_iso_in=n_iso, n_aero_in=n_aero) call icepack_init_tracer_flags(tr_iage_in=tr_iage, & tr_FY_in=tr_FY, tr_lvl_in=tr_lvl, tr_aero_in=tr_aero, & - tr_iso_in=tr_iso, & + tr_iso_in=tr_iso, tr_snow_in=tr_snow, & tr_pond_in=tr_pond, tr_pond_cesm_in=tr_pond_cesm, & tr_pond_lvl_in=tr_pond_lvl, & tr_pond_topo_in=tr_pond_topo, tr_fsd_in=tr_fsd) @@ -796,6 +949,8 @@ subroutine input_data nt_qsno_in=nt_qsno, nt_iage_in=nt_iage, & nt_fy_in=nt_fy, nt_alvl_in=nt_alvl, nt_vlvl_in=nt_vlvl, & nt_apnd_in=nt_apnd, nt_hpnd_in=nt_hpnd, nt_ipnd_in=nt_ipnd, & + nt_smice_in=nt_smice, nt_smliq_in=nt_smliq, & + nt_rhos_in=nt_rhos, nt_rsnw_in=nt_rsnw, & nt_aero_in=nt_aero, nt_fsd_in=nt_fsd, & nt_isosno_in=nt_isosno, nt_isoice_in=nt_isoice) @@ -881,10 +1036,11 @@ subroutine init_state integer (kind=int_kind) :: ntrcr logical (kind=log_kind) :: tr_iage, tr_FY, tr_lvl, tr_aero, tr_fsd, tr_iso - logical (kind=log_kind) :: tr_pond_cesm, tr_pond_lvl, tr_pond_topo + logical (kind=log_kind) :: tr_pond_cesm, tr_pond_lvl, tr_pond_topo, tr_snow integer (kind=int_kind) :: nt_Tsfc, nt_sice, nt_qice, nt_qsno, nt_iage, nt_fy - integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, & - nt_ipnd, nt_aero, nt_fsd, nt_isosno, nt_isoice + integer (kind=int_kind) :: nt_alvl, nt_vlvl, nt_apnd, nt_hpnd, nt_ipnd, & + nt_smice, nt_smliq, nt_rhos, nt_rsnw, & + nt_aero, nt_fsd, nt_isosno, nt_isoice character(len=*), parameter :: subname='(init_state)' @@ -896,7 +1052,7 @@ subroutine init_state call icepack_query_tracer_sizes(ntrcr_out=ntrcr) call icepack_query_tracer_flags(tr_iage_out=tr_iage, & tr_FY_out=tr_FY, tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, & - tr_iso_out=tr_iso, & + tr_iso_out=tr_iso, tr_snow_out=tr_snow, & tr_pond_cesm_out=tr_pond_cesm, tr_pond_lvl_out=tr_pond_lvl, & tr_pond_topo_out=tr_pond_topo, tr_fsd_out=tr_fsd) call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, & @@ -905,6 +1061,8 @@ subroutine init_state nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & nt_ipnd_out=nt_ipnd, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice, & nt_aero_out=nt_aero, nt_fsd_out=nt_fsd) call icepack_warnings_flush(nu_diag) @@ -976,6 +1134,14 @@ subroutine init_state trcr_depend(nt_hpnd) = 2+nt_apnd ! melt pond depth trcr_depend(nt_ipnd) = 2+nt_apnd ! refrozen pond lid endif + if (tr_snow) then + do k = 1, nslyr + trcr_depend(nt_smice + k - 1) = 2 ! ice mass in snow + trcr_depend(nt_smliq + k - 1) = 2 ! liquid mass in snow + trcr_depend(nt_rhos + k - 1) = 2 ! effective snow density + trcr_depend(nt_rsnw + k - 1) = 2 ! snow radius + enddo + endif if (tr_fsd) then do it = 1, nfsd trcr_depend(nt_fsd + it - 1) = 0 ! area-weighted floe size distribution @@ -1107,7 +1273,6 @@ subroutine set_state_var (nx, & use icedrv_domain_size, only: nilyr, nslyr, max_ntrcr, ncat, nfsd use icedrv_arrays_column, only: floe_rad_c, floe_binwidth - integer (kind=int_kind), intent(in) :: & nx ! number of grid cells @@ -1145,7 +1310,7 @@ subroutine set_state_var (nx, & real (kind=dbl_kind) :: & Tsfc, sum, hbar, & - rhos, Lfresh, puny + rhos, Lfresh, puny, rsnw_fall real (kind=dbl_kind), dimension(ncat) :: & ainit, hinit ! initial area, thickness @@ -1159,9 +1324,10 @@ subroutine set_state_var (nx, & real (kind=dbl_kind), parameter :: & hsno_init = 0.25_dbl_kind ! initial snow thickness (m) - logical (kind=log_kind) :: tr_brine, tr_lvl, tr_fsd + logical (kind=log_kind) :: tr_brine, tr_lvl, tr_fsd, tr_snow integer (kind=int_kind) :: nt_Tsfc, nt_qice, nt_qsno, nt_sice, nt_fsd integer (kind=int_kind) :: nt_fbri, nt_alvl, nt_vlvl + integer (kind=int_kind) :: nt_rhos, nt_rsnw, nt_smice, nt_smliq character(len=*), parameter :: subname='(set_state_var)' @@ -1170,11 +1336,14 @@ subroutine set_state_var (nx, & !----------------------------------------------------------------- call icepack_query_tracer_flags(tr_brine_out=tr_brine, tr_lvl_out=tr_lvl, & - tr_fsd_out=tr_fsd) - call icepack_query_tracer_indices( nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & + tr_fsd_out=tr_fsd, tr_snow_out=tr_snow) + call icepack_query_tracer_indices(nt_Tsfc_out=nt_Tsfc, nt_qice_out=nt_qice, & nt_qsno_out=nt_qsno, nt_sice_out=nt_sice, nt_fsd_out=nt_fsd, & - nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl) - call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, puny_out=puny) + nt_fbri_out=nt_fbri, nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, & + nt_rsnw_out=nt_rsnw, nt_rhos_out=nt_rhos, & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq) + call icepack_query_parameters(rhos_out=rhos, Lfresh_out=Lfresh, puny_out=puny, & + rsnw_fall_out=rsnw_fall) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -1262,6 +1431,15 @@ subroutine set_state_var (nx, & enddo ! nslyr ! brine fraction if (tr_brine) trcrn(i,nt_fbri,n) = c1 + ! snow radius, effective density, ice and liquid mass content + if (tr_snow) then + do k = 1, nslyr + trcrn(i,nt_rsnw +k-1,n) = rsnw_fall + trcrn(i,nt_rhos +k-1,n) = rhos + trcrn(i,nt_smice+k-1,n) = rhos + trcrn(i,nt_smliq+k-1,n) = c0 + enddo ! nslyr + endif enddo ! ncat call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & @@ -1323,11 +1501,20 @@ subroutine set_state_var (nx, & enddo ! nslyr ! brine fraction if (tr_brine) trcrn(i,nt_fbri,n) = c1 + ! snow radius, effective density, ice and liquid mass content + if (tr_snow) then + do k = 1, nslyr + trcrn(i,nt_rsnw +k-1,n) = rsnw_fall + trcrn(i,nt_rhos +k-1,n) = rhos + trcrn(i,nt_smice+k-1,n) = rhos + trcrn(i,nt_smliq+k-1,n) = c0 + enddo ! nslyr + endif enddo ! ncat call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) - + !----------------------------------------------------------------- ! land diff --git a/configuration/driver/icedrv_init_column.F90 b/configuration/driver/icedrv_init_column.F90 index d8deade79..dfd2a59e1 100644 --- a/configuration/driver/icedrv_init_column.F90 +++ b/configuration/driver/icedrv_init_column.F90 @@ -122,21 +122,23 @@ subroutine init_shortwave logical (kind=log_kind) :: & l_print_point, & ! flag to print designated grid point diagnostics - dEdd_algae, & ! from icepack - modal_aero ! from icepack + dEdd_algae, & ! BGC - radiation interactions + modal_aero, & ! modal aerosol optical properties + snwgrain ! use variable snow grain size character (len=char_len) :: & - shortwave ! from icepack + shortwave ! shortwave formulation real (kind=dbl_kind), dimension(ncat) :: & fbri ! brine height to ice thickness real (kind=dbl_kind), allocatable, dimension(:,:) :: & - ztrcr_sw + rsnow , & ! snow grain radius + ztrcr_sw ! BGC tracers affecting radiation logical (kind=log_kind) :: tr_brine, tr_zaero, tr_bgc_N integer (kind=int_kind) :: nt_alvl, nt_apnd, nt_hpnd, nt_ipnd, nt_aero, & - nt_fbri, nt_tsfc, ntrcr, nbtrcr_sw, nlt_chl_sw + nt_fbri, nt_tsfc, nt_rsnw, ntrcr, nbtrcr_sw, nlt_chl_sw integer (kind=int_kind), dimension(icepack_max_aero) :: nlt_zaero_sw integer (kind=int_kind), dimension(icepack_max_aero) :: nt_zaero integer (kind=int_kind), dimension(icepack_max_algae) :: nt_bgc_N @@ -152,6 +154,7 @@ subroutine init_shortwave call icepack_query_parameters(shortwave_out=shortwave) call icepack_query_parameters(dEdd_algae_out=dEdd_algae) call icepack_query_parameters(modal_aero_out=modal_aero) + call icepack_query_parameters(snwgrain_out=snwgrain) call icepack_query_tracer_sizes(ntrcr_out=ntrcr, & nbtrcr_sw_out=nbtrcr_sw) call icepack_query_tracer_flags(tr_brine_out=tr_brine, & @@ -160,6 +163,7 @@ subroutine init_shortwave nt_apnd_out=nt_apnd, nt_hpnd_out=nt_hpnd, & nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, & nt_fbri_out=nt_fbri, nt_tsfc_out=nt_tsfc, & + nt_rsnw_out=nt_rsnw, & nt_bgc_N_out=nt_bgc_N, nt_zaero_out=nt_zaero, & nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw) call icepack_warnings_flush(nu_diag) @@ -170,6 +174,7 @@ subroutine init_shortwave ! Initialize !----------------------------------------------------------------- + allocate(rsnow(nslyr,ncat)) allocate(ztrcr_sw(nbtrcr_sw, ncat)) fswpenln(:,:,:) = c0 @@ -223,10 +228,12 @@ subroutine init_shortwave call icedrv_system_abort(i, istep1, subname, __FILE__, __LINE__) endif - fbri(:) = c0 - ztrcr_sw(:,:) = c0 + fbri (:) = c0 + rsnow (:,:) = c0 + ztrcr_sw (:,:) = c0 do n = 1, ncat - if (tr_brine) fbri(n) = trcrn(i,nt_fbri,n) + if (tr_brine) fbri (n) = trcrn(i,nt_fbri,n) + if (snwgrain) rsnow (:,n) = trcrn(i,nt_rsnw:nt_rsnw+nslyr-1,n) enddo if (tmask(i)) then @@ -276,6 +283,7 @@ subroutine init_shortwave albpndn=albpndn(i,:), apeffn=apeffn(i,:), & snowfracn=snowfracn(i,:), & dhsn=dhsn(i,:), ffracn=ffracn(i,:), & + rsnow=rsnow(:,:), & l_print_point=l_print_point, & initonly = .true.) endif @@ -349,6 +357,7 @@ subroutine init_shortwave enddo ! i + deallocate(rsnow) deallocate(ztrcr_sw) end subroutine init_shortwave @@ -999,20 +1008,20 @@ subroutine init_zbgc open (nu_nml, file=trim(nml_filename), status='old',iostat=nml_error) if (nml_error /= 0) then - nml_error = -1 - else - nml_error = 1 + print*,'error opening zbgc namelist file '//trim(nml_filename) + call icedrv_system_abort(file=__FILE__,line=__LINE__) endif + nml_error = 1 print*,'Reading zbgc_nml' do while (nml_error > 0) read(nu_nml, nml=zbgc_nml,iostat=nml_error) end do - if (nml_error == 0) close(nu_nml) if (nml_error /= 0) then print*,'error reading zbgc namelist' call icedrv_system_abort(file=__FILE__,line=__LINE__) endif + close(nu_nml) !----------------------------------------------------------------- ! resolve conflicts diff --git a/configuration/driver/icedrv_restart.F90 b/configuration/driver/icedrv_restart.F90 index 677d28cf3..78337681b 100644 --- a/configuration/driver/icedrv_restart.F90 +++ b/configuration/driver/icedrv_restart.F90 @@ -16,12 +16,14 @@ module icedrv_restart use icedrv_system, only: icedrv_system_abort implicit none - private :: write_restart_pond_topo, read_restart_pond_topo, & + private :: & write_restart_age, read_restart_age, & write_restart_FY, read_restart_FY, & write_restart_lvl, read_restart_lvl, & write_restart_pond_cesm, read_restart_pond_cesm, & write_restart_pond_lvl, read_restart_pond_lvl, & + write_restart_pond_topo, read_restart_pond_topo, & + write_restart_snow, read_restart_snow, & write_restart_fsd, read_restart_fsd, & write_restart_iso, read_restart_iso, & write_restart_aero, read_restart_aero @@ -63,7 +65,7 @@ subroutine dumpfile logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_brine, & - tr_pond_topo, tr_pond_cesm, tr_pond_lvl, tr_fsd + tr_pond_topo, tr_pond_cesm, tr_pond_lvl, tr_snow, tr_fsd ! solve_zsal, skl_bgc, z_tracers character(len=char_len_long) :: filename @@ -83,7 +85,7 @@ subroutine dumpfile tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, tr_iso_out=tr_iso, & tr_brine_out=tr_brine, & tr_pond_topo_out=tr_pond_topo, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_lvl_out=tr_pond_lvl,tr_fsd_out=tr_fsd) + tr_pond_lvl_out=tr_pond_lvl,tr_snow_out=tr_snow,tr_fsd_out=tr_fsd) ! call icepack_query_parameters(solve_zsal_out=solve_zsal, & ! skl_bgc_out=skl_bgc, z_tracers_out=z_tracers) call icepack_warnings_flush(nu_diag) @@ -138,6 +140,7 @@ subroutine dumpfile if (tr_pond_cesm) call write_restart_pond_cesm() ! CESM melt ponds if (tr_pond_lvl) call write_restart_pond_lvl() ! level-ice melt ponds if (tr_pond_topo) call write_restart_pond_topo() ! topographic melt ponds + if (tr_snow) call write_restart_snow() ! snow metamorphosis tracers if (tr_iso) call write_restart_iso() ! ice isotopes if (tr_aero) call write_restart_aero() ! ice aerosols if (tr_brine) call write_restart_hbrine() ! brine height @@ -179,7 +182,7 @@ subroutine restartfile (ice_ic) logical (kind=log_kind) :: & tr_iage, tr_FY, tr_lvl, tr_iso, tr_aero, tr_brine, & - tr_pond_topo, tr_pond_cesm, tr_pond_lvl, tr_fsd + tr_pond_topo, tr_pond_cesm, tr_pond_lvl, tr_snow, tr_fsd character(len=char_len_long) :: filename character(len=*), parameter :: subname='(restartfile)' @@ -202,7 +205,7 @@ subroutine restartfile (ice_ic) tr_lvl_out=tr_lvl, tr_aero_out=tr_aero, tr_iso_out=tr_iso, & tr_brine_out=tr_brine, & tr_pond_topo_out=tr_pond_topo, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_lvl_out=tr_pond_lvl,tr_fsd_out=tr_fsd) + tr_pond_lvl_out=tr_pond_lvl,tr_snow_out=tr_snow,tr_fsd_out=tr_fsd) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -265,6 +268,7 @@ subroutine restartfile (ice_ic) if (tr_pond_cesm) call read_restart_pond_cesm() ! CESM melt ponds if (tr_pond_lvl) call read_restart_pond_lvl() ! level-ice melt ponds if (tr_pond_topo) call read_restart_pond_topo() ! topographic melt ponds + if (tr_snow) call read_restart_snow() ! snow metamorphosis tracers if (tr_iso) call read_restart_iso() ! ice isotopes if (tr_aero) call read_restart_aero() ! ice aerosols if (tr_brine) call read_restart_hbrine ! brine height @@ -463,6 +467,66 @@ end subroutine read_restart_pond_topo !======================================================================= +! Dumps values needed to restart snow redistribution/metamorphism tracers +! +! authors Elizabeth C. Hunke, LANL + + subroutine write_restart_snow() + + use icedrv_state, only: trcrn + use icedrv_domain_size, only: nslyr, ncat + + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw, k + character(len=*), parameter :: subname='(write_restart_snow)' + + call icepack_query_tracer_indices(nt_smice_out=nt_smice, & + nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + do k=1,nslyr + call write_restart_field(nu_dump,trcrn(:,nt_smice+k-1,:),ncat) + call write_restart_field(nu_dump,trcrn(:,nt_smliq+k-1,:),ncat) + call write_restart_field(nu_dump,trcrn(:,nt_rhos +k-1,:),ncat) + call write_restart_field(nu_dump,trcrn(:,nt_rsnw +k-1,:),ncat) + enddo + + end subroutine write_restart_snow + +!======================================================================= + +! Reads all values needed to restart snow redistribution/metamorphism +! +! authors Elizabeth C. Hunke, LANL + + subroutine read_restart_snow() + + use icedrv_state, only: trcrn + use icedrv_domain_size, only: nslyr, ncat + + integer (kind=int_kind) :: nt_smice, nt_smliq, nt_rhos, nt_rsnw, k + character(len=*), parameter :: subname='(read_restart_snow)' + + call icepack_query_tracer_indices(nt_smice_out=nt_smice, & + nt_smliq_out=nt_smliq, nt_rhos_out=nt_rhos, nt_rsnw_out=nt_rsnw) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + write(nu_diag,*) 'min/max snow metamorphosis tracers' + + do k=1,nslyr + call read_restart_field(nu_restart,trcrn(:,nt_smice+k-1,:),ncat) + call read_restart_field(nu_restart,trcrn(:,nt_smliq+k-1,:),ncat) + call read_restart_field(nu_restart,trcrn(:,nt_rhos +k-1,:),ncat) + call read_restart_field(nu_restart,trcrn(:,nt_rsnw +k-1,:),ncat) + enddo + + end subroutine read_restart_snow + +!======================================================================= + ! Dumps all values needed for restarting ! author Elizabeth C. Hunke, LANL diff --git a/configuration/driver/icedrv_step.F90 b/configuration/driver/icedrv_step.F90 index 7d6b68c70..b807639bc 100644 --- a/configuration/driver/icedrv_step.F90 +++ b/configuration/driver/icedrv_step.F90 @@ -23,7 +23,7 @@ module icedrv_step public :: step_therm1, step_therm2, step_dyn_ridge, & prep_radiation, step_radiation, ocean_mixed_layer, & - update_state, biogeochemistry, step_dyn_wave + update_state, biogeochemistry, step_dyn_wave, step_snow !======================================================================= @@ -108,6 +108,7 @@ subroutine step_therm1 (dt) use icedrv_arrays_column, only: hkeel, dkeel, lfloe, dfloe use icedrv_arrays_column, only: fswsfcn, fswintn, Sswabsn, Iswabsn use icedrv_arrays_column, only: fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf + use icedrv_arrays_column, only: meltsliqn, meltsliq use icedrv_calendar, only: yday use icedrv_domain_size, only: ncat, nilyr, nslyr, n_aero, n_iso, nx use icedrv_flux, only: frzmlt, sst, Tf, strocnxT, strocnyT, rside, fside, & @@ -115,7 +116,7 @@ subroutine step_therm1 (dt) use icedrv_flux, only: meltsn, melttn, meltbn, congeln, snoicen, uatm, vatm use icedrv_flux, only: wind, rhoa, potT, Qa, Qa_iso, zlvl, strax, stray, flatn use icedrv_flux, only: fsensn, fsurfn, fcondtopn, fcondbotn - use icedrv_flux, only: flw, fsnow, fpond, sss, mlt_onset, frz_onset + use icedrv_flux, only: flw, fsnow, fpond, sss, mlt_onset, frz_onset, fsloss use icedrv_flux, only: frain, Tair, strairxT, strairyT, fsurf use icedrv_flux, only: fcondtop, fcondbot, fsens, fresh, fsalt, fhocn use icedrv_flux, only: flat, fswabs, flwout, evap, evaps, evapi @@ -123,7 +124,7 @@ subroutine step_therm1 (dt) use icedrv_flux, only: meltt, melts, meltb, congel, snoice use icedrv_flux, only: fswthru, fswthru_vdr, fswthru_vdf, fswthru_idr, fswthru_idf use icedrv_flux, only: flatn_f, fsensn_f, fsurfn_f, fcondtopn_f - use icedrv_flux, only: dsnown, faero_atm, faero_ocn + use icedrv_flux, only: dsnow, dsnown, faero_atm, faero_ocn use icedrv_flux, only: fiso_atm, fiso_ocn, fiso_evap use icedrv_flux, only: HDO_ocn, H2_16O_ocn, H2_18O_ocn use icedrv_init, only: lmask_n, lmask_s @@ -149,11 +150,10 @@ subroutine step_therm1 (dt) integer (kind=int_kind) :: & ntrcr, nt_apnd, nt_hpnd, nt_ipnd, nt_alvl, nt_vlvl, nt_Tsfc, & nt_iage, nt_FY, nt_qice, nt_sice, nt_qsno, & - nt_aero, nt_isosno, nt_isoice + nt_aero, nt_isosno, nt_isoice, nt_rsnw, nt_smice, nt_smliq logical (kind=log_kind) :: & - tr_iage, tr_FY, tr_aero, tr_iso, tr_pond, tr_pond_cesm, & - tr_pond_lvl, tr_pond_topo, calc_Tsfc + tr_iage, tr_FY, tr_aero, tr_iso, calc_Tsfc, tr_snow real (kind=dbl_kind), dimension(n_aero,2,ncat) :: & aerosno, aeroice ! kg/m^2 @@ -161,6 +161,9 @@ subroutine step_therm1 (dt) real (kind=dbl_kind), dimension(n_iso,ncat) :: & isosno, isoice ! kg/m^2 + real (kind=dbl_kind), dimension(nslyr,ncat) :: & + rsnwn, smicen, smliqn + real (kind=dbl_kind) :: & puny @@ -184,9 +187,7 @@ subroutine step_therm1 (dt) call icepack_query_tracer_flags( & tr_iage_out=tr_iage, tr_FY_out=tr_FY, & - tr_aero_out=tr_aero, tr_iso_out=tr_iso, & - tr_pond_out=tr_pond, tr_pond_cesm_out=tr_pond_cesm, & - tr_pond_lvl_out=tr_pond_lvl, tr_pond_topo_out=tr_pond_topo) + tr_aero_out=tr_aero, tr_iso_out=tr_iso, tr_snow_out=tr_snow) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -197,6 +198,7 @@ subroutine step_therm1 (dt) nt_iage_out=nt_iage, nt_FY_out=nt_FY, & nt_qice_out=nt_qice, nt_sice_out=nt_sice, & nt_aero_out=nt_aero, nt_qsno_out=nt_qsno, & + nt_rsnw_out=nt_rsnw, nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & nt_isosno_out=nt_isosno, nt_isoice_out=nt_isoice) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & @@ -209,6 +211,9 @@ subroutine step_therm1 (dt) aeroice(:,:,:) = c0 isosno (:,:) = c0 isoice (:,:) = c0 + rsnwn (:,:) = c0 + smicen (:,:) = c0 + smliqn (:,:) = c0 do i = 1, nx @@ -229,10 +234,11 @@ subroutine step_therm1 (dt) enddo ! i do i = 1, nx +!echmod do i = 3,3 if (tr_aero) then ! trcrn(nt_aero) has units kg/m^3 - do n=1,ncat - do k=1,n_aero + do n = 1, ncat + do k = 1, n_aero aerosno (k,:,n) = & trcrn(i,nt_aero+(k-1)*4 :nt_aero+(k-1)*4+1,n) & * vsnon_init(i,n) @@ -245,14 +251,24 @@ subroutine step_therm1 (dt) if (tr_iso) then ! trcrn(nt_isosno/ice) has units kg/m^3 - do n=1,ncat - do k=1,n_iso + do n = 1, ncat + do k = 1, n_iso isosno(k,n) = trcrn(i,nt_isosno+k-1,n) * vsnon_init(i,n) isoice(k,n) = trcrn(i,nt_isoice+k-1,n) * vicen_init(i,n) enddo enddo endif ! tr_iso - + + if (tr_snow) then + do n = 1, ncat + do k = 1, nslyr + rsnwn (k,n) = trcrn(i,nt_rsnw +k-1,n) + smicen(k,n) = trcrn(i,nt_smice+k-1,n) + smliqn(k,n) = trcrn(i,nt_smliq+k-1,n) + enddo + enddo + endif ! tr_snow + call icepack_step_therm1(dt=dt, ncat=ncat, nilyr=nilyr, nslyr=nslyr, & aicen_init = aicen_init(i,:), & vicen_init = vicen_init(i,:), & @@ -272,6 +288,9 @@ subroutine step_therm1 (dt) ipnd = trcrn(i,nt_ipnd,:), & iage = trcrn(i,nt_iage,:), & FY = trcrn(i,nt_FY,:), & + rsnwn = rsnwn (:,:), & + smicen = smicen(:,:), & + smliqn = smliqn(:,:), & aerosno = aerosno(:,:,:), & aeroice = aeroice(:,:,:), & isosno = isosno(:,:), & @@ -306,7 +325,7 @@ subroutine step_therm1 (dt) Tbot = Tbot(i), Tsnice = Tsnice(i), & rside = rside(i), fside = fside(i), & fsnow = fsnow(i), frain = frain(i), & - fpond = fpond(i), & + fpond = fpond(i), fsloss = fsloss(i), & fsurf = fsurf(i), fsurfn = fsurfn(i,:), & fcondtop = fcondtop(i), fcondtopn = fcondtopn(i,:), & fcondbot = fcondbot(i), fcondbotn = fcondbotn(i,:), & @@ -346,7 +365,8 @@ subroutine step_therm1 (dt) melts = melts(i), meltsn = meltsn(i,:), & congel = congel(i), congeln = congeln(i,:), & snoice = snoice(i), snoicen = snoicen(i,:), & - dsnown = dsnown(i,:), & + dsnow = dsnow(i), dsnown = dsnown(i,:), & + meltsliqn= meltsliqn(i,:), & lmask_n = lmask_n(i), lmask_s = lmask_s(i), & mlt_onset=mlt_onset(i), frz_onset = frz_onset(i), & yday = yday, prescribed_ice = prescribed_ice) @@ -377,6 +397,16 @@ subroutine step_therm1 (dt) enddo endif ! tr_iso + if (tr_snow) then + do n = 1, ncat + do k = 1, nslyr + trcrn(i,nt_rsnw +k-1,n) = rsnwn (k,n) + trcrn(i,nt_smice+k-1,n) = smicen(k,n) + trcrn(i,nt_smliq+k-1,n) = smliqn(k,n) + enddo + enddo + endif ! tr_snow + enddo ! i call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & @@ -522,14 +552,16 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) use icepack_intfc, only: icepack_aggregate real (kind=dbl_kind), intent(in) :: & - dt , & ! time step - offset ! d(age)/dt time offset = dt for thermo, 0 for dyn + dt ! time step - real (kind=dbl_kind), dimension(:), intent(inout) :: & + real (kind=dbl_kind), dimension(:), intent(inout), optional :: & daidt, & ! change in ice area per time step dvidt, & ! change in ice volume per time step dagedt ! change in ice age per time step + real (kind=dbl_kind), intent(in), optional :: & + offset ! d(age)/dt time offset = dt for thermo, 0 for dyn + integer (kind=int_kind) :: & i, & ! horizontal indices ntrcr, & ! @@ -580,6 +612,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) nt_strata=nt_strata (1:ntrcr,:)) endif + if (present(offset)) then + !----------------------------------------------------------------- ! Compute thermodynamic area and volume tendencies. !----------------------------------------------------------------- @@ -595,7 +629,8 @@ subroutine update_state (dt, daidt, dvidt, dagedt, offset) dagedt(i) = (trcr(i,nt_iage) & - dagedt(i)) / dt endif - endif + endif ! tr_iage + endif ! present(offset) enddo ! i !$OMP END PARALLEL DO @@ -804,6 +839,74 @@ subroutine step_dyn_ridge (dt, ndtd) end subroutine step_dyn_ridge +!======================================================================= +! +! Updates snow tracers +! +! authors: Elizabeth C. Hunke, LANL +! Nicole Jeffery, LANL + + subroutine step_snow (dt) + + use icedrv_domain_size, only: ncat, nslyr, nilyr, nx + use icedrv_flux, only: wind, fresh, fhocn, fsloss, fsnow + use icedrv_state, only: trcrn, vsno, vsnon, vicen, aicen, aice + use icepack_intfc, only: icepack_step_snow + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + + ! local variables + + integer (kind=int_kind) :: & + nt_smice, nt_smliq, nt_rsnw, & + nt_Tsfc, nt_qice, nt_sice, nt_qsno, & + nt_alvl, nt_vlvl, nt_rhos + + integer (kind=int_kind) :: & + i, & ! horizontal index + n ! category index + + character(len=*), parameter :: subname='(step_snow)' + + !----------------------------------------------------------------- + ! query icepack values + !----------------------------------------------------------------- + + call icepack_query_tracer_indices( & + nt_smice_out=nt_smice, nt_smliq_out=nt_smliq, & + nt_rsnw_out=nt_rsnw, nt_Tsfc_out=nt_Tsfc, & + nt_qice_out=nt_qice, nt_sice_out=nt_sice, nt_qsno_out=nt_qsno, & + nt_alvl_out=nt_alvl, nt_vlvl_out=nt_vlvl, nt_rhos_out=nt_rhos) + call icepack_warnings_flush(nu_diag) + if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & + file=__FILE__,line= __LINE__) + + !----------------------------------------------------------------- + ! Snow redistribution and metamorphosis + !----------------------------------------------------------------- + + do i = 1, nx + + call icepack_step_snow (dt, nilyr, & + nslyr, ncat, & + wind (i), aice (i), & + aicen(i,:), vicen (i,:), & + vsnon(i,:), trcrn(i,nt_Tsfc,:), & + trcrn(i,nt_qice,:), & ! top layer only + trcrn(i,nt_sice,:), & ! top layer only + trcrn(i,nt_qsno:nt_qsno+nslyr-1,:), & + trcrn(i,nt_alvl,:), trcrn(i,nt_vlvl,:), & + trcrn(i,nt_smice:nt_smice+nslyr-1,:), & + trcrn(i,nt_smliq:nt_smliq+nslyr-1,:), & + trcrn(i,nt_rsnw:nt_rsnw+nslyr-1,:), & + trcrn(i,nt_rhos:nt_rhos+nslyr-1,:), & + fresh (i), fhocn (i), & + fsloss (i), fsnow (i)) + enddo + + end subroutine step_snow + !======================================================================= ! ! Computes radiation fields @@ -841,19 +944,20 @@ subroutine step_radiation (dt) integer (kind=int_kind) :: & max_aero, max_algae, nt_Tsfc, nt_alvl, & nt_apnd, nt_hpnd, nt_ipnd, nt_aero, nlt_chl_sw, & - ntrcr, nbtrcr_sw, nt_fbri + ntrcr, nbtrcr_sw, nt_fbri, nt_rsnw integer (kind=int_kind), dimension(:), allocatable :: & nlt_zaero_sw, nt_zaero, nt_bgc_N logical (kind=log_kind) :: & - tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero + tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero, snwgrain real (kind=dbl_kind), dimension(ncat) :: & - fbri ! brine height to ice thickness + fbri ! brine height to ice thickness real(kind= dbl_kind), dimension(:,:), allocatable :: & - ztrcr_sw + rsnow , & ! snow grain radius + ztrcr_sw ! BGC tracers affecting radiation logical (kind=log_kind) :: & l_print_point ! flag for printing debugging information @@ -888,28 +992,33 @@ subroutine step_radiation (dt) nt_Tsfc_out=nt_Tsfc, nt_alvl_out=nt_alvl, nt_apnd_out=nt_apnd, & nt_hpnd_out=nt_hpnd, nt_ipnd_out=nt_ipnd, nt_aero_out=nt_aero, & nlt_chl_sw_out=nlt_chl_sw, nlt_zaero_sw_out=nlt_zaero_sw, & + nt_rsnw_out=nt_rsnw, & nt_fbri_out=nt_fbri, nt_zaero_out=nt_zaero, nt_bgc_N_out=nt_bgc_N) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) - call icepack_query_parameters(dEdd_algae_out=dEdd_algae, modal_aero_out=modal_aero) + call icepack_query_parameters(dEdd_algae_out=dEdd_algae, modal_aero_out=modal_aero, & + snwgrain_out=snwgrain) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) !----------------------------------------------------------------- + allocate(rsnow(nslyr,ncat)) allocate(ztrcr_sw(nbtrcr_sw,ncat)) l_print_point = .false. do i = 1, nx - fbri(:) = c0 - ztrcr_sw(:,:) = c0 + fbri (:) = c0 + rsnow (:,:) = c0 + ztrcr_sw (:,:) = c0 do n = 1, ncat - if (tr_brine) fbri(n) = trcrn(i,nt_fbri,n) + if (tr_brine) fbri (n) = trcrn(i,nt_fbri,n) + if (snwgrain) rsnow (:,n) = trcrn(i,nt_rsnw:nt_rsnw+nslyr-1,n) enddo if (tmask(i)) then @@ -955,6 +1064,7 @@ subroutine step_radiation (dt) albpndn=albpndn(i,:), apeffn=apeffn(i,:), & snowfracn=snowfracn(i,:), & dhsn=dhsn(i,:), ffracn=ffracn(i,:), & + rsnow=rsnow(:,:), & l_print_point=l_print_point) endif ! tmask @@ -972,6 +1082,7 @@ subroutine step_radiation (dt) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__, line=__LINE__) + deallocate(rsnow) deallocate(ztrcr_sw) deallocate(nlt_zaero_sw) deallocate(nt_zaero) diff --git a/configuration/scripts/Makefile b/configuration/scripts/Makefile index 5041310ec..0407d917c 100644 --- a/configuration/scripts/Makefile +++ b/configuration/scripts/Makefile @@ -68,6 +68,7 @@ OBJS := $(addsuffix .o, $(sort $(basename $(notdir $(SRCS))))) DEPS := $(addsuffix .d, $(sort $(basename $(notdir $(SRCS))))) INCS := $(patsubst %,-I%, $(VPATH) ) RM := rm +MODDIR:= -I. .SUFFIXES: .SUFFIXES: .F90 .F .c .o @@ -95,15 +96,16 @@ db_files: @echo "* VPATH := $(VPATH)" @echo "* SRCFILE := $(SRCFILE)" @echo "* INCS := $(INCS)" + @echo "* MODDIR := $(MODDIR)" @echo "* SRCS := $(SRCS)" @echo "* OBJS := $(OBJS)" @echo "* DEPS := $(DEPS)" db_flags: @echo " " - @echo "* cpp := $(CPP) $(CPPFLAGS) $(CPPDEFS) $(INCS) $(INCLDIR)" - @echo "* cc := cc -c $(CFLAGS) $(INCS) $(INCLDIR)" - @echo "* .F.o := $(FC) -c $(FFLAGS) $(FIXEDFLAGS) $(INCS) $(INCLDIR)" - @echo "* .F90.o := $(FC) -c $(FFLAGS) $(FREEFLAGS) $(INCS) $(INCLDIR)" + @echo "* cpp := $(CPP) $(CPPFLAGS) $(CPPDEFS) $(INCLDIR)" + @echo "* cc := $(CC) -c $(CFLAGS) $(INCLDIR)" + @echo "* .F.o := $(FC) -c $(FFLAGS) $(FIXEDFLAGS) $(INCLDIR)" + @echo "* .F90.o := $(FC) -c $(FFLAGS) $(FREEFLAGS) $(MODDIR) $(INCLDIR)" #------------------------------------------------------------------------------- # build rule for makdep: MACFILE, cmd-line, or env vars must provide @@ -121,13 +123,13 @@ $(EXEC): $(OBJS) $(LD) -o $(EXEC) $(LDFLAGS) $(OBJS) $(ULIBS) $(SLIBS) .c.o: - cc $(CFLAGS) $(CPPDEFS) $(INCS) $(INCLDIR) $< + $(CC) $(CFLAGS) $(CPPDEFS) $(INCLDIR) $< .F.o: - $(FC) -c $(FFLAGS) $(FIXEDFLAGS) $(CPPDEFS) $(INCS) $(INCLDIR) $< + $(FC) -c $(FFLAGS) $(FIXEDFLAGS) $(CPPDEFS) $(INCLDIR) $< .F90.o: - $(FC) -c $(FFLAGS) $(FREEFLAGS) $(CPPDEFS) $(INCS) $(INCLDIR) $< + $(FC) -c $(FFLAGS) $(FREEFLAGS) $(CPPDEFS) $(MODDIR) $(INCLDIR) $< mostlyclean: $(RM) -f *.f *.f90 diff --git a/configuration/scripts/icepack.build b/configuration/scripts/icepack.build index 24dc40c7d..43a47661b 100755 --- a/configuration/scripts/icepack.build +++ b/configuration/scripts/icepack.build @@ -24,7 +24,11 @@ endif if !(-d ${ICE_OBJDIR}) mkdir -p ${ICE_OBJDIR} cd ${ICE_OBJDIR} -setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DNXGLOB=${ICE_NXGLOB} -DNICELYR=${NICELYR} -DNSNWLYR=${NSNWLYR} -DNICECAT=${NICECAT} -DNFSDCAT=${NFSDCAT} -DTRAGE=${TRAGE} -DTRFY=${TRFY} -DTRLVL=${TRLVL} -DTRPND=${TRPND} -DTRBRI=${TRBRI} -DNTRISO=${NTRISO} -DNTRAERO=${NTRAERO} -DTRZS=${TRZS} -DNBGCLYR=${NBGCLYR} -DTRALG=${TRALG} -DTRBGCZ=${TRBGCZ} -DTRDOC=${TRDOC} -DTRDOC=${TRDOC} -DTRDIC=${TRDIC} -DTRDON=${TRDON} -DTRFED=${TRFED} -DTRFEP=${TRFEP} -DTRZAERO=${TRZAERO} -DTRBGCS=${TRBGCS} " +setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DNXGLOB=${ICE_NXGLOB} -DNICELYR=${NICELYR} -DNSNWLYR=${NSNWLYR} -DNICECAT=${NICECAT} -DNFSDCAT=${NFSDCAT} -DTRAGE=${TRAGE} -DTRFY=${TRFY} -DTRLVL=${TRLVL} -DTRPND=${TRPND} -DTRSNOW=${TRSNOW} -DTRBRI=${TRBRI} -DNTRISO=${NTRISO} -DNTRAERO=${NTRAERO} -DTRZS=${TRZS} -DNBGCLYR=${NBGCLYR} -DTRALG=${TRALG} -DTRBGCZ=${TRBGCZ} -DTRDOC=${TRDOC} -DTRDOC=${TRDOC} -DTRDIC=${TRDIC} -DTRDON=${TRDON} -DTRFED=${TRFED} -DTRFEP=${TRFEP} -DTRZAERO=${TRZAERO} -DTRBGCS=${TRBGCS} " + +if (${ICE_IOTYPE} == 'netcdf') then + setenv ICE_CPPDEFS "${ICE_CPPDEFS} -DUSE_NETCDF" +endif ### List of source code directories (in order of importance). cat >! Filepath << EOF diff --git a/configuration/scripts/icepack.settings b/configuration/scripts/icepack.settings index 21d8468f5..dab7276fc 100755 --- a/configuration/scripts/icepack.settings +++ b/configuration/scripts/icepack.settings @@ -49,6 +49,7 @@ setenv TRAGE 1 # set to 1 for ice age tracer setenv TRFY 1 # set to 1 for first-year ice area tracer setenv TRLVL 1 # set to 1 for level and deformed ice tracers setenv TRPND 1 # set to 1 for melt pond tracers +setenv TRSNOW 0 # set to 1 for snow metamorphism tracers setenv NTRAERO 1 # number of aerosol tracers # (up to max_aero in ice_domain_size.F90) # CESM uses 3 aerosol tracers diff --git a/configuration/scripts/icepack_in b/configuration/scripts/icepack_in index 04f8aa408..ff5f4b166 100644 --- a/configuration/scripts/icepack_in +++ b/configuration/scripts/icepack_in @@ -13,6 +13,7 @@ dump_last = .false. diagfreq = 24 diag_file = 'ice_diag' + history_cdf = .false. cpl_bgc = .false. conserv_check = .false. / @@ -28,6 +29,7 @@ tr_pond_cesm = .false. tr_pond_topo = .false. tr_pond_lvl = .true. + tr_snow = .false. tr_aero = .false. tr_fsd = .false. tr_iso = .false. @@ -78,6 +80,21 @@ pndaspect = 0.8 / +&snow_nml + snwredist = 'none' + snwgrain = .false. + use_smliq_pnd = .false. + rsnw_fall = 100.0 + rsnw_tmax = 1500.0 + rhosnew = 100.0 + rhosmin = 100.0 + rhosmax = 450.0 + windmin = 10.0 + drhosdwind = 27.3 + snwlvlfac = 0.3 + snw_aging_table = 'test' +/ + &forcing_nml formdrag = .false. atmbndy = 'default' diff --git a/configuration/scripts/machines/Macros.badger_intel b/configuration/scripts/machines/Macros.badger_intel index c8488ab84..c572515b9 100644 --- a/configuration/scripts/machines/Macros.badger_intel +++ b/configuration/scripts/machines/Macros.badger_intel @@ -24,28 +24,23 @@ CC := $(SCC) FC := $(SFC) LD := $(FC) -# set in Macros file -NETCDF_PATH := /usr/projects/climate/SHARED_CLIMATE/software/conejo/netcdf/3.6.3/intel-13.0.1 -PNETCDF_PATH := /usr/projects/climate/SHARED_CLIMATE/software/conejo/parallel-netcdf/1.3.1/intel-13.0.1/openmpi-1.6.3 -#LAPACK_LIBDIR := /glade/apps/opt/lapack/3.4.2/intel/12.1.5/lib +NETCDF_PATH := /usr/projects/hpcsoft/toss3/common/netcdf/4.4.0_intel-18.0.5 +PNETCDF_PATH := /usr/projects/hpcsoft/toss3/badger/netcdf/4.4.0_intel-18.0.5_openmpi-2.1.2 PIO_CONFIG_OPTS:= --enable-filesystem-hints=gpfs ifeq ($(ICE_IOTYPE), netcdf) - INCLDIR := $(INCLDIR) -I$(NETCDF_PATH)/include -# INCLDIR := $(INCLDIR) -I/usr/projects/climate/SHARED_CLIMATE/software/conejo/netcdf/3.6.3/intel-13.0.1/include + INCLDIR := $(INCLDIR) -I$(NETCDF_PATH)/include -I$(PNETCDF_PATH)/include LIB_NETCDF := $(NETCDF_PATH)/lib LIB_PNETCDF := $(PNETCDF_PATH)/lib LIB_MPI := $(IMPILIBDIR) - #SLIBS := -L$(LIB_NETCDF) -lnetcdf -L$(LIB_PNETCDF) -lpnetcdf -L$(LAPACK_LIBDIR) -llapack -lblas - SLIBS := -L$(LIB_NETCDF) -lnetcdf -L$(LIB_PNETCDF) -lpnetcdf + SLIBS := -L$(LIB_NETCDF) -lnetcdf -L$(LIB_PNETCDF) -lnetcdff else SLIBS := endif - ifeq ($(ICE_THREADED), true) LDFLAGS += -qopenmp CFLAGS += -qopenmp diff --git a/configuration/scripts/machines/Macros.conda_macos b/configuration/scripts/machines/Macros.conda_macos index 583a37773..a9381791f 100644 --- a/configuration/scripts/machines/Macros.conda_macos +++ b/configuration/scripts/machines/Macros.conda_macos @@ -26,6 +26,9 @@ CC := $(SCC) FC := $(SFC) LD := $(FC) +# Location of the compiled Fortran modules (NetCDF) +MODDIR += -I$(CONDA_PREFIX)/include + # Location of the system C header files (required on recent macOS to compile makdep) SDKPATH = $(shell xcrun --show-sdk-path) ifeq ($(strip $(SDKPATH)),) @@ -35,6 +38,9 @@ else LD += -L$(SDKPATH)/usr/lib endif +# Libraries to be passed to the linker +SLIBS := -L$(CONDA_PREFIX)/lib -lnetcdf -lnetcdff + # Necessary flag to compile with OpenMP support ifeq ($(ICE_THREADED), true) LDFLAGS += -fopenmp diff --git a/configuration/scripts/machines/Macros.onyx_gnu b/configuration/scripts/machines/Macros.onyx_gnu index 9e455ab06..6a550a314 100644 --- a/configuration/scripts/machines/Macros.onyx_gnu +++ b/configuration/scripts/machines/Macros.onyx_gnu @@ -8,7 +8,7 @@ CFLAGS := -c -ffloat-store -march=native FIXEDFLAGS := -ffixed-line-length-132 FREEFLAGS := -ffree-form -FFLAGS := -ffloat-store -fconvert=swap -fbacktrace -march=native -ffree-line-length-none +FFLAGS := -ffloat-store -fconvert=swap -fbacktrace -march=native -ffree-line-length-none -fallow-argument-mismatch FFLAGS_NOOPT:= -O0 ifeq ($(ICE_BLDDEBUG), true) diff --git a/configuration/scripts/machines/env.badger_intel b/configuration/scripts/machines/env.badger_intel index 9239d2e84..4a1e5d668 100755 --- a/configuration/scripts/machines/env.badger_intel +++ b/configuration/scripts/machines/env.badger_intel @@ -12,6 +12,14 @@ if ("$inp" != "-nomodules") then #module purge #module load intel #module load openmpi +module unload hdf5-serial +module unload hdf5-parallel +module unload netcdf-serial +module unload netcdf-h5parallel +module load hdf5-serial +module load netcdf-serial/4.4.0 +module load hdf5-parallel +module load netcdf-h5parallel/4.4.0 setenv NETCDF_PATH /usr/projects/climate/SHARED_CLIMATE/software/conejo/netcdf/3.6.3/intel-13.0.1 setenv PNETCDF_PATH /usr/projects/climate/SHARED_CLIMATE/software/conejo/parallel-netcdf/1.3.1/intel-13.0.1/openmpi-1.6.3 @@ -29,7 +37,7 @@ endif setenv ICE_MACHINE_MACHNAME badger setenv ICE_MACHINE_MACHINFO "Penguin Intel Xeon Broadwell" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "(Note: can vary) ifort 19.0.4.243 20190416" +setenv ICE_MACHINE_ENVINFO "(Note: can vary) ifort 19.0.4.243 20190416, netcdf4.4.0" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR /net/scratch3/$user/ICEPACK_RUNS setenv ICE_MACHINE_INPUTDATA /usr/projects/climate/eclare/DATA/Consortium diff --git a/configuration/scripts/machines/env.onyx_cray b/configuration/scripts/machines/env.onyx_cray index 5bdfda727..8080bc0e0 100755 --- a/configuration/scripts/machines/env.onyx_cray +++ b/configuration/scripts/machines/env.onyx_cray @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-cray/6.0.4 +module load PrgEnv-cray/6.0.9 module unload cce -module load cce/8.6.4 +module load cce/11.0.2 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.6.3 +module load cray-mpich/7.7.16 module unload netcdf module unload cray-netcdf @@ -28,10 +28,11 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.4.1.1.3 -module load cray-hdf5/1.10.0.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci +module unload craype-hugepages2M module load craype-broadwell @@ -44,7 +45,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME cray -setenv ICE_MACHINE_ENVINFO "Cray cce/8.6.4" +setenv ICE_MACHINE_ENVINFO "Cray cce/11.0.2" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/ICEPACK_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/env.onyx_gnu b/configuration/scripts/machines/env.onyx_gnu index 03d16f3c9..efa93a3b4 100755 --- a/configuration/scripts/machines/env.onyx_gnu +++ b/configuration/scripts/machines/env.onyx_gnu @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-gnu/6.0.4 +module load PrgEnv-gnu/6.0.9 module unload gcc -module load gcc/7.2.0 +module load gcc/10.2.0 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.6.2 +module load cray-mpich/7.7.16 module unload netcdf module unload cray-netcdf @@ -28,10 +28,11 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.4.1.1.3 -module load cray-hdf5/1.10.0.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci +module unload craype-hugepages2M module load craype-broadwell @@ -44,7 +45,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME gnu -setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 7.2.0 20170814" +setenv ICE_MACHINE_ENVINFO "GNU Fortran (GCC) 10.2.0" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/ICEPACK_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/env.onyx_intel b/configuration/scripts/machines/env.onyx_intel index c807a375d..ae452081d 100755 --- a/configuration/scripts/machines/env.onyx_intel +++ b/configuration/scripts/machines/env.onyx_intel @@ -13,14 +13,14 @@ module unload PrgEnv-cray module unload PrgEnv-gnu module unload PrgEnv-intel module unload PrgEnv-pgi -module load PrgEnv-intel/6.0.4 +module load PrgEnv-intel/6.0.9 module unload intel -module load intel/17.0.1.132 +module load intel/19.1.3.304 module unload cray-mpich module unload cray-mpich2 -module load cray-mpich/7.6.2 +module load cray-mpich/7.7.16 module unload netcdf module unload cray-netcdf @@ -28,10 +28,11 @@ module unload cray-hdf5 module unload cray-hdf5-parallel module unload cray-netcdf-hdf5parallel module unload cray-parallel-netcdf -module load cray-netcdf/4.4.1.1.3 -module load cray-hdf5/1.10.0.3 +module load cray-netcdf/4.7.4.0 +module load cray-hdf5/1.12.0.0 module unload cray-libsci +module unload craype-hugepages2M module load craype-broadwell @@ -44,7 +45,7 @@ endif setenv ICE_MACHINE_MACHNAME onyx setenv ICE_MACHINE_MACHINFO "Cray XC40/50 Xeon E5-2699v4 Broadwell" setenv ICE_MACHINE_ENVNAME intel -setenv ICE_MACHINE_ENVINFO "ifort 17.0.1 20161005" +setenv ICE_MACHINE_ENVINFO "ifort 19.1.3.304" setenv ICE_MACHINE_MAKE gmake setenv ICE_MACHINE_WKDIR $WORKDIR/ICEPACK_RUNS setenv ICE_MACHINE_INPUTDATA /p/app/unsupported/RASM/cice_consortium diff --git a/configuration/scripts/machines/environment.yml b/configuration/scripts/machines/environment.yml index c63ccbf5b..dfbcaf85e 100644 --- a/configuration/scripts/machines/environment.yml +++ b/configuration/scripts/machines/environment.yml @@ -5,6 +5,8 @@ channels: dependencies: # Build dependencies - compilers + - netcdf-fortran + - netcdf4 - make # Python dependencies for building the HTML documentation - sphinx diff --git a/configuration/scripts/options/set_env.ionetcdf b/configuration/scripts/options/set_env.ionetcdf new file mode 100644 index 000000000..1824dde94 --- /dev/null +++ b/configuration/scripts/options/set_env.ionetcdf @@ -0,0 +1 @@ +setenv ICE_IOTYPE netcdf diff --git a/configuration/scripts/options/set_env.snw30percent b/configuration/scripts/options/set_env.snw30percent new file mode 100644 index 000000000..c84089602 --- /dev/null +++ b/configuration/scripts/options/set_env.snw30percent @@ -0,0 +1,5 @@ +setenv NSNWLYR 5 # number of vertical layers in the snow +setenv TRSNOW 1 # set to 1 for advanced snow physics tracers + + + diff --git a/configuration/scripts/options/set_env.snwITDrdg b/configuration/scripts/options/set_env.snwITDrdg new file mode 100644 index 000000000..5c9a34b8a --- /dev/null +++ b/configuration/scripts/options/set_env.snwITDrdg @@ -0,0 +1,3 @@ +setenv NSNWLYR 5 # number of vertical layers in the snow +setenv TRSNOW 1 # set to 1 for advanced snow physics tracers + diff --git a/configuration/scripts/options/set_env.snwgrain b/configuration/scripts/options/set_env.snwgrain new file mode 100644 index 000000000..5c9a34b8a --- /dev/null +++ b/configuration/scripts/options/set_env.snwgrain @@ -0,0 +1,3 @@ +setenv NSNWLYR 5 # number of vertical layers in the snow +setenv TRSNOW 1 # set to 1 for advanced snow physics tracers + diff --git a/configuration/scripts/options/set_nml.ionetcdf b/configuration/scripts/options/set_nml.ionetcdf new file mode 100644 index 000000000..6aaa620e7 --- /dev/null +++ b/configuration/scripts/options/set_nml.ionetcdf @@ -0,0 +1 @@ +history_cdf = .true. diff --git a/configuration/scripts/options/set_nml.snw30percent b/configuration/scripts/options/set_nml.snw30percent new file mode 100644 index 000000000..7461f2b44 --- /dev/null +++ b/configuration/scripts/options/set_nml.snw30percent @@ -0,0 +1,5 @@ +tr_snow = .true. +snwredist = 'bulk' +snwlvlfac = 0.3 + + diff --git a/configuration/scripts/options/set_nml.snwITDrdg b/configuration/scripts/options/set_nml.snwITDrdg new file mode 100644 index 000000000..c802c51fe --- /dev/null +++ b/configuration/scripts/options/set_nml.snwITDrdg @@ -0,0 +1,9 @@ +tr_snow = .true. +snwredist = 'ITDrdg' +nslyr = 5 +rhosnew = 100.0 +rhosmin = 100.0 +rhosmax = 450.0 +windmin = 10.0 +drhosdwind = 27.3 +snwlvlfac = 0.3 diff --git a/configuration/scripts/options/set_nml.snwgrain b/configuration/scripts/options/set_nml.snwgrain new file mode 100644 index 000000000..386a3238b --- /dev/null +++ b/configuration/scripts/options/set_nml.snwgrain @@ -0,0 +1,6 @@ +tr_snow = .true. +snwgrain = .true. +use_smliq_pnd = .true. +rsnw_fall = 54.526 +rsnw_tmax = 1500.0 + diff --git a/configuration/scripts/setup_run_dirs.csh b/configuration/scripts/setup_run_dirs.csh index a034bfbf8..e9001347f 100755 --- a/configuration/scripts/setup_run_dirs.csh +++ b/configuration/scripts/setup_run_dirs.csh @@ -7,7 +7,7 @@ if !(-d ${ICE_RUNDIR}) then echo "mkdir ${ICE_RUNDIR}" mkdir -p ${ICE_RUNDIR} endif -#if !(-d ${ICE_HSTDIR}) mkdir -p ${ICE_HSTDIR} +if !(-d ${ICE_HSTDIR}) mkdir -p ${ICE_HSTDIR} if !(-d ${ICE_RSTDIR}) mkdir -p ${ICE_RSTDIR} exit 0 diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index 3f1c4572a..fb1840b9f 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -16,6 +16,8 @@ smoke col 1x1 debug,run1year,leap,dt30min smoke col 1x1 debug,run1year,dyn smoke col 1x1 debug,run1year,fsd12 smoke col 1x1 debug,run1year,fsd1 +smoke col 1x1 debug,run1year,snw30percent,snwgrain +smoke col 1x1 debug,run1year,snwITDrdg smoke col 1x1 debug,run1year,calcdragio restart col 1x1 debug restart col 1x1 diag1 @@ -33,4 +35,5 @@ restart col 1x1 alt03 restart col 1x1 alt04 restart col 1x1 dyn restart col 1x1 fsd12 +restart col 1x1 snwITDrdg,snwgrain diff --git a/configuration/scripts/tests/io_suite.ts b/configuration/scripts/tests/io_suite.ts new file mode 100644 index 000000000..2af2980d5 --- /dev/null +++ b/configuration/scripts/tests/io_suite.ts @@ -0,0 +1,2 @@ +restart col 1x1 debug,ionetcdf +smoke col 1x1 run1year,diag1,ionetcdf diff --git a/doc/source/conf.py b/doc/source/conf.py index 37dc338bd..d236074d0 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -62,9 +62,9 @@ # built documents. # # The short X.Y version. -version = u'1.2.5' +version = u'1.3.0' # The full version, including alpha/beta/rc tags. -version = u'1.2.5' +version = u'1.3.0' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. diff --git a/doc/source/icepack_index.rst b/doc/source/icepack_index.rst index 601c54310..293ddd797 100755 --- a/doc/source/icepack_index.rst +++ b/doc/source/icepack_index.rst @@ -210,6 +210,7 @@ either Celsius or Kelvin units). "highfreq", ":math:`\bullet` high-frequency atmo coupling", "F" "hin_old", "ice thickness prior to growth/melt", "m" "hin_max", "category thickness limits", "m" + "history_cdf", "flag to turn on netcdf history output", "F" "hmix", "ocean mixed layer depth", "20. m" "hour", "hour of the year", "" "hp0", "pond depth at which shortwave transition to bare ice occurs", "0.2 m" @@ -413,7 +414,13 @@ either Celsius or Kelvin units). "shortwave", ":math:`\bullet` flag for shortwave parameterization ('default' or 'dEdd')", "" "sil", "silicate concentration", "mmol/m\ :math:`^3`" "sk_l", "skeletal layer thickness", "0.03 m" - "snoice", "snow-ice formation", "m" + "snowage_drdt0", "snowage table 3D data for drdt0 (10^-6 m/hr)", "" + "snowage_kappa", "snowage table 3D data for kappa (10^-6 m)", "" + "snowage_rhos", "snowage table dimension data for rhos (kg/m^3)", "" + "snowage_T", "snowage table dimension data for temperature (deg K)", "" + "snowage_tau", "snowage table 3D data for tau (10^-6 m)", "" + "snowage_Tgrd", "snowage table dimension data for temp gradient (deg K/m)", "" + "snoice"", "snow-ice formation", "m"" "snowpatch", "length scale for parameterizing nonuniform snow coverage", "0.02 m" "skl_bgc", ":math:`\bullet` biogeochemistry on/off", "" "spval", "special value (single precision)", ":math:`10^{30}`", "" diff --git a/doc/source/master_list.bib b/doc/source/master_list.bib index 6aba6a416..29f3c4a4d 100644 --- a/doc/source/master_list.bib +++ b/doc/source/master_list.bib @@ -753,6 +753,44 @@ @article{danabasoglu20 year = {2020} } +@Article{Sturm02, + author = "M. Sturm and J. Holmgren and D. K. Perovich", + title = "{Winter snow cover on the sea ice of the Arctic Ocean at the Surface Heat Budget of the Arctic Ocean (SHEBA): Temporal evolution and spatial variability}", + journal = JGRO, + year = {2002}, + volume = {107}, + issue = {C10}, + url = {https://doi.org/10.1029/2000JC000400} +} + +@Article{Lecomte13, + author = "O. Lecomte and T. Fichefet and M. Vancoppenolle and F. Domine and F. Massonet and P. Mathiot and S. Morin and P. Y. Barriat", + title = "{On the formulation of snow thermal conductivity in large-scale sea ice models}", + journal = JAMES, + year = {2013}, + volume = {5}, + issue = {3}, + pages = {542-557}, + url = {https://doi.org/10.1002/jame.20039} +} + +@Article{Lecomte15, + author = "O. Lecomte and T. Fichefet and D. Flocco and D. Schroeder and M. Vancoppenolle", + title = "{Interactions between wind-blown snow redistribution and melt ponds in a coupled ocean-sea ice model}", + journal = OM, + year = {2015}, + volume = {87}, + pages = {67-80}, + url = {https://doi.org/10.1016/j.ocemod.2014.12.003} +} + +@Manual{Oleson10, + author = "W. K. Oleson and D. M. Lawrence and G. B. Bonan and M. G. Flanner and E. Kluzek and P. J. Lawrence and S. Levis and S. C. Swenson and P. E. Thornton", + title = "{Technical description of version 4.0 of the Community Land Model (CLM)}", + organization = "NCAR Technical Note NCAR/TN-478+STR, National Center for Atmospheric Research", + year = {2019}, + url = {https://opensky.ucar.edu/islandora/object/technotes:493} +} % ********************************************** diff --git a/doc/source/science_guide/index.rst b/doc/source/science_guide/index.rst index 0ef243883..eafffde1f 100755 --- a/doc/source/science_guide/index.rst +++ b/doc/source/science_guide/index.rst @@ -17,5 +17,6 @@ Science Guide sg_transport.rst sg_mechanical.rst sg_thermo.rst + sg_snow.rst sg_bgc.rst diff --git a/doc/source/science_guide/sg_snow.rst b/doc/source/science_guide/sg_snow.rst new file mode 100755 index 000000000..7b0ea3dce --- /dev/null +++ b/doc/source/science_guide/sg_snow.rst @@ -0,0 +1,146 @@ +:tocdepth: 3 + +.. _snow: + +Advanced snow physics +===================== + +Once deposited, the character and distribution of snow on sea ice depend on re-transport (wind), melting/wetting, and metamorphism (chiefly producing low-conductivity depth hoar or snow-ice). Each of these processes affects the other, and they are crucial for the evolution of the sea ice pack :cite:`Sturm02`. In particular, Wind slab and depth hoar resist densification, and Wind slab may prevent snow from drifting after deposition. Snow drifts around ridges cover only 6% of the ice surface area and are about 30% deeper than other snow-covered areas, but they prevent seawater filled cracks around the ridges from freezing, with important biological consequences. + +The standard model configuration includes a basic snow formulation describing the essential effects of snow on sea ice, such as its albedo, vertical conduction, and growth/melt processes. It also incorporates more detailed processes such as snow-ice formation due to flooding and snow infiltration by melt water, which may form melt ponds. Several potentially important processes are not included in the standard configuration, such as compaction and redistribution of snow by wind and their effects on the thermal balance and on effective roughness. Snow metamorphism due to temperature gradients and liquid water content also are not included. + +Setting ``tr_snow`` = ``.true.`` activates advanced snow physics parameterizations that represent the following processes, each of which has its own namelist flag for flexible configuration: + +1. Radiative effects of snow redistribution by wind with respect to ice topography, including snow loss to leads and snow compaction by wind + +2. Coupling effects associated with snow saturation and pond formation. + +3. Radiative effects of snow grain metamorphism (variable grain size) + +Snow can be scoured from level ice, blowing into leads or piling up on ridges. +The presence of liquid water in snow, such as rain or melt water, changes the surface albedo dramatically. It also alters the conductivity of the snow pack. These effects are associated mainly with the formation of depth hoar (change in grain size). + +The standard model configuration assumes that the snow depth is uniform across each ice thickness category within a grid cell for the vertical thermodynamic calculation. However, there are separate radiation calculations for bare ice, snow-covered ice, and pond-covered ice; snow and ponds interact through snow saturation levels. Redistributing the snow alters these radiative calculations. + +.. _snow_redistribution: + +Snow redistribution +------------------- + +Because the thermodynamic schemes in CICE assume a uniform snow depth over each category, ignoring the fractions of level and deformed ice, effects of snow redistribution are included only via the delta-Eddington radiation scheme. The redistributed snow depth is used to determine the effective area of bare ice (for very small snow depths) and the effective area and depth of melt ponds over level ice. Once those areas are determined, the redistributed snow volume over them is known, from which the snow depth for the remaining snow-covered area can be computed and used for its radiation balance calculation. + +Two basic approaches are available for snow redistribution by wind, ``snwredist`` = ``bulk``, for which a user-defined parameter :math:`p` (``snwlvlfac``) determines the ratio of snow on ridges to that on level ice, and ``snwITDrdg``, in which snow can be compacted by the wind or eroded and redeposited on other thickness categories. For both, nonlocal redistribution of snow (i.e., between grid cells) is neglected, assuming that the difference between snow mass blowing into a grid cell and that blowing out is negligible, but snow can be blown into nearby leads and open water. + + + +.. _snow_bulk: + +Bulk snow redistribution +~~~~~~~~~~~~~~~~~~~~~~~~ + +:cite:`Sturm02` noted that on average during the SHEBA experiment, snow near ridged ice was 30% deeper than snow on undeformed ice. Using this rule of thumb, we can reduce the amount of snow on level ice in the model by reducing the snowfall rate over the sea ice and assuming the removed snow volume passes into the ocean through leads, instantaneously. This approach takes into account the area of open water available, as in the original code, by employing a precipitation flux in units of kg m :math:`^{-2}` s :math:`^{-1}`, which accumulates snow only on the ice-covered area of the grid cell. + +This approach affects the simulation in two ways: (1) the snow removed from the level ice area is deposited into leads, and (2) using the snow remaining on the level ice area to adjust the effective melt pond and bare ice areas. Case (1) affects both the radiative and thermodynamic calculations by reducing the total amount of snow on the ice. Case (2) affects the radiative calculation directly, by possibly exposing more bare ice or melt ponds, but it affects the thermodynamic (conduction) calculation only through the altered radiative absorption, since the snow is always assumed to be equally deep over both level and deformed ice for the thermodynamic calculation. + +When ``snwredist`` = ``bulk``, snow loss to leads is accomplished simply by reducing the volume of snowfall reaching the ice: + +.. math:: + f_{s}^\prime = {f_s \left[ a_{lvl} \left({p\over{1+p}}\right)\right]}, + +where :math:`f_s` is the snowfall rate, :math:`a_{lvl}` is the average level-ice tracer value, and primed quantities represent their modified values. + +Snow is redistributed between level and ridged ice within a single thickness category by solving a pair of equations for the modified level- and ridged-ice snow depths in terms of the original snow depth: + +.. math:: + h_{lvl}^\prime = {1\over {1+p(1-a_{lvl})}} h_{lvl} + +.. math:: + h_{rdg}^\prime = {{1 + p}\over {1+p(1-a_{lvl})}} h_{lvl}. + +In the shortwave module for level-ice ponds, we create a new variable :math:`h_{lvl}^\prime` (``hsnlvl``) for snow depth over the level ice, and replace ``hsn`` with ``hsnlvl`` for the snow infiltration calculation and for the calculation of snow depth over refrozen melt ponds. + +.. _snow_windredist: + +Snow redistribution and compaction by wind +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Following :cite:`Lecomte15`, when ``snwredist`` = ``snwITDrdg`` we parameterize the amount of snow lost into the ocean through leads or redistributed to other thickness categories by defining the redistribution function :math:`\Phi` for snow mass as the sum of an erosion rate :math:`\Phi_E` and a redeposition rate :math:`\Phi_R` for each category of thickness :math:`h_i`: + +.. math:: + \Phi_E = \left({\partial m \over \partial t}\right)_{erosion} = -{\gamma \over \sigma_{ITD}} \left(V-V^*\right){\rho_{max} - \rho_s \over \rho_{max}} + +where :math:`\rho_s` and :math:`\rho_{max}` are the effective snow density and the maximum snow density in the model, respectively. For now, we take :math:`\rho_s` to be the wind-compacted snow density computed at the end of the snow model time step. + +:math:`\Phi_E \Delta t` represents the maximum snow mass per unit area that may be suspended from each category, subject to the total mass (per unit area) available on each category. + +Erosion begins when the instantaneous wind speed :math:`V` exceeds the seasonal wind speed required to compact the snow to a density :math:`\rho_s`, :math:`V^* = (\rho_s − \beta)/\alpha`. :math:`\sigma_{ITD}` is the standard deviation of the ice thicknesses from the thickness distribution :math:`g` within the grid cell. :math:`\gamma` is a tuning coefficient for +the eroded mass, which :cite:`Lecomte15` set to :math:`10^{-5}` kg m :math:`^{-2}`. From :cite:`Lecomte13`, :math:`\rho_s = 44.6V^* + 174` kg m :math:`^{−3}` for seasonal mean wind speed :math:`V`, i.e. :math:`\alpha=174` kg m :math:`^{-3}` and :math:`\beta=44.6` kg s m :math:`^{-4}`. + +In :cite:`Lecomte15`, the fraction of this suspended snow lost in leads is + +.. math:: + f = \left(1-a_i\right) \exp\left({\sigma_{ITD}\over\sigma_{ref}}\right), + +where the scale factor :math:`\sigma_{ref}=1` m and :math:`a_i` is the total ice area fraction within the grid cell. +Thus, the snow mass that is redistribution on the ice (i.e., not lost in leads) is + +.. math:: + \Phi_R \Delta t = a_i \left(1-f\right) \Phi_E \Delta t. + +We extend this approach by using the level and ridged ice thicknesses to compute the standard deviation of ice thickness across all categories. That is, + +.. math:: + \sigma_{ITD}^2 = \sum_{n=1}^N a_{in} a_{lvln} \left(h_{ilvln}-\sum_{k=1}^N a_{ik}h_{ik}\right)^2 + a_{in} a_{rdgn} \left(h_{irdgn} - \sum_{k=1}^N a_{ik} h_{ik} \right)^2. + +When considering snow over ridged and level ice for the redistribution, we reapportion the fraction of snow on level ice as :math:`a_{slvl} = 1-(1+p)a_{rdg}` and note that with the average expression + +.. math:: + a_{slvl} = {\sum_{n=1}^N a_{in}\left(a_{lvln} - p a_{rdgn}\right) \over \sum_{n=1}^N a_{in}} + +a conservative redistribution of snow across thickness categories is (for each category :math:`n`) + +.. math:: + \Phi_R(n) \Delta t = a_i \left(1-f\right) \left[a_{rdgn}\left(1+p\right) + a_{slvl} \right] \Phi_E \Delta t, + +where :math:`p \le a_{lvln}/a_{rdgn}`. + +The snow volume and energy state variables are updated in two steps, first for erosion of snow into suspension, then snow redeposition. When redepositing the snow, the snow energy is distributed among the snow layers affected by erosion, proportionally to the fraction of snow eroded. Finally, snow layer thicknesses are re-equalized, conserving snow energy. The fraction of suspended snow mass and energy lost in leads is added to the fresh water and heat fluxes for strict conservation. + +High wind speeds compact the upper portion of a snow pack into "wind slab," a dense and more conductive medium that resists further drifting. An effective snow density is computed based on wind speed, which is then used to limit snow erosion of denser snow. + +:cite:`Lecomte15` note that once snow is deposited, its density changes very little. During deposition, the density primarily falls into one of two types, wind slab for wind velocities greater than about 10 m/s, and loose snow for lighter winds. Their table 3 indicates densities for a variety of snow types. "Hard slab," deposited at :math:`V` = 13 m/s, has a density of :math:`\rho_s` = 403 kg m :math:`^{-3}` and "soft slab" is :math:`\rho_s` = 321 kg m :math:`^{-3}`, deposited at :math:`V` = 10 m/s. Linearly interpolating between these values, we have :math:`\rho_s = 27.3V + 47.7`. The slope is an adjustable namelist parameter, ``drhosdwind``. +For simplicity, we assign a minimum snow density of :math:`\rho_s^{min}` = 100 kg m :math:`^{-3}` s (``rhosmin``) +and add to it the gradient associated with wind speed from :cite:`Lecomte15` for wind speeds greater than 10 m/s: :math:`\rho_{s}^{new} = \rho_{s}^{min} + 27.3 \max \left(V-10, 0\right)`. The minimum wind speed to compact snow ``windmin`` is adjustable, and the maximum snow density is also a namelist parameter, ``rhosmax``. +This density is merged with preexisting layer densities only if new snow falls. The thickness of the wind slab is the larger of the depth of newly fallen snow or the thickness of snow redeposited by the wind. Following :cite:`Sturm02`, density does not evolve further, other than by transport, unless additional snow falls at high enough wind speeds to compact the snow. + +.. _snow_liquid: + +Ice and liquid water mass in snow +--------------------------------- + +The advanced snow physics option calculates ice and liquid water mass and effective snow grain radius, enabling them to interact with the radiation calculation. The mass of ice and liquid water in snow are implemented as tracers on snow volume layers and used for the snow grain metamorphism. +Together with snow volume, they also can be used to determine effective snow density as :math:`\rho_s^{eff} = (m_{ice}+m_{liq}) / h_s`. Note that :math:`m_{ice}+m_{liq}` is the snow water equivalent (kg/m :math:`^2`). + +Sources of :math:`m_{ice}` are snowfall, condensation, and freezing of liquid water within the snowpack; sinks are sublimation and melting. All of the sources and sinks of :math:`m_{ice}` are already computed in the code except for freezing of liquid water within the snow pack. + +Sources of :math:`m_{liq}` are rain and snow melt; freezing of liquid water within the snowpack and runoff are sinks. Runoff and meltwater entering a snow layer (i.e., runoff from the layer above) are associated with vertical flow through the snow column. As in :cite:`Oleson10`, when the liquid water within a snow layer exceeds the layer's holding capacity, the excess water is added to the underlying layer, limited by the effective porosity of the layer. When ``use_smliq_pnd`` is true, the excess water is supplied to the melt pond parameterization, which puts a fraction of it into the pond volume and allows the rest to run off into the ocean. + +The snow mass fractions of precipitation and old ice are saved for metamorphosing the snow grain radius. + +Except for the topo melt pond scheme, melt water and heat in ponds (which may be hidden within a partially saturated snow pack) are "virtual" in the sense that they are provided to the ocean model component immediately upon melting, even though the effects of the liquid water continue to be tracked as if it were retained on the ice. Retaining that water and heat in the sea ice component alters the timing, location and magnitude of fresh water runoff events into the ocean. All melt pond schemes include the meltwater effects, regardless of whether the liquid water is virtual. The advanced snow physics option allows the liquid water calculated by the snow metamorphism scheme to be used for melt pond calculations, replacing the snow melt and rainfall terms. + +.. _snow_metamorphosis: + +Metamorphosis of snow grains +---------------------------- + +When ``snwgrain`` = ``.true.``, dynamic, effective snow radius, a snow volume tracer, evolves analytically as a function of snow temperature, temperature gradient, and density for radiative calculations using the delta-Eddington radiation scheme. +Wet metamorphism changes both density (through volume change) and effective grain size; here we only consider changes in grain radius. +In the formation of depth hoar, dry snow kinetic metamorphism (TG metamorphism) also increases the snow grain radius. + +The tracers :math:`m_{liq}` and :math:`m_{ice}` characterize the snow in each snow layer, for each ice category and horizontal grid cell. The model's meltpond volume covers a fraction of the grid cell and represents liquid in excess of :math:`m_{liq}`. The radiative effects of snow grain radius in the fraction of ice covered by pond volume are only calculated when the pond volume has not yet saturated the snow pack; otherwise, delta-Eddington transfer uses meltpond properties. Therefore, modelled changes in snow grain radii from metamorphism are designed specifically for the fraction without exposed (i.e. effective) melt ponds. + +Following :cite:`Oleson10`, the new snow grain radius is computed as a weighted function of existing and new (freshly fallen, ``rsnw_fall``) snow grain radii, using parameters from a look-up table that depends on snow temperature, temperature gradient and (effective) density. The maximum snow radius is a namelist option, ``rsnw_tmax``. + + + diff --git a/doc/source/science_guide/sg_tracers.rst b/doc/source/science_guide/sg_tracers.rst index 4503da399..77d3fd959 100755 --- a/doc/source/science_guide/sg_tracers.rst +++ b/doc/source/science_guide/sg_tracers.rst @@ -10,7 +10,8 @@ required (surface temperature and thickness, salinity and enthalpy of ice and sn and many others are options. For instance, there are tracers to track the age of the ice; the area of first-year ice, fractions of ice area and volume that are level, from which the amount of deformed ice can be calculated; pond area, pond volume and volume of ice covering ponds; -a prognostic floe size distribution; aerosols, water isotopes, and numerous other biogeochemical tracers. +a prognostic floe size distribution; snow density, grain size, and ice and liquid content; +aerosols, water isotopes, and numerous other biogeochemical tracers. Most of these tracers are presented in later sections. Here we describe the ice age tracers and how tracers may depend on other tracers, using the pond tracers as an example. diff --git a/doc/source/user_guide/ug_case_settings.rst b/doc/source/user_guide/ug_case_settings.rst index 76b54d9d1..7ee316339 100755 --- a/doc/source/user_guide/ug_case_settings.rst +++ b/doc/source/user_guide/ug_case_settings.rst @@ -31,6 +31,7 @@ can be found in :ref:`cicecpps`. The following CPPs are available. "**General Macros**", "" "NO_I8", "Converts ``integer*8`` to ``integer*4``." "NO_R16", "Converts ``real*16`` to ``real*8``." + "USE_NETCDF", "Turns on netcdf capabilities in Icepack. By default and generally, Icepack does not need netcdf." "","" "**Application Macros**", "" "CESMCOUPLED", "Turns on code changes for the CESM coupled application " @@ -65,7 +66,7 @@ can be modified as needed. "ICE_LOGDIR", "string", "log directory", "${ICE_CASEDIR}/logs" "ICE_RSTPFILE", "string", "unused", "undefined" "ICE_DRVOPT", "string", "unused", "icepack" - "ICE_IOTYPE", "string", "unused", "none" + "ICE_IOTYPE", "none,netcdf", "IO options", "none" "ICE_CLEANBUILD", "true,false", "automatically clean before building", "true" "ICE_CPPDEFS", "string", "user defined preprocessor macros for build", "null" "ICE_QUIETMODE", "true, false", "reduce build output to the screen", "false" @@ -139,6 +140,7 @@ setup_nml "", "``y``", "write restart every ``dumpfreq_n`` years", "" "``dump_last``", "true/false", "write restart at end of run", "false" "``dt``", "seconds", "thermodynamics time step length", "3600." + "``history_cdf``", "logical", "netcdf history output", "``.false.``" "``ice_ic``", "``default``", "latitude and sst dependent initial condition", "``default``" "", "``none``", "no ice", "" "", "'path/file'", "restart file name", "" @@ -184,6 +186,7 @@ tracer_nml "``tr_pond_cesm``", "logical", "CESM melt ponds", "``.false.``" "``tr_pond_lvl``", "logical", "level-ice melt ponds", "``.false.``" "``tr_pond_topo``", "logical", "topo melt ponds", "``.false.``" + "``tr_snow``", "logical", "advanced snow physics", "``.false.``" "", "", "", "" thermo_nml @@ -278,6 +281,31 @@ ponds_nml "``rfracmin``", ":math:`0 \le r_{min} \le 1`", "minimum melt water added to ponds", "0.15" "", "", "", "" +snow_nml +~~~~~~~~~~~~~~~~~~~~~~~~~ + +.. csv-table:: **snow_nml namelist options** + :header: "variable", "options/format", "description", "default value" + :widths: 15, 15, 30, 15 + + "", "", "", "" + "``drhosdwind``", "real", "wind compaction factor for snow", "27.3" + "``rhosmin``", "real", "minimum snow density", "100.0" + "``rhosmax``", "real", "maximum snow density", "450.0" + "``rhosnew``", "real", "new snow density", "100.0" + "``rsnw_fall``", "real", "radius of new snow (um)", "54.526" + "``rsnw_tmax``", "real", "maximum snow radius (um)", "1500.0" + "``snw_aging_table``", "test", "snow aging lookup table", "test" + "", "snicar", "(not available in Icepack)", "" + "``snwgrain``", "logical", "snow grain metamorphosis", ".true." + "``snwlvlfac``", "real", "fraction increase in bulk snow redistribution", "0.3" + "``snwredist``", "``snwITDrdg``", "snow redistribution using ITD/ridges", "snwITDrdg" + "", "``bulk``", "bulk snow redistribution", "" + "", "``none``", "no snow redistribution", "" + "``use_smliq_pnd``", "logical", "use liquid in snow for ponds", ".true." + "``windmin``", "real", "minimum wind speed to compact snow", "10.0" + "", "", "", "" + forcing_nml ~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/doc/source/user_guide/ug_implementation.rst b/doc/source/user_guide/ug_implementation.rst index 70a806bf0..fe244fcea 100755 --- a/doc/source/user_guide/ug_implementation.rst +++ b/doc/source/user_guide/ug_implementation.rst @@ -150,9 +150,9 @@ default in this distribution, this is not a stringent limitation: Model output ------------ -History output from Icepack is not currently supported in the Icepack driver, except -in restart files. -The sea ice model `CICE `_ provides extensive +The Icepack model provides diagnostic output files, binary restart files, and a primitive +netcdf history file capability. +The sea ice model `CICE `_ provides more extensive options for model output, including many derived output variables. Diagnostic files @@ -176,6 +176,30 @@ the namelist option ``restart`` must be set to ``.true.`` to use the file. ``dump_last`` namelist can also be set to true to trigger restarts automatically at then end of runs. +History files +~~~~~~~~~~~~~ + +Icepack has a primitive netcdf history capability that is turned on with the +``history_cdf`` namelist. When ``history_cdf`` is set to true, history files +are created for each run with a naming convention of **icepack.h.yyyymmdd.nc** +in the run directory history directory. The yyyymmdd is the start date for each run. + +When Icepack history files are turned on, data for a set of fixed fields is written +to the history file for each column at every timestep without ability to control +fields, frequencies, or temporal averaging. All output fields are hardwired into +the implementation in **configuration/driver/icedrv_history.F90** file. The netcdf file +does NOT meet NetCDF CF conventions and is provided as an amenity in the standalone +Icepack model. Users are free to modify the output fields or +extend the implementation and are encouraged to share any updates with the Consortium. + +The default configuration of Icepack does not require NetCDF. If history files are +written, the USE_NETCDF C preprocessor directive must be set during compilation. This +is done by setting ``ICE_IOTYPE`` to ``netcdf`` in **icepack.settings**. In addition, +the machine env and Macros files must include support for compilation with NetCDF. The +``icepack.setup -s`` option ``ionetcdf`` will set the ICE_IOTYPE to netcdf, which turns on +the USE_NETCDF C preprocessor. ``ionetcdf`` also sets the ``history_cdf`` flag to true. + + .. _bgc-hist: Biogeochemistry History Fields diff --git a/doc/source/user_guide/ug_running.rst b/doc/source/user_guide/ug_running.rst index 94b66c405..85a9c7cd9 100755 --- a/doc/source/user_guide/ug_running.rst +++ b/doc/source/user_guide/ug_running.rst @@ -585,7 +585,12 @@ Next, create the "icepack" conda environment from the ``environment.yml`` file i conda env create -f configuration/scripts/machines/environment.yml -This step needs to be done only once. +This step needs to be done only once. If you ever need to update the conda environment +because the required packages change or packages are out of date, do + +.. code-block:: bash + + conda env update -f configuration/scripts/machines/environment.yml .. _using_conda_env: