From 045e353e396bbccf6d2e08f45039ba1ea7586ced Mon Sep 17 00:00:00 2001 From: apcraig Date: Wed, 7 Sep 2022 15:40:27 -0600 Subject: [PATCH 1/2] Clean up icepack_shortwave - Remove modal_aero, dEdd_algae, and heat_capacity from icepack_shortwave arguments, use directly from icepack_parameters - Modify fswthrun_ optional argument implementation - Modify rsnow optional argument implementation - Change days_per_year, nextsw_cday, and calendar_type to optional arguments in icepack_step_radiation and down the calling tree - Fix some indentation --- columnphysics/icepack_shortwave.F90 | 416 +++++++------------- configuration/driver/icedrv_calendar.F90 | 1 - configuration/driver/icedrv_init_column.F90 | 11 +- configuration/driver/icedrv_step.F90 | 14 +- 4 files changed, 160 insertions(+), 282 deletions(-) diff --git a/columnphysics/icepack_shortwave.F90 b/columnphysics/icepack_shortwave.F90 index 4acae8602..1bb02e626 100644 --- a/columnphysics/icepack_shortwave.F90 +++ b/columnphysics/icepack_shortwave.F90 @@ -43,18 +43,19 @@ module icepack_shortwave use icepack_kinds 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: argcheck use icepack_parameters, only: albocn, Timelt, snowpatch, awtvdr, awtidr, awtvdf, awtidf use icepack_parameters, only: kappav, hs_min, rhofresh, rhos use icepack_parameters, only: rsnw_fall, snwredist, rsnw_tmax use icepack_parameters, only: hi_ssl, hs_ssl, min_bgc, sk_l, snwlvlfac, snwgrain #ifdef UNDEPRECATE_0LAYER - use icepack_parameters, only: z_tracers, skl_bgc, calc_tsfc, shortwave, kalg, heat_capacity -#else - use icepack_parameters, only: z_tracers, skl_bgc, calc_tsfc, shortwave, kalg + use icepack_parameters, only: heat_capacity #endif + use icepack_parameters, only: z_tracers, skl_bgc, calc_tsfc, shortwave, kalg 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 - use icepack_parameters, only: snw_ssp_table, use_snicar + use icepack_parameters, only: snw_ssp_table, use_snicar, modal_aero + use icepack_parameters, only: dEdd_algae use icepack_tracers, only: ntrcr, nbtrcr_sw #ifdef UNDEPRECATE_CESMPONDS @@ -224,9 +225,6 @@ subroutine shortwave_ccsm3 (aicen, vicen, & vsnon, Tsfcn, & swvdr, swvdf, & swidr, swidf, & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, & -#endif albedo_type, & albicev, albicei, & albsnowv, albsnowi, & @@ -234,11 +232,11 @@ subroutine shortwave_ccsm3 (aicen, vicen, & alvdrn, alidrn, & alvdfn, alidfn, & fswsfc, fswint, & - fswthru, & - fswthru_vdr, & - fswthru_vdf, & - fswthru_idr, & - fswthru_idf, & + fswthrun, & + fswthrun_vdr, & + fswthrun_vdf, & + fswthrun_idr, & + fswthrun_idf, & fswpenl, & Iswabs, SSwabs, & albin, albsn, & @@ -269,10 +267,6 @@ subroutine shortwave_ccsm3 (aicen, vicen, & albsnowi, & ! cold snow albedo, near IR ahmax ! thickness above which ice albedo is constant (m) -#ifdef UNDEPRECATE_0LAYER - logical(kind=log_kind), intent(in) :: & - heat_capacity! if true, ice has nonzero heat capacity -#endif character (len=char_len), intent(in) :: & albedo_type ! albedo parameterization, 'ccsm3' or 'constant' @@ -283,15 +277,15 @@ subroutine shortwave_ccsm3 (aicen, vicen, & alidfn , & ! near-ir, diffuse, avg (fraction) fswsfc , & ! SW absorbed at ice/snow surface (W m-2) fswint , & ! SW absorbed in ice interior, below surface (W m-2) - fswthru , & ! SW through ice to ocean (W m-2) + fswthrun , & ! SW through ice to ocean (W m-2) albin , & ! bare ice albedo albsn ! snow albedo real (kind=dbl_kind), dimension (:), intent(out), optional :: & - fswthru_vdr , & ! vis dir SW through ice to ocean (W m-2) - fswthru_vdf , & ! vis dif SW through ice to ocean (W m-2) - fswthru_idr , & ! nir dir SW through ice to ocean (W m-2) - fswthru_idf ! nir dif SW through ice to ocean (W m-2) + fswthrun_vdr , & ! vis dir SW through ice to ocean (W m-2) + fswthrun_vdf , & ! vis dif SW through ice to ocean (W m-2) + fswthrun_idr , & ! nir dir SW through ice to ocean (W m-2) + fswthrun_idf ! nir dif SW through ice to ocean (W m-2) real (kind=dbl_kind), intent(inout) :: & coszen ! cosine(zenith angle) @@ -318,7 +312,8 @@ subroutine shortwave_ccsm3 (aicen, vicen, & alvdfns, & ! visible, diffuse, snow (fraction) alidfns ! near-ir, diffuse, snow (fraction) - real (kind=dbl_kind), dimension(:), allocatable :: & + ! needed for optional fswthrun arrays when passed as scalars + real (kind=dbl_kind) :: & l_fswthru_vdr , & ! vis dir SW through ice to ocean (W m-2) l_fswthru_vdf , & ! vis dif SW through ice to ocean (W m-2) l_fswthru_idr , & ! nir dir SW through ice to ocean (W m-2) @@ -330,11 +325,6 @@ subroutine shortwave_ccsm3 (aicen, vicen, & ! Solar radiation: albedo and absorbed shortwave !----------------------------------------------------------------- - allocate(l_fswthru_vdr(ncat)) - allocate(l_fswthru_vdf(ncat)) - allocate(l_fswthru_idr(ncat)) - allocate(l_fswthru_idf(ncat)) - ! For basic shortwave, set coszen to a constant between 0 and 1. coszen = p5 ! sun above the horizon @@ -362,7 +352,7 @@ subroutine shortwave_ccsm3 (aicen, vicen, & fswsfc(n) = c0 fswint(n) = c0 - fswthru(n) = c0 + fswthrun(n) = c0 fswpenl(:,n) = c0 Iswabs (:,n) = c0 @@ -422,12 +412,7 @@ subroutine shortwave_ccsm3 (aicen, vicen, & ! Compute solar radiation absorbed in ice and penetrating to ocean. !----------------------------------------------------------------- -#ifdef UNDEPRECATE_0LAYER - call absorbed_solar (heat_capacity, & - nilyr, & -#else call absorbed_solar (nilyr, & -#endif aicen(n), & vicen(n), & vsnon(n), & @@ -439,30 +424,25 @@ subroutine shortwave_ccsm3 (aicen, vicen, & alidrns, alidfns, & fswsfc=fswsfc(n), & fswint=fswint(n), & - fswthru=fswthru(n), & - fswthru_vdr=l_fswthru_vdr(n),& - fswthru_vdf=l_fswthru_vdf(n),& - fswthru_idr=l_fswthru_idr(n),& - fswthru_idf=l_fswthru_idf(n),& + fswthru=fswthrun(n), & + fswthru_vdr=l_fswthru_vdr,& + fswthru_vdf=l_fswthru_vdf,& + fswthru_idr=l_fswthru_idr,& + fswthru_idf=l_fswthru_idf,& fswpenl=fswpenl(:,n), & Iswabs=Iswabs(:,n)) if (icepack_warnings_aborted(subname)) return + if(present(fswthrun_vdr)) fswthrun_vdr(n) = l_fswthru_vdr + if(present(fswthrun_vdf)) fswthrun_vdf(n) = l_fswthru_vdf + if(present(fswthrun_idr)) fswthrun_idr(n) = l_fswthru_idr + if(present(fswthrun_idf)) fswthrun_idf(n) = l_fswthru_idf + endif ! aicen > puny enddo ! ncat - 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 - - deallocate(l_fswthru_vdr) - deallocate(l_fswthru_vdf) - deallocate(l_fswthru_idr) - deallocate(l_fswthru_idf) - end subroutine shortwave_ccsm3 !======================================================================= @@ -705,12 +685,7 @@ end subroutine constant_albedos ! authors William H. Lipscomb, LANL ! C. M. Bitz, UW -#ifdef UNDEPRECATE_0LAYER - subroutine absorbed_solar (heat_capacity, & - nilyr, aicen, & -#else subroutine absorbed_solar (nilyr, aicen, & -#endif vicen, vsnon, & swvdr, swvdf, & swidr, swidf, & @@ -727,10 +702,6 @@ subroutine absorbed_solar (nilyr, aicen, & fswpenl, & Iswabs) -#ifdef UNDEPRECATE_0LAYER - logical(kind=log_kind), intent(in) :: & - heat_capacity ! if true, ice has nonzero heat capacity -#endif integer (kind=int_kind), intent(in) :: & nilyr ! number of ice layers @@ -908,7 +879,6 @@ end subroutine absorbed_solar ! 2013 ECH merged with NCAR version subroutine run_dEdd(dt, ncat, & - dEdd_algae, & nilyr, nslyr, & aicen, vicen, & vsnon, Tsfcn, & @@ -916,15 +886,11 @@ subroutine run_dEdd(dt, ncat, & hpndn, ipndn, & aeron, & trcrn_bgcsw, & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, & -#endif - tlat, tlon, & + TLAT, TLON, & calendar_type, & days_per_year, & nextsw_cday, yday, & sec, & - modal_aero, & swvdr, swvdf, & swidr, swidf, & coszen, fsnow, & @@ -951,28 +917,25 @@ subroutine run_dEdd(dt, ncat, & nilyr , & ! number of ice layers nslyr ! number of snow layers - logical(kind=log_kind), intent(in) :: & -#ifdef UNDEPRECATE_0LAYER - heat_capacity,& ! if true, ice has nonzero heat capacity -#endif - dEdd_algae, & ! .true. use prognostic chla in dEdd - modal_aero ! .true. use modal aerosol treatment + integer (kind=int_kind), intent(in) :: & + sec ! elapsed seconds into date - character (len=char_len), intent(in) :: & + real (kind=dbl_kind), intent(in), optional :: & + yday ! day of the year + + character (len=char_len), intent(in), optional :: & calendar_type ! differentiates Gregorian from other calendars - integer (kind=int_kind), intent(in) :: & - days_per_year, & ! number of days in one year - sec ! elapsed seconds into date + integer (kind=int_kind), intent(in), optional :: & + days_per_year ! number of days in one year - real (kind=dbl_kind), intent(in) :: & - nextsw_cday , & ! julian day of next shortwave calculation - yday ! day of the year + real (kind=dbl_kind), intent(in), optional :: & + nextsw_cday ! julian day of next shortwave calculation real(kind=dbl_kind), intent(in) :: & dt, & ! time step (s) - tlat, & ! latitude of temp pts (radians) - tlon, & ! longitude of temp pts (radians) + TLAT, & ! latitude of temp pts (radians) + TLON, & ! longitude of temp pts (radians) swvdr, & ! sw down, visible, direct (W/m^2) swvdf, & ! sw down, visible, diffuse (W/m^2) swidr, & ! sw down, near IR, direct (W/m^2) @@ -1021,11 +984,13 @@ 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) + real(kind=dbl_kind), dimension(:,:), intent(inout), optional :: & + rsnow ! snow grain radius tracer (10^-6 m) + logical (kind=log_kind), intent(in) :: & l_print_point @@ -1068,33 +1033,34 @@ subroutine run_dEdd(dt, ncat, & rnslyr , & ! 1/nslyr tmp ! 0 or 1 + ! needed for optional fswthrun arrays when passed as scalars + real (kind=dbl_kind) :: & + l_fswthru_vdr , & ! vis dir SW through ice to ocean (W m-2) + l_fswthru_vdf , & ! vis dif SW through ice to ocean (W m-2) + l_fswthru_idr , & ! nir dir SW through ice to ocean (W m-2) + l_fswthru_idf ! nir dif SW through ice to ocean (W m-2) + logical (kind=log_kind) :: & - linitonly ! local initonly value + l_initonly ! local initonly value - real (kind=dbl_kind), dimension(:), allocatable :: & - l_fswthrun_vdr , & ! vis dir SW through ice to ocean (W m-2) - l_fswthrun_vdf , & ! vis dif SW through ice to ocean (W m-2) - 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(nslyr) :: & + l_rsnows ! snow grain radius tracer (10^-6 m) character(len=*),parameter :: subname='(run_dEdd)' - allocate(l_fswthrun_vdr(ncat)) - allocate(l_fswthrun_vdf(ncat)) - allocate(l_fswthrun_idr(ncat)) - allocate(l_fswthrun_idf(ncat)) - - linitonly = .false. + l_initonly = .false. if (present(initonly)) then - linitonly = initonly + l_initonly = initonly endif + l_rsnows(:) = c0 + ! cosine of the zenith angle #ifdef CESMCOUPLED - call compute_coszen (tlat, tlon, yday, sec, coszen, & + call compute_coszen (TLAT, TLON, yday, sec, coszen, & days_per_year, nextsw_cday, calendar_type) #else - call compute_coszen (tlat, tlon, yday, sec, coszen) + call compute_coszen (TLAT, TLON, yday, sec, coszen) #endif if (icepack_warnings_aborted(subname)) return @@ -1113,13 +1079,16 @@ subroutine run_dEdd(dt, ncat, & if (aicen(n) > puny) then + if (snwgrain) then + l_rsnows(:) = rsnow(:,n) + endif call shortwave_dEdd_set_snow(nslyr, R_snw, & dT_mlt, rsnw_mlt, & aicen(n), vsnon(n), & Tsfcn(n), fsn, & hs0, hsn, & rhosnwn, rsnwn, & - rsnow(:,n)) + l_rsnows(:)) if (icepack_warnings_aborted(subname)) return ! set pond properties @@ -1161,7 +1130,7 @@ subroutine run_dEdd(dt, ncat, & Tsfcn(n), fsn, & hs0, hsnlvl, & rhosnwn(:), rsnwn(:), & - rsnow(:,n)) + l_rsnows(:)) if (icepack_warnings_aborted(subname)) return endif ! snwredist @@ -1171,11 +1140,11 @@ subroutine run_dEdd(dt, ncat, & ! allow snow to cover pond ice ipn = alvln(n) * apndn(n) * ipndn(n) dhs = dhsn(n) ! snow depth difference, sea ice - pond - if (.not. linitonly .and. ipn > puny .and. & + if (.not. l_initonly .and. ipn > puny .and. & dhs < puny .and. fsnow*dt > hs_min) & dhs = hsnlvl - fsnow*dt ! initialize dhs>0 spn = hsnlvl - dhs ! snow depth on pond ice - if (.not. linitonly .and. ipn*spn < puny) dhs = c0 + if (.not. l_initonly .and. ipn*spn < puny) dhs = c0 dhsn(n) = dhs ! save: constant until reset to 0 ! not using ipn assumes that lid ice is perfectly clear @@ -1257,31 +1226,25 @@ subroutine run_dEdd(dt, ncat, & hpn = c0 endif ! pond type - snowfracn(n) = fsn ! for history + snowfracn(n) = fsn ! for history - call shortwave_dEdd(dEdd_algae, & - nslyr, nilyr, & -#ifdef UNDEPRECATE_0LAYER - coszen, heat_capacity, & -#else + call shortwave_dEdd(nslyr, nilyr, & coszen, & -#endif aicen(n), vicen(n), & hsn, fsn, & rhosnwn, rsnwn, & fpn, hpn, & aeron(:,n), & - modal_aero, & swvdr, swvdf, & swidr, swidf, & alvdrn(n), alvdfn(n), & 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_fswthru_vdr, & + fswthru_vdf=l_fswthru_vdf, & + fswthru_idr=l_fswthru_idr, & + fswthru_idf=l_fswthru_idf, & Sswabs=Sswabsn(:,n), & Iswabs=Iswabsn(:,n), & albice=albicen(n), & @@ -1293,7 +1256,12 @@ subroutine run_dEdd(dt, ncat, & if (icepack_warnings_aborted(subname)) return - if (.not. snwgrain) then + if(present(fswthrun_vdr)) fswthrun_vdr(n) = l_fswthru_vdr + if(present(fswthrun_vdf)) fswthrun_vdf(n) = l_fswthru_vdf + if(present(fswthrun_idr)) fswthrun_idr(n) = l_fswthru_idr + if(present(fswthrun_idf)) fswthrun_idf(n) = l_fswthru_idf + + if (present(rsnow) .and. .not. snwgrain) then do k = 1,nslyr rsnow(k,n) = rsnwn(k) ! for history enddo @@ -1303,16 +1271,6 @@ subroutine run_dEdd(dt, ncat, & enddo ! ncat - 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 - - deallocate(l_fswthrun_vdr) - deallocate(l_fswthrun_vdf) - deallocate(l_fswthrun_idr) - deallocate(l_fswthrun_idf) - end subroutine run_dEdd !======================================================================= @@ -1343,19 +1301,13 @@ end subroutine run_dEdd ! author: Bruce P. Briegleb, NCAR ! 2013: E Hunke merged with NCAR version ! - subroutine shortwave_dEdd (dEdd_algae, & - nslyr, nilyr, & -#ifdef UNDEPRECATE_0LAYER - coszen, heat_capacity,& -#else + subroutine shortwave_dEdd (nslyr, nilyr, & coszen, & -#endif aice, vice, & hs, fs, & rhosnw, rsnw, & fp, hp, & aero, & - modal_aero, & swvdr, swvdf, & swidr, swidf, & alvdr, alvdf, & @@ -1376,13 +1328,6 @@ subroutine shortwave_dEdd (dEdd_algae, & nilyr , & ! number of ice layers nslyr ! number of snow layers - logical (kind=log_kind), intent(in) :: & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, & ! if true, ice has nonzero heat capacity -#endif - dEdd_algae, & ! .true. use prognostic chla in dEdd - modal_aero ! .true. use modal aerosol treatment - real (kind=dbl_kind), intent(in) :: & aice , & ! concentration of ice vice , & ! volume of ice @@ -1547,13 +1492,8 @@ subroutine shortwave_dEdd (dEdd_algae, & srftyp = 0 call compute_dEdd_3bd(nilyr, nslyr, & - klev, klevp, zbio, dEdd_algae, & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, fnidr, coszen, & -#else + klev, klevp, zbio, & fnidr, coszen, & -#endif - modal_aero, & swvdr, swvdf, swidr, swidf, srftyp, & hstmp, rhosnw, rsnw, hi, hp, & fi, aero_mp, avdrl, avdfl, & @@ -1590,9 +1530,8 @@ subroutine shortwave_dEdd (dEdd_algae, & srftyp = 1 if (use_snicar) then call compute_dEdd_5bd(nilyr, nslyr, klev, klevp, & - zbio, dEdd_algae, & -!!!!!! heat_capacity, fnidr, coszen, & - fnidr, coszen, modal_aero, & + zbio, & + fnidr, coszen, & swvdr, swvdf, swidr, swidf, srftyp, & hs, rhosnw, rsnw, hi, hp, & fs, aero_mp, avdrl, avdfl, & @@ -1604,13 +1543,8 @@ subroutine shortwave_dEdd (dEdd_algae, & else !echmod - this can be combined with the 5bd call above, if we use module data call compute_dEdd_3bd(nilyr, nslyr, & - klev, klevp, zbio, dEdd_algae, & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, fnidr, coszen, & -#else + klev, klevp, zbio, & fnidr, coszen, & -#endif - modal_aero, & swvdr, swvdf, swidr, swidf, srftyp, & hs, rhosnw, rsnw, hi, hp, & fs, aero_mp, avdrl, avdfl, & @@ -1652,13 +1586,8 @@ subroutine shortwave_dEdd (dEdd_algae, & srftyp = 2 call compute_dEdd_3bd(nilyr, nslyr, & - klev, klevp, zbio, dEdd_algae, & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, fnidr, coszen, & -#else + klev, klevp, zbio, & fnidr, coszen, & -#endif - modal_aero, & swvdr, swvdf, swidr, swidf, srftyp, & hs, rhosnw, rsnw, hi, hp, & fp, aero_mp, avdrl, avdfl, & @@ -1773,13 +1702,8 @@ end subroutine shortwave_dEdd ! 2022: E Hunke, T Craig moved data (now module data) subroutine compute_dEdd_3bd(nilyr, nslyr, & - klev, klevp, zbio, dEdd_algae, & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, fnidr, coszen, & -#else + klev, klevp, zbio, & fnidr, coszen, & -#endif - modal_aero, & swvdr, swvdf, swidr, swidf, srftyp, & hs, rhosnw, rsnw, hi, hp, & fi, aero_mp, alvdr, alvdf, & @@ -1800,13 +1724,6 @@ subroutine compute_dEdd_3bd(nilyr, nslyr, & klevp ! number of radiation interfaces - 1 ! (0 layer is included also) - logical (kind=log_kind), intent(in) :: & -#ifdef UNDEPRECATE_0LAYER - heat_capacity,& ! if true, ice has nonzero heat capacity -#endif - dEdd_algae, & ! .true. use prognostic chla in dEdd - modal_aero ! .true. use modal aerosol treatment - real (kind=dbl_kind), intent(in) :: & fnidr , & ! fraction of direct to total down flux in nir coszen , & ! cosine solar zenith angle @@ -3925,7 +3842,6 @@ end subroutine icepack_prep_radiation subroutine icepack_step_radiation (dt, ncat, & nblyr, & nilyr, nslyr, & - dEdd_algae, & swgrid, igrid, & fbri, & aicen, vicen, & @@ -3940,7 +3856,6 @@ subroutine icepack_step_radiation (dt, ncat, & days_per_year, & nextsw_cday, & yday, sec, & - modal_aero, & swvdr, swvdf, & swidr, swidf, & coszen, fsnow, & @@ -3977,25 +3892,29 @@ subroutine icepack_step_radiation (dt, ncat, & fsnow , & ! snowfall rate (kg/m^2 s) TLAT, TLON ! latitude and longitude (radian) - character (len=char_len), intent(in) :: & - calendar_type ! differentiates Gregorian from other calendars - integer (kind=int_kind), intent(in) :: & - days_per_year, & ! number of days in one year - sec ! elapsed seconds into date + sec ! elapsed seconds into date real (kind=dbl_kind), intent(in) :: & - nextsw_cday , & ! julian day of next shortwave calculation - yday ! day of the year + yday ! day of the year + + character (len=char_len), intent(in), optional :: & + calendar_type ! differentiates Gregorian from other calendars + + integer (kind=int_kind), intent(in), optional :: & + days_per_year ! number of days in one year + + real (kind=dbl_kind), intent(in), optional :: & + nextsw_cday ! julian day of next shortwave calculation real (kind=dbl_kind), intent(inout) :: & coszen ! cosine solar zenith angle, < 0 for sun below horizon real (kind=dbl_kind), dimension (:), intent(in) :: & - igrid ! biology vertical interface points + igrid ! biology vertical interface points real (kind=dbl_kind), dimension (:), intent(in) :: & - swgrid ! grid for ice tracers used in dEdd scheme + swgrid ! grid for ice tracers used in dEdd scheme real (kind=dbl_kind), dimension(:), intent(in) :: & aicen , & ! ice area fraction in each category @@ -4045,74 +3964,67 @@ subroutine icepack_step_radiation (dt, ncat, & Sswabsn ! SW radiation absorbed in snow layers (W m-2) logical (kind=log_kind), intent(in) :: & - l_print_point, & ! flag for printing diagnostics - dEdd_algae , & ! .true. use prognostic chla in dEdd - modal_aero ! .true. use modal aerosol optical treatment + l_print_point ! flag for printing diagnostics real (kind=dbl_kind), dimension(:,:), intent(inout), optional :: & - rsnow ! snow grain radius tracer (10^-6 m) + rsnow ! snow grain radius tracer (10^-6 m) logical (kind=log_kind), optional :: & - initonly ! flag to indicate init only, default is false + initonly ! flag to indicate init only, default is false !autodocument_end ! local variables integer (kind=int_kind) :: & - n ! thickness category index + n ! thickness category index - logical (kind=log_kind) :: & - linitonly ! local flag for initonly + logical (kind=log_kind), save :: & + first_call=.true. ! first call logical real(kind=dbl_kind) :: & hin, & ! Ice thickness (m) hbri ! brine thickness (m) - real (kind=dbl_kind), dimension(:), allocatable :: & - l_fswthrun_vdr , & ! vis dir SW through ice to ocean (W/m^2) - l_fswthrun_vdf , & ! vis dif SW through ice to ocean (W/m^2) - 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)) - allocate(l_fswthrun_vdf(ncat)) - allocate(l_fswthrun_idr(ncat)) - allocate(l_fswthrun_idf(ncat)) + if ((first_call .and. argcheck == 'first') .or. (argcheck == 'always')) then + if (snwgrain .and. .not. present(rsnow)) then + call icepack_warnings_add(subname//' ERROR: snwgrain on, rsnow not passed') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + return + endif +#ifdef CESMCOUPLED + if (.not.present(days_per_year) .or. & + .not.present(nextsw_cday) .or. & + .not.present(calendar_type)) then + call icepack_warnings_add(subname//' ERROR: CESMCOUPLE CPP on, need more calendar data') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + return + endif +#endif + 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 - alvdrn (n) = c0 - alidrn (n) = c0 - alvdfn (n) = c0 - alidfn (n) = c0 - fswsfcn (n) = c0 - fswintn (n) = c0 - fswthrun(n) = c0 - enddo ! ncat - fswpenln (:,:) = c0 - Iswabsn (:,:) = c0 - Sswabsn (:,:) = c0 - trcrn_bgcsw(:,:) = c0 - - ! Interpolate z-shortwave tracers to shortwave grid - if (dEdd_algae) then + ! Initialize + do n = 1, ncat + alvdrn (n) = c0 + alidrn (n) = c0 + alvdfn (n) = c0 + alidfn (n) = c0 + fswsfcn (n) = c0 + fswintn (n) = c0 + fswthrun(n) = c0 + enddo ! ncat + fswpenln (:,:) = c0 + Iswabsn (:,:) = c0 + Sswabsn (:,:) = c0 + trcrn_bgcsw(:,:) = c0 + + ! Interpolate z-shortwave tracers to shortwave grid + if (dEdd_algae) then do n = 1, ncat if (aicen(n) .gt. puny) then hin = vicen(n)/aicen(n) @@ -4129,13 +4041,12 @@ subroutine icepack_step_radiation (dt, ncat, & if (icepack_warnings_aborted(subname)) return endif enddo - endif + endif - if (calc_Tsfc) then + if (calc_Tsfc) then if (trim(shortwave(1:4)) == 'dEdd') then ! delta Eddington call run_dEdd(dt, ncat, & - dEdd_algae, & nilyr, nslyr, & aicen, vicen, & vsnon, Tsfcn, & @@ -4143,14 +4054,10 @@ subroutine icepack_step_radiation (dt, ncat, & hpndn, ipndn, & aeron, & trcrn_bgcsw, & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, & -#endif TLAT, TLON, & calendar_type,days_per_year, & nextsw_cday, yday, & sec, & - modal_aero, & swvdr, swvdf, & swidr, swidf, & coszen, fsnow, & @@ -4158,10 +4065,10 @@ subroutine icepack_step_radiation (dt, ncat, & alidrn, alidfn, & fswsfcn, fswintn, & fswthrun=fswthrun, & - fswthrun_vdr=l_fswthrun_vdr, & - fswthrun_vdf=l_fswthrun_vdf, & - fswthrun_idr=l_fswthrun_idr, & - fswthrun_idf=l_fswthrun_idf, & + fswthrun_vdr=fswthrun_vdr, & + fswthrun_vdf=fswthrun_vdf, & + fswthrun_idr=fswthrun_idr, & + fswthrun_idf=fswthrun_idf, & fswpenln=fswpenln, & Sswabsn=Sswabsn, & Iswabsn=Iswabsn, & @@ -4172,9 +4079,9 @@ subroutine icepack_step_radiation (dt, ncat, & snowfracn=snowfracn, & dhsn=dhsn, & ffracn=ffracn, & - rsnow=l_rsnow, & + rsnow=rsnow, & l_print_point=l_print_point, & - initonly=linitonly) + initonly=initonly) if (icepack_warnings_aborted(subname)) return elseif (trim(shortwave(1:4)) == 'ccsm') then @@ -4184,9 +4091,6 @@ subroutine icepack_step_radiation (dt, ncat, & Tsfcn, & swvdr, swvdf, & swidr, swidf, & -#ifdef UNDEPRECATE_0LAYER - heat_capacity, & -#endif albedo_type, & albicev, albicei, & albsnowv, albsnowi, & @@ -4194,11 +4098,11 @@ subroutine icepack_step_radiation (dt, ncat, & alvdrn, alidrn, & alvdfn, alidfn, & fswsfcn, fswintn, & - fswthru=fswthrun, & - fswthru_vdr=l_fswthrun_vdr,& - fswthru_vdf=l_fswthrun_vdf,& - fswthru_idr=l_fswthrun_idr,& - fswthru_idf=l_fswthrun_idf,& + fswthrun=fswthrun, & + fswthrun_vdr=fswthrun_vdr,& + fswthrun_vdf=fswthrun_vdf,& + fswthrun_idr=fswthrun_idr,& + fswthrun_idf=fswthrun_idf,& fswpenl=fswpenln, & Iswabs=Iswabsn, & Sswabs=Sswabsn, & @@ -4252,16 +4156,7 @@ subroutine icepack_step_radiation (dt, ncat, & endif ! calc_Tsfc - 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 - - deallocate(l_fswthrun_vdr) - deallocate(l_fswthrun_vdf) - deallocate(l_fswthrun_idr) - deallocate(l_fswthrun_idf) - deallocate(l_rsnow) + first_call = .false. end subroutine icepack_step_radiation @@ -4383,7 +4278,7 @@ end function asys ! https://doi.org/10.5194/tc-2019-22, in review, 2019 subroutine compute_dEdd_5bd (nilyr, nslyr, klev, klevp, & - zbio, dEdd_algae, fnidr, coszen, modal_aero, & + zbio, fnidr, coszen, & swvdr, swvdf, swidr, swidf, srftyp, & hs, rhosnw, rsnw, hi, hp, & fi, aero_mp, alvdr, alvdf, & @@ -4399,11 +4294,6 @@ subroutine compute_dEdd_5bd (nilyr, nslyr, klev, klevp, & klevp ! number of radiation interfaces - 1 ! (0 layer is included also) - logical (kind=log_kind), intent(in) :: & -! heat_capacity , & ! if true, ice has nonzero heat capacity - dEdd_algae , & ! .true. use prognostic chla in dEdd - modal_aero ! .true. use modal aerosol treatment - ! dEdd tuning parameters, set in namelist real (kind=dbl_kind), intent(in) :: & diff --git a/configuration/driver/icedrv_calendar.F90 b/configuration/driver/icedrv_calendar.F90 index dc6642eb4..048a23e4c 100644 --- a/configuration/driver/icedrv_calendar.F90 +++ b/configuration/driver/icedrv_calendar.F90 @@ -78,7 +78,6 @@ module icedrv_calendar yday , & ! day of the year tday , & ! absolute day number dayyr , & ! number of days per year - nextsw_cday , & ! julian day of next shortwave calculation basis_seconds , & ! Seconds since calendar zero secday ! seconds per day diff --git a/configuration/driver/icedrv_init_column.F90 b/configuration/driver/icedrv_init_column.F90 index 4678614cb..ad5a2aa2f 100644 --- a/configuration/driver/icedrv_init_column.F90 +++ b/configuration/driver/icedrv_init_column.F90 @@ -100,8 +100,7 @@ subroutine init_shortwave use icedrv_arrays_column, only: fswthrun, fswthrun_vdr, fswthrun_vdf, fswthrun_idr, fswthrun_idf use icedrv_arrays_column, only: fswintn, albpndn, apeffn, trcrn_sw, dhsn use icedrv_arrays_column, only: swgrid, igrid - use icedrv_calendar, only: istep1, dt, calendar_type - use icedrv_calendar, only: days_per_year, nextsw_cday, yday, sec + use icedrv_calendar, only: istep1, dt, yday, sec use icedrv_system, only: icedrv_system_abort use icedrv_forcing, only: snw_ssp_table use icedrv_flux, only: alvdf, alidf, alvdr, alidr @@ -123,7 +122,6 @@ subroutine init_shortwave l_print_point, & ! flag to print designated grid point diagnostics use_snicar, & ! use 5-band SNICAR radiation scheme for snow dEdd_algae, & ! BGC - radiation interactions - modal_aero, & ! modal aerosol optical properties snwgrain ! use variable snow grain size character (len=char_len) :: & @@ -153,7 +151,6 @@ subroutine init_shortwave call icepack_query_parameters(puny_out=puny) 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) @@ -254,7 +251,6 @@ subroutine init_shortwave dt=dt, ncat=ncat, & nblyr=nblyr, & nilyr=nilyr, nslyr=nslyr, & - dEdd_algae=dEdd_algae, & swgrid=swgrid(:), & igrid=igrid(:), & fbri=fbri(:), & @@ -271,10 +267,7 @@ subroutine init_shortwave zaeron=trcrn(i,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:), & trcrn_bgcsw=ztrcr_sw, & TLAT=TLAT(i), TLON=TLON(i), & - calendar_type=calendar_type, & - days_per_year=days_per_year, & - nextsw_cday=nextsw_cday, yday=yday, sec=sec, & - modal_aero=modal_aero, & + yday=yday, sec=sec, & swvdr=swvdr(i), swvdf=swvdf(i), & swidr=swidr(i), swidf=swidf(i), & coszen=coszen(i), fsnow=fsnow(i), & diff --git a/configuration/driver/icedrv_step.F90 b/configuration/driver/icedrv_step.F90 index d96e2bad2..25304ec1f 100644 --- a/configuration/driver/icedrv_step.F90 +++ b/configuration/driver/icedrv_step.F90 @@ -923,7 +923,7 @@ subroutine step_radiation (dt) use icedrv_arrays_column, only: albicen, albsnon, albpndn use icedrv_arrays_column, only: alvdrn, alidrn, alvdfn, alidfn, apeffn, trcrn_sw, snowfracn use icedrv_arrays_column, only: swgrid, igrid - use icedrv_calendar, only: calendar_type, days_per_year, nextsw_cday, yday, sec + use icedrv_calendar, only: yday, sec use icedrv_domain_size, only: ncat, n_aero, nilyr, nslyr, n_zaero, n_algae, nblyr, nx use icedrv_flux, only: swvdr, swvdf, swidr, swidf, coszen, fsnow use icedrv_init, only: TLAT, TLON, tmask @@ -949,7 +949,7 @@ subroutine step_radiation (dt) nlt_zaero_sw, nt_zaero, nt_bgc_N logical (kind=log_kind) :: & - tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, modal_aero, snwgrain + tr_bgc_N, tr_zaero, tr_brine, dEdd_algae, snwgrain real (kind=dbl_kind), dimension(ncat) :: & fbri ! brine height to ice thickness @@ -997,8 +997,7 @@ subroutine step_radiation (dt) 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, & - snwgrain_out=snwgrain) + call icepack_query_parameters(dEdd_algae_out=dEdd_algae, snwgrain_out=snwgrain) call icepack_warnings_flush(nu_diag) if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, & file=__FILE__,line= __LINE__) @@ -1024,7 +1023,7 @@ subroutine step_radiation (dt) call icepack_step_radiation(dt=dt, ncat=ncat, & nblyr=nblyr, nilyr=nilyr, & - nslyr=nslyr, dEdd_algae=dEdd_algae, & + nslyr=nslyr, & swgrid=swgrid(:), igrid=igrid(:), & fbri=fbri(:), & aicen=aicen(i,:), vicen=vicen(i,:), & @@ -1039,10 +1038,7 @@ subroutine step_radiation (dt) zaeron=trcrn(i,nt_zaero(1):nt_zaero(1)+n_zaero*(nblyr+3)-1,:), & trcrn_bgcsw=ztrcr_sw, & TLAT=TLAT(i), TLON=TLON(i), & - calendar_type=calendar_type, & - days_per_year=days_per_year, sec=sec, & - nextsw_cday=nextsw_cday, yday=yday, & - modal_aero=modal_aero, & + sec=sec, yday=yday, & swvdr=swvdr(i), swvdf=swvdf(i), & swidr=swidr(i), swidf=swidf(i), & coszen=coszen(i), fsnow=fsnow(i), & From 69ed7883123126de0b74032a05afc5925dbb5b6d Mon Sep 17 00:00:00 2001 From: apcraig Date: Wed, 7 Sep 2022 19:23:08 -0600 Subject: [PATCH 2/2] - Remove ncat, nilyr, nslyr, nblyr from interface arguments - More indentation adjustments --- columnphysics/icepack_shortwave.F90 | 211 ++++++++------------ configuration/driver/icedrv_init_column.F90 | 6 +- configuration/driver/icedrv_step.F90 | 6 +- 3 files changed, 82 insertions(+), 141 deletions(-) diff --git a/columnphysics/icepack_shortwave.F90 b/columnphysics/icepack_shortwave.F90 index 1bb02e626..5bec38d58 100644 --- a/columnphysics/icepack_shortwave.F90 +++ b/columnphysics/icepack_shortwave.F90 @@ -57,6 +57,7 @@ module icepack_shortwave use icepack_parameters, only: snw_ssp_table, use_snicar, modal_aero use icepack_parameters, only: dEdd_algae + use icepack_tracers, only: ncat, nilyr, nslyr, nblyr use icepack_tracers, only: ntrcr, nbtrcr_sw #ifdef UNDEPRECATE_CESMPONDS use icepack_tracers, only: tr_pond_cesm, tr_pond_lvl, tr_pond_topo @@ -68,14 +69,12 @@ module icepack_shortwave use icepack_tracers, only: tr_zaero, nlt_chl_sw, nlt_zaero_sw use icepack_tracers, only: n_algae, n_aero, n_zaero use icepack_tracers, only: nmodal1, nmodal2, max_aero - use icepack_warnings, only: warnstr, icepack_warnings_add - use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted - + use icepack_shortwave_data, only: nspint_3bd, nspint_5bd use icepack_zbgc_shared,only: R_chl2N, F_abs_chl use icepack_zbgc_shared,only: remap_zbgc - use icepack_orbital, only: compute_coszen - - use icepack_shortwave_data, only: nspint_3bd, nspint_5bd + use icepack_orbital, only: compute_coszen + use icepack_warnings, only: warnstr, icepack_warnings_add + use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted ! dEdd 3-band data use icepack_shortwave_data, only: & @@ -240,12 +239,7 @@ subroutine shortwave_ccsm3 (aicen, vicen, & fswpenl, & Iswabs, SSwabs, & albin, albsn, & - coszen, ncat, & - nilyr) - - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - ncat ! number of ice thickness categories + coszen) real (kind=dbl_kind), dimension (:), intent(in) :: & aicen , & ! concentration of ice per category @@ -412,8 +406,7 @@ subroutine shortwave_ccsm3 (aicen, vicen, & ! Compute solar radiation absorbed in ice and penetrating to ocean. !----------------------------------------------------------------- - call absorbed_solar (nilyr, & - aicen(n), & + call absorbed_solar (aicen(n), & vicen(n), & vsnon(n), & swvdr, swvdf, & @@ -685,7 +678,7 @@ end subroutine constant_albedos ! authors William H. Lipscomb, LANL ! C. M. Bitz, UW - subroutine absorbed_solar (nilyr, aicen, & + subroutine absorbed_solar (aicen, & vicen, vsnon, & swvdr, swvdf, & swidr, swidf, & @@ -702,9 +695,6 @@ subroutine absorbed_solar (nilyr, aicen, & fswpenl, & Iswabs) - integer (kind=int_kind), intent(in) :: & - nilyr ! number of ice layers - real (kind=dbl_kind), intent(in) :: & aicen , & ! fractional ice area vicen , & ! ice volume @@ -878,8 +868,7 @@ end subroutine absorbed_solar ! 2011 ECH modified for melt pond tracers ! 2013 ECH merged with NCAR version - subroutine run_dEdd(dt, ncat, & - nilyr, nslyr, & + subroutine run_dEdd(dt, & aicen, vicen, & vsnon, Tsfcn, & alvln, apndn, & @@ -912,11 +901,6 @@ subroutine run_dEdd(dt, ncat, & l_print_point, & initonly) - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of ice thickness categories - nilyr , & ! number of ice layers - nslyr ! number of snow layers - integer (kind=int_kind), intent(in) :: & sec ! elapsed seconds into date @@ -933,69 +917,69 @@ subroutine run_dEdd(dt, ncat, & nextsw_cday ! julian day of next shortwave calculation real(kind=dbl_kind), intent(in) :: & - dt, & ! time step (s) - TLAT, & ! latitude of temp pts (radians) - TLON, & ! longitude of temp pts (radians) - swvdr, & ! sw down, visible, direct (W/m^2) - swvdf, & ! sw down, visible, diffuse (W/m^2) - swidr, & ! sw down, near IR, direct (W/m^2) - swidf, & ! sw down, near IR, diffuse (W/m^2) - fsnow ! snowfall rate (kg/m^2 s) + dt, & ! time step (s) + TLAT, & ! latitude of temp pts (radians) + TLON, & ! longitude of temp pts (radians) + swvdr, & ! sw down, visible, direct (W/m^2) + swvdf, & ! sw down, visible, diffuse (W/m^2) + swidr, & ! sw down, near IR, direct (W/m^2) + swidf, & ! sw down, near IR, diffuse (W/m^2) + fsnow ! snowfall rate (kg/m^2 s) real(kind=dbl_kind), dimension(:), intent(in) :: & - aicen, & ! concentration of ice - vicen, & ! volume per unit area of ice (m) - vsnon, & ! volume per unit area of snow (m) - Tsfcn, & ! surface temperature (deg C) - alvln, & ! level-ice area fraction - apndn, & ! pond area fraction - hpndn, & ! pond depth (m) - ipndn ! pond refrozen lid thickness (m) + aicen, & ! concentration of ice + vicen, & ! volume per unit area of ice (m) + vsnon, & ! volume per unit area of snow (m) + Tsfcn, & ! surface temperature (deg C) + alvln, & ! level-ice area fraction + apndn, & ! pond area fraction + hpndn, & ! pond depth (m) + ipndn ! pond refrozen lid thickness (m) real(kind=dbl_kind), dimension(:,:), intent(in) :: & - aeron, & ! aerosols (kg/m^3) - trcrn_bgcsw ! zaerosols (kg/m^3) + chlorophyll on shorthwave grid + aeron, & ! aerosols (kg/m^3) + trcrn_bgcsw ! zaerosols (kg/m^3) + chlorophyll on shorthwave grid real(kind=dbl_kind), dimension(:), intent(inout) :: & - ffracn,& ! fraction of fsurfn used to melt ipond - dhsn ! depth difference for snow on sea ice and pond ice + ffracn,& ! fraction of fsurfn used to melt ipond + dhsn ! depth difference for snow on sea ice and pond ice real(kind=dbl_kind), intent(inout) :: & - coszen ! cosine solar zenith angle, < 0 for sun below horizon + coszen ! cosine solar zenith angle, < 0 for sun below horizon real(kind=dbl_kind), dimension(:), intent(inout) :: & - alvdrn, & ! visible direct albedo (fraction) - alvdfn, & ! near-ir direct albedo (fraction) - alidrn, & ! visible diffuse albedo (fraction) - alidfn, & ! near-ir diffuse albedo (fraction) - fswsfcn, & ! SW absorbed at ice/snow surface (W m-2) - fswintn, & ! SW absorbed in ice interior, below surface (W m-2) - fswthrun, & ! SW through ice to ocean (W/m^2) - albicen, & ! albedo bare ice - albsnon, & ! albedo snow - albpndn, & ! albedo pond - apeffn, & ! effective pond area used for radiation calculation - snowfracn ! snow fraction on each category used for radiation + alvdrn, & ! visible direct albedo (fraction) + alvdfn, & ! near-ir direct albedo (fraction) + alidrn, & ! visible diffuse albedo (fraction) + alidfn, & ! near-ir diffuse albedo (fraction) + fswsfcn, & ! SW absorbed at ice/snow surface (W m-2) + fswintn, & ! SW absorbed in ice interior, below surface (W m-2) + fswthrun, & ! SW through ice to ocean (W/m^2) + albicen, & ! albedo bare ice + albsnon, & ! albedo snow + albpndn, & ! albedo pond + apeffn, & ! effective pond area used for radiation calculation + snowfracn ! snow fraction on each category used for radiation real(kind=dbl_kind), dimension(:), intent(out), optional :: & - fswthrun_vdr, & ! vis dir SW through ice to ocean (W/m^2) - fswthrun_vdf, & ! vis dif SW through ice to ocean (W/m^2) - fswthrun_idr, & ! nir dir SW through ice to ocean (W/m^2) - fswthrun_idf ! nir dif SW through ice to ocean (W/m^2) + fswthrun_vdr, & ! vis dir SW through ice to ocean (W/m^2) + fswthrun_vdf, & ! vis dif SW through ice to ocean (W/m^2) + fswthrun_idr, & ! nir dir SW through ice to ocean (W/m^2) + fswthrun_idf ! nir dif SW through ice to ocean (W/m^2) real(kind=dbl_kind), dimension(:,:), intent(inout) :: & - 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) + 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) real(kind=dbl_kind), dimension(:,:), intent(inout), optional :: & - rsnow ! snow grain radius tracer (10^-6 m) + rsnow ! snow grain radius tracer (10^-6 m) logical (kind=log_kind), intent(in) :: & - l_print_point + l_print_point logical (kind=log_kind), optional :: & - initonly ! flag to indicate init only, default is false + initonly ! flag to indicate init only, default is false ! local temporary variables @@ -1082,7 +1066,7 @@ subroutine run_dEdd(dt, ncat, & if (snwgrain) then l_rsnows(:) = rsnow(:,n) endif - call shortwave_dEdd_set_snow(nslyr, R_snw, & + call shortwave_dEdd_set_snow(R_snw, & dT_mlt, rsnw_mlt, & aicen(n), vsnon(n), & Tsfcn(n), fsn, & @@ -1124,7 +1108,7 @@ subroutine run_dEdd(dt, ncat, & alvl = aicen(n) endif ! set snow properties over level ice - call shortwave_dEdd_set_snow(nslyr, R_snw, & + call shortwave_dEdd_set_snow(R_snw, & dT_mlt, rsnw_mlt, & alvl, vsn, & Tsfcn(n), fsn, & @@ -1228,7 +1212,7 @@ subroutine run_dEdd(dt, ncat, & snowfracn(n) = fsn ! for history - call shortwave_dEdd(nslyr, nilyr, & + call shortwave_dEdd( & coszen, & aicen(n), vicen(n), & hsn, fsn, & @@ -1301,8 +1285,7 @@ end subroutine run_dEdd ! author: Bruce P. Briegleb, NCAR ! 2013: E Hunke merged with NCAR version ! - subroutine shortwave_dEdd (nslyr, nilyr, & - coszen, & + subroutine shortwave_dEdd (coszen, & aice, vice, & hs, fs, & rhosnw, rsnw, & @@ -1324,10 +1307,6 @@ subroutine shortwave_dEdd (nslyr, nilyr, & fswpenl, zbio, & l_print_point ) - integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr ! number of snow layers - real (kind=dbl_kind), intent(in) :: & aice , & ! concentration of ice vice , & ! volume of ice @@ -1491,7 +1470,7 @@ subroutine shortwave_dEdd (nslyr, nilyr, & ! calculate bare sea ice srftyp = 0 - call compute_dEdd_3bd(nilyr, nslyr, & + call compute_dEdd_3bd( & klev, klevp, zbio, & fnidr, coszen, & swvdr, swvdf, swidr, swidf, srftyp, & @@ -1529,7 +1508,7 @@ subroutine shortwave_dEdd (nslyr, nilyr, & srftyp = 1 if (use_snicar) then - call compute_dEdd_5bd(nilyr, nslyr, klev, klevp, & + call compute_dEdd_5bd(klev, klevp, & zbio, & fnidr, coszen, & swvdr, swvdf, swidr, swidf, srftyp, & @@ -1542,7 +1521,7 @@ subroutine shortwave_dEdd (nslyr, nilyr, & else !echmod - this can be combined with the 5bd call above, if we use module data - call compute_dEdd_3bd(nilyr, nslyr, & + call compute_dEdd_3bd( & klev, klevp, zbio, & fnidr, coszen, & swvdr, swvdf, swidr, swidf, srftyp, & @@ -1585,7 +1564,7 @@ subroutine shortwave_dEdd (nslyr, nilyr, & ! calculate ponded ice srftyp = 2 - call compute_dEdd_3bd(nilyr, nslyr, & + call compute_dEdd_3bd( & klev, klevp, zbio, & fnidr, coszen, & swvdr, swvdf, swidr, swidf, srftyp, & @@ -1701,7 +1680,7 @@ end subroutine shortwave_dEdd ! 2013: E Hunke merged with NCAR version ! 2022: E Hunke, T Craig moved data (now module data) - subroutine compute_dEdd_3bd(nilyr, nslyr, & + subroutine compute_dEdd_3bd( & klev, klevp, zbio, & fnidr, coszen, & swvdr, swvdf, swidr, swidf, srftyp, & @@ -1718,8 +1697,6 @@ subroutine compute_dEdd_3bd(nilyr, nslyr, & Iswabs, fswpenl ) integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers klev , & ! number of radiation layers - 1 klevp ! number of radiation interfaces - 1 ! (0 layer is included also) @@ -2085,9 +2062,9 @@ subroutine compute_dEdd_3bd(nilyr, nslyr, & ! near-infrared solar (0.7-5.0 micro-meter) which indicates clear/cloudy ! conditions: more cloud, the less 1.19-5.0 relative to the ! 0.7-1.19 micro-meter due to cloud absorption. - wghtns(1) = c1 - wghtns(2) = cp67 + (cp78-cp67)*(c1-fnidr) - wghtns(3) = c1 - wghtns(2) + wghtns(1) = c1 + wghtns(2) = cp67 + (cp78-cp67)*(c1-fnidr) + wghtns(3) = c1 - wghtns(2) ! find snow grain adjustment factor, dependent upon clear/overcast sky ! estimate. comparisons with SNICAR show better agreement with DE when @@ -2730,7 +2707,7 @@ subroutine compute_dEdd_3bd(nilyr, nslyr, & ! the surface; see comments in solution_dEdd for more details. call solution_dEdd & - (coszen, srftyp, klev, klevp, nslyr, & + (coszen, srftyp, klev, klevp, & tau, w0, g, albodr, albodf, & trndir, trntdr, trndif, rupdir, rupdif, & rdndif) @@ -2962,7 +2939,7 @@ end subroutine compute_dEdd_3bd ! author: Bruce P. Briegleb, NCAR ! 2013: E Hunke merged with NCAR version subroutine solution_dEdd & - (coszen, srftyp, klev, klevp, nslyr, & + (coszen, srftyp, klev, klevp, & tau, w0, g, albodr, albodf, & trndir, trntdr, trndif, rupdir, rupdif, & rdndif) @@ -2973,9 +2950,8 @@ subroutine solution_dEdd & integer (kind=int_kind), intent(in) :: & srftyp , & ! surface type over ice: (0=air, 1=snow, 2=pond) klev , & ! number of radiation layers - 1 - klevp , & ! number of radiation interfaces - 1 + klevp ! number of radiation interfaces - 1 ! (0 layer is included also) - nslyr ! number of snow layers real (kind=dbl_kind), dimension(0:klev), intent(in) :: & tau , & ! layer extinction optical depth @@ -3420,7 +3396,7 @@ end subroutine solution_dEdd ! author: Bruce P. Briegleb, NCAR ! 2013: E Hunke merged with NCAR version - subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & + subroutine shortwave_dEdd_set_snow(R_snw, & dT_mlt, rsnw_mlt, & aice, vsno, & Tsfc, fs, & @@ -3428,9 +3404,6 @@ subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & rhosnw, rsnw, & rsnow) - integer (kind=int_kind), intent(in) :: & - nslyr ! number of snow layers - real (kind=dbl_kind), intent(in) :: & R_snw , & ! snow tuning parameter; +1 > ~.01 change in broadband albedo dT_mlt, & ! change in temp for non-melt to melt snow grain radius change (C) @@ -3560,22 +3533,14 @@ end subroutine shortwave_dEdd_set_pond ! ! authors Nicole Jeffery, LANL - subroutine compute_shortwave_trcr(nslyr, & + subroutine compute_shortwave_trcr( & bgcN, zaero, & trcrn_bgcsw, & sw_grid, hin, & hbri, & - nilyr, nblyr, & i_grid, & skl_bgc, z_tracers ) - integer (kind=int_kind), intent(in) :: & - nslyr ! number of snow layers - - integer (kind=int_kind), intent(in) :: & - nblyr , & ! number of bio layers - nilyr ! number of ice layers - real (kind=dbl_kind), dimension (:), intent(in) :: & bgcN , & ! Nit tracer zaero ! zaero tracer @@ -3720,8 +3685,7 @@ end subroutine compute_shortwave_trcr ! ! authors: Elizabeth Hunke, LANL - subroutine icepack_prep_radiation (ncat, nilyr, nslyr, & - aice, aicen, & + subroutine icepack_prep_radiation(aice, aicen, & swvdr, swvdf, & swidr, swidf, & alvdr_ai, alvdf_ai, & @@ -3736,11 +3700,6 @@ subroutine icepack_prep_radiation (ncat, nilyr, nslyr, & fswpenln, & Sswabsn, Iswabsn) - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of ice thickness categories - nilyr , & ! number of ice layers - nslyr ! number of snow layers - real (kind=dbl_kind), intent(in) :: & aice , & ! ice area fraction swvdr , & ! sw down, visible, direct (W/m^2) @@ -3839,9 +3798,7 @@ end subroutine icepack_prep_radiation ! David Bailey, NCAR ! Elizabeth C. Hunke, LANL - subroutine icepack_step_radiation (dt, ncat, & - nblyr, & - nilyr, nslyr, & + subroutine icepack_step_radiation (dt, & swgrid, igrid, & fbri, & aicen, vicen, & @@ -3877,12 +3834,6 @@ subroutine icepack_step_radiation (dt, ncat, & l_print_point, & initonly) - integer (kind=int_kind), intent(in) :: & - ncat , & ! number of ice thickness categories - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers - nblyr ! number of bgc layers - real (kind=dbl_kind), intent(in) :: & dt , & ! time step (s) swvdr , & ! sw down, visible, direct (W/m^2) @@ -3983,8 +3934,8 @@ subroutine icepack_step_radiation (dt, ncat, & first_call=.true. ! first call logical real(kind=dbl_kind) :: & - hin, & ! Ice thickness (m) - hbri ! brine thickness (m) + hin, & ! Ice thickness (m) + hbri ! brine thickness (m) character(len=*),parameter :: subname='(icepack_step_radiation)' @@ -4029,13 +3980,12 @@ subroutine icepack_step_radiation (dt, ncat, & if (aicen(n) .gt. puny) then hin = vicen(n)/aicen(n) hbri= fbri(n)*hin - call compute_shortwave_trcr(nslyr, & + call compute_shortwave_trcr( & bgcNn(:,n), & zaeron(:,n), & trcrn_bgcsw(:,n), & swgrid, hin, & hbri, & - nilyr, nblyr, & igrid, & skl_bgc, z_tracers ) if (icepack_warnings_aborted(subname)) return @@ -4046,8 +3996,7 @@ subroutine icepack_step_radiation (dt, ncat, & if (calc_Tsfc) then if (trim(shortwave(1:4)) == 'dEdd') then ! delta Eddington - call run_dEdd(dt, ncat, & - nilyr, nslyr, & + call run_dEdd(dt, & aicen, vicen, & vsnon, Tsfcn, & alvln, apndn, & @@ -4108,9 +4057,7 @@ subroutine icepack_step_radiation (dt, ncat, & Sswabs=Sswabsn, & albin=albicen, & albsn=albsnon, & - coszen=coszen, & - ncat=ncat, & - nilyr=nilyr) + coszen=coszen) if (icepack_warnings_aborted(subname)) return else @@ -4277,7 +4224,7 @@ end function asys ! cryospheric surfaces in ESMs, The Cryosphere Discuss., ! https://doi.org/10.5194/tc-2019-22, in review, 2019 - subroutine compute_dEdd_5bd (nilyr, nslyr, klev, klevp, & + subroutine compute_dEdd_5bd (klev, klevp, & zbio, fnidr, coszen, & swvdr, swvdf, swidr, swidf, srftyp, & hs, rhosnw, rsnw, hi, hp, & @@ -4288,8 +4235,6 @@ subroutine compute_dEdd_5bd (nilyr, nslyr, klev, klevp, & Iswabs, fswpenl ) integer (kind=int_kind), intent(in) :: & - nilyr , & ! number of ice layers - nslyr , & ! number of snow layers klev , & ! number of radiation layers - 1 klevp ! number of radiation interfaces - 1 ! (0 layer is included also) @@ -5332,7 +5277,7 @@ subroutine compute_dEdd_5bd (nilyr, nslyr, klev, klevp, & ! underlying ocean and combine successive layers upwards to ! the surface; see comments in solution_dEdd for more details. call solution_dEdd & - (coszen, srftyp, klev, klevp, nslyr, & + (coszen, srftyp, klev, klevp, & tau, w0, g, albodr, albodf, & trndir, trntdr, trndif, rupdir, rupdif, & rdndif) diff --git a/configuration/driver/icedrv_init_column.F90 b/configuration/driver/icedrv_init_column.F90 index ad5a2aa2f..ec77837ef 100644 --- a/configuration/driver/icedrv_init_column.F90 +++ b/configuration/driver/icedrv_init_column.F90 @@ -247,10 +247,8 @@ subroutine init_shortwave enddo if (tmask(i)) then - call icepack_step_radiation ( & - dt=dt, ncat=ncat, & - nblyr=nblyr, & - nilyr=nilyr, nslyr=nslyr, & + call icepack_step_radiation ( & + dt=dt, & swgrid=swgrid(:), & igrid=igrid(:), & fbri=fbri(:), & diff --git a/configuration/driver/icedrv_step.F90 b/configuration/driver/icedrv_step.F90 index 25304ec1f..2b0a4042d 100644 --- a/configuration/driver/icedrv_step.F90 +++ b/configuration/driver/icedrv_step.F90 @@ -67,7 +67,7 @@ subroutine prep_radiation () alidr_init(i) = alidr_ai(i) alidf_init(i) = alidf_ai(i) - call icepack_prep_radiation(ncat=ncat, nilyr=nilyr, nslyr=nslyr, & + call icepack_prep_radiation( & aice=aice(i), aicen=aicen(i,:), & swvdr=swvdr(i), swvdf=swvdf(i), & swidr=swidr(i), swidf=swidf(i), & @@ -1021,9 +1021,7 @@ subroutine step_radiation (dt) if (tmask(i)) then - call icepack_step_radiation(dt=dt, ncat=ncat, & - nblyr=nblyr, nilyr=nilyr, & - nslyr=nslyr, & + call icepack_step_radiation(dt=dt, & swgrid=swgrid(:), igrid=igrid(:), & fbri=fbri(:), & aicen=aicen(i,:), vicen=vicen(i,:), &