diff --git a/columnphysics/icepack_aerosol.F90 b/columnphysics/icepack_aerosol.F90 index 1d2f2b2a4..68b8d0a7a 100644 --- a/columnphysics/icepack_aerosol.F90 +++ b/columnphysics/icepack_aerosol.F90 @@ -14,7 +14,7 @@ module icepack_aerosol use icepack_warnings, only: warnstr, icepack_warnings_add use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted - use icepack_zbgc_shared, only: kscavz + use icepack_zbgc_shared, only: kscavz implicit none @@ -59,7 +59,7 @@ subroutine update_aerosol(dt, & aicen, & ! ice area fraction aice_old, & ! values prior to thermodynamic changes vice_old, & - vsno_old + vsno_old real (kind=dbl_kind), dimension(:), & intent(in) :: & @@ -101,9 +101,9 @@ subroutine update_aerosol(dt, & ! echmod: this assumes max_aero=6 data kscav / .03_dbl_kind, .20_dbl_kind, .02_dbl_kind, & - .02_dbl_kind, .01_dbl_kind, .01_dbl_kind / + .02_dbl_kind, .01_dbl_kind, .01_dbl_kind / data kscavsi / .03_dbl_kind, .20_dbl_kind, .02_dbl_kind, & - .02_dbl_kind, .01_dbl_kind, .01_dbl_kind / + .02_dbl_kind, .01_dbl_kind, .01_dbl_kind / character(len=*),parameter :: subname='(update_aerosol)' @@ -111,17 +111,17 @@ subroutine update_aerosol(dt, & ! initialize !------------------------------------------------------------------- focn_old(:) = faero_ocn(:) - + hs_old = vsno_old/aice_old hi_old = vice_old/aice_old hslyr_old = hs_old/real(nslyr,kind=dbl_kind) hilyr_old = hi_old/real(nilyr,kind=dbl_kind) - + dzssl = min(hslyr_old/c2, hs_ssl) dzssli = min(hilyr_old/c2, hi_ssl) dzint = hs_old - dzssl dzinti = hi_old - dzssli - + if (aicen > c0) then ar = c1/aicen else ! ice disappeared during time step @@ -146,7 +146,7 @@ subroutine update_aerosol(dt, & aerotot0(k) = aerosno(k,2) + aerosno(k,1) & + aeroice(k,2) + aeroice(k,1) enddo - + !------------------------------------------------------------------- ! evaporation !------------------------------------------------------------------- @@ -212,7 +212,7 @@ subroutine update_aerosol(dt, & aeroice(k,2) = aeroice(k,2) - sloss2 faero_ocn(k) = faero_ocn(k) + (sloss1+sloss2)/dt enddo - + dzinti = dzinti + min(dzssli+dhi_meltt, c0) dzssli = max(dzssli+dhi_meltt, c0) if (dzssli <= puny) then ! ssl ice melts away @@ -251,7 +251,7 @@ subroutine update_aerosol(dt, & enddo dzssli = dzssli + min(dzinti+dhi_meltb, c0) - dzinti = max(dzinti+dhi_meltb, c0) + dzinti = max(dzinti+dhi_meltb, c0) endif !------------------------------------------------------------------- @@ -292,7 +292,7 @@ subroutine update_aerosol(dt, & else hs = c0 endif - if (hs > hs_min) then ! should this really be hs_min or 0? + if (hs > hs_min) then ! should this really be hs_min or 0? ! should use same hs_min value as in radiation do k=1,n_aero aerosno(k,1) = aerosno(k,1) & @@ -333,7 +333,7 @@ subroutine update_aerosol(dt, & aeroice(k,1) = c0 enddo endif - + if (dzinti <= puny) then ! nothing in Ice INT do k = 1, n_aero faero_ocn(k) = faero_ocn(k) & @@ -341,7 +341,7 @@ subroutine update_aerosol(dt, & aeroice(k,:)=c0 enddo endif - + hslyr = hs/real(nslyr,kind=dbl_kind) hilyr = hi/real(nilyr,kind=dbl_kind) dzssl_new = min(hslyr/c2, hs_ssl) @@ -356,7 +356,7 @@ subroutine update_aerosol(dt, & dznew = max(dzssl_new-dzssl, c0) if (dzint > puny) & sloss1 = sloss1 + aerosno(k,2)*dznew/dzint - aerosno(k,1) = aerosno(k,1) + sloss1 + aerosno(k,1) = aerosno(k,1) + sloss1 aerosno(k,2) = aerosno(k,2) - sloss1 enddo else @@ -364,24 +364,24 @@ subroutine update_aerosol(dt, & + aerosno(:,1) + aerosno(:,2) aerosno(:,:) = c0 endif - + if (vicen > puny) then ! may want a limit on hi instead? do k = 1, n_aero sloss2 = c0 dznew = min(dzssli_new-dzssli, c0) - if (dzssli > puny) & + if (dzssli > puny) & sloss2 = dznew*aeroice(k,1)/dzssli dznew = max(dzssli_new-dzssli, c0) - if (dzinti > puny) & + if (dzinti > puny) & sloss2 = sloss2 + aeroice(k,2)*dznew/dzinti - aeroice(k,1) = aeroice(k,1) + sloss2 + aeroice(k,1) = aeroice(k,1) + sloss2 aeroice(k,2) = aeroice(k,2) - sloss2 enddo else faero_ocn(:) = faero_ocn(:) + (aeroice(:,1)+aeroice(:,2))/dt aeroice(:,:) = c0 endif - + !------------------------------------------------------------------- ! check conservation !------------------------------------------------------------------- @@ -406,7 +406,7 @@ subroutine update_aerosol(dt, & ! check for negative values !------------------------------------------------------------------- -!echmod: note that this does not test or fix all aero tracers +!echmod: note that this does not test or fix all aero tracers if (aeroice(1,1) < -puny .or. & aeroice(1,2) < -puny .or. & aerosno(1,1) < -puny .or. & @@ -449,7 +449,7 @@ subroutine update_snow_bgc (dt, nblyr, & ntrcr ! number of tracers integer (kind=int_kind), dimension (nbtrcr), intent(in) :: & - bio_index + bio_index real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -466,7 +466,7 @@ subroutine update_snow_bgc (dt, nblyr, & aicen, & ! ice area fraction aice_old, & ! values prior to thermodynamic changes vice_old, & - vsno_old + vsno_old real (kind=dbl_kind),dimension(nbtrcr), intent(inout) :: & zbgc_snow, & ! aerosol contribution from snow to ice @@ -547,21 +547,21 @@ subroutine update_snow_bgc (dt, nblyr, & do k=1,nbtrcr flux_bio(k) = flux_bio(k) + & (trcrn(bio_index(k)+ nblyr+1)*dzssl+ & - trcrn(bio_index(k)+ nblyr+2)*dzint)/dt + trcrn(bio_index(k)+ nblyr+2)*dzint)/dt trcrn(bio_index(k) + nblyr+1) = c0 trcrn(bio_index(k) + nblyr+2) = c0 zbgc_atm(k) = zbgc_atm(k) & - + flux_bio_atm(k)*dt + + flux_bio_atm(k)*dt enddo - else - + else + do k=1,nbtrcr flux_bio_o(k) = flux_bio(k) aerosno (k,1) = trcrn(bio_index(k)+ nblyr+1) * dzssl aerosno (k,2) = trcrn(bio_index(k)+ nblyr+2) * dzint aerosno0(k,:) = aerosno(k,:) - aerotot0(k) = aerosno(k,2) + aerosno(k,1) + aerotot0(k) = aerosno(k,2) + aerosno(k,1) enddo !------------------------------------------------------------------- @@ -586,7 +586,7 @@ subroutine update_snow_bgc (dt, nblyr, & *max(-dhs_melts-dzssl,c0)/dzint aerosno(k,2) = aerosno(k,2) - sloss2 zbgc_snow(k) = zbgc_snow(k) + (sloss1+sloss2) - enddo ! + enddo ! ! update snow thickness dzint=dzint+min(dzssl+dhs_melts, c0) @@ -608,7 +608,7 @@ subroutine update_snow_bgc (dt, nblyr, & !------------------------------------------------------------------- ! snowfall !------------------------------------------------------------------- - if (fsnow > c0) dzssl = dzssl + fsnow/rhos*dt + if (fsnow > c0) dzssl = dzssl + fsnow/rhos*dt !------------------------------------------------------------------- ! snow-ice formation @@ -640,13 +640,13 @@ subroutine update_snow_bgc (dt, nblyr, & else hs = c0 endif - if (hs >= hs_min) then !should this really be hs_min or 0? + if (hs >= hs_min) then !should this really be hs_min or 0? ! should use same hs_min value as in radiation do k=1,nbtrcr aerosno(k,1) = aerosno(k,1) & + flux_bio_atm(k)*dt enddo - else + else do k=1,nbtrcr zbgc_atm(k) = zbgc_atm(k) & + flux_bio_atm(k)*dt @@ -678,7 +678,7 @@ subroutine update_snow_bgc (dt, nblyr, & dzssl_new = min(hslyr/c2, hs_ssl) dzint_new = hs - dzssl_new - if (hs > hs_min) then !should this really be hs_min or 0? + if (hs > hs_min) then !should this really be hs_min or 0? do k = 1, nbtrcr dznew = min(dzssl_new-dzssl, c0) sloss1 = c0 @@ -687,7 +687,7 @@ subroutine update_snow_bgc (dt, nblyr, & dznew = max(dzssl_new-dzssl, c0) if (dzint > puny) & sloss1 = sloss1 + aerosno(k,2)*dznew/dzint - aerosno(k,1) = aerosno(k,1) + sloss1 + aerosno(k,1) = aerosno(k,1) + sloss1 aerosno(k,2) = aerosno(k,2) - sloss1 enddo else @@ -701,11 +701,11 @@ subroutine update_snow_bgc (dt, nblyr, & !------------------------------------------------------------------- do k = 1, nbtrcr aerotot(k) = aerosno(k,2) + aerosno(k,1) & - + zbgc_snow(k) + zbgc_atm(k) + + zbgc_snow(k) + zbgc_atm(k) aero_cons(k) = aerotot(k)-aerotot0(k) & - - ( flux_bio_atm(k) & + - ( flux_bio_atm(k) & - (flux_bio(k)-flux_bio_o(k))) * dt - if (aero_cons(k) > puny .or. zbgc_snow(k) + zbgc_atm(k) < c0) then + if (aero_cons(k) > puny .or. zbgc_snow(k) + zbgc_atm(k) < c0) then write(warnstr,*) subname, 'Conservation failure: aerosols in snow' call icepack_warnings_add(warnstr) write(warnstr,*) subname, 'test aerosol 1' @@ -735,7 +735,7 @@ subroutine update_snow_bgc (dt, nblyr, & !------------------------------------------------------------------- if (vsnon > puny) then do k = 1,nbtrcr - trcrn(bio_index(k)+nblyr+1)=aerosno(k,1)/dzssl_new + trcrn(bio_index(k)+nblyr+1)=aerosno(k,1)/dzssl_new trcrn(bio_index(k)+nblyr+2)=aerosno(k,2)/dzint_new enddo else diff --git a/columnphysics/icepack_age.F90 b/columnphysics/icepack_age.F90 index 78dea0318..e3eedf27b 100644 --- a/columnphysics/icepack_age.F90 +++ b/columnphysics/icepack_age.F90 @@ -32,7 +32,7 @@ subroutine increment_age (dt, iage) character(len=*),parameter :: subname='(increment_age)' - iage = iage + dt + iage = iage + dt end subroutine increment_age diff --git a/columnphysics/icepack_algae.F90 b/columnphysics/icepack_algae.F90 index c22fa8d1d..4a3bce7ac 100644 --- a/columnphysics/icepack_algae.F90 +++ b/columnphysics/icepack_algae.F90 @@ -27,7 +27,7 @@ module icepack_algae use icepack_parameters, only: y_sk_DMS , t_sk_conv use icepack_parameters, only: t_sk_ox - use icepack_tracers, only: ntrcr, bio_index + use icepack_tracers, only: ntrcr, bio_index use icepack_tracers, only: nt_bgc_N, nt_fbri, nt_zbgc_frac use icepack_tracers, only: tr_brine use icepack_tracers, only: tr_bgc_Nit, tr_bgc_Am, tr_bgc_Sil @@ -62,10 +62,10 @@ module icepack_algae implicit none - private + private public :: zbio, sklbio - real (kind=dbl_kind), parameter :: & + real (kind=dbl_kind), parameter :: & exp_argmax = c10 ! maximum argument of exponential !======================================================================= @@ -84,18 +84,18 @@ subroutine zbio (dt, nblyr, & aice_old, & vice_old, vsno_old, & vicen, vsnon, & - aicen, flux_bio_atm,& - n_cat, n_algae, & + aicen, flux_bio_atm,& + n_cat, n_algae, & n_doc, n_dic, & n_don, & n_fed, n_fep, & n_zaero, first_ice, & - hice_old, ocean_bio, & + hice_old, ocean_bio, & bphin, iphin, & iDin, & fswthrul, & dh_top, dh_bot, & - zfswin, & + zfswin, & hbri, hbri_old, & ! darcy_V, darcy_V_chl, & darcy_V, & @@ -122,7 +122,7 @@ subroutine zbio (dt, nblyr, & ntrcr ! number of tracers integer (kind=int_kind), dimension (nbtrcr), intent(in) :: & - bio_index + bio_index real (kind=dbl_kind), intent(in) :: & dt, & ! time step @@ -163,12 +163,12 @@ subroutine zbio (dt, nblyr, & real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid , & ! biology vertical interface points iTin , & ! salinity vertical interface points - iphin , & ! Porosity on the igrid + iphin , & ! Porosity on the igrid iDin ! Diffusivity/h on the igrid (1/s) - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - icgrid , & ! CICE interface coordinate - fswthrul ! visible short wave radiation on icgrid (W/m^2) + icgrid , & ! CICE interface coordinate + fswthrul ! visible short wave radiation on icgrid (W/m^2) real (kind=dbl_kind), dimension(nbtrcr), & intent(in) :: & @@ -176,26 +176,26 @@ subroutine zbio (dt, nblyr, & real (kind=dbl_kind), dimension(ntrcr), & intent(inout) :: & - trcrn + trcrn - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - zfswin ! visible Short wave flux on igrid (W/m^2) - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & + real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & + zfswin ! visible Short wave flux on igrid (W/m^2) + + real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & Zoo ! N losses to the system from reaction terms - ! (ie. zooplankton/bacteria) (mmol/m^3) + ! (ie. zooplankton/bacteria) (mmol/m^3) - real (kind=dbl_kind), dimension (nbtrcr), intent(in) :: & + real (kind=dbl_kind), dimension (nbtrcr), intent(in) :: & !change to inout when updating ocean fields - ocean_bio ! ocean concentrations (mmol/m^3) + ocean_bio ! ocean concentrations (mmol/m^3) real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & bphin ! Porosity on the bgrid - real (kind=dbl_kind), intent(inout):: & + real (kind=dbl_kind), intent(inout):: & PP_net , & ! net PP (mg C/m^2/d) times aice grow_net , & ! net specific growth (m/d) times vice - upNO , & ! tot nitrate uptake rate (mmol/m^2/d) times aice + upNO , & ! tot nitrate uptake rate (mmol/m^2/d) times aice upNH ! tot ammonium uptake rate (mmol/m^2/d) times aice logical (kind=log_kind), intent(in) :: & @@ -244,7 +244,7 @@ subroutine zbio (dt, nblyr, & hsnow_i = c0 hsnow_f = c0 write_flux_diag = .false. - + if (write_flux_diag) then if (aice_old > c0) then hsnow_i = vsno_old/aice_old @@ -256,7 +256,7 @@ subroutine zbio (dt, nblyr, & enddo endif endif - + call update_snow_bgc (dt, nblyr, & nslyr, & meltt, melts, & @@ -274,19 +274,19 @@ subroutine zbio (dt, nblyr, & call z_biogeochemistry (n_cat, dt, & nilyr, & nblyr, nbtrcr, & - n_algae, n_doc, & + n_algae, n_doc, & n_dic, n_don, & n_fed, n_fep, & n_zaero, first_ice, & - aicen, vicen, & - hice_old, ocean_bio, & + aicen, vicen, & + hice_old, ocean_bio, & flux_bion, bphin, & - iphin, trcrn, & + iphin, trcrn, & iDin, & fswthrul, grow_alg, & upNOn, upNHn, & dh_top, dh_bot, & - zfswin, hbri, & + zfswin, hbri, & hbri_old, darcy_V, & ! darcy_V_chl, bgrid, & bgrid, & @@ -297,7 +297,7 @@ subroutine zbio (dt, nblyr, & Zoo, meltb, & congel ) if (icepack_warnings_aborted(subname)) return - + do mm = 1,nbtrcr flux_bion(mm) = flux_bion(mm) + flux_bio_sno(mm) enddo @@ -334,7 +334,7 @@ subroutine zbio (dt, nblyr, & call merge_bgc_fluxes (dt, nblyr, & nslyr, & bio_index, n_algae, & - nbtrcr, aicen, & + nbtrcr, aicen, & vicen, vsnon, & iphin, & trcrn, & @@ -347,7 +347,7 @@ subroutine zbio (dt, nblyr, & snow_bio_net, grow_alg, & grow_net) if (icepack_warnings_aborted(subname)) return - + if (write_flux_diag) then if (aicen > c0) then if (n_cat .eq. 1) a_ice = c0 @@ -369,7 +369,7 @@ subroutine zbio (dt, nblyr, & endif endif - end subroutine zbio + end subroutine zbio !======================================================================= @@ -403,7 +403,7 @@ subroutine sklbio (dt, ntrcr, & aicen, & ! ice area fraction meltb, & ! bottom melt (m) congel, & ! bottom growth (m) - fswthru ! visible shortwave passing to ocean(W/m^2) + fswthru ! visible shortwave passing to ocean(W/m^2) real (kind=dbl_kind), dimension(ntrcr), intent(inout) :: & trcrn ! bulk concentration per m^3 @@ -415,10 +415,10 @@ subroutine sklbio (dt, ntrcr, & ocean_bio ! ocean tracer concentration (mmol/m^3) ! history output - real (kind=dbl_kind), intent(inout):: & + real (kind=dbl_kind), intent(inout):: & PP_net , & ! Bulk net PP (mg C/m^2/s) grow_net, & ! net specific growth (/s) - upNO , & ! tot nitrate uptake rate (mmol/m^2/s) + upNO , & ! tot nitrate uptake rate (mmol/m^2/s) upNH ! tot ammonium uptake rate (mmol/m^2/s) ! local variables @@ -459,13 +459,13 @@ subroutine sklbio (dt, ntrcr, & upNH, grow_net, & grow_alg) if (icepack_warnings_aborted(subname)) return - - end subroutine sklbio + + end subroutine sklbio !======================================================================= ! ! skeletal layer biochemistry -! +! subroutine skl_biogeochemistry (dt, & n_doc, & n_dic, n_don, & @@ -483,11 +483,11 @@ subroutine skl_biogeochemistry (dt, & nbtrcr , n_algae ! number of bgc tracers and number algae real (kind=dbl_kind), intent(in) :: & - dt , & ! time step + dt , & ! time step ! hmix , & ! mixed layer depth -! aicen , & ! ice area +! aicen , & ! ice area meltb , & ! bottom ice melt - congel , & ! bottom ice growth + congel , & ! bottom ice growth fswthru ! shortwave passing through ice to ocean logical (kind=log_kind), intent(in) :: & @@ -495,9 +495,9 @@ subroutine skl_biogeochemistry (dt, & real (kind=dbl_kind), dimension(:), intent(inout) :: & trcrn ! bulk concentration per m^3 - + ! history variables - + real (kind=dbl_kind), dimension (:), intent(out) :: & flux_bio ! ocean tracer flux (mmol/m^2/s) positive into ocean @@ -505,9 +505,9 @@ subroutine skl_biogeochemistry (dt, & ocean_bio ! ocean tracer concentration (mmol/m^3) real (kind=dbl_kind), dimension (:), intent(out) :: & - grow_alg_skl, & ! tot algal growth rate (mmol/m^3/s) - upNOn , & ! algal NO uptake rate (mmol/m^3/s) - upNHn ! algal NH uptake rate (mmol/m^3/s) + grow_alg_skl, & ! tot algal growth rate (mmol/m^3/s) + upNOn , & ! algal NO uptake rate (mmol/m^3/s) + upNHn ! algal NH uptake rate (mmol/m^3/s) ! local variables @@ -517,7 +517,7 @@ subroutine skl_biogeochemistry (dt, & react , & ! biological sources and sinks (mmol/m^3) cinit , & ! initial brine concentration*sk_l (mmol/m^2) cinit_v , & ! initial brine concentration (mmol/m^3) - congel_alg , & ! congelation flux contribution to ice algae (mmol/m^2 s) + congel_alg , & ! congelation flux contribution to ice algae (mmol/m^2 s) ! (used as initialization) f_meltn , & ! vertical melt fraction of skeletal layer in dt flux_bio_temp, & ! tracer flux to ocean (mmol/m^2 s) @@ -527,7 +527,7 @@ subroutine skl_biogeochemistry (dt, & real (kind=dbl_kind) :: & Zoo_skl , & ! N losses from zooplankton/bacteria ... (mmol/m^3) iTin , & - PVt , & ! type 'Jin2006' piston velocity (m/s) + PVt , & ! type 'Jin2006' piston velocity (m/s) ice_growth , & ! Jin2006 definition: either congel rate or bottom melt rate (m/s) grow_val , & ! (m/x) rphi_sk , & ! 1 / skeletal layer porosity @@ -535,14 +535,14 @@ subroutine skl_biogeochemistry (dt, & Nerror ! change in total nitrogen from reactions real (kind=dbl_kind), parameter :: & - PVc = 1.e-6_dbl_kind , & ! type 'constant' piston velocity for interface (m/s) + PVc = 1.e-6_dbl_kind , & ! type 'constant' piston velocity for interface (m/s) PV_scale_growth = p5 , & ! scale factor in Jin code PV during ice growth PV_scale_melt = p05 , & ! scale factor in Jin code PV during ice melt growth_max = 1.85e-5_dbl_kind , & ! PVt function reaches maximum here. (m/s) Tin_bot = -1.8_dbl_kind , & ! temperature of the ice bottom (oC) MJ1 = 9.667e-9_dbl_kind , & ! (m/s) coefficients in Jin2008 - MJ2 = 38.8_dbl_kind , & ! (1) from:4.49e-4_dbl_kind*secday - MJ3 = 1.04e7_dbl_kind , & ! 1/(m/s) from: 1.39e-3_dbl_kind*secday^2 + MJ2 = 38.8_dbl_kind , & ! (1) from:4.49e-4_dbl_kind*secday + MJ3 = 1.04e7_dbl_kind , & ! 1/(m/s) from: 1.39e-3_dbl_kind*secday^2 PV_frac_max = 0.9_dbl_kind ! Maximum Piston velocity is 90% of skeletal layer/dt logical (kind=log_kind) :: conserve_N @@ -550,7 +550,7 @@ subroutine skl_biogeochemistry (dt, & character(len=*),parameter :: subname='(skl_biogeochemistry)' !----------------------------------------------------------------- - ! Initialize + ! Initialize !----------------------------------------------------------------- conserve_N = .true. @@ -559,9 +559,9 @@ subroutine skl_biogeochemistry (dt, & PVt = c0 iTin = Tin_bot - do nn = 1, nbtrcr + do nn = 1, nbtrcr cinit (nn) = c0 - cinit_v (nn) = c0 + cinit_v (nn) = c0 congel_alg(nn) = c0 f_meltn (nn) = c0 react (nn) = c0 @@ -574,13 +574,13 @@ subroutine skl_biogeochemistry (dt, & ! NOTE: retention times are not used in skl model !----------------------------------------------------------------- - if (bgc_tracer_type(nn) >= c0) then + if (bgc_tracer_type(nn) >= c0) then PVflag(nn) = c0 cling (nn) = c1 endif - + ice_growth = (congel-meltb)/dt - if (first_ice) then + if (first_ice) then trcrn(bio_index(nn)) = ocean_bio(nn) ! * sk_l*rphi_sk endif ! first_ice cinit (nn) = trcrn(bio_index(nn)) * sk_l * rphi_sk @@ -592,42 +592,42 @@ subroutine skl_biogeochemistry (dt, & call icepack_warnings_add(subname//' cinit < c0') call icepack_warnings_setabort(.true.,__FILE__,__LINE__) return - endif + endif enddo ! nbtrcr if (icepack_warnings_aborted(subname)) return - if (trim(bgc_flux_type) == 'Jin2006') then - + if (trim(bgc_flux_type) == 'Jin2006') then + !----------------------------------------------------------------- ! 'Jin2006': ! 1. congel/melt dependent piston velocity (PV) for growth and melt ! 2. If congel > melt use 'congel'; if melt > congel use 'melt' - ! 3. For algal N, PV for ice growth only provides a seeding concentration + ! 3. For algal N, PV for ice growth only provides a seeding concentration ! 4. Melt affects nutrients and algae in the same manner through PV(melt) !----------------------------------------------------------------- if (ice_growth > c0) then ! ice_growth = congel/dt - grow_val = min(ice_growth,growth_max) + grow_val = min(ice_growth,growth_max) PVt = -min(abs(PV_scale_growth*(MJ1 + MJ2*grow_val & - MJ3*grow_val**2)), & - PV_frac_max*sk_l/dt) + PV_frac_max*sk_l/dt) else ! ice_growth = -meltb/dt PVt = min(abs(PV_scale_melt *( MJ2*ice_growth & - MJ3*ice_growth**2)), & PV_frac_max*sk_l/dt) endif - do nn = 1, nbtrcr + do nn = 1, nbtrcr if (bgc_tracer_type(nn) >= c0) then if (ice_growth < c0) then ! flux from ice to ocean - ! Algae and clinging tracers melt like nutrients + ! Algae and clinging tracers melt like nutrients f_meltn(nn) = PVt*cinit_v(nn) ! for algae only elseif (ice_growth > c0 .AND. & cinit(nn) < ocean_bio(nn)*sk_l/phi_sk) then - ! Growth only contributes to seeding from ocean + ! Growth only contributes to seeding from ocean congel_alg(nn) = (ocean_bio(nn)*sk_l/phi_sk - cinit(nn))/dt - endif ! PVt > c0 - endif + endif ! PVt > c0 + endif enddo else ! bgc_flux_type = 'constant' @@ -635,7 +635,7 @@ subroutine skl_biogeochemistry (dt, & !----------------------------------------------------------------- ! 'constant': ! 1. Constant PV for congel > melt - ! 2. For algae, PV for ice growth only provides a seeding concentration + ! 2. For algae, PV for ice growth only provides a seeding concentration ! 3. Melt loss (f_meltn) affects algae only and is proportional to melt !----------------------------------------------------------------- @@ -656,13 +656,13 @@ subroutine skl_biogeochemistry (dt, & ! begin building biogeochemistry terms !----------------------------------------------------------------- - react(:) = c0 + react(:) = c0 grow_alg_skl(:) = c0 call algal_dyn (dt, & n_doc, n_dic, n_don, n_fed, n_fep, & dEdd_algae, & - fswthru, react, & + fswthru, react, & cinit_v, & grow_alg_skl(:), n_algae, & iTin, & @@ -674,14 +674,14 @@ subroutine skl_biogeochemistry (dt, & !----------------------------------------------------------------- ! compute new tracer concencentrations !----------------------------------------------------------------- - + do nn = 1, nbtrcr !----------------------------------------------------------------- ! if PVt > 0, ie melt, then ocean_bio term drops out (MJ2006) ! Combine boundary fluxes !----------------------------------------------------------------- - + PVflag(nn) = SIGN(PVflag(nn),PVt) cinit_tmp = max(c0, cinit_v(nn) + react(nn)) flux_bio_temp(nn) = (PVflag(nn)*PVt*cinit_tmp & @@ -693,7 +693,7 @@ subroutine skl_biogeochemistry (dt, & endif cinit(nn) = cinit_tmp*sk_l - flux_bio_temp(nn)*dt - flux_bio(nn) = flux_bio(nn) + flux_bio_temp(nn)*phi_sk + flux_bio(nn) = flux_bio(nn) + flux_bio_temp(nn)*phi_sk ! Uncomment to update ocean concentration ! Currently not coupled with ocean biogeochemistry @@ -730,27 +730,27 @@ subroutine skl_biogeochemistry (dt, & endif if (icepack_warnings_aborted(subname)) return - + !----------------------------------------------------------------- ! reload tracer array: Bulk tracer concentration (mmol or mg per m^3) !----------------------------------------------------------------- trcrn(bio_index(nn)) = cinit(nn) * phi_sk/sk_l - - enddo !nbtrcr + + enddo !nbtrcr end subroutine skl_biogeochemistry !======================================================================= ! -! Solve the scalar vertical diffusion equation implicitly using +! Solve the scalar vertical diffusion equation implicitly using ! tridiag_solver. Calculate the diffusivity from temperature and salinity. -! -! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with -! dynamic salinity or the height ratio == hinS/vicen*aicen, where hinS is the +! +! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with +! dynamic salinity or the height ratio == hinS/vicen*aicen, where hinS is the ! height of the brine surface relative to the bottom of the ice. This volume fraction -! may be > 1 in which case there is brine above the ice surface (meltponds). -! +! may be > 1 in which case there is brine above the ice surface (meltponds). +! subroutine z_biogeochemistry (n_cat, dt, & nilyr, & @@ -759,15 +759,15 @@ subroutine z_biogeochemistry (n_cat, dt, & n_dic, n_don, & n_fed, n_fep, & n_zaero, first_ice, & - aicen, vicen, & - hice_old, ocean_bio, & + aicen, vicen, & + hice_old, ocean_bio, & flux_bio, bphin, & - iphin, trcrn, & + iphin, trcrn, & iDin, & fswthrul, grow_alg, & upNOn, upNHn, & dh_top, dh_bot, & - zfswin, hbri, & + zfswin, hbri, & hbri_old, darcy_V, & ! darcy_V_chl, bgrid, & bgrid, & @@ -785,12 +785,12 @@ subroutine z_biogeochemistry (n_cat, dt, & nbtrcr, n_algae, & ! number of bgc tracers, number of autotrophs n_zaero, & ! number of aerosols n_doc, n_dic, n_don, n_fed, n_fep - + logical (kind=log_kind), intent(in) :: & first_ice ! initialized values should be used real (kind=dbl_kind), intent(in) :: & - dt , & ! time step + dt , & ! time step hbri , & ! brine height (m) bphi_min , & ! surface porosity aicen , & ! concentration of ice @@ -807,21 +807,21 @@ subroutine z_biogeochemistry (n_cat, dt, & real (kind=dbl_kind), dimension (:), intent(inout) :: & bgrid , & ! biology nondimensional vertical grid points flux_bio , & ! total ocean tracer flux (mmol/m^2/s) - zfswin , & ! visible Short wave flux on igrid (W/m^2) + zfswin , & ! visible Short wave flux on igrid (W/m^2) Zoo , & ! N losses to the system from reaction terms - ! (ie. zooplankton/bacteria) (mmol/m^3) + ! (ie. zooplankton/bacteria) (mmol/m^3) trcrn ! bulk tracer concentration (mmol/m^3) real (kind=dbl_kind), dimension (:), intent(in) :: & i_grid , & ! biology vertical interface points iTin , & ! salinity vertical interface points - iphin , & ! Porosity on the igrid + iphin , & ! Porosity on the igrid iDin , & ! Diffusivity/h on the igrid (1/s) - ic_grid , & ! CICE interface coordinate - fswthrul , & ! visible short wave radiation on icgrid (W/m^2) + ic_grid , & ! CICE interface coordinate + fswthrul , & ! visible short wave radiation on icgrid (W/m^2) zbgc_snow , & ! tracer input from snow (mmol/m^3*m) zbgc_atm , & ! tracer input from atm (mmol/m^3 *m) - ocean_bio , & ! ocean concentrations (mmol/m^3) + ocean_bio , & ! ocean concentrations (mmol/m^3) bphin ! Porosity on the bgrid real (kind=dbl_kind), intent(inout) :: & @@ -842,10 +842,10 @@ subroutine z_biogeochemistry (n_cat, dt, & ! local variables integer (kind=int_kind) :: & - k, m, mm ! vertical biology layer index + k, m, mm ! vertical biology layer index real (kind=dbl_kind) :: & - hin , & ! ice thickness (m) + hin , & ! ice thickness (m) hin_old , & ! ice thickness before current melt/growth (m) ice_conc , & ! algal concentration in ice above hin > hinS sum_old , & ! @@ -858,7 +858,7 @@ subroutine z_biogeochemistry (n_cat, dt, & dhflood ! >=0 (m) surface flooding from the ocean real (kind=dbl_kind), dimension (nblyr+2) :: & - bphin_N ! porosity for tracer model has minimum + bphin_N ! porosity for tracer model has minimum ! bphin_N >= bphimin real (kind=dbl_kind), dimension (nblyr+1) :: & @@ -902,15 +902,15 @@ subroutine z_biogeochemistry (n_cat, dt, & conserve_N real (kind=dbl_kind), dimension(nblyr+1):: & ! temporary variables for - Diff , & ! diffusivity + Diff , & ! diffusivity initcons , & ! initial concentration biocons , & ! new concentration dmobile , & ! initcons_mobile,&! initcons_stationary - + real (kind=dbl_kind):: & - top_conc ! 1% (min_bgc) of surface concentration + top_conc ! 1% (min_bgc) of surface concentration ! when hin > hbri: just used in sw calculation real (kind=dbl_kind):: & @@ -925,11 +925,11 @@ subroutine z_biogeochemistry (n_cat, dt, & V_c , & ! volume of collector (um^3) V_alg ! volume of algae (um^3) - real (kind=dbl_kind), dimension(nbtrcr) :: & + real (kind=dbl_kind), dimension(nbtrcr) :: & mobile ! c1 if mobile, c0 otherwise ! local parameters - + real (kind=dbl_kind), parameter :: & accuracy = 1.0e-14_dbl_kind, & r_c = 3.0e3_dbl_kind , & ! ice crystal radius (um) @@ -941,15 +941,15 @@ subroutine z_biogeochemistry (n_cat, dt, & f_a = c1 , & ! fraction of collector available for attachment f_v = 0.7854 ! fraction of algal coverage on area availabel for attachment ! 4(pi r^2)/(4r)^2 [Johnson et al, 1995, water res. research] - + integer, parameter :: & nt_zfswin = 1 ! for interpolation of short wave to bgrid character(len=*),parameter :: subname='(z_biogeochemistry)' !------------------------------------- - ! Initialize - !----------------------------------- + ! Initialize + !----------------------------------- zspace = c1/real(nblyr,kind=dbl_kind) in_init_cons(:,:) = c0 @@ -972,7 +972,7 @@ subroutine z_biogeochemistry (n_cat, dt, & if (first_ice) then trcrn(bio_index(m) + k-1) = ocean_bio(m)*zbgc_init_frac(m) in_init_cons(k,m) = trcrn(bio_index(m) + k-1)*hbri_old - elseif (abs(trcrn(bio_index(m) + k-1)) < puny) then + elseif (abs(trcrn(bio_index(m) + k-1)) < puny) then trcrn(bio_index(m) + k-1) = c0 in_init_cons(k,m) = c0 else @@ -984,7 +984,7 @@ subroutine z_biogeochemistry (n_cat, dt, & call icepack_warnings_add(warnstr) write(warnstr,*) subname,'Category,m:',n_cat,m call icepack_warnings_add(warnstr) - write(warnstr,*) subname,'hbri,hbri_old' + write(warnstr,*) subname,'hbri,hbri_old' call icepack_warnings_add(warnstr) write(warnstr,*) subname, hbri,hbri_old call icepack_warnings_add(warnstr) @@ -994,7 +994,7 @@ subroutine z_biogeochemistry (n_cat, dt, & call icepack_warnings_add(warnstr) call icepack_warnings_add(subname//' zbgc initialization error') call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - endif + endif if (icepack_warnings_aborted(subname)) return enddo !k enddo !m @@ -1005,7 +1005,7 @@ subroutine z_biogeochemistry (n_cat, dt, & ice_conc = c0 hin = vicen/aicen - hin_old = hice_old + hin_old = hice_old !----------------------------------------------------------------- ! calculate the saturation concentration for attachment: Sat_conc @@ -1017,10 +1017,10 @@ subroutine z_biogeochemistry (n_cat, dt, & V_c = 4.0_dbl_kind*pi*r_c**3/3.0_dbl_kind*(1.0e-6_dbl_kind)**3 ! (m^3) sphere V_alg = pi/6.0_dbl_kind*r_bac*r_alg**2 ! prolate spheroid (*10-9 for colloids) Sat_conc= f_s*f_a*f_v*(c1-phi_max)/V_c*S_col/P_b*N_vol*V_alg/Ng_to_mmol - !mmol/m^3 (algae, don, hum...) and umols/m^3 for colloids + !mmol/m^3 (algae, don, hum...) and umols/m^3 for colloids !----------------------------------------------------------------- - ! convert surface dust flux (n_zaero > 2) to dFe(1) flux + ! convert surface dust flux (n_zaero > 2) to dFe(1) flux !----------------------------------------------------------------- dust_Fe(:) = c0 @@ -1032,10 +1032,10 @@ subroutine z_biogeochemistry (n_cat, dt, & R_dFe2dust * dustFe_sol ! dust_Fe(nlt_zaero(m)) = -(zbgc_snow(nlt_zaero(m)) + zbgc_atm(nlt_zaero(m))) * & ! dustFe_sol - enddo + enddo endif - do m = 1,nbtrcr + do m = 1,nbtrcr !----------------------------------------------------------------- ! time constants for mobile/stationary phase changes !----------------------------------------------------------------- @@ -1050,12 +1050,12 @@ subroutine z_biogeochemistry (n_cat, dt, & exp_min = min(dt/tau_rel(m),exp_argmax) exp_rel(m) = exp(-exp_min) endif - if (m .ne. nlt_bgc_N(1)) then + if (m .ne. nlt_bgc_N(1)) then if (hin_old > hin) then !melting exp_ret(m) = c1 else !not melting exp_rel(m) = c1 - endif + endif elseif (tr_bgc_N .and. hin_old > hin + algal_vel*dt) then exp_ret(m) = c1 elseif (tr_bgc_N) then @@ -1071,33 +1071,33 @@ subroutine z_biogeochemistry (n_cat, dt, & if (dhtop+darcyV/bphin_N(1)*dt < -puny) then !snow/top ice melt C_top(m) = (zbgc_snow(m)+zbgc_atm(m) + dust_Fe(m))/abs(dhtop & - + darcyV/bphin_N(1)*dt + puny)*hbri_old + + darcyV/bphin_N(1)*dt + puny)*hbri_old elseif (dhtop+darcyV/bphin_N(1)*dt >= -puny .and. & abs((zbgc_snow(m)+zbgc_atm(m) + dust_Fe(m)) + & ocean_bio(m)*bphin_N(1)*dhflood) > puny) then atm_add_cons(m) = abs(zbgc_snow(m) + zbgc_atm(m)+ dust_Fe(m)) + & - ocean_bio(m)*bphin_N(1)*dhflood - else ! only positive fluxes + ocean_bio(m)*bphin_N(1)*dhflood + else ! only positive fluxes atm_add_cons(m) = abs(zbgc_snow(m) + zbgc_atm(m)+ dust_Fe(m)) endif - C_bot(m) = ocean_bio(m)*hbri_old*iphin_N(nblyr+1) + C_bot(m) = ocean_bio(m)*hbri_old*iphin_N(nblyr+1) enddo ! m !----------------------------------------------------------------- - ! Interpolate shortwave flux, fswthrul (defined at top to bottom with nilyr+1 + ! Interpolate shortwave flux, fswthrul (defined at top to bottom with nilyr+1 ! evenly spaced with spacing = (1/nilyr) to grid variable zfswin: !----------------------------------------------------------------- - trtmp(:) = c0 + trtmp(:) = c0 trtmp0(:)= c0 zfswin(:) = c0 do k = 1, nilyr+1 ! contains cice values (fswthrul(1) is surface value) ! and fwsthrul(nilyr+1) is output - trtmp0(nt_zfswin+k-1) = fswthrul(k) + trtmp0(nt_zfswin+k-1) = fswthrul(k) enddo !k call remap_zbgc(nilyr+1, & @@ -1115,8 +1115,8 @@ subroutine z_biogeochemistry (n_cat, dt, & enddo !----------------------------------------------------------------- - ! Initialze Biology - !----------------------------------------------------------------- + ! Initialze Biology + !----------------------------------------------------------------- do mm = 1, nbtrcr mobile(mm) = c0 @@ -1129,11 +1129,11 @@ subroutine z_biogeochemistry (n_cat, dt, & !----------------------------------------------------------------- ! Compute FCT - !----------------------------------------------------------------- + !----------------------------------------------------------------- - do mm = 1, nbtrcr + do mm = 1, nbtrcr - if (hbri_old > thinS .and. hbri > thinS) then + if (hbri_old > thinS .and. hbri > thinS) then do k = 1,nblyr+1 initcons_mobile(k) = in_init_cons(k,mm)*trcrn(nt_zbgc_frac+mm-1) initcons_stationary(k) = mobile(mm)*(in_init_cons(k,mm)-initcons_mobile(k)) @@ -1146,14 +1146,14 @@ subroutine z_biogeochemistry (n_cat, dt, & initcons_stationary(k) = Sat_conc*hbri_old endif - Diff(k) = iDin(k) - initcons(k) = initcons_mobile(k) + Diff(k) = iDin(k) + initcons(k) = initcons_mobile(k) biocons(k) = initcons_mobile(k) enddo call compute_FCT_matrix & (initcons,sbdiagz, dt, nblyr, & - diagz, spdiagz, rhsz, bgrid, & + diagz, spdiagz, rhsz, bgrid, & darcyV, dhtop, & dhbot, iphin_N, & Diff, hbri_old, & @@ -1183,19 +1183,19 @@ subroutine z_biogeochemistry (n_cat, dt, & source(mm)) if (icepack_warnings_aborted(subname)) return - call compute_FCT_corr & + call compute_FCT_corr & (initcons, & biocons, dt, nblyr, & - D_sbdiag, D_spdiag, ML_diag) + D_sbdiag, D_spdiag, ML_diag) if (icepack_warnings_aborted(subname)) return top_conc = c0 ! or frazil ice concentration - + ! assume diatoms actively maintain there relative position in the ice - if (mm .ne. nlt_bgc_N(1)) then - - call regrid_stationary & + if (mm .ne. nlt_bgc_N(1)) then + + call regrid_stationary & (initcons_stationary, hbri_old, & hbri, dt, & ntrcr, & @@ -1204,7 +1204,7 @@ subroutine z_biogeochemistry (n_cat, dt, & meltb, congel) if (icepack_warnings_aborted(subname)) return - elseif (tr_bgc_N .and. mm .eq. nlt_bgc_N(1)) then + elseif (tr_bgc_N .and. mm .eq. nlt_bgc_N(1)) then if (meltb > algal_vel*dt .or. aicen < 0.001_dbl_kind) then call regrid_stationary & @@ -1213,7 +1213,7 @@ subroutine z_biogeochemistry (n_cat, dt, & ntrcr, & nblyr, top_conc, & i_grid, flux_bio(mm),& - meltb, congel) + meltb, congel) if (icepack_warnings_aborted(subname)) return endif @@ -1268,8 +1268,8 @@ subroutine z_biogeochemistry (n_cat, dt, & endif if (icepack_warnings_aborted(subname)) return - else - + else + call thin_ice_flux(hbri,hbri_old,biomat_cons(:,mm), & flux_bio(mm),source(mm), & dt, nblyr,ocean_bio(mm)) @@ -1277,20 +1277,20 @@ subroutine z_biogeochemistry (n_cat, dt, & endif ! thin or not - do k = 1,nblyr+1 - biomat_brine(k,mm) = biomat_cons(k,mm)/hbri/iphin_N(k) + do k = 1,nblyr+1 + biomat_brine(k,mm) = biomat_cons(k,mm)/hbri/iphin_N(k) enddo ! k - enddo ! mm + enddo ! mm - react(:,:) = c0 + react(:,:) = c0 grow_alg(:,:) = c0 if (solve_zbgc) then - do k = 1, nblyr+1 + do k = 1, nblyr+1 call algal_dyn (dt, & n_doc, n_dic, n_don, n_fed, n_fep, & dEdd_algae, & - zfswin(k), react(k,:), & + zfswin(k), react(k,:), & biomat_brine(k,:), & grow_alg(k,:), n_algae, & iTin(k), & @@ -1298,19 +1298,19 @@ subroutine z_biogeochemistry (n_cat, dt, & Zoo(k), & Nerror(k), conserve_N(k)) if (icepack_warnings_aborted(subname)) return - + enddo ! k endif ! solve_zbgc !----------------------------------------------------------------- ! Update the tracer variable !----------------------------------------------------------------- - + do m = 1,nbtrcr do k = 1,nblyr+1 ! back to bulk quantity - bio_tmp = (biomat_brine(k,m) + react(k,m))*iphin_N(k) - - if (.not. conserve_N(k)) then + bio_tmp = (biomat_brine(k,m) + react(k,m))*iphin_N(k) + + if (.not. conserve_N(k)) then write(warnstr,*) subname, 'N in algal_dyn not conserved' call icepack_warnings_add(warnstr) write(warnstr,*) subname, 'Nerror(k):', Nerror(k) @@ -1325,7 +1325,7 @@ subroutine z_biogeochemistry (n_cat, dt, & call icepack_warnings_add(warnstr) call icepack_warnings_add(subname//' N in algal_dyn not conserved') call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - elseif (abs(bio_tmp) < puny) then + elseif (abs(bio_tmp) < puny) then bio_tmp = c0 elseif (bio_tmp > 1.0e6_dbl_kind) then write(warnstr,*) subname, 'very large bgc value' @@ -1390,16 +1390,7 @@ subroutine z_biogeochemistry (n_cat, dt, & flux_bio(m) = max(c0,flux_bio(m)) endif enddo ! k - enddo ! m - -770 format (I6,D16.6) -781 format (I6,I6,I6) -790 format (I6,I6) -791 format (f24.17) -792 format (2D16.6) -793 format (3D16.6) -794 format (4D15.5) -800 format (F10.4) + enddo ! m end subroutine z_biogeochemistry @@ -1412,20 +1403,20 @@ end subroutine z_biogeochemistry subroutine algal_dyn (dt, & n_doc, n_dic, n_don, n_fed, n_fep, & dEdd_algae, & - fswthru, reactb, & + fswthru, reactb, & ltrcrn, & grow_alg, n_algae, & T_bot, & upNOn, upNHn, & Zoo, & - Nerror, conserve_N) + Nerror, conserve_N) integer (kind=int_kind), intent(in) :: & n_doc, n_dic, n_don, n_fed, n_fep, & n_algae ! number of autotrophic types real (kind=dbl_kind), intent(in) :: & - dt , & ! time step + dt , & ! time step T_bot , & ! ice temperature (oC) fswthru ! average shortwave passing through current ice layer (W/m^2) @@ -1442,24 +1433,24 @@ subroutine algal_dyn (dt, & reactb ! biological reaction terms (mmol/m3) real (kind=dbl_kind), dimension(:), intent(in) :: & - ltrcrn ! brine concentrations in layer (mmol/m^3) + ltrcrn ! brine concentrations in layer (mmol/m^3) - logical (kind=log_kind), intent(inout) :: & + logical (kind=log_kind), intent(inout) :: & conserve_N - logical (kind=log_kind), intent(in) :: & + logical (kind=log_kind), intent(in) :: & dEdd_algae ! .true. chla impact on shortwave computed in dEdd ! local variables !------------------------------------------------------------------------------------ ! 3 possible autotrophs nt_bgc_N(1:3): diatoms, flagellates, phaeocystis - ! 2 types of dissolved organic carbon nt_bgc_DOC(1:2): + ! 2 types of dissolved organic carbon nt_bgc_DOC(1:2): ! polysaccharids, lipids ! 1 DON (proteins) ! 1 particulate iron (nt_bgc_Fe) n_fep - ! 1 dossp;ved orpm m+fed - ! Limiting macro/micro nutrients: nt_bgc_Nit -> nitrate, nt_bgc_NH -> ammonium, - ! nt_bgc_Sil -> silicate, nt_bgc_Fe -> dissolved iron + ! 1 dossp;ved orpm m+fed + ! Limiting macro/micro nutrients: nt_bgc_Nit -> nitrate, nt_bgc_NH -> ammonium, + ! nt_bgc_Sil -> silicate, nt_bgc_Fe -> dissolved iron ! -------------------------------------------------------------------------------------- ! real (kind=dbl_kind), parameter, dimension(max_algae) :: & @@ -1468,29 +1459,29 @@ subroutine algal_dyn (dt, & integer (kind=int_kind) :: k, n real (kind=dbl_kind), dimension(n_algae) :: & - Nin , & ! algal nitrogen concentration on volume (mmol/m^3) + Nin , & ! algal nitrogen concentration on volume (mmol/m^3) ! Cin , & ! algal carbon concentration on volume (mmol/m^3) chlin ! algal chlorophyll concentration on volume (mg/m^3) real (kind=dbl_kind), dimension(n_doc) :: & - DOCin ! dissolved organic carbon concentration on volume (mmolC/m^3) + DOCin ! dissolved organic carbon concentration on volume (mmolC/m^3) ! real (kind=dbl_kind), dimension(n_dic) :: & -! DICin ! dissolved inorganic carbon concentration on volume (mmolC/m^3) +! DICin ! dissolved inorganic carbon concentration on volume (mmolC/m^3) real (kind=dbl_kind), dimension(n_don) :: & !proteins - DONin ! dissolved organic nitrogen concentration on volume (mmolN/m^3) + DONin ! dissolved organic nitrogen concentration on volume (mmolN/m^3) real (kind=dbl_kind), dimension(n_fed) :: & !iron - Fedin ! dissolved iron concentration on volume (umol/m^3) + Fedin ! dissolved iron concentration on volume (umol/m^3) real (kind=dbl_kind), dimension(n_fep) :: & !iron - Fepin ! algal nitrogen concentration on volume (umol/m^3) + Fepin ! algal nitrogen concentration on volume (umol/m^3) real (kind=dbl_kind) :: & - Nitin , & ! nitrate concentration on volume (mmol/m^3) - Amin , & ! ammonia/um concentration on volume (mmol/m^3) - Silin , & ! silicon concentration on volume (mmol/m^3) + Nitin , & ! nitrate concentration on volume (mmol/m^3) + Amin , & ! ammonia/um concentration on volume (mmol/m^3) + Silin , & ! silicon concentration on volume (mmol/m^3) ! DMSPpin , & ! DMSPp concentration on volume (mmol/m^3) DMSPdin , & ! DMSPd concentration on volume (mmol/m^3) DMSin , & ! DMS concentration on volume (mmol/m^3) @@ -1537,7 +1528,7 @@ subroutine algal_dyn (dt, & ! fr_graze_p , & ! fraction of N grazed that becomes protein ! ! (rest is assimilated) < (1-fr_graze_a) ! ! and fr_graze_a*fr_graze_e becomes ammonia -! fr_mort_p ! fraction of N mortality that becomes protein +! fr_mort_p ! fraction of N mortality that becomes protein ! ! < (1-fr_mort2min) real (kind=dbl_kind), dimension(n_algae) :: & @@ -1583,7 +1574,7 @@ subroutine algal_dyn (dt, & Nit_r , & ! net nitrate removal (mmol/m^3) Am_s_e , & ! ammonium source from excretion (mmol/m^3) Am_s_r , & ! ammonium source from respiration (mmol/m^3) - Am_s_mo , & ! ammonium source from mort/remin (mmol/m^3) + Am_s_mo , & ! ammonium source from mort/remin (mmol/m^3) Am_r_p , & ! ammonium uptake by algae (mmol/m^3) Am_s , & ! net ammonium sources (mmol/m^3) Am_r , & ! net ammonium removal (mmol/m^3) @@ -1592,7 +1583,7 @@ subroutine algal_dyn (dt, & Fe_r_p ! iron uptake by algae (nM) ! DOC_r_c , & ! net doc removal from bacterial consumption (mmol/m^3) ! doc_s_m , & ! protein source due to algal mortality (mmol/m^3) -! doc_s_g ! protein source due to grazing (mmol/m^3) +! doc_s_g ! protein source due to grazing (mmol/m^3) real (kind=dbl_kind) :: & DMSPd_s_r , & ! skl dissolved DMSP from respiration (mmol/m^3) @@ -1646,7 +1637,7 @@ subroutine algal_dyn (dt, & DOC_s(:) = c0 DOC_r(:) = c0 ! DOC_r_c = c0 - nitrif = c0 + nitrif = c0 mort_N = c0 mort_C = c0 graze_N = c0 @@ -1654,15 +1645,15 @@ subroutine algal_dyn (dt, & exude_C = c0 resp_N = c0 growth_N = c0 - Nit_r = c0 + Nit_r = c0 Am_s = c0 - Am_r = c0 + Am_r = c0 Sil_r = c0 Fed_r(:) = c0 Fed_s(:) = c0 Fep_r(:) = c0 Fep_s(:) = c0 - DMSPd_s = c0 + DMSPd_s = c0 dTemp = min(T_bot-T_max,c0) Fed_tot = c0 Fed_tot_r = c0 @@ -1672,12 +1663,12 @@ subroutine algal_dyn (dt, & ! Fep_tot_r = c0 Fep_tot_s = c0 rFep(:) = c0 - + Nitin = ltrcrn(nlt_bgc_Nit) op_dep = c0 do k = 1, n_algae Nin(k) = ltrcrn(nlt_bgc_N(k)) - chlin(k) = R_chl2N(k)* Nin(k) + chlin(k) = R_chl2N(k)* Nin(k) op_dep = op_dep + chlabs(k)*chlin(k) enddo if (tr_bgc_C) then @@ -1696,11 +1687,11 @@ subroutine algal_dyn (dt, & if (tr_bgc_DMS) then ! DMSPpin = ltrcrn(nlt_bgc_DMSPp) DMSPdin = ltrcrn(nlt_bgc_DMSPd) - DMSin = ltrcrn(nlt_bgc_DMS) + DMSin = ltrcrn(nlt_bgc_DMS) endif ! if (tr_bgc_PON) then -! PONin = c0 -! PONin = ltrcrn(nlt_bgc_PON) +! PONin = c0 +! PONin = ltrcrn(nlt_bgc_PON) ! endif if (tr_bgc_DON) then do k = 1, n_don @@ -1708,10 +1699,10 @@ subroutine algal_dyn (dt, & enddo endif if (tr_bgc_Fe ) then - do k = 1, n_fed + do k = 1, n_fed Fedin(k) = ltrcrn(nlt_bgc_Fed(k)) enddo - do k = 1, n_fep + do k = 1, n_fep Fepin(k) = ltrcrn(nlt_bgc_Fep(k)) enddo endif @@ -1763,7 +1754,7 @@ subroutine algal_dyn (dt, & N_lim(k) = Nit_lim(k) if (tr_bgc_Am) then Am_lim(k) = Amin/(Amin + K_Am(k)) - N_lim(k) = min(c1, Nit_lim(k) + Am_lim(k)) + N_lim(k) = min(c1, Nit_lim(k) + Am_lim(k)) endif Sil_lim(k) = c1 if (tr_bgc_Sil .and. K_Sil(k) > c0) Sil_lim(k) = Silin/(Silin + K_Sil(k)) @@ -1772,13 +1763,13 @@ subroutine algal_dyn (dt, & ! Iron limitation !----------------------------------------------------------------------- - Fe_lim(k) = c1 + Fe_lim(k) = c1 if (tr_bgc_Fe .and. K_Fe (k) > c0) Fe_lim (k) = Fed_tot/(Fed_tot + K_Fe(k)) - + !---------------------------------------------------------------------------- - ! Growth and uptake computed within the bottom layer - ! Note here per A93 discussions and MBJ model, salinity is a universal - ! restriction. Comparison with available column nutrients inserted + ! Growth and uptake computed within the bottom layer + ! Note here per A93 discussions and MBJ model, salinity is a universal + ! restriction. Comparison with available column nutrients inserted ! but in tests had no effect. ! Primary production reverts to SE form, see MBJ below and be careful !---------------------------------------------------------------------------- @@ -1786,7 +1777,7 @@ subroutine algal_dyn (dt, & growmax_N(k) = mu_max(k) / secday * exp(grow_Tdep(k) * dTemp)* Nin(k) *fsal grow_N(k) = min(L_lim(k), N_lim(k), Sil_lim(k), Fe_lim(k)) * growmax_N(k) ! potU_Nit(k) = Nit_lim(k)* growmax_N(k) - potU_Am(k) = Am_lim(k)* growmax_N(k) + potU_Am(k) = Am_lim(k)* growmax_N(k) U_Am(k) = min(grow_N(k), potU_Am(k)) U_Nit(k) = grow_N(k) - U_Am(k) U_Sil(k) = R_Si2N(k) * grow_N(k) @@ -1806,8 +1797,8 @@ subroutine algal_dyn (dt, & if (tr_bgc_Sil) U_Sil_tot = min(U_Sil_tot, max_loss * Silin/dt) if (tr_bgc_Fe) U_Fe_tot = min(U_Fe_tot, max_loss * Fed_tot/dt) - U_Nit_tot = min(U_Nit_tot, max_loss * Nitin/dt) - U_Am_tot = min(U_Am_tot, max_loss * Amin/dt) + U_Nit_tot = min(U_Nit_tot, max_loss * Nitin/dt) + U_Am_tot = min(U_Am_tot, max_loss * Amin/dt) do k = 1, n_algae U_Am(k) = U_Am_f(k)*U_Am_tot @@ -1831,13 +1822,13 @@ subroutine algal_dyn (dt, & U_Am(k) = fr_Am(k) * grow_N(k) U_Sil(k) = R_Si2N(k) * grow_N(k) U_Fe (k) = R_Fe2N(k) * grow_N(k) - + !----------------------------------------------------------------------- ! Define reaction terms !----------------------------------------------------------------------- ! Since the framework remains incomplete at this point, - ! it is assumed as a starting expedient that + ! it is assumed as a starting expedient that ! DMSP loss to melting results in 10% conversion to DMS ! which is then given a ten day removal constant. ! Grazing losses are channeled into rough spillage and assimilation @@ -1845,33 +1836,33 @@ subroutine algal_dyn (dt, & !-------------------------------------------------------------------- ! Algal reaction term - ! N_react = (grow_N*(c1 - fr_graze-fr_resp) - mort)*dt + ! N_react = (grow_N*(c1 - fr_graze-fr_resp) - mort)*dt !-------------------------------------------------------------------- - resp(k) = fr_resp * grow_N(k) + resp(k) = fr_resp * grow_N(k) graze(k) = fr_graze(k) * grow_N(k) mort(k) = min(max_loss * Nin(k)/dt, & mort_pre(k)*exp(mort_Tdep(k)*dTemp) * Nin(k)/secday) - + ! history variables grow_alg(k) = grow_N(k) upNOn(k) = U_Nit(k) upNHn(k) = U_Am(k) -! N_s_p = grow_N(k) * dt -! N_r_g = graze(k) * dt +! N_s_p = grow_N(k) * dt +! N_r_g = graze(k) * dt ! N_r_r = resp(k) * dt ! N_r_mo = mort(k) * dt N_s(k) = (c1- fr_resp - fr_graze(k)) * grow_N(k) *dt !N_s_p - N_r(k) = mort(k) * dt !N_r_g + N_r_mo + N_r_r + N_r(k) = mort(k) * dt !N_r_g + N_r_mo + N_r_r graze_N = graze_N + graze(k) graze_C = graze_C + R_C2N(k)*graze(k) - mort_N = mort_N + mort(k) + mort_N = mort_N + mort(k) mort_C = mort_C + R_C2N(k)*mort(k) resp_N = resp_N + resp(k) growth_N = growth_N + grow_N(k) - + enddo ! n_algae !-------------------------------------------------------------------- ! Ammonium source: algal grazing, respiration, and mortality @@ -1885,7 +1876,7 @@ subroutine algal_dyn (dt, & !-------------------------------------------------------------------- ! Nutrient net loss terms: algal uptake !-------------------------------------------------------------------- - + do k = 1, n_algae Am_r_p = U_Am(k) * dt Am_r = Am_r + Am_r_p @@ -1910,10 +1901,10 @@ subroutine algal_dyn (dt, & !-------------------------------------------------------------------- ! PON: currently using PON to shadow nitrate ! - ! N Losses are counted in Zoo. These arise from mortality not - ! remineralized (Zoo_s_m), assimilated grazing not excreted (Zoo_s_a), - !spilled N not going to DON (Zoo_s_s) and bacterial recycling - ! of DON (Zoo_s_b). + ! N Losses are counted in Zoo. These arise from mortality not + ! remineralized (Zoo_s_m), assimilated grazing not excreted (Zoo_s_a), + !spilled N not going to DON (Zoo_s_s) and bacterial recycling + ! of DON (Zoo_s_b). !-------------------------------------------------------------------- if (tr_bgc_Am) then @@ -1923,14 +1914,14 @@ subroutine algal_dyn (dt, & else Zoo_s_a = graze_N*dt*(c1-fr_graze_s) Zoo_s_s = graze_N*fr_graze_s*dt - Zoo_s_m = mort_N*dt + Zoo_s_m = mort_N*dt endif Zoo_s_b = c0 !-------------------------------------------------------------------- ! DON (n_don = 1) - ! Proteins + ! Proteins !-------------------------------------------------------------------- DON_r(:) = c0 @@ -1945,7 +1936,7 @@ subroutine algal_dyn (dt, & !Am_s = Am_s + DON_r(n)*f_don_Am(n) enddo endif - + Zoo = Zoo_s_a + Zoo_s_s + Zoo_s_m + Zoo_s_b !-------------------------------------------------------------------- @@ -1954,7 +1945,7 @@ subroutine algal_dyn (dt, & !-------------------------------------------------------------------- do n = 1, n_doc - + DOC_r(n) = k_bac(n)/secday * DOCin(n) * dt DOC_s(n) = f_doc(n)*(fr_graze_s *graze_C + mort_C)*dt & + f_exude(n)*exude_C @@ -1964,7 +1955,7 @@ subroutine algal_dyn (dt, & ! Iron sources from remineralization (follows ammonium but reduced) ! only Fed_s(1) has remineralized sources !-------------------------------------------------------------------- - + Fed_s(1) = Fed_s(1) + Am_s * R_Fe2N(1) * fr_dFe ! remineralization source !-------------------------------------------------------------------- @@ -1973,8 +1964,8 @@ subroutine algal_dyn (dt, & !-------------------------------------------------------------------- if (tr_bgc_C .and. tr_bgc_Fe) then - if (DOCin(1) > c0) then - if (Fed_tot/DOCin(1) > max_dfe_doc1) then + if (DOCin(1) > c0) then + if (Fed_tot/DOCin(1) > max_dfe_doc1) then do n = 1,n_fed ! low saccharid:dFe ratio leads to Fed_r_l(n) = Fedin(n)/t_iron_conv*dt/secday ! loss of bioavailable Fe to particulate fraction Fep_tot_s = Fep_tot_s + Fed_r_l(n) @@ -1983,27 +1974,27 @@ subroutine algal_dyn (dt, & do n = 1,n_fep Fep_s(n) = rFep(n)* Fep_tot_s ! source from dissolved Fe enddo - elseif (Fed_tot/DOCin(1) < max_dfe_doc1) then + elseif (Fed_tot/DOCin(1) < max_dfe_doc1) then do n = 1,n_fep ! high saccharid:dFe ratio leads to Fep_r(n) = Fepin(n)/t_iron_conv*dt/secday ! gain of bioavailable Fe from particulate fraction Fed_tot_s = Fed_tot_s + Fep_r(n) - enddo + enddo do n = 1,n_fed Fed_s(n) = Fed_s(n) + rFed(n)* Fed_tot_s ! source from particulate Fe - enddo + enddo endif endif !Docin(1) > c0 elseif (tr_bgc_Fe) then do n = 1,n_fed Fed_r(n) = Fed_r(n) + rFed(n)*Fed_tot_r ! scavenging + uptake - enddo + enddo - ! source from algal mortality/grazing and fraction of remineralized nitrogen that does + ! source from algal mortality/grazing and fraction of remineralized nitrogen that does ! not become immediately bioavailable do n = 1,n_fep - Fep_s(n) = Fep_s(n) + rFep(n)* (Am_s * R_Fe2N(1) * (c1-fr_dFe)) - enddo ! losses not direct to Fed + Fep_s(n) = Fep_s(n) + rFep(n)* (Am_s * R_Fe2N(1) * (c1-fr_dFe)) + enddo ! losses not direct to Fed endif !-------------------------------------------------------------------- @@ -2011,7 +2002,7 @@ subroutine algal_dyn (dt, & !-------------------------------------------------------------------- ! Grazing losses are channeled into rough spillage and assimilation ! then onward and the MBJ mortality channel is included - ! It is assumed as a starting expedient that + ! It is assumed as a starting expedient that ! DMSP loss to melting gives partial conversion to DMS in product layer ! which then undergoes Stefels removal. @@ -2024,12 +2015,12 @@ subroutine algal_dyn (dt, & do k = 1,n_algae DMSPd_s_r = fr_resp_s * R_S2N(k) * resp(k) * dt !respiration fraction to DMSPd DMSPd_s_mo= fr_mort2min * R_S2N(k)* mort(k) * dt !mortality and extracellular excretion - DMSPd_s = DMSPd_s + DMSPd_s_r + DMSPd_s_mo + DMSPd_s = DMSPd_s + DMSPd_s_r + DMSPd_s_mo enddo DMSPd_r = (c1/t_sk_conv) * (c1/secday) * (DMSPdin) * dt !-------------------------------------------------------------------- - ! DMS reaction term + DMSPd loss term + ! DMS reaction term + DMSPd loss term ! DMS_react = ([\DMSPd]*y_sk_DMS/t_sk_conv - c1/t_sk_ox *[\DMS])*dt !-------------------------------------------------------------------- @@ -2066,16 +2057,16 @@ subroutine algal_dyn (dt, & endif if (tr_bgc_DON) then do k = 1,n_don - reactb(nlt_bgc_DON(k))= DON_s(k) - DON_r(k) + reactb(nlt_bgc_DON(k))= DON_s(k) - DON_r(k) dN = dN + reactb(nlt_bgc_DON(k)) enddo endif if (tr_bgc_Fe ) then do k = 1,n_fed - reactb(nlt_bgc_Fed(k))= Fed_s (k) - Fed_r (k) + reactb(nlt_bgc_Fed(k))= Fed_s (k) - Fed_r (k) enddo do k = 1,n_fep - reactb(nlt_bgc_Fep(k))= Fep_s (k) - Fep_r (k) + reactb(nlt_bgc_Fep(k))= Fep_s (k) - Fep_r (k) enddo endif if (tr_bgc_DMS) then @@ -2101,7 +2092,7 @@ subroutine algal_dyn (dt, & ! call icepack_warnings_add(warnstr) ! write(warnstr,*) subname, 'Zoo:',Zoo ! endif - + end subroutine algal_dyn !======================================================================= @@ -2113,7 +2104,7 @@ end subroutine algal_dyn subroutine thin_ice_flux (hin, hin_old, Cin, flux_o_tot, & source, dt, nblyr, & - ocean_bio) + ocean_bio) integer (kind=int_kind), intent(in) :: & nblyr ! number of bio layers @@ -2122,7 +2113,7 @@ subroutine thin_ice_flux (hin, hin_old, Cin, flux_o_tot, & Cin ! initial concentration*hin_old*phin real (kind=dbl_kind), intent(in) :: & - hin_old , & ! brine thickness (m) + hin_old , & ! brine thickness (m) hin , & ! new brine thickness (m) dt , & ! time step source , & ! atm, ocean, dust flux (mmol/m^2) @@ -2130,20 +2121,20 @@ subroutine thin_ice_flux (hin, hin_old, Cin, flux_o_tot, & real (kind=dbl_kind), intent(inout) :: & flux_o_tot ! tracer flux, gravity+molecular drainage flux , - ! and boundary flux to ocean (mmol/m^2/s) - ! positive into the ocean + ! and boundary flux to ocean (mmol/m^2/s) + ! positive into the ocean ! local variables integer (kind=int_kind) :: & k ! vertical biology layer index - + real (kind=dbl_kind) :: & sum_bio, & ! initial bio mass (mmol/m^2) zspace, & ! 1/nblyr dC, & ! added ocean bio mass (mmol/m^2) - dh ! change in thickness (m) - + dh ! change in thickness (m) + character(len=*),parameter :: subname='(thin_ice_flux)' zspace = c1/real(nblyr,kind=dbl_kind) @@ -2151,14 +2142,14 @@ subroutine thin_ice_flux (hin, hin_old, Cin, flux_o_tot, & dC = c0 sum_bio = c0 dh = hin-hin_old - + if (dh .le. c0) then ! keep the brine concentration fixed sum_bio = (Cin(1)+Cin(nblyr+1))/hin_old*zspace*p5 - Cin(1) = Cin(1)/hin_old*hin + Cin(1) = Cin(1)/hin_old*hin Cin(nblyr+1) = Cin(nblyr+1)/hin_old*hin do k = 2, nblyr sum_bio = sum_bio + Cin(k)/hin_old*zspace - Cin(k) = Cin(k)/hin_old*hin + dC + Cin(k) = Cin(k)/hin_old*hin + dC enddo else dC = dh*ocean_bio @@ -2166,8 +2157,8 @@ subroutine thin_ice_flux (hin, hin_old, Cin, flux_o_tot, & Cin(k) = Cin(k) + dC enddo endif - - flux_o_tot = - dh*sum_bio/dt - dC/dt + source/dt + + flux_o_tot = - dh*sum_bio/dt - dC/dt + source/dt end subroutine thin_ice_flux @@ -2196,7 +2187,7 @@ subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, & real (kind=dbl_kind), intent(in) :: & dt ! time step - + real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & iDin ! Diffusivity on the igrid (1/s) @@ -2205,7 +2196,7 @@ subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, & real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & bphin_N, & ! Porosity with min condition on igrid - bgrid + bgrid real (kind=dbl_kind), dimension (nblyr+1), & intent(out) :: & @@ -2291,13 +2282,13 @@ subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, & iDin_phi(nblyr) = p5*(iDin(nblyr+1)/iphin_N(nblyr+1)+iDin(nblyr)/iphin_N(nblyr)) vel = (bgrid(2)*dhbot - (bgrid(2)-c1)*dhtop)/dt+darcyV/bphin_N(2) - K_diag(1) = p5*vel/hbri_old + K_diag(1) = p5*vel/hbri_old dphi_dx = (iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace) - vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt +darcyV/bphin_N(nblyr+1) - vel = vel/hbri_old - vel2 = (dhbot/hbri_old/dt +darcyV/hbri_old) + vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt +darcyV/bphin_N(nblyr+1) + vel = vel/hbri_old + vel2 = (dhbot/hbri_old/dt +darcyV/hbri_old) K_diag(nblyr+1) = min(c0, vel2) - iDin_phi(nblyr+1)/(zspace+ grid_o/hbri_old) & - + p5*(-vel + iDin_phi(nblyr)/bphin_N(nblyr+1)*dphi_dx) + + p5*(-vel + iDin_phi(nblyr)/bphin_N(nblyr+1)*dphi_dx) do k = 1, nblyr-1 vel = (bgrid(k+1)*dhbot - (bgrid(k+1)-c1)*dhtop)/dt+darcyV/bphin_N(k+1) @@ -2306,15 +2297,15 @@ subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, & K_spdiag(k)= p5*(vel/hbri_old - & iDin_phi(k)/(bphin_N(k+1))*dphi_dx) - vel = (bgrid(k+1)*dhbot - (bgrid(k+1)-c1)*dhtop)/dt +darcyV/bphin_N(k+1) + vel = (bgrid(k+1)*dhbot - (bgrid(k+1)-c1)*dhtop)/dt +darcyV/bphin_N(k+1) dphi_dx = c0 - dphi_dx = kvectorn1(k)*(iphin_N(k+1) - iphin_N(k))/(zspace) + dphi_dx = kvectorn1(k)*(iphin_N(k+1) - iphin_N(k))/(zspace) K_sbdiag(k+1)= -p5*(vel/hbri_old- & iDin_phi(k)/bphin_N(k+1)*dphi_dx) K_diag(k) = K_diag(1)*kvector1(k) + (K_spdiag(k) + K_sbdiag(k))*kvectorn1(k) S_diag(k+1) = -(iDin_phi(k)+ iDin_phi(k+1))/zspace - S_spdiag(k) = iDin_phi(k)/zspace + S_spdiag(k) = iDin_phi(k)/zspace S_sbdiag(k+1) = iDin_phi(k)/zspace enddo @@ -2324,15 +2315,15 @@ subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, & dphi_dx = (iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace) K_spdiag(nblyr)= p5*(vel/hbri_old - & iDin_phi(nblyr)/(bphin_N(nblyr+1))*dphi_dx) - vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt +darcyV/bphin_N(nblyr+1) - dphi_dx = kvectorn1(nblyr)*(iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace) + vel = (bgrid(nblyr+1)*dhbot - (bgrid(nblyr+1)-c1)*dhtop)/dt +darcyV/bphin_N(nblyr+1) + dphi_dx = kvectorn1(nblyr)*(iphin_N(nblyr+1) - iphin_N(nblyr))/(zspace) K_sbdiag(nblyr+1)= -p5*(vel/hbri_old- & iDin_phi(nblyr)/bphin_N(nblyr+1)*dphi_dx) K_diag(nblyr) = K_spdiag(nblyr) + K_sbdiag(nblyr) - S_diag(nblyr+1) = -iDin_phi(nblyr)/zspace - S_spdiag(nblyr) = iDin_phi(nblyr)/zspace + S_diag(nblyr+1) = -iDin_phi(nblyr)/zspace + S_spdiag(nblyr) = iDin_phi(nblyr)/zspace S_sbdiag(nblyr+1) = iDin_phi(nblyr)/zspace - + ! compute matrix artificial D: D_spdiag, D_diag (D_spdiag(k) = D_sbdiag(k+1)) do k = 1,nblyr @@ -2343,7 +2334,7 @@ subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, & D_diag(k) = D_diag(k) - D_spdiag(k) - D_sbdiag(k) enddo -! compute Q_top and Q_bot: top and bottom sources +! compute Q_top and Q_bot: top and bottom sources vel2 = -(dhtop/hbri_old/dt +darcyV/bphin_N(1)/hbri_old) @@ -2354,11 +2345,11 @@ subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, & vel = (dhbot/hbri_old/dt +darcyV/hbri_old) ! going from iphin_N(nblyr+1) to c1 makes a difference Q_bot(:) = c0 - Q_bot(nblyr+1) = max(c0,vel*C_bot) + iDin_phi(nblyr+1)*C_bot& + Q_bot(nblyr+1) = max(c0,vel*C_bot) + iDin_phi(nblyr+1)*C_bot& /(zspace + grid_o/hbri_old) - + Qbot = Q_bot(nblyr+1) - + Sink_bot = K_diag(nblyr+1) + K_spdiag(nblyr) Sink_top = K_diag(1) + K_sbdiag(2) @@ -2367,8 +2358,8 @@ subroutine compute_FCT_matrix (C_in, sbdiag, dt, nblyr, & spdiag = -dt * (D_spdiag + K_spdiag + S_spdiag) sbdiag = -dt * (D_sbdiag + K_sbdiag + S_sbdiag) diag = ML - dt * (D_diag + K_diag + S_diag) - rhs = ML * C_in + dt * Q_top + dt* Q_bot - + rhs = ML * C_in + dt * Q_top + dt* Q_bot + end subroutine compute_FCT_matrix !======================================================================= @@ -2424,7 +2415,7 @@ subroutine compute_FCT_corr (C_in, C_low, dt, nblyr, & ! sbdiag(j) == (j,j-1) solve for j = 2:nblyr+1 otherwise 0 !--------------------------------------------------------------------- - zspace = c1/real(nblyr,kind=dbl_kind) + zspace = c1/real(nblyr,kind=dbl_kind) ! compute the mass matrix @@ -2439,7 +2430,7 @@ subroutine compute_FCT_corr (C_in, C_low, dt, nblyr, & F_spdiag(:) = c0 F_sbdiag(:) = c0 - do k = 1, nblyr + do k = 1, nblyr F_spdiag(k) = M_spdiag(k)*(C_low(k)-C_in(k) - C_low(k+1)+ C_in(k+1))/dt & + D_spdiag(k)*(C_low(k)-C_low(k+1)) F_sbdiag(k+1) = M_sbdiag(k+1)*(C_low(k+1)-C_in(k+1) - C_low(k)+ C_in(k))/dt & @@ -2456,7 +2447,7 @@ subroutine compute_FCT_corr (C_in, C_low, dt, nblyr, & a_spdiag(:) = c0 a_sbdiag(:) = c0 - Pplus(1) = max(c0, F_spdiag(1)) + Pplus(1) = max(c0, F_spdiag(1)) Pminus(1) = min(c0, F_spdiag(1)) Pplus(nblyr+1) = max(c0, F_sbdiag(nblyr+1)) Pminus(nblyr+1) = min(c0, F_sbdiag(nblyr+1)) @@ -2476,8 +2467,8 @@ subroutine compute_FCT_corr (C_in, C_low, dt, nblyr, & Rplus(k) = min(c1, ML(k)*Qplus(k)/dt/(Pplus(k)+puny)) Rminus(k) = min(c1, ML(k)*Qminus(k)/dt/(Pminus(k)-puny)) enddo - - do k = 1, nblyr + + do k = 1, nblyr a_spdiag(k) = min(Rminus(k),Rplus(k+1)) if (F_spdiag(k) > c0) a_spdiag(k) = min(Rplus(k),Rminus(k+1)) a_sbdiag(k+1) = min(Rminus(k+1),Rplus(k)) @@ -2495,11 +2486,11 @@ subroutine compute_FCT_corr (C_in, C_low, dt, nblyr, & F_diag(k) = a_spdiag(k)*F_spdiag(k) + a_sbdiag(k)*F_sbdiag(k) C_low(k) = C_low(k) + dt*F_diag(k)/ML(k) enddo - + endif !F_spdiag is nonzero end subroutine compute_FCT_corr - + !======================================================================= ! ! Tridiagonal matrix solver-- for salinity @@ -2523,7 +2514,7 @@ subroutine tridiag_solverz (nmat, sbdiag, & real (kind=dbl_kind), dimension (nmat), intent(inout) :: & xout ! solution vector - ! local variables + ! local variables integer (kind=int_kind) :: & k ! row counter @@ -2558,7 +2549,7 @@ end subroutine tridiag_solverz subroutine check_conservation_FCT (C_init, C_new, C_low, S_top, & S_bot, L_bot, L_top, dt, & fluxbio, nblyr, & - source) + source) integer (kind=int_kind), intent(in) :: & nblyr ! number of bio layers @@ -2575,7 +2566,7 @@ subroutine check_conservation_FCT (C_init, C_new, C_low, S_top, & S_bot , & ! bottom flux into ice (mmol/m^2/s) L_bot , & ! remaining bottom flux into ice (mmol/m^2/s) L_top , & ! remaining top flux into ice (mmol/m^2/s) - dt , & + dt , & source ! nutrient source from snow and atmosphere (mmol/m^2) real (kind=dbl_kind), intent(inout) :: & @@ -2619,7 +2610,7 @@ subroutine check_conservation_FCT (C_init, C_new, C_low, S_top, & write(warnstr,*) subname, 'Positivity of zbgc low order solution failed: C_low:',C_low call icepack_warnings_setabort(.true.,__FILE__,__LINE__) endif - + if (abs(diff_dt) > accuracy ) then call icepack_warnings_setabort(.true.,__FILE__,__LINE__) write(warnstr,*) subname, 'Conservation of zbgc low order solution failed: diff_dt:',& @@ -2639,7 +2630,7 @@ subroutine check_conservation_FCT (C_init, C_new, C_low, S_top, & write(warnstr,*) subname, 'fluxbio:', fluxbio write(warnstr,*) subname, 'Remaining top flux*dt into ice:', L_top*C_new(1)*dt endif - + end subroutine check_conservation_FCT !======================================================================= @@ -2659,7 +2650,7 @@ subroutine bgc_column_sum (nblyr, nslyr, hsnow, hbrine, xin, xout) real (kind=dbl_kind), intent(in) :: & hsnow, & ! snow thickness - hbrine ! brine height + hbrine ! brine height real (kind=dbl_kind), intent(out) :: & xout ! output field @@ -2680,7 +2671,7 @@ subroutine bgc_column_sum (nblyr, nslyr, hsnow, hbrine, xin, xout) hslyr = hsnow/real(nslyr,kind=dbl_kind) dzssl = min(hslyr*p5, hs_ssl) dzint = max(c0,hsnow - dzssl) - zspace = c1/real(nblyr,kind=dbl_kind) + zspace = c1/real(nblyr,kind=dbl_kind) xout = c0 xout = (xin(1) + xin(nblyr+1))*hbrine*p5*zspace diff --git a/columnphysics/icepack_atmo.F90 b/columnphysics/icepack_atmo.F90 index b18726f63..919e7e2fd 100644 --- a/columnphysics/icepack_atmo.F90 +++ b/columnphysics/icepack_atmo.F90 @@ -7,7 +7,7 @@ ! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb ! 2004: Block structure added by William Lipscomb ! 2006: Converted to free source form (F90) by Elizabeth Hunke -! 2013: Form drag routine added (neutral_drag_coeffs) by David Schroeder +! 2013: Form drag routine added (neutral_drag_coeffs) by David Schroeder ! 2014: Adjusted form drag and added high frequency coupling by Andrew Roberts module icepack_atmo @@ -39,7 +39,7 @@ module icepack_atmo ! Compute coefficients for atm/ice fluxes, stress, and reference ! temperature and humidity. NOTE: -! (1) All fluxes are positive downward, +! (1) All fluxes are positive downward, ! (2) Here, tstar = (WT)/U*, and qstar = (WQ)/U*, ! (3a) wind speeds should all be above a minimum speed (eg. 1.0 m/s). ! @@ -51,10 +51,10 @@ module icepack_atmo subroutine atmo_boundary_layer (sfctype, & calc_strair, formdrag, & Tsf, potT, & - uatm, vatm, & - wind, zlvl, & + uatm, vatm, & + wind, zlvl, & Qa, rhoa, & - strx, stry, & + strx, stry, & Tref, Qref, & delt, delq, & lhcoef, shcoef, & @@ -63,7 +63,7 @@ subroutine atmo_boundary_layer (sfctype, & Qa_iso, Qref_iso, & iso_flag, & uvel, vvel, & - Uref, zlvs ) + Uref, zlvs ) use icepack_parameters, only: highfreq, natmiter, atmiter_conv @@ -86,7 +86,7 @@ subroutine atmo_boundary_layer (sfctype, & real (kind=dbl_kind), intent(inout) :: & Cdn_atm ! neutral drag coefficient - + real (kind=dbl_kind), intent(inout) :: & Cdn_atm_ratio_n ! ratio drag coeff / neutral drag coeff @@ -134,7 +134,6 @@ subroutine atmo_boundary_layer (sfctype, & fac , & ! interpolation factor al2 , & ! ln(z10 /zTrf) psix2 , & ! stability function at zTrf (heat and water) - psimhs, & ! stable profile ssq , & ! sat surface humidity (kg/kg) qqq , & ! for qsat, dqsfcdt TTT , & ! for qsat, dqsfcdt @@ -145,7 +144,6 @@ subroutine atmo_boundary_layer (sfctype, & real (kind=dbl_kind) :: & ustar , & ! ustar (m/s) ustar_prev , & ! ustar_prev (m/s) - vscl , & ! vscl tstar , & ! tstar qstar , & ! qstar ratio , & ! ratio @@ -187,7 +185,7 @@ subroutine atmo_boundary_layer (sfctype, & cpvir = cp_wv/cp_air-c1 ! defined as cp_wv/cp_air - 1. - if (highfreq) then + if (highfreq) then umin = p5 ! minumum allowable wind-ice speed difference of 0.5 m/s else umin = c1 ! minumum allowable wind speed of 1m/s @@ -223,8 +221,8 @@ subroutine atmo_boundary_layer (sfctype, & vmag = max(umin, wind) endif - if (formdrag .and. Cdn_atm > puny) then - rdn = sqrt(Cdn_atm) + if (formdrag .and. Cdn_atm > puny) then + rdn = sqrt(Cdn_atm) else rdn = vonkar/log(zref/iceruf) ! neutral coefficient Cdn_atm = rdn * rdn @@ -249,7 +247,7 @@ subroutine atmo_boundary_layer (sfctype, & delt = potT - TsfK ! pot temp diff (K) qsat = qqq * exp(-TTT/TsfK) ! saturation humidity (kg/m^3) ssq = qsat / rhoa ! sat surf hum (kg/kg) - + thva = potT * (c1 + zvir * Qa) ! virtual pot temp (K) delq = Qa - ssq ! spec hum dif (kg/kg) alzm = log(zlvl/zref) @@ -259,7 +257,7 @@ subroutine atmo_boundary_layer (sfctype, & alzs = alzm endif cp = cp_air*(c1 + cpvir*ssq) - + !------------------------------------------------------------ ! first estimate of Z/L and ustar, tstar and qstar !------------------------------------------------------------ @@ -267,7 +265,7 @@ subroutine atmo_boundary_layer (sfctype, & ! neutral coefficients, z/L = 0.0 rhn = rdn ren = rdn - + ! ustar,tstar,qstar ustar = rdn * vmag tstar = rhn * delt @@ -303,7 +301,7 @@ subroutine atmo_boundary_layer (sfctype, & rd = rdn / (c1+rdn/vonkar*(alzm-psimh)) rh = rhn / (c1+rhn/vonkar*(alzs-psixh)) re = ren / (c1+ren/vonkar*(alzs-psixh)) - + ! update ustar, tstar, qstar using updated, shifted coeffs ustar = rd * vmag tstar = rh * delt @@ -320,7 +318,7 @@ subroutine atmo_boundary_layer (sfctype, & if (highfreq .and. sfctype(1:3)=='ice') then !------------------------------------------------------------ - ! momentum flux for high frequency coupling (RASM/CESM) + ! momentum flux for high frequency coupling (RASM/CESM) !------------------------------------------------------------ ! tau = rhoa * rd * rd ! strx = tau * |Uatm-U| * (uatm-u) @@ -393,7 +391,7 @@ subroutine atmo_boundary_layer (sfctype, & if (l_iso_flag) then if (present(Qref_iso) .and. present(Qa_iso)) then - Qref_iso(:) = c0 + Qref_iso(:) = c0 if (tr_iso) then do n = 1, n_iso ratio = c0 @@ -418,9 +416,9 @@ end subroutine atmo_boundary_layer ! (2) reference temperature and humidity are NOT computed subroutine atmo_boundary_const (sfctype, calc_strair, & - uatm, vatm, & + uatm, vatm, & wind, rhoa, & - strx, stry, & + strx, stry, & Tsf, potT, & Qa, & delt, delq, & @@ -470,7 +468,7 @@ subroutine atmo_boundary_const (sfctype, calc_strair, & delq = c0 shcoef = c0 lhcoef = c0 - + if (calc_strair) then strx = c0 @@ -504,10 +502,10 @@ subroutine atmo_boundary_const (sfctype, calc_strair, & TsfK = Tsf + Tffresh ! surface temp (K) qsat = qqqocn * exp(-TTTocn/TsfK) ! sat humidity (kg/m^3) ssq = qsat / rhoa ! sat surf hum (kg/kg) - + delt= potT - TsfK ! pot temp diff (K) delq= Qa - ssq ! spec hum dif (kg/kg) - + !------------------------------------------------------------ ! coefficients for turbulent flux calculation !------------------------------------------------------------ @@ -519,7 +517,7 @@ end subroutine atmo_boundary_const !======================================================================= -! Neutral drag coefficients for ocean and atmosphere also compute the +! Neutral drag coefficients for ocean and atmosphere also compute the ! intermediate necessary variables ridge height, distance, floe size ! based upon Tsamados et al. (2014), JPO, DOI: 10.1175/JPO-D-13-0215.1. ! Places where the code varies from the paper are commented. @@ -545,27 +543,27 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & dkeel, lfloe, & dfloe, ncat) - use icepack_tracers, only: tr_pond, tr_pond_lvl, tr_pond_topo + use icepack_tracers, only: tr_pond integer (kind=int_kind), intent(in) :: & ncat real (kind=dbl_kind), dimension (:), intent(in) :: & - apnd ,& ! melt pond fraction of sea ice - hpnd ,& ! mean melt pond depth over sea ice + apnd ,& ! melt pond fraction of sea ice + hpnd ,& ! mean melt pond depth over sea ice ipnd ,& ! mean ice pond depth over sea ice in cat n alvl ,& ! level ice area fraction (of grid cell ?) - vlvl ! level ice mean thickness - + vlvl ! level ice mean thickness + real (kind=dbl_kind), intent(in) :: & aice , & ! concentration of ice vice , & ! volume per unit area of ice - vsno ! volume per unit area of snow - + vsno ! volume per unit area of snow + real (kind=dbl_kind), dimension (:), intent(in) :: & aicen , & ! concentration of ice vicen ! volume per unit area of ice (m) - + real (kind=dbl_kind), & intent(out) :: & hfreebd , & ! freeboard (m) @@ -576,31 +574,31 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & dkeel , & ! distance between keels lfloe , & ! floe length (m) dfloe , & ! distance between floes - Cdn_ocn , & ! ocean-ice neutral drag coefficient - Cdn_ocn_skin , & ! drag coefficient due to skin drag - Cdn_ocn_floe , & ! drag coefficient due to floe edges - Cdn_ocn_keel , & ! drag coefficient due to keels - Cdn_atm , & ! ice-atmosphere drag coefficient - Cdn_atm_skin , & ! drag coefficient due to skin drag - Cdn_atm_floe , & ! drag coefficient due to floe edges - Cdn_atm_pond , & ! drag coefficient due to ponds - Cdn_atm_rdg ! drag coefficient due to ridges - - real (kind=dbl_kind), parameter :: & - ! [,] = range of values that can be tested + Cdn_ocn , & ! ocean-ice neutral drag coefficient + Cdn_ocn_skin , & ! drag coefficient due to skin drag + Cdn_ocn_floe , & ! drag coefficient due to floe edges + Cdn_ocn_keel , & ! drag coefficient due to keels + Cdn_atm , & ! ice-atmosphere drag coefficient + Cdn_atm_skin , & ! drag coefficient due to skin drag + Cdn_atm_floe , & ! drag coefficient due to floe edges + Cdn_atm_pond , & ! drag coefficient due to ponds + Cdn_atm_rdg ! drag coefficient due to ridges + + real (kind=dbl_kind), parameter :: & + ! [,] = range of values that can be tested csw = 0.002_dbl_kind ,&! ice-ocn drag coefficient [0.0005,0.005] - csa = 0.0005_dbl_kind,&! ice-air drag coefficient [0.0001,0.001] + csa = 0.0005_dbl_kind,&! ice-air drag coefficient [0.0001,0.001] mrdg = c20 ,&! screening effect see Lu2011 [5,50] mrdgo = c10 ,&! screening effect see Lu2011 [5,50] - beta = p5 ,&! power exponent appearing in astar and + beta = p5 ,&! power exponent appearing in astar and ! L=Lmin(A*/(A*-A))**beta [0,1] Lmin = c8 ,&! min length of floe (m) [5,100] Lmax = 300._dbl_kind ,&! max length of floe (m) [30,3000] - cfa = p2 ,&! Eq. 12 ratio of local from drag over - ! geometrical parameter [0,1] - cfw = p2 ,&! Eq. 15 ratio of local from drag over + cfa = p2 ,&! Eq. 12 ratio of local from drag over + ! geometrical parameter [0,1] + cfw = p2 ,&! Eq. 15 ratio of local from drag over ! geometrical parameter [0,1] - cpa = p2 ,&! Eq. 16 ratio of local form drag over + cpa = p2 ,&! Eq. 16 ratio of local form drag over ! geometrical parameter [0,1] cra = p2 ,&! Eq. 10 local form drag coefficient [0,1] crw = p2 ,&! Eq. 11 local form drag coefficient [0,1] @@ -613,20 +611,20 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & phik = 0.8_dbl_kind ,&! porosity of keels [0.4,1] hkoverhr = c4 ,&! hkeel/hridge ratio [4,8] dkoverdr = c1 ,&! dkeel/distrdg ratio [1,5] - sHGB = 0.18_dbl_kind ,&! Lupkes2012 Eq. 28, Hanssen1988, + sHGB = 0.18_dbl_kind ,&! Lupkes2012 Eq. 28, Hanssen1988, ! Steele1989 suggest instead 0.18 - alpha2 = c0 ,&! weight functions for area of + alpha2 = c0 ,&! weight functions for area of beta2 = p75 ! ridged ice [0,1] integer (kind=int_kind) :: & - n ! category index + n ! category index real (kind=dbl_kind) :: & astar, & ! new constant for form drag ctecaf, & ! constante ctecwf, & ! constante sca, & ! wind attenuation function - scw, & ! ocean attenuation function + scw, & ! ocean attenuation function lp, & ! pond length (m) ctecar, & ctecwk, & @@ -638,7 +636,7 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & real (kind=dbl_kind) :: & apond , & ! melt pond fraction of grid cell ardg , & ! ridged ice area fraction of grid cell - vrdg ! ridged ice mean thickness + vrdg ! ridged ice mean thickness real (kind=dbl_kind), parameter :: & ocnruf = 0.000327_dbl_kind ! ocean surface roughness (m) @@ -658,31 +656,31 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & ocnrufi = c1/ocnruf ! inverse ocean roughness icerufi = c1/iceruf ! inverse ice roughness hfreebd=c0 - hdraft =c0 - hridge =c0 - distrdg=c0 - hkeel =c0 - dkeel =c0 + hdraft =c0 + hridge =c0 + distrdg=c0 + hkeel =c0 + dkeel =c0 lfloe =c0 - dfloe =c0 + dfloe =c0 Cdn_ocn=dragio - Cdn_ocn_skin=c0 - Cdn_ocn_floe=c0 - Cdn_ocn_keel=c0 + Cdn_ocn_skin=c0 + Cdn_ocn_floe=c0 + Cdn_ocn_keel=c0 Cdn_atm = (vonkar/log(zref/iceruf)) * (vonkar/log(zref/iceruf)) - Cdn_atm_skin=c0 - Cdn_atm_floe=c0 - Cdn_atm_pond=c0 + Cdn_atm_skin=c0 + Cdn_atm_floe=c0 + Cdn_atm_pond=c0 Cdn_atm_rdg =c0 - if (aice > p001) then - + if (aice > p001) then + Cdn_atm_skin = csa Cdn_ocn_skin = csw ai = aice aii = c1/ai - + !------------------------------------------------------------ ! Compute average quantities !------------------------------------------------------------ @@ -691,48 +689,48 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & apond = c0 if (tr_pond) then do n = 1,ncat - ! area of pond per unit area of grid cell - apond = apond+apnd(n)*aicen(n) + ! area of pond per unit area of grid cell + apond = apond+apnd(n)*aicen(n) enddo endif - + ! draft and freeboard (see Eq. 27) hdraft = (rhoi*vice+rhos*vsno)*aii/rhow ! without ponds hfreebd = (vice+vsno)*aii-hdraft - - ! Do not allow draft larger than ice thickness (see Eq. 28) + + ! Do not allow draft larger than ice thickness (see Eq. 28) if (hdraft >= vice*aii) then ! replace excess snow with ice so hi~=hdraft hfreebd = (hdraft*ai*(c1-rhoi/rhow) + & (vsno-(vice-hdraft*ai)*rhoi/rhos) * & - (c1-rhos/rhow))*aii ! Stoessel1993 + (c1-rhos/rhow))*aii ! Stoessel1993 endif - + ! floe size parameterization see Eq. 13 lfloe = Lmin * (astar / (astar - ai))**beta - + ! distance between floes parameterization see Eq. 14 dfloe = lfloe * (c1/sqrt(ai) - c1) - - ! Relate ridge height and distance between ridges to + + ! Relate ridge height and distance between ridges to ! ridged ice area fraction and ridged ice mean thickness ! Assumes total volume of ridged ice is split into ridges and keels. - ! Then assume total ridges volume over total area of ridges = + ! Then assume total ridges volume over total area of ridges = ! volume of one average ridge / area of one average ridge ! Same for keels. - + ardg=c0 vrdg=c0 do n=1,ncat - ! ridged ice area fraction over grid cell + ! ridged ice area fraction over grid cell ardg=ardg+(c1-alvl(n))*aicen(n) ! total ridged ice volume per unit grid cell area vrdg=vrdg+(c1-vlvl(n))*vicen(n) enddo - - ! hridge, hkeel, distrdg and dkeel estimates from CICE for + + ! hridge, hkeel, distrdg and dkeel estimates from CICE for ! simple triangular geometry - if (ardg > p001) then + if (ardg > p001) then ! see Eq. 25 and Eq. 26 hridge = vrdg/ardg*c2 & * (alpha2+beta2*hkoverhr/dkoverdr*tanar/tanak) & @@ -741,16 +739,16 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & * (alpha2/tanar+beta2/tanak*hkoverhr/dkoverdr) hkeel = hkoverhr * hridge dkeel = dkoverdr * distrdg - + ! Use the height of ridges relative to the mean freeboard of ! the pack. Therefore skin drag and ridge drag differ in ! this code as compared to Tsamados et al. (2014) equations - ! 10 and 18, which reference both to sea level. + ! 10 and 18, which reference both to sea level. tmp1 = max(c0,hridge - hfreebd) !------------------------------------------------------------ ! Skin drag (atmo) - !------------------------------------------------------------ + !------------------------------------------------------------ Cdn_atm_skin = csa*(c1 - mrdg*tmp1/distrdg) Cdn_atm_skin = max(min(Cdn_atm_skin,camax),c0) @@ -777,23 +775,23 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & !------------------------------------------------------------ ! Skin drag bottom ice (ocean) - !------------------------------------------------------------ - + !------------------------------------------------------------ + Cdn_ocn_skin = csw * (c1 - mrdgo*tmp1/dkeel) Cdn_ocn_skin = max(min(Cdn_ocn_skin,cwmax), c0) - + !------------------------------------------------------------ ! Keel effect (ocean) !------------------------------------------------------------ if (tmp1 > puny) then - scw = c1 - exp(-sHGB*dkeel/tmp1) + scw = c1 - exp(-sHGB*dkeel/tmp1) ctecwk = crw*p5 Cdn_ocn_keel = ctecwk*tmp1/dkeel*scw* & - (log(tmp1*icerufi)/log(zref*icerufi))**c2 + (log(tmp1*icerufi)/log(zref*icerufi))**c2 Cdn_ocn_keel = max(min(Cdn_ocn_keel,cwmax),c0) endif - + endif ! ardg > 0.001 !------------------------------------------------------------ @@ -818,7 +816,7 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & * (log(hfreebd*ocnrufi)/log(zref*ocnrufi))**c2 Cdn_atm_pond = min(Cdn_atm_pond,camax) endif - + !------------------------------------------------------------ ! Floe edge drag effect (ocean) !------------------------------------------------------------ @@ -842,7 +840,7 @@ subroutine neutral_drag_coeffs (apnd, hpnd, & !------------------------------------------------------------ Cdn_ocn = Cdn_ocn_skin + Cdn_ocn_floe + Cdn_ocn_keel - Cdn_ocn = min(Cdn_ocn,cwmax) + Cdn_ocn = min(Cdn_ocn,cwmax) endif @@ -850,7 +848,7 @@ end subroutine neutral_drag_coeffs !======================================================================= !autodocument_start icepack_atm_boundary -! +! subroutine icepack_atm_boundary(sfctype, & Tsf, potT, & diff --git a/columnphysics/icepack_brine.F90 b/columnphysics/icepack_brine.F90 index ddd34931b..28e2301c6 100644 --- a/columnphysics/icepack_brine.F90 +++ b/columnphysics/icepack_brine.F90 @@ -11,7 +11,7 @@ module icepack_brine use icepack_parameters, only: gravit, rhoi, rhow, rhos, depressT use icepack_parameters, only: salt_loss, min_salin, rhosi use icepack_parameters, only: dts_b, l_sk - use icepack_tracers, only: ntrcr, nt_qice, nt_sice, nt_bgc_S + use icepack_tracers, only: ntrcr, nt_qice, nt_sice, nt_bgc_S use icepack_tracers, only: nt_Tsfc use icepack_zbgc_shared, only: k_o, exp_h, Dm, Ra_c, viscos_dynamic, thinS use icepack_zbgc_shared, only: remap_zbgc @@ -31,19 +31,19 @@ module icepack_brine calculate_drho, & icepack_init_hbrine, & icepack_init_zsalinity - - real (kind=dbl_kind), parameter :: & + + real (kind=dbl_kind), parameter :: & maxhbr = 1.25_dbl_kind , & ! brine overflows if hbr > maxhbr*hin - viscos = 2.1e-6_dbl_kind, & ! kinematic viscosity (m^2/s) + viscos = 2.1e-6_dbl_kind, & ! kinematic viscosity (m^2/s) ! Brine salinity as a cubic function of temperature - a1 = -21.4_dbl_kind , & ! (psu/C) + a1 = -21.4_dbl_kind , & ! (psu/C) a2 = -0.886_dbl_kind, & ! (psu/C^2) a3 = -0.012_dbl_kind, & ! (psu/C^3) ! Brine density as a quadratic of brine salinity - b1 = 1000.0_dbl_kind, & ! (kg/m^3) + b1 = 1000.0_dbl_kind, & ! (kg/m^3) b2 = 0.8_dbl_kind ! (kg/m^3/ppt) - real (kind=dbl_kind), parameter :: & + real (kind=dbl_kind), parameter :: & exp_argmax = 30.0_dbl_kind ! maximum argument of exponential for underflow !======================================================================= @@ -54,17 +54,17 @@ module icepack_brine ! Computes the top and bottom brine boundary changes for flushing ! works for zsalinity and tr_salinity ! -! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with -! dynamic salinity or the height ratio = hbr/vicen*aicen, where hbr is the +! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with +! dynamic salinity or the height ratio = hbr/vicen*aicen, where hbr is the ! height of the brine surface relative to the bottom of the ice. This volume fraction -! may be > 1 in which case there is brine above the ice surface (meltponds). +! may be > 1 in which case there is brine above the ice surface (meltponds). subroutine preflushing_changes (aicen, vicen, vsnon, & meltb, meltt, congel, & snoice, hice_old, dhice, & fbri, dhbr_top, dhbr_bot, & hbr_old, hin,hsn, firstice ) - + real (kind=dbl_kind), intent(in) :: & aicen , & ! concentration of ice vicen , & ! volume per unit area of ice (m) @@ -73,13 +73,13 @@ subroutine preflushing_changes (aicen, vicen, vsnon, & meltt , & ! top ice melt (m) congel , & ! bottom ice growth (m) snoice ! top ice growth from flooding (m) - + real (kind=dbl_kind), intent(out) :: & hbr_old ! old brine height (m) real (kind=dbl_kind), intent(inout) :: & - hin , & ! ice thickness (m) - hsn , & ! snow thickness (m) + hin , & ! ice thickness (m) + hsn , & ! snow thickness (m) dhice ! change due to sublimation (<0)/condensation (>0) (m) real (kind=dbl_kind), intent(inout) :: & @@ -89,7 +89,7 @@ subroutine preflushing_changes (aicen, vicen, vsnon, & hice_old ! old ice thickness (m) logical (kind=log_kind), intent(in) :: & - firstice ! if true, initialized values should be used + firstice ! if true, initialized values should be used ! local variables @@ -106,7 +106,7 @@ subroutine preflushing_changes (aicen, vicen, vsnon, & write(warnstr, *) subname,'fbri, hice_old', fbri, hice_old call icepack_warnings_add(warnstr) write(warnstr, *) subname,'vicen, aicen', vicen, aicen - call icepack_warnings_add(warnstr) + call icepack_warnings_add(warnstr) call icepack_warnings_add(subname//' icepack_brine preflushing: fbri <= c0') call icepack_warnings_setabort(.true.,__FILE__,__LINE__) endif @@ -115,7 +115,7 @@ subroutine preflushing_changes (aicen, vicen, vsnon, & hsn = vsnon / aicen hin_old = max(c0, hin + meltb + meltt - congel - snoice) dhice = hin_old - hice_old ! change due to subl/cond - dhbr_top = meltt - snoice - dhice + dhbr_top = meltt - snoice - dhice dhbr_bot = congel - meltb if ((hice_old < puny) .OR. (hin_old < puny) .OR. firstice) then @@ -123,7 +123,7 @@ subroutine preflushing_changes (aicen, vicen, vsnon, & dhbr_top = c0 dhbr_bot = c0 dhice = c0 - fbri = c1 + fbri = c1 endif hbr_old = fbri * hice_old @@ -150,27 +150,27 @@ subroutine compute_microS_mushy (nilyr, nblyr, & integer (kind=int_kind), intent(in) :: & nilyr , & ! number of ice layers nblyr ! number of bio layers - + real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & bgrid ! biology nondimensional vertical grid points real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), & intent(in) :: & hice_old , & ! previous timestep ice height (m) sss , & ! ocean salinity (ppt) sst ! ocean temperature (C) - + real (kind=dbl_kind), dimension(ntrcr), & intent(in) :: & - trcrn + trcrn - real (kind=dbl_kind), intent(out) :: & + real (kind=dbl_kind), intent(out) :: & kperm , & ! average ice permeability (m^2) bphi_min ! surface porosity @@ -183,47 +183,47 @@ subroutine compute_microS_mushy (nilyr, nblyr, & real (kind=dbl_kind), dimension (nblyr+1), & intent(inout) :: & - iphin , & ! porosity on the igrid - ibrine_rho , & ! brine rho on interface - ibrine_sal , & ! brine sal on interface + iphin , & ! porosity on the igrid + ibrine_rho , & ! brine rho on interface + ibrine_sal , & ! brine sal on interface iTin ! Temperature on the igrid (oC) real (kind=dbl_kind), dimension (nblyr+2), & intent(inout) :: & bSin , & ! bulk salinity (ppt) on bgrid - brine_sal , & ! equilibrium brine salinity (ppt) - brine_rho ! internal brine density (kg/m^3) + brine_sal , & ! equilibrium brine salinity (ppt) + brine_rho ! internal brine density (kg/m^3) real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & bTin , & ! Temperature on bgrid bphin ! porosity on bgrid real (kind=dbl_kind), intent(inout) :: & - sice_rho ! average ice density + sice_rho ! average ice density real (kind=dbl_kind), dimension (nblyr+2) :: & bqin ! enthalpy on the bgrid () real (kind=dbl_kind), dimension (nblyr+1) :: & - ikin ! permeability (m^2) + ikin ! permeability (m^2) integer (kind=int_kind) :: & - k ! vertical biology layer index - + k ! vertical biology layer index + real (kind=dbl_kind) :: & - surface_S , & ! salinity of ice above hin > hbr + surface_S , & ! salinity of ice above hin > hbr hinc_old ! mean ice thickness before current melt/growth (m) - + real (kind=dbl_kind), dimension (ntrcr+2) :: & ! nblyr+2) - trtmp_s , & ! temporary, remapped tracers - trtmp_q ! temporary, remapped tracers - - real (kind=dbl_kind), dimension(nblyr+1) :: & + trtmp_s , & ! temporary, remapped tracers + trtmp_q ! temporary, remapped tracers + + real (kind=dbl_kind), dimension(nblyr+1) :: & drho ! brine density difference (kg/m^3) - + real(kind=dbl_kind), parameter :: & Smin = p01 - + character(len=*),parameter :: subname='(compute_microS_mushy)' !----------------------------------------------------------------- @@ -234,7 +234,7 @@ subroutine compute_microS_mushy (nilyr, nblyr, & trtmp_q(:) = c0 iDin(:) = c0 - ! map Sin and qin (cice) profiles to bgc grid + ! map Sin and qin (cice) profiles to bgc grid surface_S = min_salin hbr_old = min(hbr_old, maxhbr*hice_old) hinc_old = hice_old @@ -247,7 +247,7 @@ subroutine compute_microS_mushy (nilyr, nblyr, & cgrid(2:nilyr+1), & bgrid(2:nblyr+1), surface_S ) if (icepack_warnings_aborted(subname)) return - + call remap_zbgc(nilyr, & nt_qice, & trcrn, trtmp_q, & @@ -275,7 +275,7 @@ subroutine compute_microS_mushy (nilyr, nblyr, & !----------------------------------------------------------------- ! Define ice multiphase structure !----------------------------------------------------------------- - + call prepare_hbrine (nblyr, & bSin, bTin, iTin, & brine_sal, brine_rho, & @@ -287,15 +287,15 @@ subroutine compute_microS_mushy (nilyr, nblyr, & if (icepack_warnings_aborted(subname)) return call calculate_drho(nblyr, igrid, bgrid, & - brine_rho, ibrine_rho, drho) + brine_rho, ibrine_rho, drho) if (icepack_warnings_aborted(subname)) return do k= 2, nblyr+1 - ikin(k) = k_o*iphin(k)**exp_h - iDin(k) = iphin(k)*Dm/hbr_old**2 + ikin(k) = k_o*iphin(k)**exp_h + iDin(k) = iphin(k)*Dm/hbr_old**2 if (hbr_old .GE. Ra_c) & iDin(k) = iDin(k) & - + l_sk*ikin(k)*gravit/viscos_dynamic*drho(k)/hbr_old**2 + + l_sk*ikin(k)*gravit/viscos_dynamic*drho(k)/hbr_old**2 enddo ! k end subroutine compute_microS_mushy @@ -306,7 +306,7 @@ subroutine prepare_hbrine (nblyr, & bSin, bTin, iTin, & brine_sal, brine_rho, & ibrine_sal, ibrine_rho, & - sice_rho, bphin, iphin,& + sice_rho, bphin, iphin,& kperm, bphi_min, & i_grid, sss) @@ -321,12 +321,12 @@ subroutine prepare_hbrine (nblyr, & real (kind=dbl_kind), dimension (:), & intent(inout) :: & - brine_sal , & ! equilibrium brine salinity (ppt) + brine_sal , & ! equilibrium brine salinity (ppt) brine_rho , & ! internal brine density (kg/m^3) ibrine_rho , & ! brine density on interface (kg/m^3) ibrine_sal , & ! brine salinity on interface (ppt) iphin , & ! porosity on interface - iTin , & ! Temperature on interface + iTin , & ! Temperature on interface bphin ! porosity of layers real (kind=dbl_kind), intent(in) :: & @@ -337,13 +337,13 @@ subroutine prepare_hbrine (nblyr, & bphi_min ! minimum porosity real (kind=dbl_kind), intent(inout) :: & - sice_rho ! avg sea ice density + sice_rho ! avg sea ice density ! local variables real (kind=dbl_kind), dimension(nblyr+1) :: & - kin ! permeability - + kin ! permeability + real (kind=dbl_kind) :: & k_min, ktemp, & igrp, igrm, rigr ! grid finite differences @@ -354,14 +354,14 @@ subroutine prepare_hbrine (nblyr, & character(len=*),parameter :: subname='(prepare_hbrine)' !----------------------------------------------------------------- - ! calculate equilibrium brine density and gradients + ! calculate equilibrium brine density and gradients !----------------------------------------------------------------- - + sice_rho = c0 - + do k = 1, nblyr+1 - - if (k == 1) then + + if (k == 1) then igrm = 0 else igrm = i_grid(k) - i_grid(k-1) @@ -374,10 +374,10 @@ subroutine prepare_hbrine (nblyr, & bphin (k) = max(puny, bSin(k)*rhosi & / (brine_sal(k)*brine_rho(k))) bphin (k) = min(c1, bphin(k)) - kin (k) = k_o*bphin(k)**exp_h + kin (k) = k_o*bphin(k)**exp_h sice_rho = sice_rho + (rhoi*(c1-bphin(k)) & + brine_rho(k)*bphin(k))*igrm - enddo ! k + enddo ! k brine_sal (nblyr+2) = sss brine_rho (nblyr+2) = rhow @@ -394,7 +394,7 @@ subroutine prepare_hbrine (nblyr, & kperm = c0 ! initialize ktemp = c0 bphi_min = bphin (1) -! bphi_min = max(bphin(1),bSin(2)*rhosi/bphin(2) & +! bphi_min = max(bphin(1),bSin(2)*rhosi/bphin(2) & ! / (brine_sal(1)*brine_rho(1))*phi_snow) do k = 2, nblyr @@ -413,10 +413,10 @@ subroutine prepare_hbrine (nblyr, & iphin (k) = max(puny, & (bphin (k+1)*igrp + bphin (k)*igrm) * rigr) iphin (k) = min(c1, iphin (k)) - enddo ! k + enddo ! k if (k_min > c0) then - ktemp = ktemp + c1/kin(nblyr+1) + ktemp = ktemp + c1/kin(nblyr+1) kperm = real(nblyr,kind=dbl_kind)/ktemp endif @@ -424,15 +424,15 @@ end subroutine prepare_hbrine !======================================================================= -! Changes include brine height increases from ice and snow surface melt, +! Changes include brine height increases from ice and snow surface melt, ! congelation growth, and upward pressure driven flow from snow loading. -! -! Decreases arise from downward flushing and bottom melt. ! -! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice -! with dynamic salinity or the height ratio == hbr/vicen*aicen, where -! hbr is the height of the brine surface relative to the bottom of the -! ice. This volume fraction may be > 1 in which case there is brine +! Decreases arise from downward flushing and bottom melt. +! +! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice +! with dynamic salinity or the height ratio == hbr/vicen*aicen, where +! hbr is the height of the brine surface relative to the bottom of the +! ice. This volume fraction may be > 1 in which case there is brine ! above the ice surface (ponds). subroutine update_hbrine (meltt, & @@ -450,7 +450,7 @@ subroutine update_hbrine (meltt, & real (kind=dbl_kind), intent(in) :: & dt ! timestep - + real (kind=dbl_kind), intent(in):: & meltt, & ! true top melt over dt (m) melts, & ! true snow melt over dt (m) @@ -458,28 +458,28 @@ subroutine update_hbrine (meltt, & hsn, & ! snow thickness (m) hin_old, & ! past timestep ice thickness (m) hbr_old, & ! previous timestep hbr - kperm, & ! avg ice permeability - bphin, & ! upper brine porosity + kperm, & ! avg ice permeability + bphin, & ! upper brine porosity dhS_bottom, & ! change in bottom hbr initially before darcy flow aice0 ! open water area fraction real (kind=dbl_kind), intent(inout):: & darcy_V , & ! Darcy velocity: m/s - darcy_V_chl, & ! Darcy velocity: m/s for bgc + darcy_V_chl, & ! Darcy velocity: m/s for bgc dhS_top , & ! change in top hbr before darcy flow - dh_bot_chl , & ! change in bottom for algae - dh_top_chl , & ! change in bottom for algae - hbr , & ! thickness of brine (m) - fbri , & ! brine height ratio tracer (hbr/hin) - bphi_min ! surface porosity + dh_bot_chl , & ! change in bottom for algae + dh_top_chl , & ! change in bottom for algae + hbr , & ! thickness of brine (m) + fbri , & ! brine height ratio tracer (hbr/hin) + bphi_min ! surface porosity real (kind=dbl_kind), intent(out):: & dh_direct ! surface flooding or runoff (m) - + ! local variables - real (kind=dbl_kind) :: & - hbrmin , & ! thinS or hin + real (kind=dbl_kind) :: & + hbrmin , & ! thinS or hin dhbr_hin , & ! hbr-hin hbrocn , & ! brine height above sea level (m) hbr-h_ocn dhbr , & ! change in brine surface @@ -493,28 +493,28 @@ subroutine update_hbrine (meltt, & real (kind=dbl_kind), parameter :: & dh_min = p001 ! brine remains within dh_min of sea level ! when ice thickness is less than thinS - + character(len=*),parameter :: subname='(update_hbrine)' hbrocn = c0 darcy_V = c0 - darcy_V_chl = c0 + darcy_V_chl = c0 hbrocn_new = c0 - h_ocn = rhosi/rhow*hin + rhos/rhow*hsn + h_ocn = rhosi/rhow*hin + rhos/rhow*hsn dh_direct = c0 - + if (hbr_old > thinS .AND. hin_old > thinS .AND. hin > thinS ) then hbrmin = thinS - dhS_top = -max(c0, min(hin_old-hbr_old, meltt)) * rhoi/rhow + dhS_top = -max(c0, min(hin_old-hbr_old, meltt)) * rhoi/rhow dhS_top = dhS_top - max(c0, melts) * rhos/rhow dh_top_chl = dhS_top - dhbr = dhS_bottom - dhS_top - hbr = max(puny, hbr_old+dhbr) + dhbr = dhS_bottom - dhS_top + hbr = max(puny, hbr_old+dhbr) hbrocn = hbr - h_ocn darcy_coeff = max(c0, kperm*gravit/(viscos*hbr_old)) - if (hbrocn > c0 .AND. hbr > thinS ) then - bphi_min = bphin + if (hbrocn > c0 .AND. hbr > thinS ) then + bphi_min = bphin dhrunoff = -dhS_top*aice0 hbrocn = max(c0,hbrocn - dhrunoff) exp_arg = darcy_coeff/bphi_min*dt @@ -527,7 +527,7 @@ subroutine update_hbrine (meltt, & hbr = max(hbrmin, h_ocn + hbrocn_new) hbrocn_new = hbr-h_ocn darcy_V = -SIGN((hbrocn-hbrocn_new)/dt*bphi_min, hbrocn) - darcy_V_chl= darcy_V + darcy_V_chl= darcy_V dhS_top = dhS_top - darcy_V*dt/bphi_min + dhrunoff dh_top_chl = dh_top_chl - darcy_V_chl*dt/bphi_min + dhrunoff dh_direct = dhrunoff @@ -539,42 +539,42 @@ subroutine update_hbrine (meltt, & else hbrocn_new = hbrocn*exp(-exp_arg) endif - dhflood = max(c0,hbrocn_new - hbrocn)*aice0 + dhflood = max(c0,hbrocn_new - hbrocn)*aice0 hbr = max(hbrmin, h_ocn + hbrocn_new) darcy_V = -SIGN((hbrocn-hbrocn_new + dhflood)/dt*bphi_min, hbrocn) - darcy_V_chl= darcy_V + darcy_V_chl= darcy_V dhS_top = dhS_top - darcy_V*dt/bphi_min - dhflood dh_top_chl = dh_top_chl - darcy_V_chl*dt/bphi_min - dhflood dh_direct = -dhflood endif - - dh_bot_chl = dhS_bottom - - else ! very thin brine height + + dh_bot_chl = dhS_bottom + + else ! very thin brine height hbrmin = min(thinS, hin) hbr = max(hbrmin, hbr_old+dhS_bottom-dhS_top) dhbr_hin = hbr - h_ocn if (abs(dhbr_hin) > dh_min) & - hbr = max(hbrmin, h_ocn + SIGN(dh_min,dhbr_hin)) + hbr = max(hbrmin, h_ocn + SIGN(dh_min,dhbr_hin)) dhS_top = hbr_old - hbr + dhS_bottom dh_top_chl = dhS_top dh_bot_chl = dhS_bottom - endif - - fbri = hbr/hin + endif + + fbri = hbr/hin end subroutine update_hbrine !======================================================================= ! -! Computes ice microstructural properties for zbgc and zsalinity +! Computes ice microstructural properties for zbgc and zsalinity ! -! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with -! dynamic salinity or the height ratio == hbr/vicen*aicen, where hbr is the -! height of the brine surface relative to the bottom of the ice. +! NOTE: In this subroutine, trcrn(nt_fbri) is the volume fraction of ice with +! dynamic salinity or the height ratio == hbr/vicen*aicen, where hbr is the +! height of the brine surface relative to the bottom of the ice. ! This volume fraction -! may be > 1 in which case there is brine above the ice surface (meltponds). -! +! may be > 1 in which case there is brine above the ice surface (meltponds). +! subroutine compute_microS (n_cat, nilyr, nblyr, & bgrid, cgrid, igrid, & trcrn, hice_old, & @@ -585,38 +585,38 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & bSin, brine_sal, & brine_rho, iphin, ibrine_rho, & ibrine_sal, sice_rho, sloss) - + integer (kind=int_kind), intent(in) :: & n_cat , & ! ice category nilyr , & ! number of ice layers nblyr ! number of bio layers - + real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & bgrid ! biology nondimensional vertical grid points real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), intent(in) :: & hice_old , & ! previous timestep ice height (m) sss , & ! ocean salinity (ppt) sst ! ocean temperature (oC) - + real (kind=dbl_kind), dimension(ntrcr), intent(inout) :: & - trcrn + trcrn real (kind=dbl_kind), intent(inout) :: & hbr_old , & ! old brine height sice_rho ! average ice density real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & - bTin , & ! Temperature of ice layers on bio grid for history file (^oC) + bTin , & ! Temperature of ice layers on bio grid for history file (^oC) bphin , & ! Porosity of layers - brine_sal , & ! equilibrium brine salinity (ppt) - brine_rho ! Internal brine density (kg/m^3) + brine_sal , & ! equilibrium brine salinity (ppt) + brine_rho ! Internal brine density (kg/m^3) real (kind=dbl_kind), dimension (nblyr+2), intent(out) :: & bSin @@ -624,38 +624,38 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & iTin ! Temperature on the interface grid - real (kind=dbl_kind), intent(out) :: & + real (kind=dbl_kind), intent(out) :: & bphi_min , & ! surface porosity kperm , & ! average ice permeability (m^2) sloss ! (g/m^2) salt from brine runoff for hbr > maxhbr*hin logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. if ice exceeded a minimum thickness hin >= Ra_c - + Rayleigh_criteria ! .true. if ice exceeded a minimum thickness hin >= Ra_c + logical (kind=log_kind), intent(in) :: & firstice ! .true. if ice is newly formed real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - iphin , & ! porosity on the igrid - ibrine_rho , & ! brine rho on interface - ibrine_sal ! brine sal on interface + iphin , & ! porosity on the igrid + ibrine_rho , & ! brine rho on interface + ibrine_sal ! brine sal on interface ! local variables - + integer (kind=int_kind) :: & - k ! vertical biology layer index - + k ! vertical biology layer index + real (kind=dbl_kind) :: & - surface_S , & ! salinity of ice above hin > hbr + surface_S , & ! salinity of ice above hin > hbr hinc_old ! ice thickness (cell quantity) before current melt/growth (m) ! logical (kind=log_kind) :: & -! Rayleigh ! .true. if ice exceeded a minimum thickness hin >= Ra_c +! Rayleigh ! .true. if ice exceeded a minimum thickness hin >= Ra_c real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp0 , & ! temporary, remapped tracers - trtmp ! temporary, remapped tracers - + trtmp0 , & ! temporary, remapped tracers + trtmp ! temporary, remapped tracers + real (kind=dbl_kind) :: & Tmlts ! melting temperature @@ -665,27 +665,27 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & ! Initialize !----------------------------------------------------------------- - sloss = c0 + sloss = c0 bTin(:) = c0 bSin(:) = c0 - trtmp(:) = c0 - surface_S = min_salin + trtmp(:) = c0 + surface_S = min_salin hinc_old = hice_old !----------------------------------------------------------------- ! Rayleigh condition for salinity and bgc: ! Implemented as a minimum thickness criteria for category 1 ice only. - ! When hin >= Ra_c (m), pressure flow is allowed. + ! When hin >= Ra_c (m), pressure flow is allowed. ! Turn off by putting Ra_c = 0 in ice_in namelist. !----------------------------------------------------------------- ! Rayleigh = .true. ! if (n_cat == 1 .AND. hbr_old < Ra_c) then -! Rayleigh = Rayleigh_criteria ! only category 1 ice can be false +! Rayleigh = Rayleigh_criteria ! only category 1 ice can be false ! endif - + !----------------------------------------------------------------- ! Define ice salinity on Sin !----------------------------------------------------------------- @@ -693,7 +693,7 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & if (firstice) then do k = 1, nilyr - trcrn(nt_sice+k-1) = sss*salt_loss + trcrn(nt_sice+k-1) = sss*salt_loss enddo call remap_zbgc(nilyr, & @@ -705,15 +705,15 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & bgrid(2:nblyr+1), surface_S ) if (icepack_warnings_aborted(subname)) return - do k = 1, nblyr - trcrn(nt_bgc_S+k-1) = max(min_salin,trtmp(nt_sice+k-1)) - bSin(k+1) = max(min_salin,trcrn(nt_bgc_S+k-1)) + do k = 1, nblyr + trcrn(nt_bgc_S+k-1) = max(min_salin,trtmp(nt_sice+k-1)) + bSin(k+1) = max(min_salin,trcrn(nt_bgc_S+k-1)) if (trcrn(nt_bgc_S+k-1) < min_salin-puny) & call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - enddo ! k + enddo ! k - bSin(1) = bSin(2) - bSin(nblyr+2) = sss + bSin(1) = bSin(2) + bSin(nblyr+2) = sss elseif (hbr_old > maxhbr*hice_old) then @@ -726,12 +726,12 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & bgrid(2:nblyr+1), & bgrid(2:nblyr+1), surface_S ) if (icepack_warnings_aborted(subname)) return - - do k = 1, nblyr - bSin(k+1) = max(min_salin,trtmp(nt_bgc_S+k-1)) + + do k = 1, nblyr + bSin(k+1) = max(min_salin,trtmp(nt_bgc_S+k-1)) sloss = sloss + rhosi*(hbr_old*trcrn(nt_bgc_S+k-1) & - maxhbr*hice_old*bSin(k+1))*(igrid(k+1)-igrid(k)) - trcrn(nt_bgc_S+k-1) = bSin(k+1) + trcrn(nt_bgc_S+k-1) = bSin(k+1) if (trcrn(nt_bgc_S+k-1) < min_salin-puny) & call icepack_warnings_setabort(.true.,__FILE__,__LINE__) enddo ! k @@ -742,8 +742,8 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & else ! old, thin ice - do k = 1, nblyr - trcrn(nt_bgc_S+k-1) = max(min_salin,trcrn(nt_bgc_S+k-1)) + do k = 1, nblyr + trcrn(nt_bgc_S+k-1) = max(min_salin,trcrn(nt_bgc_S+k-1)) bSin (k+1) = trcrn(nt_bgc_S+k-1) enddo ! k @@ -751,24 +751,24 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & bSin (nblyr+2) = sss endif ! ice type - + !----------------------------------------------------------------- ! sea ice temperature for bio grid !----------------------------------------------------------------- - + do k = 1, nilyr Tmlts = -trcrn(nt_sice+k-1)*depressT trtmp0(nt_qice+k-1) = calculate_Tin_from_qin(trcrn(nt_qice+k-1),Tmlts) enddo ! k - trtmp(:) = c0 - + trtmp(:) = c0 + ! CICE to Bio: remap temperatures call remap_zbgc (nilyr, nt_qice, & trtmp0(1:ntrcr), trtmp, & 0, nblyr, & hinc_old, hbr_old, & - cgrid(2:nilyr+1), & + cgrid(2:nilyr+1), & bgrid(2:nblyr+1), surface_S ) if (icepack_warnings_aborted(subname)) return @@ -777,15 +777,15 @@ subroutine compute_microS (n_cat, nilyr, nblyr, & bTin (k+1) = min(Tmlts,trtmp(nt_qice+k-1)) enddo !k - Tmlts = -min_salin* depressT - bTin (1) = min(Tmlts,(bTin(2) + trcrn(nt_Tsfc))*p5) - Tmlts = -bSin(nblyr+2)* depressT + Tmlts = -min_salin* depressT + bTin (1) = min(Tmlts,(bTin(2) + trcrn(nt_Tsfc))*p5) + Tmlts = -bSin(nblyr+2)* depressT bTin (nblyr+2) = sst !----------------------------------------------------------------- ! Define ice multiphase structure !----------------------------------------------------------------- - + call prepare_hbrine (nblyr, & bSin, bTin, iTin, & brine_sal, brine_rho, & @@ -810,10 +810,10 @@ subroutine calculate_drho (nblyr, i_grid, b_grid, & nblyr ! number of bio layers real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & - b_grid ! biology nondimensional grid layer points + b_grid ! biology nondimensional grid layer points real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - i_grid ! biology grid interface points + i_grid ! biology grid interface points real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & brine_rho ! Internal brine density (kg/m^3) @@ -821,7 +821,7 @@ subroutine calculate_drho (nblyr, i_grid, b_grid, & real (kind=dbl_kind), dimension (nblyr + 1), intent(in) :: & ibrine_rho ! Internal brine density (kg/m^3) - real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & + real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & drho ! brine difference about grid point (kg/m^3) ! local variables @@ -846,13 +846,13 @@ subroutine calculate_drho (nblyr, i_grid, b_grid, & rho_2a(:) = c0 rho_b (:) = c0 rho_2b(:) = c0 - drho (:) = c0 ! surface is snow or atmosphere + drho (:) = c0 ! surface is snow or atmosphere do k = 1, nblyr+1 ! i_grid values !---------------------------------------------- - ! h_avg(k) = i_grid(k) - ! Calculate rho_a(k), ie average rho above i_grid(k) + ! h_avg(k) = i_grid(k) + ! Calculate rho_a(k), ie average rho above i_grid(k) ! first part is good !---------------------------------------------- @@ -862,7 +862,7 @@ subroutine calculate_drho (nblyr, i_grid, b_grid, & * p5*(i_grid(2)-b_grid(2)) )/i_grid(2) rho_b(2) = brine_rho(2) - elseif (k > 2 .AND. k < nblyr+1) then + elseif (k > 2 .AND. k < nblyr+1) then rho_a(k) = (rho_a(k-1)*i_grid(k-1) + (ibrine_rho(k-1) + brine_rho(k)) & * p5*(b_grid(k)-i_grid(k-1)) + (ibrine_rho(k ) + brine_rho(k)) & * p5*(i_grid(k)-b_grid(k)))/i_grid(k) @@ -896,7 +896,7 @@ subroutine calculate_drho (nblyr, i_grid, b_grid, & else mstart = nblyr+2 mstop = nblyr+3 - endif + endif do mm = mstart,mstop rho_2a(k) =(rho_a(nblyr+1) + rhow*(c2*i_grid(k)-c1))*p5/i_grid(k) @@ -928,9 +928,9 @@ subroutine icepack_init_hbrine(bgrid, igrid, cgrid, & real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(out) :: & - cgrid , & ! CICE vertical coordinate + cgrid , & ! CICE vertical coordinate icgrid , & ! interface grid for CICE (shortwave variable) swgrid ! grid for ice tracers used in dEdd scheme @@ -941,7 +941,7 @@ subroutine icepack_init_hbrine(bgrid, igrid, cgrid, & integer (kind=int_kind) :: & k ! vertical index - real (kind=dbl_kind) :: & + real (kind=dbl_kind) :: & zspace ! grid spacing for CICE vertical grid character(len=*),parameter :: subname='(icepack_init_hbrine)' @@ -950,58 +950,58 @@ subroutine icepack_init_hbrine(bgrid, igrid, cgrid, & if (phi_snow .le. c0) phi_snow = c1-rhos/rhoi !----------------------------------------------------------------- - ! Calculate bio gridn: 0 to 1 corresponds to ice top to bottom + ! Calculate bio gridn: 0 to 1 corresponds to ice top to bottom !----------------------------------------------------------------- - bgrid(:) = c0 ! zsalinity grid points + bgrid(:) = c0 ! zsalinity grid points bgrid(nblyr+2) = c1 ! bottom value - igrid(:) = c0 ! bgc interface grid points + igrid(:) = c0 ! bgc interface grid points igrid(1) = c0 ! ice top igrid(nblyr+1) = c1 ! ice bottom - + zspace = c1/max(c1,(real(nblyr,kind=dbl_kind))) do k = 2, nblyr+1 bgrid(k) = zspace*(real(k,kind=dbl_kind) - c1p5) enddo - + do k = 2, nblyr igrid(k) = p5*(bgrid(k+1)+bgrid(k)) enddo !----------------------------------------------------------------- - ! Calculate CICE cgrid for interpolation ice top (0) to bottom (1) + ! Calculate CICE cgrid for interpolation ice top (0) to bottom (1) !----------------------------------------------------------------- - + cgrid(1) = c0 ! CICE vertical grid top point zspace = c1/(real(nilyr,kind=dbl_kind)) ! CICE grid spacing - + do k = 2, nilyr+1 - cgrid(k) = zspace * (real(k,kind=dbl_kind) - c1p5) - enddo + cgrid(k) = zspace * (real(k,kind=dbl_kind) - c1p5) + enddo !----------------------------------------------------------------- ! Calculate CICE icgrid for ishortwave interpolation top(0) , bottom (1) !----------------------------------------------------------------- - - icgrid(1) = c0 + + icgrid(1) = c0 zspace = c1/(real(nilyr,kind=dbl_kind)) ! CICE grid spacing - + do k = 2, nilyr+1 icgrid(k) = zspace * (real(k,kind=dbl_kind)-c1) - enddo + enddo !------------------------------------------------------------------------ ! Calculate CICE swgrid for dEdd ice: top of ice (0) , bottom of ice (1) ! Does not include snow ! see icepack_shortwave.F90 ! swgrid represents the layer index of the delta-eddington ice layer index - !------------------------------------------------------------------------ + !------------------------------------------------------------------------ zspace = c1/(real(nilyr,kind=dbl_kind)) ! CICE grid spacing - swgrid(1) = min(c1/60.0_dbl_kind, zspace/c2) + swgrid(1) = min(c1/60.0_dbl_kind, zspace/c2) swgrid(2) = zspace/c2 !+ swgrid(1) do k = 3, nilyr+1 swgrid(k) = zspace * (real(k,kind=dbl_kind)-c1p5) - enddo + enddo end subroutine icepack_init_hbrine @@ -1036,16 +1036,16 @@ subroutine icepack_init_zsalinity(nblyr,ntrcr_o, Rayleigh_criteria, & integer (kind=int_kind) :: & k, n - + character(len=*),parameter :: subname='(icepack_init_zsalinity)' if (nblyr .LE. 7) then dts_b = 300.0_dbl_kind else - dts_b = 50.0_dbl_kind + dts_b = 50.0_dbl_kind endif - Rayleigh_criteria = .false. ! no ice initial condition + Rayleigh_criteria = .false. ! no ice initial condition Rayleigh_real = c0 do n = 1,ncat do k = 1,nblyr diff --git a/columnphysics/icepack_firstyear.F90 b/columnphysics/icepack_firstyear.F90 index 4922b1a64..ea2c87c51 100644 --- a/columnphysics/icepack_firstyear.F90 +++ b/columnphysics/icepack_firstyear.F90 @@ -2,7 +2,7 @@ ! ! First year concentration tracer for sea ice ! -! see +! see ! Armour, K. C., C. M. Bitz, L. Thompson and E. C. Hunke (2011). Controls ! on Arctic sea ice from first-year and multi-year ice survivability. ! J. Climate, 24, 23782390. doi: 10.1175/2010JCLI3823.1. @@ -30,7 +30,7 @@ module icepack_firstyear !======================================================================= ! Zero ice FY tracer on fixed day of year. Zeroing FY ice tracer promotes -! ice to MY ice. Unfortunately some frazil ice may grow before the +! ice to MY ice. Unfortunately some frazil ice may grow before the ! zeroing date and thus get promoted to MY ice too soon. ! Bummer. diff --git a/columnphysics/icepack_flux.F90 b/columnphysics/icepack_flux.F90 index 4f951fff2..50bbd72d4 100644 --- a/columnphysics/icepack_flux.F90 +++ b/columnphysics/icepack_flux.F90 @@ -16,7 +16,7 @@ module icepack_flux implicit none private - public :: merge_fluxes, set_sfcflux + public :: merge_fluxes, set_sfcflux !======================================================================= @@ -28,13 +28,13 @@ module icepack_flux ! ! author: Elizabeth C. Hunke and William H. Lipscomb, LANL - subroutine merge_fluxes (aicen, & + subroutine merge_fluxes (aicen, & flw, & strairxn, strairyn, & Cdn_atm_ratio_n, & - fsurfn, fcondtopn, & + fsurfn, fcondtopn, & fcondbotn, & - fsensn, flatn, & + fsensn, flatn, & fswabsn, flwoutn, & evapn, & evapsn, evapin, & @@ -43,16 +43,16 @@ subroutine merge_fluxes (aicen, & fhocnn, fswthrun, & fswthrun_vdr, fswthrun_vdf,& fswthrun_idr, fswthrun_idf,& - strairxT, strairyT, & + strairxT, strairyT, & Cdn_atm_ratio, & fsurf, fcondtop, & fcondbot, & - fsens, flat, & + fsens, flat, & fswabs, flwout, & - evap, & + evap, & evaps, evapi, & Tref, Qref, & - fresh, fsalt, & + fresh, fsalt, & fhocn, fswthru, & fswthru_vdr, fswthru_vdf,& fswthru_idr, fswthru_idf,& @@ -72,7 +72,7 @@ subroutine merge_fluxes (aicen, & flw , & ! downward longwave flux (W/m**2) strairxn, & ! air/ice zonal strss, (N/m**2) strairyn, & ! air/ice merdnl strss, (N/m**2) - Cdn_atm_ratio_n, & ! ratio of total drag over neutral drag + Cdn_atm_ratio_n, & ! ratio of total drag over neutral drag fsurfn , & ! net heat flux to top surface (W/m**2) fcondtopn,& ! downward cond flux at top sfc (W/m**2) fcondbotn,& ! downward cond flux at bottom sfc (W/m**2) @@ -100,7 +100,7 @@ subroutine merge_fluxes (aicen, & dsnown , & ! change in snow depth (m) congeln , & ! congelation ice growth (m) snoicen ! snow-ice growth (m) - + real (kind=dbl_kind), optional, intent(in):: & Urefn ! air speed reference level (m/s) @@ -158,7 +158,7 @@ subroutine merge_fluxes (aicen, & ! Merge fluxes ! NOTE: The albedo is aggregated only in cells where ice exists ! and (for the delta-Eddington scheme) where the sun is above - ! the horizon. + ! the horizon. !----------------------------------------------------------------- ! atmo fluxes @@ -168,8 +168,8 @@ subroutine merge_fluxes (aicen, & Cdn_atm_ratio = Cdn_atm_ratio + & Cdn_atm_ratio_n * aicen fsurf = fsurf + fsurfn * aicen - fcondtop = fcondtop + fcondtopn * aicen - fcondbot = fcondbot + fcondbotn * aicen + fcondtop = fcondtop + fcondtopn * aicen + fcondbot = fcondbot + fcondbotn * aicen fsens = fsens + fsensn * aicen flat = flat + flatn * aicen fswabs = fswabs + fswabsn * aicen @@ -223,7 +223,7 @@ subroutine merge_fluxes (aicen, & dsnow = dsnow + dsnown * aicen congel = congel + congeln * aicen snoice = snoice + snoicen * aicen - + end subroutine merge_fluxes !======================================================================= @@ -232,8 +232,8 @@ end subroutine merge_fluxes ! flux values using values read in from forcing data or supplied via ! coupling (stored in ice_flux). ! -! If CICE is running in NEMO environment, convert fluxes from GBM values -! to per unit ice area values. If model is not running in NEMO environment, +! If CICE is running in NEMO environment, convert fluxes from GBM values +! to per unit ice area values. If model is not running in NEMO environment, ! the forcing is supplied as per unit ice area values. ! ! authors Alison McLaren, Met Office @@ -252,14 +252,14 @@ subroutine set_sfcflux (aicen, & real (kind=dbl_kind), & intent(in) :: & aicen , & ! concentration of ice - flatn_f , & ! latent heat flux (W/m^2) - fsensn_f , & ! sensible heat flux (W/m^2) + flatn_f , & ! latent heat flux (W/m^2) + fsensn_f , & ! sensible heat flux (W/m^2) fsurfn_f , & ! net flux to top surface, not including fcondtopn fcondtopn_f ! downward cond flux at top surface (W m-2) real (kind=dbl_kind), intent(out):: & - flatn , & ! latent heat flux (W/m^2) - fsensn , & ! sensible heat flux (W/m^2) + flatn , & ! latent heat flux (W/m^2) + fsensn , & ! sensible heat flux (W/m^2) fsurfn , & ! net flux to top surface, not including fcondtopn fcondtopn ! downward cond flux at top surface (W m-2) @@ -271,7 +271,7 @@ subroutine set_sfcflux (aicen, & logical (kind=log_kind) :: & extreme_flag ! flag for extreme forcing values - logical (kind=log_kind), parameter :: & + logical (kind=log_kind), parameter :: & extreme_test=.false. ! test and write out extreme forcing data character(len=*),parameter :: subname='(set_sfcflux)' @@ -280,7 +280,7 @@ subroutine set_sfcflux (aicen, & #ifdef CICE_IN_NEMO !---------------------------------------------------------------------- -! Convert fluxes from GBM values to per ice area values when +! Convert fluxes from GBM values to per ice area values when ! running in NEMO environment. (When in standalone mode, fluxes ! are input as per ice area.) !---------------------------------------------------------------------- @@ -298,60 +298,60 @@ subroutine set_sfcflux (aicen, & if (extreme_test) then extreme_flag = .false. - if (fcondtopn < -100.0_dbl_kind & + if (fcondtopn < -100.0_dbl_kind & .or. fcondtopn > 20.0_dbl_kind) then extreme_flag = .true. endif - - if (fsurfn < -100.0_dbl_kind & + + if (fsurfn < -100.0_dbl_kind & .or. fsurfn > 80.0_dbl_kind) then extreme_flag = .true. endif - - if (flatn < -20.0_dbl_kind & + + if (flatn < -20.0_dbl_kind & .or. flatn > 20.0_dbl_kind) then extreme_flag = .true. endif if (extreme_flag) then - if (fcondtopn < -100.0_dbl_kind & + if (fcondtopn < -100.0_dbl_kind & .or. fcondtopn > 20.0_dbl_kind) then - write(warnstr,*) subname, & + write(warnstr,*) subname, & 'Extreme forcing: -100 > fcondtopn > 20' call icepack_warnings_add(warnstr) - write(warnstr,*) subname, & - 'aicen,fcondtopn = ', & + write(warnstr,*) subname, & + 'aicen,fcondtopn = ', & aicen,fcondtopn call icepack_warnings_add(warnstr) endif - - if (fsurfn < -100.0_dbl_kind & + + if (fsurfn < -100.0_dbl_kind & .or. fsurfn > 80.0_dbl_kind) then - write(warnstr,*) subname, & + write(warnstr,*) subname, & 'Extreme forcing: -100 > fsurfn > 40' call icepack_warnings_add(warnstr) - write(warnstr,*) subname, & - 'aicen,fsurfn = ', & + write(warnstr,*) subname, & + 'aicen,fsurfn = ', & aicen,fsurfn call icepack_warnings_add(warnstr) endif - - if (flatn < -20.0_dbl_kind & + + if (flatn < -20.0_dbl_kind & .or. flatn > 20.0_dbl_kind) then - write(warnstr,*) subname, & + write(warnstr,*) subname, & 'Extreme forcing: -20 > flatn > 20' call icepack_warnings_add(warnstr) - write(warnstr,*) subname, & - 'aicen,flatn = ', & + write(warnstr,*) subname, & + 'aicen,flatn = ', & aicen,flatn call icepack_warnings_add(warnstr) endif - + endif ! extreme_flag - endif ! extreme_test - - end subroutine set_sfcflux + endif ! extreme_test + + end subroutine set_sfcflux !======================================================================= diff --git a/columnphysics/icepack_fsd.F90 b/columnphysics/icepack_fsd.F90 index 835623e82..4d89ca845 100644 --- a/columnphysics/icepack_fsd.F90 +++ b/columnphysics/icepack_fsd.F90 @@ -33,13 +33,13 @@ ! ! authors: Lettie Roach, VUW/NIWA ! C. M. Bitz, UW -! +! ! 2016: CMB started ! 2016-8: LR worked on most of it ! 2019: ECH ported to Icepack !----------------------------------------------------------------- - + module icepack_fsd use icepack_kinds @@ -114,12 +114,9 @@ subroutine icepack_init_fsd_bounds(nfsd, & real (kind=dbl_kind) :: test - real (kind=dbl_kind), dimension (nfsd+1) :: & - area_lims, area_lims_scaled - real (kind=dbl_kind), dimension (0:nfsd) :: & floe_rad - + real (kind=dbl_kind), dimension(:), allocatable :: & lims @@ -146,7 +143,7 @@ subroutine icepack_init_fsd_bounds(nfsd, & 3.35434988e+03, 4.55051413e+03, 6.17323164e+03, 8.37461170e+03, & 1.13610059e+04, 1.54123510e+04, 2.09084095e+04, 2.83643675e+04, & 3.84791270e+04 /) - + elseif (nfsd.eq.16) then allocate(lims(16+1)) @@ -156,7 +153,7 @@ subroutine icepack_init_fsd_bounds(nfsd, & 3.08037274e+02, 4.31203059e+02, 5.81277225e+02, 7.55141047e+02, & 9.45812834e+02, 1.34354446e+03, 1.82265364e+03, 2.47261361e+03, & 3.35434988e+03 /) - + else if (nfsd.eq.12) then allocate(lims(12+1)) @@ -165,7 +162,7 @@ subroutine icepack_init_fsd_bounds(nfsd, & 5.24122136e+01, 8.78691405e+01, 1.39518470e+02, 2.11635752e+02, & 3.08037274e+02, 4.31203059e+02, 5.81277225e+02, 7.55141047e+02, & 9.45812834e+02 /) - + else if (nfsd.eq.1) then ! default case allocate(lims(1+1)) @@ -176,7 +173,7 @@ subroutine icepack_init_fsd_bounds(nfsd, & call icepack_warnings_add(subname//& ' floe size categories not defined for nfsd') - call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) return end if @@ -191,7 +188,7 @@ subroutine icepack_init_fsd_bounds(nfsd, & stat=ierr) if (ierr/=0) then call icepack_warnings_add(subname//' Out of Memory fsd') - call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) return endif @@ -206,7 +203,7 @@ subroutine icepack_init_fsd_bounds(nfsd, & floe_binwidth = floe_rad_h - floe_rad_l floe_area_binwidth = floe_area_h - floe_area_l - + ! floe size categories that can combine during welding iweld(:,:) = -999 do n = 1, nfsd @@ -227,7 +224,7 @@ subroutine icepack_init_fsd_bounds(nfsd, & do n = 1, nfsd floe_rad(n) = floe_rad_h(n) ! Save character string to write to history file - write (c_nf, '(i2)') n + write (c_nf, '(i2)') n write (c_fsd1, '(f7.3)') floe_rad(n-1) write (c_fsd2, '(f7.3)') floe_rad(n) c_fsd_range(n)=c_fsd1//'m < fsd Cat '//c_nf//' < '//c_fsd2//'m' @@ -255,16 +252,16 @@ end subroutine icepack_init_fsd_bounds ! This allows the FSD to emerge, as described in Roach, Horvat et al. (2018) ! ! Otherwise initalize with a power law, following Perovich -! & Jones (2014). The basin-wide applicability of such a +! & Jones (2014). The basin-wide applicability of such a ! prescribed power law has not yet been tested. ! -! Perovich, D. K., & Jones, K. F. (2014). The seasonal evolution of +! Perovich, D. K., & Jones, K. F. (2014). The seasonal evolution of ! sea ice floe size distribution. Journal of Geophysical Research: Oceans, ! 119(12), 8767–8777. doi:10.1002/2014JC010136 ! !autodocument_start icepack_init_fsd ! -! Initialize the FSD +! Initialize the FSD ! ! authors: Lettie Roach, NIWA/VUW @@ -302,11 +299,11 @@ subroutine icepack_init_fsd(nfsd, ice_ic, & afsd(:) = c0 else ! Perovich (2014) - + ! fraction of ice in each floe size and thickness category ! same for ALL cells (even where no ice) initially alpha = 2.1_dbl_kind - totfrac = c0 ! total fraction of floes + totfrac = c0 ! total fraction of floes do k = 1, nfsd num_fsd(k) = (2*floe_rad_c(k))**(-alpha-c1) ! number distribution of floes afsd (k) = num_fsd(k)*floe_area_c(k)*floe_binwidth(k) ! fraction distribution of floes @@ -393,7 +390,7 @@ subroutine icepack_cleanup_fsdn (nfsd, afsd) end subroutine icepack_cleanup_fsdn !======================================================================= -! +! ! Given the joint ice thickness and floe size distribution, calculate ! the lead region and the total lateral surface area following Horvat ! and Tziperman (2015). @@ -586,7 +583,7 @@ subroutine fsd_lateral_growth (ncat, nfsd, & + c2*aicen(n)*afsdn(k,n)*G_radial*dt/floe_rad_c(k) end do end do ! n - + ! cannot expand ice laterally beyond lead region if (SUM(d_an_latg(:)).ge.lead_area) then d_an_latg(:) = d_an_latg(:)/SUM(d_an_latg(:)) @@ -613,8 +610,8 @@ end subroutine fsd_lateral_growth ! Shen et al. (2001). Otherwise, new floes all grow in the smallest ! floe size category, representing pancake ice formation. ! -! Shen, H., Ackley, S., & Hopkins, M. (2001). A conceptual model -! for pancake-ice formation in a wave field. +! Shen, H., Ackley, S., & Hopkins, M. (2001). A conceptual model +! for pancake-ice formation in a wave field. ! Annals of Glaciology, 33, 361-367. doi:10.3189/172756401781818239 ! ! authors: Lettie Roach, NIWA/VUW @@ -706,10 +703,10 @@ subroutine fsd_add_new_ice (ncat, n, nfsd, & nsubt = 0 DO WHILE (elapsed_t.lt.dt) - + nsubt = nsubt + 1 if (nsubt.gt.100) print *, 'latg not converging' - + ! finite differences df_flx(:) = c0 ! NB could stay zero if all in largest FS cat f_flx (:) = c0 @@ -730,9 +727,9 @@ subroutine fsd_add_new_ice (ncat, n, nfsd, & end do ! timestep required for this - subdt = get_subdt_fsd(nfsd, afsdn_latg(:,n), dafsd_tmp(:)) + subdt = get_subdt_fsd(nfsd, afsdn_latg(:,n), dafsd_tmp(:)) subdt = MIN(subdt, dt) - + ! update fsd and elapsed time afsdn_latg(:,n) = afsdn_latg(:,n) + subdt*dafsd_tmp(:) elapsed_t = elapsed_t + subdt @@ -818,7 +815,7 @@ end subroutine fsd_add_new_ice !======================================================================= ! -! Given a wave spectrum, calculate size of new floes based on +! Given a wave spectrum, calculate size of new floes based on ! tensile failure, following Shen et al. (2001) ! ! The tensile mode parameter is based on in-situ measurements @@ -877,9 +874,9 @@ end subroutine wave_dep_growth !======================================================================= ! ! Floes are perimitted to weld together in freezing conditions, according -! to their geometric probability of overlap if placed randomly on the -! domain. The rate per unit area c_weld is the total number -! of floes that weld with another, per square meter, per unit time, in the +! to their geometric probability of overlap if placed randomly on the +! domain. The rate per unit area c_weld is the total number +! of floes that weld with another, per square meter, per unit time, in the ! case of a fully covered ice surface (aice=1), equal to twice the reduction ! in total floe number. See Roach, Smith & Dean (2018). ! @@ -916,16 +913,15 @@ subroutine fsd_weld_thermo (ncat, nfsd, & aminweld = p1 ! minimum ice concentration likely to weld real (kind=dbl_kind), parameter :: & - c_weld = 1.0e-8_dbl_kind + c_weld = 1.0e-8_dbl_kind ! constant of proportionality for welding ! total number of floes that weld with another, per square meter, ! per unit time, in the case of a fully covered ice surface ! units m^-2 s^-1, see documentation for details integer (kind=int_kind) :: & - nt , & ! time step index n , & ! thickness category index - k, kx, ky, i, j ! floe size category indices + k, i, j ! floe size category indices real (kind=dbl_kind), dimension(nfsd,ncat) :: & afsdn ! floe size distribution tracer @@ -970,14 +966,14 @@ subroutine fsd_weld_thermo (ncat, nfsd, & afsd_init(:) = afsdn(:,n) ! save initial values afsd_tmp (:) = afsd_init(:) ! work array - + ! in case of minor numerical errors WHERE(afsd_tmp < puny) afsd_tmp = c0 afsd_tmp = afsd_tmp/SUM(afsd_tmp) ! adaptive sub-timestep - elapsed_t = c0 - DO WHILE (elapsed_t < dt) + elapsed_t = c0 + DO WHILE (elapsed_t < dt) ! calculate sub timestep nfsd_tmp = afsd_tmp/floe_area_c @@ -1006,7 +1002,7 @@ subroutine fsd_weld_thermo (ncat, nfsd, & ! if (loss(nfsd) > puny) stop 'weld, largest cat losing' ! if (gain(1) > puny) stop 'weld, smallest cat gaining' - ! update afsd + ! update afsd afsd_tmp(:) = afsd_tmp(:) + subdt*(gain(:) - loss(:)) ! in case of minor numerical errors @@ -1058,7 +1054,7 @@ function get_subdt_fsd(nfsd, afsd_init, d_afsd) & nfsd ! number of floe size categories real (kind=dbl_kind), dimension (nfsd), intent(in) :: & - afsd_init, d_afsd ! floe size distribution tracer + afsd_init, d_afsd ! floe size distribution tracer ! output real (kind=dbl_kind) :: & @@ -1070,11 +1066,11 @@ function get_subdt_fsd(nfsd, afsd_init, d_afsd) & integer (kind=int_kind) :: k - check_dt(:) = bignum + check_dt(:) = bignum do k = 1, nfsd if (d_afsd(k) > puny) check_dt(k) = (1-afsd_init(k))/d_afsd(k) if (d_afsd(k) < -puny) check_dt(k) = afsd_init(k)/ABS(d_afsd(k)) - end do + end do subdt = MINVAL(check_dt) diff --git a/columnphysics/icepack_intfc.F90 b/columnphysics/icepack_intfc.F90 index c92bdc1f4..9578e83c3 100644 --- a/columnphysics/icepack_intfc.F90 +++ b/columnphysics/icepack_intfc.F90 @@ -1,21 +1,21 @@ !======================================================================= ! Copyright (c) 2022, Triad National Security, LLC ! All rights reserved. -! +! ! Copyright 2022. Triad National Security, LLC. This software was -! produced under U.S. Government contract DE-AC52-06NA25396 for Los +! produced under U.S. Government contract DE-AC52-06NA25396 for Los ! Alamos National Laboratory (LANL), which is operated by Triad -! National Security, LLC for the U.S. Department of Energy. The U.S. -! Government has rights to use, reproduce, and distribute this software. -! NEITHER THE GOVERNMENT NOR TRIAD NATIONAL SECURITY, LLC MAKES ANY +! National Security, LLC for the U.S. Department of Energy. The U.S. +! Government has rights to use, reproduce, and distribute this software. +! NEITHER THE GOVERNMENT NOR TRIAD NATIONAL SECURITY, LLC MAKES ANY ! WARRANTY, EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF -! THIS SOFTWARE. If software is modified to produce derivative works, -! such modified software should be clearly marked, so as not to confuse +! THIS SOFTWARE. If software is modified to produce derivative works, +! such modified software should be clearly marked, so as not to confuse ! it with the version available from LANL. ! ! The full license and distribution policy are available from ! https://github.com/CICE-Consortium -! +! !======================================================================= ! ! authors: Elizabeth C. Hunke, LANL @@ -126,7 +126,7 @@ module icepack_intfc implicit none - public + public public :: icepack_configure diff --git a/columnphysics/icepack_isotope.F90 b/columnphysics/icepack_isotope.F90 index 26f81fb5e..495d0bde2 100644 --- a/columnphysics/icepack_isotope.F90 +++ b/columnphysics/icepack_isotope.F90 @@ -34,7 +34,7 @@ module icepack_isotope integer, parameter, public :: isph216o = 2 ! H216O similar to "regular" integer, parameter, public :: isphdo = 3 ! HDO integer, parameter, public :: isph218o = 4 ! H218O - integer, parameter, public :: pwtspec = 4 ! number of water species + integer, parameter, public :: pwtspec = 4 ! number of water species ! h2o,hdo,h218o,h216o !======================================================================= @@ -110,11 +110,11 @@ subroutine update_isotope (dt, & hi, & hs - real (kind=dbl_kind), dimension(n_iso) :: & - isotot, isotot0 ! for diagnostics +! real (kind=dbl_kind), dimension(n_iso) :: & +! isotot, isotot0 ! for diagnostics real (kind=dbl_kind) :: & - hs_old, hi_old, dhs, dhi, sloss1, & + hs_old, hi_old, sloss1, & TsfK, & ! snow/ice temperature (K) alphai, & ! ice/vapour fractionation coefficient ratio, & ! isotopic ratio @@ -160,7 +160,7 @@ subroutine update_isotope (dt, & TsfK = Tsfc + Tffresh if (evaps > c0) then ! condensation to snow - do k = 1, n_iso + do k = 1, n_iso ratio = c1 ! ratio between 18O(HDO) and 16O in humidity alphai = c1 ! fractionation coefficient if (isotope_frac_method.ne.'nfrac' .and. Qref_iso(2)>puny) & @@ -177,7 +177,7 @@ subroutine update_isotope (dt, & endif if (evapi > c0) then ! condensation to ice - do k = 1, n_iso + do k = 1, n_iso ratio = c1 ! ratio between 18O(HDO) and 16O in ref humidity alphai = c1 ! fractionation coefficient if (isotope_frac_method.ne.'nfrac' .and. Qref_iso(2)>puny) & @@ -221,13 +221,13 @@ subroutine update_isotope (dt, & ! sublimation of snow and ice if (evaps < c0) then ! snow sublimation (no fractionation) - do k = 1, n_iso + do k = 1, n_iso !ratio = c1 ! ratio between 18O(HDO) and 16O in snow !if (isosno(2) > puny) ratio = isosno(k)/isosno(2) !if (ratio > c5) ratio = c1 !! remove latter? !work = ratio*rhos*evaps*aicen !fiso_evapn(k) = fiso_evapn(k)+work/dt - + sloss1 = c0 if (dzsno > puny) sloss1 = isosno(k)*min(-evaps,dzsno)/dzsno if (isosno(k) >= sloss1) then @@ -251,7 +251,7 @@ subroutine update_isotope (dt, & endif if (evapi < c0) then ! ice sublimation (no fractionation) - do k = 1, n_iso + do k = 1, n_iso !!ratio = c1 ! ratio between 18O(HDO) and 16O in ice !!if (isoice(2) > puny) ratio = isoice(k)/isoice(2) !!if (ratio > c5) ratio = c1 ! remove later? @@ -341,7 +341,7 @@ subroutine update_isotope (dt, & endif fiso_ocnn(k) = fiso_ocnn(k) + sloss1/dt enddo - + dzice = dzice - meltb if (dzice <= c0) then ! ice ice melts away fiso_ocnn(:) = fiso_ocnn(:) + isoice(:) @@ -392,7 +392,7 @@ subroutine update_isotope (dt, & ! - fiso_evapn(k)*dt & ! + fiso_ocnn (k)*dt > 1e-6) then ! write(nu_diag,*) 'isotope tracer: ',k -! write(nu_diag,*) 'isotot-isotot0 ',isotot(k)-isotot0(k) +! write(nu_diag,*) 'isotot-isotot0 ',isotot(k)-isotot0(k) ! write(nu_diag,*) 'fiso_atm-fiso_ocnn ',fiso_atm (k)*dt*aicen & ! + fiso_evapn(k)*dt & ! - fiso_ocnn (k)*dt @@ -413,7 +413,7 @@ end subroutine update_isotope function isoice_alpha(growth_rate, sp, frac) ! -! authors: Jiang Zhu, UW-Madison +! authors: Jiang Zhu, UW-Madison ! real (kind=dbl_kind), intent(in) :: & growth_rate ! sea-ice formation rate (m/s) @@ -437,7 +437,7 @@ function isoice_alpha(growth_rate, sp, frac) isoice_alpha = 1.02120_dbl_kind if (frac == 'cfrac' .and. sp == 'H2_18O') & isoice_alpha = 1.00291_dbl_kind - + ! Eq.9, Toyota et al., 2013 ! For HDO, 7.2852 = 0.2120/0.00291 !-------------------------------------------------- diff --git a/columnphysics/icepack_itd.F90 b/columnphysics/icepack_itd.F90 index 30508184a..0a177e5eb 100644 --- a/columnphysics/icepack_itd.F90 +++ b/columnphysics/icepack_itd.F90 @@ -19,7 +19,7 @@ ! ! 2004 WHL: Added multiple snow layers, block structure, cleanup_itd ! 2006 ECH: Added WMO standard ice thickness categories as kcatbound=2 -! Streamlined for efficiency +! Streamlined for efficiency ! Converted to free source form (F90) ! 2014 ECH: Converted to column package @@ -59,7 +59,7 @@ module icepack_itd !======================================================================= -! Aggregate ice area (but not other state variables) over thickness +! Aggregate ice area (but not other state variables) over thickness ! categories. ! ! authors: William H. Lipscomb, LANL @@ -387,7 +387,7 @@ subroutine shift_ice (ntrcr, ncat, & trcrn ! ice tracers ! NOTE: Third index of donor, daice, dvice should be ncat-1, - ! except that compilers would have trouble when ncat = 1 + ! except that compilers would have trouble when ncat = 1 integer (kind=int_kind), dimension(:), intent(in) :: & donor ! donor category index @@ -407,7 +407,7 @@ subroutine shift_ice (ntrcr, ncat, & itl ! loop index real (kind=dbl_kind), dimension(ntrcr,ncat) :: & - atrcrn ! aicen*trcrn + atrcrn ! aicen*trcrn real (kind=dbl_kind) :: & dvsnow , & ! snow volume transferred @@ -476,9 +476,9 @@ subroutine shift_ice (ntrcr, ncat, & daice_negative = .true. endif endif - + if (dvice(n) < c0) then - if (dvice(n) > -puny*vicen(nd)) then + if (dvice(n) > -puny*vicen(nd)) then daice(n) = c0 ! shift no ice dvice(n) = c0 else @@ -493,7 +493,7 @@ subroutine shift_ice (ntrcr, ncat, & else daice_greater_aicen = .true. endif - endif + endif if (dvice(n) > vicen(nd)*(c1-puny)) then if (dvice(n) < vicen(nd)*(c1+puny)) then @@ -638,7 +638,7 @@ subroutine shift_ice (ntrcr, ncat, & atrcrn(it,nd) = atrcrn(it,nd) - datrcr atrcrn(it,nr) = atrcrn(it,nr) + datrcr - + enddo ! ntrcr endif ! daice enddo ! boundaries, 1 to ncat-1 @@ -650,7 +650,7 @@ subroutine shift_ice (ntrcr, ncat, & do n = 1, ncat if (aicen(n) > puny) then - hicen(n) = vicen (n) / aicen(n) + hicen(n) = vicen (n) / aicen(n) else hicen(n) = c0 endif @@ -746,10 +746,10 @@ end subroutine column_conservation_check !======================================================================= ! Cleanup subroutine that rebins thickness categories if necessary, -! eliminates very small ice areas while conserving mass and energy, -! aggregates state variables, and does a boundary call. +! eliminates very small ice areas while conserving mass and energy, +! aggregates state variables, and does a boundary call. ! It is a good idea to call this subroutine after the thermodynamics -! (thermo_vertical/thermo_itd) and again after the dynamics +! (thermo_vertical/thermo_itd) and again after the dynamics ! (evp/transport/ridging). ! ! author: William H. Lipscomb, LANL @@ -759,13 +759,13 @@ subroutine cleanup_itd (dt, ntrcr, & ncat, hin_max, & aicen, trcrn, & vicen, vsnon, & - aice0, aice, & + aice0, aice, & n_aero, & nbtrcr, nblyr, & tr_aero, & tr_pond_topo, & #ifdef UNDEPRECATE_0LAYER - heat_capacity, & + heat_capacity, & #endif first_ice, & trcr_depend, trcr_base, & @@ -776,7 +776,7 @@ subroutine cleanup_itd (dt, ntrcr, & fzsal, & flux_bio, limit_aice_in) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & ncat , & ! number of thickness categories nilyr , & ! number of ice layers nblyr , & ! number of bio layers @@ -784,25 +784,25 @@ subroutine cleanup_itd (dt, ntrcr, & ntrcr , & ! number of tracers in use nbtrcr, & ! number of bio tracers in use n_aero ! number of aerosol tracers - - real (kind=dbl_kind), intent(in) :: & - dt ! time step - + + real (kind=dbl_kind), intent(in) :: & + dt ! time step + real (kind=dbl_kind), dimension(0:ncat), intent(in) :: & hin_max ! category boundaries (m) - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers + real (kind=dbl_kind), dimension (:), intent(inout) :: & + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) + + real (kind=dbl_kind), dimension (:,:), intent(inout) :: & + trcrn ! ice tracers - real (kind=dbl_kind), intent(inout) :: & + real (kind=dbl_kind), intent(inout) :: & aice , & ! total ice concentration - aice0 ! concentration of open water - + aice0 ! concentration of open water + integer (kind=int_kind), dimension (:), intent(in) :: & trcr_depend, & ! = 0 for aicen tracers, 1 for vicen, 2 for vsnon n_trcr_strata ! number of underlying tracer layers @@ -945,7 +945,7 @@ subroutine cleanup_itd (dt, ntrcr, & if (limit_aice) then call zap_small_areas (dt, ntrcr, & - ncat, & + ncat, & n_aero, & nblyr, & nilyr, nslyr, & @@ -954,7 +954,7 @@ subroutine cleanup_itd (dt, ntrcr, & vicen, vsnon, & dfpond, & dfresh, dfsalt, & - dfhocn, & + dfhocn, & dfaero_ocn, dfiso_ocn, & tr_aero, & tr_pond_topo, & @@ -997,9 +997,9 @@ subroutine cleanup_itd (dt, ntrcr, & !------------------------------------------------------------------- if (present(fpond)) & - fpond = fpond + dfpond + fpond = fpond + dfpond if (present(fresh)) & - fresh = fresh + dfresh + fresh = fresh + dfresh if (present(fsalt)) & fsalt = fsalt + dfsalt if (present(fhocn)) & @@ -1020,12 +1020,12 @@ subroutine cleanup_itd (dt, ntrcr, & enddo endif if (present(fzsal)) & - fzsal = fzsal + dfzsal + fzsal = fzsal + dfzsal #ifdef UNDEPRECATE_0LAYER !---------------------------------------------------------------- - ! If using zero-layer model (no heat capacity), check that the - ! energy of snow and ice is correct. + ! If using zero-layer model (no heat capacity), check that the + ! energy of snow and ice is correct. !---------------------------------------------------------------- if ((.not. heat_capacity) .and. aice > puny) then @@ -1092,7 +1092,7 @@ subroutine zap_small_areas (dt, ntrcr, & dfresh , & ! zapped fresh water flux (kg/m^2/s) dfsalt , & ! zapped salt flux (kg/m^2/s) dfhocn , & ! zapped energy flux ( W/m^2) - dfzsal ! zapped salt flux from zsalinity(kg/m^2/s) + dfzsal ! zapped salt flux from zsalinity(kg/m^2/s) real (kind=dbl_kind), dimension (:), intent(inout) :: & dfaero_ocn ! zapped aerosol flux (kg/m^2/s) @@ -1108,7 +1108,7 @@ subroutine zap_small_areas (dt, ntrcr, & tr_pond_topo ! pond flag logical (kind=log_kind), dimension (:), intent(inout) :: & - first_ice ! For bgc tracers. Set to true if zapping ice + first_ice ! For bgc tracers. Set to true if zapping ice ! local variables @@ -1117,8 +1117,8 @@ subroutine zap_small_areas (dt, ntrcr, & blevels real (kind=dbl_kind) :: xtmp ! temporary variables - real (kind=dbl_kind) , dimension (1):: trcr_skl - real (kind=dbl_kind) , dimension (nblyr+1):: bvol + real (kind=dbl_kind) , dimension (1):: trcr_skl + real (kind=dbl_kind) , dimension (nblyr+1):: bvol character(len=*),parameter :: subname='(zap_small_areas)' @@ -1126,7 +1126,7 @@ subroutine zap_small_areas (dt, ntrcr, & ! I. Zap categories with very small areas. !----------------------------------------------------------------- dfzsal = c0 - + do n = 1, ncat !----------------------------------------------------------------- @@ -1238,7 +1238,7 @@ subroutine zap_small_areas (dt, ntrcr, & !----------------------------------------------------------------- ! Zap tracers !----------------------------------------------------------------- - + if (ntrcr >= 2) then do it = 2, ntrcr trcrn(it,n) = c0 @@ -1301,40 +1301,40 @@ subroutine zap_small_areas (dt, ntrcr, & enddo ! it endif - !----------------------------------------------------------------- - ! Zap ice energy and use ocean heat to melt ice - !----------------------------------------------------------------- - - do k = 1, nilyr + !----------------------------------------------------------------- + ! Zap ice energy and use ocean heat to melt ice + !----------------------------------------------------------------- + + do k = 1, nilyr xtmp = trcrn(nt_qice+k-1,n) & * vicen(n)/real(nilyr,kind=dbl_kind) & - * (aice-c1)/aice / dt ! < 0 - dfhocn = dfhocn + xtmp - enddo ! k - - !----------------------------------------------------------------- - ! Zap snow energy and use ocean heat to melt snow - !----------------------------------------------------------------- - - do k = 1, nslyr + * (aice-c1)/aice / dt ! < 0 + dfhocn = dfhocn + xtmp + enddo ! k + + !----------------------------------------------------------------- + ! Zap snow energy and use ocean heat to melt snow + !----------------------------------------------------------------- + + do k = 1, nslyr xtmp = trcrn(nt_qsno+k-1,n) & * vsnon(n)/real(nslyr,kind=dbl_kind) & - * (aice-c1)/aice / dt ! < 0 - dfhocn = dfhocn + xtmp + * (aice-c1)/aice / dt ! < 0 + dfhocn = dfhocn + xtmp enddo ! k - + !----------------------------------------------------------------- ! Zap ice and snow volume, add water and salt to ocean !----------------------------------------------------------------- xtmp = (rhoi*vicen(n) + rhos*vsnon(n)) & - * (aice-c1)/aice / dt - dfresh = dfresh + xtmp - + * (aice-c1)/aice / dt + dfresh = dfresh + xtmp + xtmp = rhoi*vicen(n)*ice_ref_salinity*p001 & * (aice-c1)/aice / dt - dfsalt = dfsalt + xtmp - + dfsalt = dfsalt + xtmp + if (solve_zsal) then do k = 1,nblyr xtmp = rhosi*trcrn(nt_fbri,n)*vicen(n)*p001& @@ -1350,10 +1350,10 @@ subroutine zap_small_areas (dt, ntrcr, & endif endif ! solve_zsal - aicen(n) = aicen(n) * (c1/aice) - vicen(n) = vicen(n) * (c1/aice) + aicen(n) = aicen(n) * (c1/aice) + vicen(n) = vicen(n) * (c1/aice) vsnon(n) = vsnon(n) * (c1/aice) - + ! Note: Tracers are unchanged. enddo ! n @@ -1385,7 +1385,7 @@ subroutine zap_snow(dt, nslyr, & n_aero , & ! number of aerosol tracers nblyr , & ! number of bio layers nbtrcr - + real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -1451,7 +1451,7 @@ subroutine zap_snow(dt, nslyr, & endif ! z_tracers ! snow enthalpy tracer - do k = 1, nslyr + do k = 1, nslyr xtmp = trcrn(nt_qsno+k-1) / dt & * vsnon/real(nslyr,kind=dbl_kind) ! < 0 dfhocn = dfhocn + xtmp @@ -1466,7 +1466,7 @@ subroutine zap_snow(dt, nslyr, & end subroutine zap_snow !======================================================================= - + subroutine zap_snow_temperature(dt, ncat, & #ifdef UNDEPRECATE_0LAYER heat_capacity, & @@ -1494,8 +1494,8 @@ subroutine zap_snow_temperature(dt, ncat, & logical (kind=log_kind), intent(in) :: & heat_capacity ! if false, ice and snow have zero heat capacity #endif - real (kind=dbl_kind), dimension (:), intent(in) :: & - aicen ! concentration of ice + real (kind=dbl_kind), dimension (:), intent(in) :: & + aicen ! concentration of ice real (kind=dbl_kind), dimension(:), intent(inout) :: & vsnon ! volume per unit area of snow (m) @@ -1537,7 +1537,7 @@ subroutine zap_snow_temperature(dt, ncat, & character(len=*),parameter :: subname='(zap_snow_temperature)' rnslyr = real(nslyr,kind=dbl_kind) - + do n = 1, ncat !----------------------------------------------------------------- @@ -1560,14 +1560,14 @@ subroutine zap_snow_temperature(dt, ncat, & #else if (hsn > hs_min) then #endif - ! zqsn < 0 + ! zqsn < 0 zqsn = trcrn(nt_qsno+k-1,n) Tmax = -zqsn*puny*rnslyr / (rhos*cp_ice*vsnon(n)) else zqsn = -rhos * Lfresh Tmax = puny endif - + ! snow temperature zTsn = (Lfresh + zqsn/rhos)/cp_ice @@ -1618,8 +1618,8 @@ end subroutine zap_snow_temperature ! This subroutine is only called if heat_capacity = .false. ! ! author: Alison McLaren, Met Office -! May 2010: ECH replaced eicen, esnon with trcrn but did not test -! the changes. The loop below runs over n=1,ncat and I added loops +! May 2010: ECH replaced eicen, esnon with trcrn but did not test +! the changes. The loop below runs over n=1,ncat and I added loops ! over k, making the test more stringent. subroutine zerolayer_check (ncat, nilyr, & @@ -1627,19 +1627,19 @@ subroutine zerolayer_check (ncat, nilyr, & vicen, vsnon, & trcrn) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & ncat , & ! number of thickness categories nilyr , & ! number of ice layers nslyr ! number of snow layers - real (kind=dbl_kind), dimension (:), intent(inout) :: & - aicen , & ! concentration of ice - vicen , & ! volume per unit area of ice (m) - vsnon ! volume per unit area of snow (m) + real (kind=dbl_kind), dimension (:), intent(inout) :: & + aicen , & ! concentration of ice + vicen , & ! volume per unit area of ice (m) + vsnon ! volume per unit area of snow (m) real (kind=dbl_kind), dimension (:,:), intent(inout) :: & trcrn ! ice tracers - + ! local variables integer (kind=int_kind) :: & @@ -1651,10 +1651,10 @@ subroutine zerolayer_check (ncat, nilyr, & ! (so max volume error = puny) real (kind=dbl_kind), dimension (ncat) :: & - eicen ! energy of melting for each ice layer (J/m^2) - + eicen ! energy of melting for each ice layer (J/m^2) + real (kind=dbl_kind), dimension (ncat) :: & - esnon ! energy of melting for each snow layer (J/m^2) + esnon ! energy of melting for each snow layer (J/m^2) logical (kind=log_kind) :: & ice_energy_correct , & ! zero layer ice energy check @@ -1802,7 +1802,7 @@ subroutine icepack_init_itd(ncat, hin_max) ! 1.20_dbl_kind, 2.00_dbl_kind, & ! 4.56729_dbl_kind, & ! 999._dbl_kind / - ! all thickness categories + ! all thickness categories data wmo7 / 0.10_dbl_kind, 0.15_dbl_kind, & 0.30_dbl_kind, 0.70_dbl_kind, & 1.20_dbl_kind, 2.00_dbl_kind, & @@ -1821,23 +1821,23 @@ subroutine icepack_init_itd(ncat, hin_max) !----------------------------------------------------------------- ! Choose category boundaries based on one of four options. ! - ! The first formula (kcatbound = 0) was used in Lipscomb (2001) + ! The first formula (kcatbound = 0) was used in Lipscomb (2001) ! and in CICE versions 3.0 and 3.1. ! ! The second formula is more user-friendly in the sense that it ! is easy to obtain round numbers for category boundaries: ! - ! H(n) = n * [d1 + d2*(n-1)] - ! + ! H(n) = n * [d1 + d2*(n-1)] + ! ! Default values are d1 = 300/ncat, d2 = 50/ncat. - ! For ncat = 5, boundaries in cm are 60, 140, 240, 360, which are + ! For ncat = 5, boundaries in cm are 60, 140, 240, 360, which are ! close to the standard values given by the first formula. ! For ncat = 10, boundaries in cm are 30, 70, 120, 180, 250, 330, - ! 420, 520, 630. + ! 420, 520, 630. ! ! The third option provides support for World Meteorological ! Organization classification based on thickness. The full - ! WMO thickness distribution is used if ncat = 7; if ncat=5 + ! WMO thickness distribution is used if ncat = 7; if ncat=5 ! or ncat = 6, some of the thinner categories are combined. ! For ncat = 5, boundaries are 30, 70, 120, 200, >200 cm. ! For ncat = 6, boundaries are 15, 30, 70, 120, 200, >200 cm. @@ -1914,7 +1914,7 @@ subroutine icepack_init_itd(ncat, hin_max) enddo else call icepack_warnings_add(subname//' kcatbound=2 (WMO) must have ncat=5, 6 or 7') - call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) return endif @@ -1970,7 +1970,7 @@ subroutine icepack_init_itd_hist (ncat, hin_max, c_hi_range) write(warnstr,*) hin_max(n-1),' < Cat ',n, ' < ',hin_max(n) call icepack_warnings_add(warnstr) ! Write integer n to character string - write (c_nc, '(i2)') n + write (c_nc, '(i2)') n ! Write hin_max to character string write (c_hinmax1, '(f7.3)') hin_max(n-1) @@ -2000,7 +2000,7 @@ subroutine icepack_aggregate (ncat, & aice0, & ntrcr, & trcr_depend, & - trcr_base, & + trcr_base, & n_trcr_strata, & nt_strata) @@ -2097,7 +2097,7 @@ subroutine icepack_aggregate (ncat, & atrcr, aice, & vice , vsno, & trcr_base, n_trcr_strata, & - nt_strata, trcr) + nt_strata, trcr) if (icepack_warnings_aborted(subname)) return deallocate (atrcr) diff --git a/columnphysics/icepack_mechred.F90 b/columnphysics/icepack_mechred.F90 index c3bd2f021..67138aca3 100644 --- a/columnphysics/icepack_mechred.F90 +++ b/columnphysics/icepack_mechred.F90 @@ -11,16 +11,16 @@ ! Hibler, W. D. III, 1980: Modeling a variable thickness sea ice ! cover, Mon. Wea. Rev., 108, 1943-1973, 1980. ! -! Lipscomb, W. H., E. C. Hunke, W. Maslowski, and J. Jakacki, 2007: +! Lipscomb, W. H., E. C. Hunke, W. Maslowski, and J. Jakacki, 2007: ! Improving ridging schemes for high-resolution sea ice models. ! J. Geophys. Res. 112, C03S91, doi:10.1029/2005JC003355. -! +! ! Rothrock, D. A., 1975: The energetics of the plastic deformation of ! pack ice by ridging, J. Geophys. Res., 80, 4514-4519. ! -! Thorndike, A. S., D. A. Rothrock, G. A. Maykut, and R. Colony, -! 1975: The thickness distribution of sea ice, J. Geophys. Res., -! 80, 4501-4513. +! Thorndike, A. S., D. A. Rothrock, G. A. Maykut, and R. Colony, +! 1975: The thickness distribution of sea ice, J. Geophys. Res., +! 80, 4501-4513. ! ! authors: William H. Lipscomb, LANL ! Elizabeth C. Hunke, LANL @@ -50,7 +50,7 @@ module icepack_mechred use icepack_tracers, only: nt_apnd, nt_hpnd use icepack_tracers, only: n_iso use icepack_tracers, only: icepack_compute_tracers - + use icepack_warnings, only: warnstr, icepack_warnings_add use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted @@ -67,20 +67,20 @@ module icepack_mechred icepack_ice_strength, & icepack_step_ridge - real (kind=dbl_kind), parameter :: & + real (kind=dbl_kind), parameter :: & exp_argmax = 100.0_dbl_kind, & ! maximum argument of exponential for underflow - Cs = p25 , & ! fraction of shear energy contrbtng to ridging - fsnowrdg = p5 , & ! snow fraction that survives in ridging - Gstar = p15 , & ! max value of G(h) that participates - ! (krdg_partic = 0) - astar = p05 , & ! e-folding scale for G(h) participation -!echmod astar = p1 , & ! e-folding scale for G(h) participation - ! (krdg_partic = 1) - maxraft= c1 , & ! max value of hrmin - hi = max thickness - ! of ice that rafts (m) - Hstar = c25 ! determines mean thickness of ridged ice (m) - ! (krdg_redist = 0) - ! Flato & Hibler (1995) have Hstar = 100 + Cs = p25 , & ! fraction of shear energy contrbtng to ridging + fsnowrdg = p5 , & ! snow fraction that survives in ridging + Gstar = p15 , & ! max value of G(h) that participates + ! (krdg_partic = 0) + astar = p05 , & ! e-folding scale for G(h) participation +!echmod astar = p1 , & ! e-folding scale for G(h) participation + ! (krdg_partic = 1) + maxraft= c1 , & ! max value of hrmin - hi = max thickness + ! of ice that rafts (m) + Hstar = c25 ! determines mean thickness of ridged ice (m) + ! (krdg_redist = 0) + ! Flato & Hibler (1995) have Hstar = 100 !======================================================================= @@ -127,7 +127,7 @@ subroutine ridge_ice (dt, ndtd, & ntrcr ! number of tracers in use real (kind=dbl_kind), intent(in) :: & - mu_rdg , & ! gives e-folding scale of ridged ice (m^.5) + mu_rdg , & ! gives e-folding scale of ridged ice (m^.5) dt ! time step real (kind=dbl_kind), dimension(0:ncat), intent(inout) :: & @@ -136,16 +136,16 @@ subroutine ridge_ice (dt, ndtd, & real (kind=dbl_kind), intent(in) :: & rdg_conv , & ! normalized energy dissipation due to convergence (1/s) rdg_shear ! normalized energy dissipation due to shear (1/s) - + real (kind=dbl_kind), dimension (:), intent(inout) :: & aicen , & ! concentration of ice vicen , & ! volume per unit area of ice (m) vsnon ! volume per unit area of snow (m) - - real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! ice tracers - real (kind=dbl_kind), intent(inout) :: & + real (kind=dbl_kind), dimension (:,:), intent(inout) :: & + trcrn ! ice tracers + + real (kind=dbl_kind), intent(inout) :: & aice0 ! concentration of open water integer (kind=int_kind), dimension (:), intent(in) :: & @@ -185,7 +185,7 @@ subroutine ridge_ice (dt, ndtd, & aparticn , & ! participation function krdgn , & ! mean ridge thickness/thickness of ridging ice araftn , & ! rafting ice area - vraftn , & ! rafting ice volume + vraftn , & ! rafting ice volume aredistn , & ! redistribution function: fraction of new ridge area vredistn ! redistribution function: fraction of new ridge volume @@ -199,7 +199,7 @@ subroutine ridge_ice (dt, ndtd, & real (kind=dbl_kind), dimension (ncat) :: & eicen ! energy of melting for each ice layer (J/m^2) - + real (kind=dbl_kind), dimension (ncat) :: & esnon, & ! energy of melting for each snow layer (J/m^2) vbrin, & ! ice volume with defined by brine height (m) @@ -235,12 +235,12 @@ subroutine ridge_ice (dt, ndtd, & real (kind=dbl_kind), dimension (ncat) :: & hrmin , & ! minimum ridge thickness hrmax , & ! maximum ridge thickness (krdg_redist = 0) - hrexp , & ! ridge e-folding thickness (krdg_redist = 1) + hrexp , & ! ridge e-folding thickness (krdg_redist = 1) krdg , & ! mean ridge thickness/thickness of ridging ice ardg1n , & ! area of ice ridged ardg2n , & ! area of new ridges virdgn , & ! ridging ice volume - mraftn ! rafting ice mask + mraftn ! rafting ice mask real (kind=dbl_kind) :: & vice_init, vice_final, & ! ice volume summed over categories @@ -318,7 +318,7 @@ subroutine ridge_ice (dt, ndtd, & if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- - ! Compute initial values of conserved quantities. + ! Compute initial values of conserved quantities. !----------------------------------------------------------------- if (conserv_check) then @@ -362,7 +362,7 @@ subroutine ridge_ice (dt, ndtd, & vbrin, vbri_init) if (icepack_warnings_aborted(subname)) return - endif + endif rdg_iteration: do niter = 1, nitermax @@ -379,7 +379,7 @@ subroutine ridge_ice (dt, ndtd, & hrmin, hrmax, & hrexp, krdg, & aparticn, krdgn, & - mraftn) + mraftn) if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- @@ -405,7 +405,7 @@ subroutine ridge_ice (dt, ndtd, & msnow_mlt, esnow_mlt, & maero, miso, & mpond, & - aredistn, vredistn) + aredistn, vredistn) if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- @@ -447,14 +447,14 @@ subroutine ridge_ice (dt, ndtd, & write(warnstr,*) subname, 'max =',nitermax call icepack_warnings_add(warnstr) call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" ridge_ice: Exceeded max number of ridging iterations" ) + call icepack_warnings_add(subname//" ridge_ice: Exceeded max number of ridging iterations" ) return endif enddo rdg_iteration ! niter !----------------------------------------------------------------- - ! Compute final values of conserved quantities. + ! Compute final values of conserved quantities. ! Check for conservation (allowing for snow thrown into ocean). !----------------------------------------------------------------- @@ -533,7 +533,7 @@ subroutine ridge_ice (dt, ndtd, & puny*c10) if (icepack_warnings_aborted(subname)) return - endif ! conserv_check + endif ! conserv_check !----------------------------------------------------------------- ! Compute ridging diagnostics. @@ -614,7 +614,7 @@ subroutine ridge_ice (dt, ndtd, & if (abs(asum - c1) > puny) then call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" total area > 1" ) + call icepack_warnings_add(subname//" total area > 1" ) write(warnstr,*) ' ' call icepack_warnings_add(warnstr) @@ -647,7 +647,7 @@ end subroutine ridge_ice subroutine asum_ridging (ncat, aicen, aice0, asum) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & ncat ! number of thickness categories real (kind=dbl_kind), dimension (:), intent(in) :: & @@ -684,7 +684,7 @@ subroutine ridge_prep (dt, & asum, closing_net, & divu_adv, opning) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & ncat ! number of thickness categories real (kind=dbl_kind), intent(in) :: & @@ -736,7 +736,7 @@ subroutine ridge_prep (dt, & ! water closing and thin ice ridging) without the third term ! (thick, newly ridged ice). ! - ! rdg_conv is calculated differently in EAP (update_ice_rdg) and + ! rdg_conv is calculated differently in EAP (update_ice_rdg) and ! represents closing_net directly. In that case, rdg_shear=0. !----------------------------------------------------------------- @@ -773,13 +773,13 @@ end subroutine ridge_prep ! redistribution. ! The new participation scheme (krdg_partic = 1) improves stability ! by increasing the time scale for large changes in ice strength. -! The new exponential redistribution function (krdg_redist = 1) improves -! agreement between ITDs of modeled and observed ridges. +! The new exponential redistribution function (krdg_redist = 1) improves +! agreement between ITDs of modeled and observed ridges. ! ! author: William H. Lipscomb, LANL ! ! 2006: Changed subroutine name to ridge_itd -! Added new options for ridging participation and redistribution. +! Added new options for ridging participation and redistribution. subroutine ridge_itd (ncat, aice0, & aicen, vicen, & @@ -791,11 +791,11 @@ subroutine ridge_itd (ncat, aice0, & aparticn, krdgn, & mraft) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & ncat ! number of thickness categories real (kind=dbl_kind), intent(in) :: & - mu_rdg , & ! gives e-folding scale of ridged ice (m^.5) + mu_rdg , & ! gives e-folding scale of ridged ice (m^.5) aice0 ! concentration of open water real (kind=dbl_kind), dimension (:), intent(in) :: & @@ -816,7 +816,7 @@ subroutine ridge_itd (ncat, aice0, & real (kind=dbl_kind), dimension (:), intent(out) :: & hrmin , & ! minimum ridge thickness hrmax , & ! maximum ridge thickness (krdg_redist = 0) - hrexp , & ! ridge e-folding thickness (krdg_redist = 1) + hrexp , & ! ridge e-folding thickness (krdg_redist = 1) krdg ! mean ridge thickness/thickness of ridging ice ! diagnostic, category values @@ -825,7 +825,7 @@ subroutine ridge_itd (ncat, aice0, & krdgn ! mean ridge thickness/thickness of ridging ice real (kind=dbl_kind), dimension (:), intent(inout), optional :: & - mraft ! rafting ice mask + mraft ! rafting ice mask ! local variables @@ -928,7 +928,7 @@ subroutine ridge_itd (ncat, aice0, & !----------------------------------------------------------------- ! b(h) = exp(-G(h)/astar) - ! apartic(n) = [exp(-G(n-1)/astar - exp(-G(n)/astar] / [1-exp(-1/astar)]. + ! apartic(n) = [exp(-G(n-1)/astar - exp(-G(n)/astar] / [1-exp(-1/astar)]. ! The expression for apartic is found by integrating b(h)g(h) ! between the category boundaries. !----------------------------------------------------------------- @@ -945,7 +945,7 @@ subroutine ridge_itd (ncat, aice0, & !----------------------------------------------------------------- ! Compute variables related to ITD of ridged ice: - ! + ! ! krdg = mean ridge thickness / thickness of ridging ice ! hrmin = min ridge thickness ! hrmax = max ridge thickness (krdg_redist = 0) @@ -955,40 +955,40 @@ subroutine ridge_itd (ncat, aice0, & if (krdg_redist == 0) then ! Hibler 1980 formulation !----------------------------------------------------------------- - ! Assume ridged ice is uniformly distributed between hrmin and hrmax. - ! - ! This parameterization is a modified version of Hibler (1980). - ! In the original paper the min ridging thickness is hrmin = 2*hi, - ! and the max thickness is hrmax = 2*sqrt(hi*Hstar). - ! - ! Here the min thickness is hrmin = min(2*hi, hi+maxraft), - ! so thick ridging ice is not required to raft. + ! Assume ridged ice is uniformly distributed between hrmin and hrmax. + ! + ! This parameterization is a modified version of Hibler (1980). + ! In the original paper the min ridging thickness is hrmin = 2*hi, + ! and the max thickness is hrmax = 2*sqrt(hi*Hstar). + ! + ! Here the min thickness is hrmin = min(2*hi, hi+maxraft), + ! so thick ridging ice is not required to raft. ! !----------------------------------------------------------------- do n = 1, ncat - if (aicen(n) > puny) then - hi = vicen(n) / aicen(n) - hrmin(n) = min(c2*hi, hi + maxraft) - hrmax(n) = c2*sqrt(Hstar*hi) - hrmax(n) = max(hrmax(n), hrmin(n)+puny) - hrmean = p5 * (hrmin(n) + hrmax(n)) - krdg(n) = hrmean / hi + if (aicen(n) > puny) then + hi = vicen(n) / aicen(n) + hrmin(n) = min(c2*hi, hi + maxraft) + hrmax(n) = c2*sqrt(Hstar*hi) + hrmax(n) = max(hrmax(n), hrmin(n)+puny) + hrmean = p5 * (hrmin(n) + hrmax(n)) + krdg(n) = hrmean / hi ! diagnostic rafting mask not implemented - endif + endif enddo ! n else ! krdg_redist = 1; exponential redistribution - - !----------------------------------------------------------------- - ! The ridge ITD is a negative exponential: - ! - ! g(h) ~ exp[-(h-hrmin)/hrexp], h >= hrmin - ! - ! where hrmin is the minimum thickness of ridging ice and + + !----------------------------------------------------------------- + ! The ridge ITD is a negative exponential: + ! + ! g(h) ~ exp[-(h-hrmin)/hrexp], h >= hrmin + ! + ! where hrmin is the minimum thickness of ridging ice and ! hrexp is the e-folding thickness. - ! + ! ! Here, assume as above that hrmin = min(2*hi, hi+maxraft). ! That is, the minimum ridge thickness results from rafting, ! unless the ice is thicker than maxraft. @@ -1007,7 +1007,7 @@ subroutine ridge_itd (ncat, aice0, & ! 50 4.0 ! 75 5.0 ! 100 6.0 - !----------------------------------------------------------------- + !----------------------------------------------------------------- do n = 1, ncat if (aicen(n) > puny) then @@ -1034,13 +1034,13 @@ subroutine ridge_itd (ncat, aice0, & ! For instance, if a unit area of ice with h = 1 participates in ! ridging to form a ridge with a = 1/3 and h = 3, then ! aksum = 1 - 1/3 = 2/3. - !---------------------------------------------------------------- + !---------------------------------------------------------------- aksum = apartic(0) ! area participating = area removed do n = 1, ncat ! area participating > area removed - aksum = aksum + apartic(n) * (c1 - c1/krdg(n)) + aksum = aksum + apartic(n) * (c1 - c1/krdg(n)) enddo ! diagnostics @@ -1063,13 +1063,13 @@ end subroutine ridge_itd ! and add to thicker ice categories. ! ! Tracers: Ridging conserves ice volume and therefore conserves volume -! tracers. It does not conserve ice area, and therefore a portion of area -! tracers are lost (corresponding to the net closing). Area tracers on +! tracers. It does not conserve ice area, and therefore a portion of area +! tracers are lost (corresponding to the net closing). Area tracers on ! ice that participates in ridging are carried onto the resulting ridged -! ice (except the portion that are lost due to closing). Therefore, +! ice (except the portion that are lost due to closing). Therefore, ! tracers must be decremented if they are lost to the ocean during ridging -! (e.g. snow, ponds) or if they are being carried only on the level ice -! area. +! (e.g. snow, ponds) or if they are being carried only on the level ice +! area. ! ! author: William H. Lipscomb, LANL @@ -1077,7 +1077,7 @@ subroutine ridge_shift (ntrcr, dt, & ncat, hin_max, & aicen, trcrn, & vicen, vsnon, & - aice0, trcr_depend, & + aice0, trcr_depend, & trcr_base, n_trcr_strata, & nt_strata, krdg_redist, & aksum, apartic, & @@ -1094,7 +1094,7 @@ subroutine ridge_shift (ntrcr, dt, & mpond, & aredistn, vredistn) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & ncat , & ! number of thickness categories nslyr , & ! number of snow layers ntrcr , & ! number of tracers in use @@ -1139,7 +1139,7 @@ subroutine ridge_shift (ntrcr, dt, & real (kind=dbl_kind), dimension (:), intent(in) :: & hrmin , & ! minimum ridge thickness hrmax , & ! maximum ridge thickness (krdg_redist = 0) - hrexp , & ! ridge e-folding thickness (krdg_redist = 1) + hrexp , & ! ridge e-folding thickness (krdg_redist = 1) krdg ! mean ridge thickness/thickness of ridging ice real (kind=dbl_kind), intent(inout) :: & @@ -1203,7 +1203,7 @@ subroutine ridge_shift (ntrcr, dt, & ardg1n , & ! area of ice ridged ardg2n , & ! area of new ridges virdgn , & ! ridging ice volume - vsrdgn , & ! ridging snow volume + vsrdgn , & ! ridging snow volume dhr , & ! hrmax - hrmin dhr2 , & ! hrmax^2 - hrmin^2 farea , & ! fraction of new ridge area going to nr @@ -1323,7 +1323,7 @@ subroutine ridge_shift (ntrcr, dt, & !----------------------------------------------------------------- ! Compute area of ridging ice (ardg1n) and of new ridge (ardg2n). ! Make sure ridging fraction <=1. (Roundoff errors can give - ! ardg1 slightly greater than aicen.) + ! ardg1 slightly greater than aicen.) !----------------------------------------------------------------- ardg1n = apartic(n)*closing_gross*dt @@ -1351,7 +1351,7 @@ subroutine ridge_shift (ntrcr, dt, & vsrdgn = vsnon_init(n) * afrac aicen(n) = aicen(n) - ardg1n - vicen(n) = vicen(n) - virdgn + vicen(n) = vicen(n) - virdgn vsnon(n) = vsnon(n) - vsrdgn !----------------------------------------------------------------- @@ -1524,7 +1524,7 @@ subroutine ridge_shift (ntrcr, dt, & !----------------------------------------------------------------- ! Transfer area-weighted and volume-weighted tracers to category nr. - ! Note: The global sum aicen*trcrn of ice area tracers + ! Note: The global sum aicen*trcrn of ice area tracers ! (trcr_depend = 0) is not conserved by ridging. ! However, ridging conserves the global sum of volume ! tracers (trcr_depend = 1 or 2). @@ -1606,7 +1606,7 @@ subroutine icepack_ice_strength (ncat, & vicen, & strength) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & ncat ! number of thickness categories real (kind=dbl_kind), intent(in) :: & @@ -1636,7 +1636,7 @@ subroutine icepack_ice_strength (ncat, & real (kind=dbl_kind), dimension (ncat) :: & hrmin , & ! minimum ridge thickness hrmax , & ! maximum ridge thickness (krdg_redist = 0) - hrexp , & ! ridge e-folding thickness (krdg_redist = 1) + hrexp , & ! ridge e-folding thickness (krdg_redist = 1) krdg ! mean ridge thickness/thickness of ridging ice integer (kind=int_kind) :: & @@ -1646,7 +1646,7 @@ subroutine icepack_ice_strength (ncat, & hi , & ! ice thickness (m) h2rdg , & ! mean value of h^2 for new ridge dh2rdg ! change in mean value of h^2 per unit area - ! consumed by ridging + ! consumed by ridging character(len=*),parameter :: subname='(icepack_ice_strength)' @@ -1665,7 +1665,7 @@ subroutine icepack_ice_strength (ncat, & mu_rdg, & aksum, apartic, & hrmin, hrmax, & - hrexp, krdg) + hrexp, krdg) if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- @@ -1679,7 +1679,7 @@ subroutine icepack_ice_strength (ncat, & if (aicen(n) > puny .and. apartic(n) > c0)then hi = vicen(n) / aicen(n) h2rdg = p333 * (hrmax(n)**3 - hrmin(n)**3) & - / (hrmax(n) - hrmin(n)) + / (hrmax(n) - hrmin(n)) dh2rdg = -hi*hi + h2rdg/krdg(n) strength = strength + apartic(n) * dh2rdg endif ! aicen > puny @@ -1802,7 +1802,7 @@ subroutine icepack_step_ridge (dt, ndtd, & aparticn , & ! participation function krdgn , & ! mean ridge thickness/thickness of ridging ice araftn , & ! rafting ice area - vraftn , & ! rafting ice volume + vraftn , & ! rafting ice volume aredistn , & ! redistribution function: fraction of new ridge area vredistn , & ! redistribution function: fraction of new ridge volume faero_ocn, & ! aerosol flux to ocean (kg/m^2/s) @@ -1907,16 +1907,16 @@ subroutine icepack_step_ridge (dt, ndtd, & ncat, hin_max, & aicen, trcrn, & vicen, vsnon, & - aice0, aice, & + aice0, aice, & n_aero, & nbtrcr, nblyr, & tr_aero, & #ifdef UNDEPRECATE_0LAYER - tr_pond_topo, heat_capacity, & + tr_pond_topo, heat_capacity, & #else tr_pond_topo, & #endif - first_ice, & + first_ice, & trcr_depend, trcr_base, & n_trcr_strata, nt_strata, & fpond, fresh, & diff --git a/columnphysics/icepack_meltpond_cesm.F90 b/columnphysics/icepack_meltpond_cesm.F90 index fa2954bb2..24e6b762f 100644 --- a/columnphysics/icepack_meltpond_cesm.F90 +++ b/columnphysics/icepack_meltpond_cesm.F90 @@ -69,7 +69,7 @@ subroutine compute_ponds_cesm(dt, hi_min, & dTs , & ! surface temperature diff for freeze-up (C) Tp , & ! pond freezing temperature (C) apondn, & - hpondn + hpondn real (kind=dbl_kind), parameter :: & Td = c2 , & ! temperature difference for freeze-up (C) @@ -79,7 +79,7 @@ subroutine compute_ponds_cesm(dt, hi_min, & character(len=*),parameter :: subname='(compute_ponds_cesm)' !----------------------------------------------------------------- - ! Initialize + ! Initialize !----------------------------------------------------------------- volpn = hpnd * apnd * aicen diff --git a/columnphysics/icepack_meltpond_lvl.F90 b/columnphysics/icepack_meltpond_lvl.F90 index 5ba132692..fe7b822f3 100644 --- a/columnphysics/icepack_meltpond_lvl.F90 +++ b/columnphysics/icepack_meltpond_lvl.F90 @@ -53,7 +53,7 @@ subroutine compute_ponds_lvl(dt, nilyr, & ktherm ! type of thermodynamics (-1 none, 1 BL99, 2 mushy) #endif real (kind=dbl_kind), intent(in) :: & - dt, & ! time step (s) + dt, & ! time step (s) hi_min, & ! minimum ice thickness allowed for thermo (m) dpscale ! alter e-folding time scale for flushing @@ -81,7 +81,7 @@ subroutine compute_ponds_lvl(dt, nilyr, & real (kind=dbl_kind), dimension (:), intent(in) :: & qicen, & ! ice layer enthalpy (J m-3) - sicen ! salinity (ppt) + sicen ! salinity (ppt) real (kind=dbl_kind), & intent(in) :: & @@ -105,7 +105,7 @@ subroutine compute_ponds_lvl(dt, nilyr, & dTs , & ! surface temperature diff for freeze-up (C) Tp , & ! pond freezing temperature (C) Ts , & ! surface air temperature (C) - apondn , & ! local pond area + apondn , & ! local pond area hpondn , & ! local pond depth (m) dvn , & ! change in pond volume (m) hlid, alid , & ! refrozen lid thickness, area @@ -121,7 +121,7 @@ subroutine compute_ponds_lvl(dt, nilyr, & character(len=*),parameter :: subname='(compute_ponds_lvl)' !----------------------------------------------------------------- - ! Initialize + ! Initialize !----------------------------------------------------------------- volpn = hpnd * aicen * alvl * apnd @@ -132,7 +132,7 @@ subroutine compute_ponds_lvl(dt, nilyr, & !----------------------------------------------------------------- if (aicen*alvl > puny**2) then - + hi = vicen/aicen hs = vsnon/aicen alvl_tmp = alvl @@ -173,7 +173,7 @@ subroutine compute_ponds_lvl(dt, nilyr, & dTs = max(Tp - Tsfcn,c0) dvn = dvn - volpn * (c1 - exp(rexp*dTs/Tp)) - else + else ! trim(frzpnd) == 'hlid' Stefan approximation ! assumes pond is fresh (freezing temperature = 0 C) ! and ice grows from existing pond ice @@ -225,7 +225,7 @@ subroutine compute_ponds_lvl(dt, nilyr, & apondn = min (sqrt(volpn/(pndaspect*aicen)), alvl_tmp) hpondn = pndaspect * apondn - else ! melt water runs off deformed ice + else ! melt water runs off deformed ice apondn = c0 hpondn = c0 endif @@ -296,9 +296,9 @@ subroutine brine_permeability(nilyr, qicen, salin, Tmlt, perm) real (kind=dbl_kind), dimension(:), intent(in) :: & qicen, & ! enthalpy for each ice layer (J m-3) - salin, & ! salinity (ppt) + salin, & ! salinity (ppt) Tmlt ! melting temperature (C) - + real (kind=dbl_kind), intent(out) :: & perm ! permeability (m^2) @@ -312,7 +312,7 @@ subroutine brine_permeability(nilyr, qicen, salin, Tmlt, perm) phi ! liquid fraction integer (kind=int_kind) :: k - + character(len=*),parameter :: subname='(brine_permeability)' !----------------------------------------------------------------- @@ -338,9 +338,9 @@ subroutine brine_permeability(nilyr, qicen, salin, Tmlt, perm) !----------------------------------------------------------------- perm = 3.0e-8_dbl_kind * (minval(phi))**3 - + end subroutine brine_permeability - + !======================================================================= end module icepack_meltpond_lvl diff --git a/columnphysics/icepack_meltpond_topo.F90 b/columnphysics/icepack_meltpond_topo.F90 index 3245b64a2..82f4920a7 100644 --- a/columnphysics/icepack_meltpond_topo.F90 +++ b/columnphysics/icepack_meltpond_topo.F90 @@ -4,8 +4,8 @@ ! the ice thickness distribution. This code is based on (but differs ! from) that described in ! -! Flocco, D. and D. L. Feltham, 2007. A continuum model of melt pond -! evolution on Arctic sea ice. J. Geophys. Res. 112, C08016, doi: +! Flocco, D. and D. L. Feltham, 2007. A continuum model of melt pond +! evolution on Arctic sea ice. J. Geophys. Res. 112, C08016, doi: ! 10.1029/2006JC003836. ! ! Flocco, D., D. L. Feltham and A. K. Turner, 2010. Incorporation of a @@ -69,7 +69,7 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & real (kind=dbl_kind), intent(in) :: & aice, & ! total ice area fraction vsno, & ! total snow volume (m) - Tf ! ocean freezing temperature [= ice bottom temperature] (degC) + Tf ! ocean freezing temperature [= ice bottom temperature] (degC) real (kind=dbl_kind), intent(inout) :: & vice, & ! total ice volume (m) @@ -102,7 +102,7 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & real (kind=dbl_kind), dimension (ncat) :: & volpn, & ! pond volume per unit area, per category (m) - vuin ! water-equivalent volume of ice lid on melt pond ('upper ice', m) + vuin ! water-equivalent volume of ice lid on melt pond ('upper ice', m) real (kind=dbl_kind), dimension (ncat) :: & apondn,& ! pond area fraction, per category @@ -125,7 +125,7 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & integer (kind=int_kind) :: n ! loop indices real (kind=dbl_kind), parameter :: & - hicemin = p1 , & ! minimum ice thickness with ponds (m) + hicemin = p1 , & ! minimum ice thickness with ponds (m) Td = p15 , & ! temperature difference for freeze-up (C) min_volp = 1.e-4_dbl_kind ! minimum pond volume (m) @@ -134,7 +134,7 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & !--------------------------------------------------------------- ! initialize !--------------------------------------------------------------- - + volp = c0 rhoi_L = Lfresh * rhoi ! (J/m^3) @@ -151,7 +151,7 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & ! The freezing temperature for meltponds is assumed slightly below 0C, ! as if meltponds had a little salt in them. The salt budget is not - ! altered for meltponds, but if it were then an actual pond freezing + ! altered for meltponds, but if it were then an actual pond freezing ! temperature could be computed. Tp = Timelt - Td @@ -178,23 +178,25 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & aicen, vicen, vsnon, & qicen, sicen, & volpn, volp, & - Tsfcn, Tf, & +#ifdef UNDEPRECATE_0LAYER + Tsfcn, Tf, & +#endif apondn, hpondn, dvn ) if (icepack_warnings_aborted(subname)) return fpond = fpond - dvn - + ! mean surface temperature Tavg = c0 do n = 1, ncat Tavg = Tavg + Tsfcn(n)*aicen(n) enddo Tavg = Tavg / aice - + do n = 1, ncat-1 - + if (vuin(n) > puny) then - + !---------------------------------------------------------------- ! melting: floating upper ice layer melts in whole or part !---------------------------------------------------------------- @@ -207,7 +209,7 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & volpn(n) = volpn(n) + dvice volp = volp + dvice fpond = fpond + dvice - + if (vuin(n) < puny .and. volpn(n) > puny) then ! ice lid melted and category is pond covered volpn(n) = volpn(n) + vuin(n) @@ -216,7 +218,7 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & endif hpondn(n) = volpn(n) / apondn(n) endif - + !---------------------------------------------------------------- ! freezing: existing upper ice layer grows !---------------------------------------------------------------- @@ -224,12 +226,12 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & else if (volpn(n) > puny) then ! Tsfcn(i,j,n) <= Tp ! differential growth of base of surface floating ice layer - dTice = max(-Tsfcn(n)-Td, c0) ! > 0 + dTice = max(-Tsfcn(n)-Td, c0) ! > 0 omega = kice*DTice/rhoi_L dHui = sqrt(c2*omega*dt + (vuin(n)/aicen(n))**2) & - vuin(n)/aicen(n) - dvice = min(dHui*apondn(n), volpn(n)) + dvice = min(dHui*apondn(n), volpn(n)) if (dvice > puny) then vuin (n) = vuin (n) + dvice volpn(n) = volpn(n) - dvice @@ -237,7 +239,7 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & fpond = fpond - dvice hpondn(n) = volpn(n) / apondn(n) endif - + endif ! Tsfcn(i,j,n) !---------------------------------------------------------------- @@ -245,13 +247,13 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & ! note: albedo does not change !---------------------------------------------------------------- else ! vuin < puny - + ! thickness of newly formed ice ! the surface temperature of a meltpond is the same as that - ! of the ice underneath (0C), and the thermodynamic surface + ! of the ice underneath (0C), and the thermodynamic surface ! flux is the same dHui = max(-fsurf*dt/rhoi_L, c0) - dvice = min(dHui*apondn(n), volpn(n)) + dvice = min(dHui*apondn(n), volpn(n)) if (dvice > puny) then vuin (n) = dvice volpn(n) = volpn(n) - dvice @@ -259,16 +261,16 @@ subroutine compute_ponds_topo(dt, ncat, nilyr, & fpond = fpond - dvice hpondn(n)= volpn(n) / apondn(n) endif - + endif ! vuin - + enddo ! ncat else ! remove ponds on thin ice fpond = fpond - volp volpn(:) = c0 vuin (:) = c0 - volp = c0 + volp = c0 endif !--------------------------------------------------------------- @@ -312,10 +314,12 @@ subroutine pond_area(dt, ncat, nilyr,& ktherm, & #endif aice, vice, vsno, & - aicen, vicen, vsnon,& + aicen, vicen, vsnon,& qicen, sicen, & volpn, volp, & +#ifdef UNDEPRECATE_0LAYER Tsfcn, Tf, & +#endif apondn,hpondn,dvolp ) integer (kind=int_kind), intent(in) :: & @@ -331,12 +335,17 @@ subroutine pond_area(dt, ncat, nilyr,& logical (kind=log_kind), intent(in) :: & heat_capacity ! if true, ice has nonzero heat capacity ! if false, use zero-layer thermodynamics -#endif real (kind=dbl_kind), intent(in) :: & dt, aice, vice, vsno, Tf - real (kind=dbl_kind), dimension(:), intent(in) :: & aicen, vicen, vsnon, Tsfcn +#else + real (kind=dbl_kind), intent(in) :: & + dt, aice, vice, vsno + + real (kind=dbl_kind), dimension(:), intent(in) :: & + aicen, vicen, vsnon +#endif real (kind=dbl_kind), dimension(:,:), intent(in) :: & qicen, & @@ -365,7 +374,7 @@ subroutine pond_area(dt, ncat, nilyr,& alfan, & betan, & cum_max_vol, & - reduced_aicen + reduced_aicen real (kind=dbl_kind), dimension(0:ncat) :: & cum_max_vol_tmp @@ -403,7 +412,7 @@ subroutine pond_area(dt, ncat, nilyr,& ! |-----------| ! | !-----------| - + !------------------------------------------------------------------- ! initialize !------------------------------------------------------------------- @@ -414,7 +423,7 @@ subroutine pond_area(dt, ncat, nilyr,& hpondn(n) = c0 if (aicen(n) < puny) then - hicen(n) = c0 + hicen(n) = c0 hsnon(n) = c0 reduced_aicen(n) = c0 asnon(n) = c0 @@ -424,7 +433,7 @@ subroutine pond_area(dt, ncat, nilyr,& reduced_aicen(n) = c1 ! n=ncat if (n < ncat) reduced_aicen(n) = aicen(n) & * max(0.2_dbl_kind,(-0.024_dbl_kind*hicen(n) + 0.832_dbl_kind)) - asnon(n) = reduced_aicen(n) + asnon(n) = reduced_aicen(n) endif ! This choice for alfa and beta ignores hydrostatic equilibium of categories. @@ -432,41 +441,41 @@ subroutine pond_area(dt, ncat, nilyr,& ! a surface topography implied by alfa=0.6 and beta=0.4, and rigidity across all ! categories. alfa and beta partition the ITD - they are areas not thicknesses! ! Multiplying by hicen, alfan and betan (below) are thus volumes per unit area. -! Here, alfa = 60% of the ice area (and since hice is constant in a category, -! alfan = 60% of the ice volume) in each category lies above the reference line, +! Here, alfa = 60% of the ice area (and since hice is constant in a category, +! alfan = 60% of the ice volume) in each category lies above the reference line, ! and 40% below. Note: p6 is an arbitrary choice, but alfa+beta=1 is required. alfan(n) = p6 * hicen(n) betan(n) = p4 * hicen(n) - + cum_max_vol(n) = c0 cum_max_vol_tmp(n) = c0 - + enddo ! ncat cum_max_vol_tmp(0) = c0 drain = c0 dvolp = c0 - + !-------------------------------------------------------------------------- ! the maximum amount of water that can be contained up to each ice category !-------------------------------------------------------------------------- - + do n = 1, ncat-1 ! last category can not hold any volume if (alfan(n+1) >= alfan(n) .and. alfan(n+1) > c0) then ! total volume in level including snow cum_max_vol_tmp(n) = cum_max_vol_tmp(n-1) + & - (alfan(n+1) - alfan(n)) * sum(reduced_aicen(1:n)) + (alfan(n+1) - alfan(n)) * sum(reduced_aicen(1:n)) ! subtract snow solid volumes from lower categories in current level - do ns = 1, n + do ns = 1, n cum_max_vol_tmp(n) = cum_max_vol_tmp(n) & - rhos/rhow * & ! fraction of snow that is occupied by solid asnon(ns) * & ! area of snow from that category - max(min(hsnon(ns)+alfan(ns)-alfan(n), alfan(n+1)-alfan(n)), c0) + max(min(hsnon(ns)+alfan(ns)-alfan(n), alfan(n+1)-alfan(n)), c0) ! thickness of snow from ns layer in n layer enddo @@ -481,7 +490,7 @@ subroutine pond_area(dt, ncat, nilyr,& enddo cum_max_vol_tmp(ncat) = cum_max_vol_tmp(ncat-1) ! last category holds no volume cum_max_vol (1:ncat) = cum_max_vol_tmp(1:ncat) - + !---------------------------------------------------------------- ! is there more meltwater than can be held in the floe? !---------------------------------------------------------------- @@ -494,41 +503,40 @@ subroutine pond_area(dt, ncat, nilyr,& volp = c0 endif endif - + ! height and area corresponding to the remaining volume call calc_hpond(ncat, reduced_aicen, asnon, hsnon, & alfan, volp, cum_max_vol, hpond, m_index) if (icepack_warnings_aborted(subname)) return - + do n=1, m_index hpondn(n) = max((hpond - alfan(n) + alfan(1)), c0) - apondn(n) = reduced_aicen(n) + apondn(n) = reduced_aicen(n) enddo - + !------------------------------------------------------------------------ ! drainage due to ice permeability - Darcy's law !------------------------------------------------------------------------ - - ! sea water level + + ! sea water level floe_weight = (vsno*rhos + rhoi*vice + rhow*volp) / aice hsl_rel = floe_weight / rhow & - ((sum(betan(:)*aicen(:))/aice) + alfan(1)) - + deltah = hpond - hsl_rel pressure_head = gravit * rhow * max(deltah, c0) - ! drain if ice is permeable + ! drain if ice is permeable permflag = 0 if (ktherm /= 2 .and. pressure_head > c0) then do n = 1, ncat-1 if (hicen(n) > c0) then #ifdef UNDEPRECATE_0LAYER - call permeability_phi(heat_capacity, nilyr, & + call permeability_phi(heat_capacity, nilyr, qicen(:,n), sicen(:,n), Tsfcn(n), Tf, perm) #else - call permeability_phi(nilyr, & + call permeability_phi(nilyr, qicen(:,n), sicen(:,n), perm) #endif - qicen(:,n), sicen(:,n), Tsfcn(n), Tf, perm) if (icepack_warnings_aborted(subname)) return if (perm > c0) permflag = 1 drain = perm*apondn(n)*pressure_head*dt / (viscosity_dyn*hicen(n)) @@ -540,16 +548,16 @@ subroutine pond_area(dt, ncat, nilyr,& endif endif enddo - + ! adjust melt pond dimensions if (permflag > 0) then - ! recompute pond depth + ! recompute pond depth call calc_hpond(ncat, reduced_aicen, asnon, hsnon, & alfan, volp, cum_max_vol, hpond, m_index) if (icepack_warnings_aborted(subname)) return do n=1, m_index hpondn(n) = hpond - alfan(n) + alfan(1) - apondn(n) = reduced_aicen(n) + apondn(n) = reduced_aicen(n) enddo endif endif ! pressure_head @@ -574,9 +582,9 @@ subroutine pond_area(dt, ncat, nilyr,& volpn(m_index) = c0 hpondn(m_index) = c0 apondn(m_index) = c0 - ! If remaining pond volume is negative reduce pond volume of + ! If remaining pond volume is negative reduce pond volume of ! lower category - if (volp+puny < sum(volpn(1:m_index-1))) & + if (volp+puny < sum(volpn(1:m_index-1))) & volpn(m_index-1) = volpn(m_index-1) - sum(volpn(1:m_index-1)) + & volp endif @@ -599,12 +607,12 @@ subroutine pond_area(dt, ncat, nilyr,& enddo end subroutine pond_area - + !======================================================================= - + subroutine calc_hpond(ncat, aicen, asnon, hsnon, & alfan, volp, cum_max_vol, hpond, m_index) - + integer (kind=int_kind), intent(in) :: & ncat ! number of thickness categories @@ -614,43 +622,43 @@ subroutine calc_hpond(ncat, aicen, asnon, hsnon, & hsnon, & alfan, & cum_max_vol - + real (kind=dbl_kind), intent(in) :: & volp - + real (kind=dbl_kind), intent(out) :: & hpond - + integer (kind=int_kind), intent(out) :: & m_index - + integer :: n, ns - + real (kind=dbl_kind), dimension(0:ncat+1) :: & hitl, & aicetl - + real (kind=dbl_kind) :: & rem_vol, & area, & vol, & tmp - + character(len=*),parameter :: subname='(calc_hpond)' !---------------------------------------------------------------- - ! hpond is zero if volp is zero - have we fully drained? + ! hpond is zero if volp is zero - have we fully drained? !---------------------------------------------------------------- - + if (volp < puny) then hpond = c0 m_index = 0 else - + !---------------------------------------------------------------- - ! Calculate the category where water fills up to + ! Calculate the category where water fills up to !---------------------------------------------------------------- - + !----------| ! | ! | @@ -665,7 +673,7 @@ subroutine calc_hpond(ncat, aicen, asnon, hsnon, & ! | | | |---v-----| ! | | m_index | | | !------------------------------------------------------------- - + m_index = 0 ! 1:m_index categories have water in them do n = 1, ncat if (volp <= cum_max_vol(n)) then @@ -679,11 +687,11 @@ subroutine calc_hpond(ncat, aicen, asnon, hsnon, & endif enddo m_index = min(ncat-1, m_index) - + !---------------------------------------------------------------- ! semi-filled layer may have m_index different snows in it !---------------------------------------------------------------- - + !----------------------------------------------------------- ^ ! | alfan(m_index+1) ! | @@ -692,27 +700,27 @@ subroutine calc_hpond(ncat, aicen, asnon, hsnon, & !hitl(1)--> |----------|* * * * * * |* * * * * | | !hitl(0)-->------------------------------------------------- | ^ ! various snows from lower categories | |alfa(m_index) - + ! hitl - heights of the snow layers from thinner and current categories ! aicetl - area of each snow depth in this layer - + hitl(:) = c0 aicetl(:) = c0 do n = 1, m_index hitl(n) = max(min(hsnon(n) + alfan(n) - alfan(m_index), & alfan(m_index+1) - alfan(m_index)), c0) aicetl(n) = asnon(n) - + aicetl(0) = aicetl(0) + (aicen(n) - asnon(n)) enddo hitl(m_index+1) = alfan(m_index+1) - alfan(m_index) aicetl(m_index+1) = c0 - + !---------------------------------------------------------------- - ! reorder array according to hitl + ! reorder array according to hitl ! snow heights not necessarily in height order !---------------------------------------------------------------- - + do ns = 1, m_index+1 do n = 0, m_index - ns + 1 if (hitl(n) > hitl(n+1)) then ! swap order @@ -725,54 +733,53 @@ subroutine calc_hpond(ncat, aicen, asnon, hsnon, & endif enddo enddo - + !---------------------------------------------------------------- ! divide semi-filled layer into set of sublayers each vertically homogenous !---------------------------------------------------------------- - + !hitl(3)---------------------------------------------------------------- - ! | * * * * * * * * - ! |* * * * * * * * * + ! | * * * * * * * * + ! |* * * * * * * * * !hitl(2)---------------------------------------------------------------- - ! | * * * * * * * * | * * * * * * * * - ! |* * * * * * * * * |* * * * * * * * * + ! | * * * * * * * * | * * * * * * * * + ! |* * * * * * * * * |* * * * * * * * * !hitl(1)---------------------------------------------------------------- - ! | * * * * * * * * | * * * * * * * * | * * * * * * * * - ! |* * * * * * * * * |* * * * * * * * * |* * * * * * * * * + ! | * * * * * * * * | * * * * * * * * | * * * * * * * * + ! |* * * * * * * * * |* * * * * * * * * |* * * * * * * * * !hitl(0)---------------------------------------------------------------- - ! aicetl(0) aicetl(1) aicetl(2) aicetl(3) - + ! aicetl(0) aicetl(1) aicetl(2) aicetl(3) + ! move up over layers incrementing volume do n = 1, m_index+1 - + area = sum(aicetl(:)) - & ! total area of sub-layer (rhos/rhow) * sum(aicetl(n:ncat+1)) ! area of sub-layer occupied by snow - + vol = (hitl(n) - hitl(n-1)) * area ! thickness of sub-layer times area - + if (vol >= rem_vol) then ! have reached the sub-layer with the depth within hpond = rem_vol / area + hitl(n-1) + alfan(m_index) - alfan(1) exit else ! still in sub-layer below the sub-layer with the depth rem_vol = rem_vol - vol endif - + enddo - + endif - + end subroutine calc_hpond - + !======================================================================= ! determine the liquid fraction of brine in the ice and the permeability #ifdef UNDEPRECATE_0LAYER - subroutine permeability_phi(heat_capacity, nilyr, & + subroutine permeability_phi(heat_capacity, nilyr, qicen, sicen, Tsfcn, Tf, perm) #else - subroutine permeability_phi(nilyr, & + subroutine permeability_phi(nilyr, qicen, sicen, perm) #endif - qicen, sicen, Tsfcn, Tf, perm) #ifdef UNDEPRECATE_0LAYER logical (kind=log_kind), intent(in) :: & @@ -784,19 +791,21 @@ subroutine permeability_phi(nilyr, & real (kind=dbl_kind), dimension(:), intent(in) :: & qicen, & ! energy of melting for each ice layer (J/m2) - sicen ! salinity (ppt) - + sicen ! salinity (ppt) + +#ifdef UNDEPRECATE_0LAYER real (kind=dbl_kind), intent(in) :: & - Tsfcn, & ! sea ice surface skin temperature (degC) - Tf ! ocean freezing temperature [= ice bottom temperature] (degC) - + Tsfcn, & ! sea ice surface skin temperature (degC) + Tf ! ocean freezing temperature [= ice bottom temperature] (degC) +#endif + real (kind=dbl_kind), intent(out) :: & perm ! permeability ! local variables real (kind=dbl_kind) :: & - Tmlt, & ! melting temperature + Tmlt, & ! melting temperature Sbr ! brine salinity real (kind=dbl_kind), dimension(nilyr) :: & @@ -804,7 +813,7 @@ subroutine permeability_phi(nilyr, & phi ! liquid fraction integer (kind=int_kind) :: k - + character(len=*),parameter :: subname='(permeability_phi)' !----------------------------------------------------------------- @@ -847,7 +856,7 @@ subroutine permeability_phi(nilyr, & endif #endif enddo ! k - + else ! Notz 2005 thesis eq. 3.2 @@ -878,7 +887,7 @@ subroutine permeability_phi(nilyr, & !----------------------------------------------------------------- perm = 3.0e-08_dbl_kind * (minval(phi))**3 - + end subroutine permeability_phi !======================================================================= diff --git a/columnphysics/icepack_mushy_physics.F90 b/columnphysics/icepack_mushy_physics.F90 index 5c24b7a68..d100ebd2e 100644 --- a/columnphysics/icepack_mushy_physics.F90 +++ b/columnphysics/icepack_mushy_physics.F90 @@ -26,7 +26,7 @@ module icepack_mushy_physics liquidus_temperature_mush, & icepack_mushy_liquid_fraction, & icepack_mushy_density_brine - + !----------------------------------------------------------------- ! Constants for Liquidus relation from Assur (1958) !----------------------------------------------------------------- @@ -52,11 +52,11 @@ module icepack_mushy_physics bz1p_liq = bz1_liq / c1000, & az2p_liq = az2_liq / c1000, & bz2p_liq = bz2_liq / c1000 - + !----------------------------------------------------------------- ! Other parameters !----------------------------------------------------------------- - + real(kind=dbl_kind), parameter :: & ki = 2.3_dbl_kind , & ! fresh ice conductivity (W m-1 K-1) kb = 0.5375_dbl_kind ! brine conductivity (W m-1 K-1) @@ -72,30 +72,30 @@ module icepack_mushy_physics subroutine conductivity_mush_array(nilyr, zqin, zSin, km) ! detemine the conductivity of the mush from enthalpy and salinity - + integer (kind=int_kind), intent(in) :: & nilyr ! number of ice layers real(kind=dbl_kind), dimension(:), intent(in) :: & - zqin, & ! ice layer enthalpy (J m-3) + zqin, & ! ice layer enthalpy (J m-3) zSin ! ice layer bulk salinity (ppt) real(kind=dbl_kind), dimension(:), intent(out) :: & km ! ice layer conductivity (W m-1 K-1) - + integer(kind=int_kind) :: & k ! ice layer index real(kind=dbl_kind) :: Tmush - + character(len=*),parameter :: subname='(conductivity_mush_array)' do k = 1, nilyr - + Tmush = icepack_mushy_temperature_mush(zqin(k), zSin(k)) - + km(k) = heat_conductivity(Tmush, zSin(k)) - + enddo ! k end subroutine conductivity_mush_array @@ -103,7 +103,7 @@ end subroutine conductivity_mush_array !======================================================================= function icepack_mushy_density_brine(Sbr) result(rho) - + ! density of brine from brine salinity real(kind=dbl_kind), intent(in) :: & @@ -111,16 +111,16 @@ function icepack_mushy_density_brine(Sbr) result(rho) real(kind=dbl_kind) :: & rho ! brine density (kg m-3) - + real(kind=dbl_kind), parameter :: & a = 1000.3_dbl_kind , & ! zeroth empirical coefficient b = 0.78237_dbl_kind , & ! linear empirical coefficient c = 2.8008e-4_dbl_kind ! quadratic empirical coefficient - + character(len=*),parameter :: subname='(icepack_mushy_density_brine)' rho = a + b * Sbr + c * Sbr**2 - + end function icepack_mushy_density_brine !======================================================================= @@ -141,31 +141,31 @@ subroutine conductivity_snow_array(ks) end subroutine conductivity_snow_array !======================================================================= - + function enthalpy_snow(zTsn) result(zqsn) - + ! enthalpy of snow from snow temperature real(kind=dbl_kind), intent(in) :: & zTsn ! snow layer temperature (C) real(kind=dbl_kind) :: & - zqsn ! snow layer enthalpy (J m-3) - + zqsn ! snow layer enthalpy (J m-3) + character(len=*),parameter :: subname='(enthalpy_snow)' zqsn = -rhos * (-cp_ice * zTsn + Lfresh) - + end function enthalpy_snow !======================================================================= - + function temperature_snow(zqsn) result(zTsn) - + ! temperature of snow from the snow enthalpy real(kind=dbl_kind), intent(in) :: & - zqsn ! snow layer enthalpy (J m-3) + zqsn ! snow layer enthalpy (J m-3) real(kind=dbl_kind) :: & zTsn, & ! snow layer temperature (C) @@ -205,11 +205,11 @@ function liquidus_brine_salinity_mush(zTin) result(Sbr) character(len=*),parameter :: subname='(liquidus_brine_salinty_mush)' ! temperature to brine salinity - J1_liq = bz1_liq / az1_liq - K1_liq = c1 / c1000 - L1_liq = (c1 + bz1p_liq) / az1_liq - J2_liq = bz2_liq / az2_liq - K2_liq = c1 / c1000 + J1_liq = bz1_liq / az1_liq + K1_liq = c1 / c1000 + L1_liq = (c1 + bz1p_liq) / az1_liq + J2_liq = bz2_liq / az2_liq + K2_liq = c1 / c1000 L2_liq = (c1 + bz2p_liq) / az2_liq t_high = merge(c1, c0, (zTin > Tb_liq)) @@ -274,15 +274,15 @@ function enthalpy_mush(zTin, zSin) result(zqin) zSin ! ice layer bulk salinity (ppt) real(kind=dbl_kind) :: & - zqin ! ice layer enthalpy (J m-3) + zqin ! ice layer enthalpy (J m-3) real(kind=dbl_kind) :: & - phi ! ice liquid fraction + phi ! ice liquid fraction character(len=*),parameter :: subname='(enthalpy_mush)' phi = icepack_mushy_liquid_fraction(zTin, zSin) - + zqin = phi * (cp_ocn * rhow - cp_ice * rhoi) * zTin + & rhoi * cp_ice * zTin - (c1 - phi) * rhoi * Lfresh @@ -299,7 +299,7 @@ function enthalpy_mush_liquid_fraction(zTin, phi) result(zqin) phi ! liquid fraction real(kind=dbl_kind) :: & - zqin ! ice layer enthalpy (J m-3) + zqin ! ice layer enthalpy (J m-3) character(len=*),parameter :: subname='(enthalpy_mush_liquid_fraction)' @@ -352,7 +352,7 @@ function icepack_mushy_temperature_mush(zqin, zSin) result(zTin) ! temperature of mush from mush enthalpy real(kind=dbl_kind), intent(in) :: & - zqin , & ! ice enthalpy (J m-3) + zqin , & ! ice enthalpy (J m-3) zSin ! ice layer bulk salinity (ppt) real(kind=dbl_kind) :: & @@ -387,41 +387,41 @@ function icepack_mushy_temperature_mush(zqin, zSin) result(zTin) !-------------------------------------------------------- ! quadratic constants - higher temperature region - AS1_liq = az1p_liq * (rhow * cp_ocn - rhoi * cp_ice) - AC1_liq = rhoi * cp_ice * az1_liq + AS1_liq = az1p_liq * (rhow * cp_ocn - rhoi * cp_ice) + AC1_liq = rhoi * cp_ice * az1_liq BS1_liq = (c1 + bz1p_liq) * (rhow * cp_ocn - rhoi * cp_ice) & - + rhoi * Lfresh * az1p_liq - BQ1_liq = -az1_liq + + rhoi * Lfresh * az1p_liq + BQ1_liq = -az1_liq BC1_liq = rhoi * cp_ice * bz1_liq - rhoi * Lfresh * az1_liq - CS1_liq = rhoi * Lfresh * (c1 + bz1p_liq) - CQ1_liq = -bz1_liq + CS1_liq = rhoi * Lfresh * (c1 + bz1p_liq) + CQ1_liq = -bz1_liq CC1_liq = -rhoi * Lfresh * bz1_liq - + ! quadratic constants - lower temperature region - AS2_liq = az2p_liq * (rhow * cp_ocn - rhoi * cp_ice) - AC2_liq = rhoi * cp_ice * az2_liq + AS2_liq = az2p_liq * (rhow * cp_ocn - rhoi * cp_ice) + AC2_liq = rhoi * cp_ice * az2_liq BS2_liq = (c1 + bz2p_liq) * (rhow * cp_ocn - rhoi * cp_ice) & - + rhoi * Lfresh * az2p_liq - BQ2_liq = -az2_liq + + rhoi * Lfresh * az2p_liq + BQ2_liq = -az2_liq BC2_liq = rhoi * cp_ice * bz2_liq - rhoi * Lfresh * az2_liq - CS2_liq = rhoi * Lfresh * (c1 + bz2p_liq) - CQ2_liq = -bz2_liq + CS2_liq = rhoi * Lfresh * (c1 + bz2p_liq) + CQ2_liq = -bz2_liq CC2_liq = -rhoi * Lfresh * bz2_liq - + ! break enthalpy constants D_liq = ((c1 + az1p_liq*Tb_liq + bz1p_liq) & / ( az1_liq*Tb_liq + bz1_liq)) & * ((cp_ocn*rhow - cp_ice*rhoi)*Tb_liq + Lfresh*rhoi) E_liq = cp_ice*rhoi*Tb_liq - Lfresh*rhoi - + ! just fully melted enthapy constants - F1_liq = ( -c1000 * cp_ocn * rhow) / az1_liq - G1_liq = -c1000 - H1_liq = (-bz1_liq * cp_ocn * rhow) / az1_liq - F2_liq = ( -c1000 * cp_ocn * rhow) / az2_liq - G2_liq = -c1000 + F1_liq = ( -c1000 * cp_ocn * rhow) / az1_liq + G1_liq = -c1000 + H1_liq = (-bz1_liq * cp_ocn * rhow) / az1_liq + F2_liq = ( -c1000 * cp_ocn * rhow) / az2_liq + G2_liq = -c1000 H2_liq = (-bz2_liq * cp_ocn * rhow) / az2_liq - + ! warmer than fully melted constants I_liq = c1 / (cp_ocn * rhow) @@ -460,7 +460,7 @@ function temperature_mush_liquid_fraction(zqin, phi) result(zTin) ! temperature of mush from mush enthalpy real(kind=dbl_kind), intent(in) :: & - zqin , & ! ice enthalpy (J m-3) + zqin , & ! ice enthalpy (J m-3) phi ! liquid fraction real(kind=dbl_kind) :: & @@ -476,7 +476,7 @@ end function temperature_mush_liquid_fraction !======================================================================= function heat_conductivity(zTin, zSin) result(km) - + ! msuh heat conductivity from mush temperature and bulk salinity real(kind=dbl_kind), intent(in) :: & @@ -485,7 +485,7 @@ function heat_conductivity(zTin, zSin) result(km) real(kind=dbl_kind) :: & km ! ice layer conductivity (W m-1 K-1) - + real(kind=dbl_kind) :: & phi ! liquid fraction diff --git a/columnphysics/icepack_ocean.F90 b/columnphysics/icepack_ocean.F90 index 2b8eee45f..8210119bf 100644 --- a/columnphysics/icepack_ocean.F90 +++ b/columnphysics/icepack_ocean.F90 @@ -86,7 +86,7 @@ subroutine icepack_ocn_mixed_layer (alvdr_ocn, swvdr, & ! shortwave radiative flux swabs = (c1-alvdr_ocn) * swvdr + (c1-alidr_ocn) * swidr & - + (c1-alvdf_ocn) * swvdf + (c1-alidf_ocn) * swidf + + (c1-alvdf_ocn) * swvdf + (c1-alidf_ocn) * swidf ! ocean surface temperature in Kelvin TsfK = sst + Tffresh diff --git a/columnphysics/icepack_orbital.F90 b/columnphysics/icepack_orbital.F90 index 165f3c5a1..4c7c53ccf 100644 --- a/columnphysics/icepack_orbital.F90 +++ b/columnphysics/icepack_orbital.F90 @@ -1,7 +1,7 @@ !======================================================================= ! Orbital parameters computed from date -! author: Bruce P. Briegleb, NCAR +! author: Bruce P. Briegleb, NCAR ! ! 2006 ECH: Converted to free source form (F90) ! 2014 ECH: Moved routines from csm_share/shr_orb_mod.F90 @@ -34,7 +34,7 @@ module icepack_orbital logical(kind=log_kind) :: log_print ! Flags print of status/error !======================================================================= - + contains !======================================================================= @@ -85,7 +85,7 @@ subroutine icepack_init_orbit(iyear_AD_in, eccen_in, obliqr_in, & if (present(log_print_in)) log_print = log_print_in end subroutine icepack_init_orbit - + !======================================================================= !autodocument_start icepack_query_orbit @@ -134,13 +134,13 @@ subroutine icepack_query_orbit(iyear_AD_out, eccen_out, obliqr_out, & if (present(log_print_out)) log_print_out = log_print end subroutine icepack_query_orbit - + !======================================================================= ! Uses orbital and lat/lon info to compute cosine solar zenith angle ! for the specified date. ! -! author: Bruce P. Briegleb, NCAR +! author: Bruce P. Briegleb, NCAR subroutine compute_coszen (tlat, tlon, & yday, sec, coszen, & @@ -150,7 +150,7 @@ subroutine compute_coszen (tlat, tlon, & #ifdef CESMCOUPLED use shr_orb_mod, only: shr_orb_decl #endif - + real (kind=dbl_kind), intent(in) :: & tlat, tlon ! latitude and longitude (radians) @@ -161,9 +161,9 @@ subroutine compute_coszen (tlat, tlon, & yday ! day of the year real (kind=dbl_kind), intent(inout) :: & - coszen ! cosine solar zenith angle + coszen ! cosine solar zenith angle ! negative for sun below horizon - + integer (kind=int_kind), intent(in), optional :: & days_per_year ! number of days in one year @@ -176,11 +176,11 @@ subroutine compute_coszen (tlat, tlon, & ! local variables real (kind=dbl_kind) :: ydayp1 ! day of year plus one time step - + character(len=*),parameter :: subname='(compute_coszen)' ! Solar declination for next time step - + #ifdef CESMCOUPLED if (calendar_type == "GREGORIAN") then ydayp1 = min(nextsw_cday, real(days_per_year,kind=dbl_kind)) @@ -193,7 +193,7 @@ subroutine compute_coszen (tlat, tlon, & #else ydayp1 = yday + sec/secday #endif - + call shr_orb_decl(ydayp1, eccen, mvelpp, lambm0, & obliqr, decln, eccf) if (icepack_warnings_aborted(subname)) return @@ -201,13 +201,13 @@ subroutine compute_coszen (tlat, tlon, & coszen = sin(tlat)*sin(decln) & + cos(tlat)*cos(decln) & *cos((sec/secday-p5)*c2*pi + tlon) !cos(hour angle) - + #ifdef CESMCOUPLED endif #endif end subroutine compute_coszen - + !=============================================================================== #ifndef CESMCOUPLED @@ -216,9 +216,9 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & !------------------------------------------------------------------------------- ! -! Calculate earths orbital parameters using Dave Threshers formula which -! came from Berger, Andre. 1978 A Simple Algorithm to Compute Long-Term -! Variations of Daily Insolation. Contribution 18, Institute of Astronomy +! Calculate earths orbital parameters using Dave Threshers formula which +! came from Berger, Andre. 1978 A Simple Algorithm to Compute Long-Term +! Variations of Daily Insolation. Contribution 18, Institute of Astronomy ! and Geophysics, Universite Catholique de Louvain, Louvain-la-Neuve, Belgium ! !------------------------------Code history------------------------------------- @@ -241,7 +241,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & logical(log_kind),intent(in) :: log_print ! Flags print of status/error !------------------------------ Parameters ---------------------------------- - real (dbl_kind),parameter :: SHR_ORB_UNDEF_REAL = 1.e36_dbl_kind ! undefined real + real (dbl_kind),parameter :: SHR_ORB_UNDEF_REAL = 1.e36_dbl_kind ! undefined real integer(int_kind),parameter :: SHR_ORB_UNDEF_INT = 2000000000 ! undefined int integer(int_kind),parameter :: poblen =47 ! # of elements in series wrt obliquity integer(int_kind),parameter :: pecclen=19 ! # of elements in series wrt eccentricity @@ -259,7 +259,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & ! Cosine series data for computation of obliquity: amplitude (arc seconds), ! rate (arc seconds/year), phase (degrees). - + real (dbl_kind), parameter :: obamp(poblen) = & ! amplitudes for obliquity cos series (/ -2462.2214466_dbl_kind, -857.3232075_dbl_kind, -629.3231835_dbl_kind, & -414.2804924_dbl_kind, -311.7632587_dbl_kind, 308.9408604_dbl_kind, & @@ -277,7 +277,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & -1.5428851_dbl_kind, 1.4738838_dbl_kind, -1.4593669_dbl_kind, & 1.4192259_dbl_kind, -1.1818980_dbl_kind, 1.1756474_dbl_kind, & -1.1316126_dbl_kind, 1.0896928_dbl_kind/) - + real (dbl_kind), parameter :: obrate(poblen) = & ! rates for obliquity cosine series (/ 31.609974_dbl_kind, 32.620504_dbl_kind, 24.172203_dbl_kind, & 31.983787_dbl_kind, 44.828336_dbl_kind, 30.973257_dbl_kind, & @@ -295,7 +295,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & 48.344406_dbl_kind, 55.145460_dbl_kind, 69.000539_dbl_kind, & 11.071350_dbl_kind, 74.291298_dbl_kind, 11.047742_dbl_kind, & 0.636717_dbl_kind, 12.844549_dbl_kind/) - + real (dbl_kind), parameter :: obphas(poblen) = & ! phases for obliquity cosine series (/ 251.9025_dbl_kind, 280.8325_dbl_kind, 128.3057_dbl_kind, & 292.7252_dbl_kind, 15.3747_dbl_kind, 263.7951_dbl_kind, & @@ -313,11 +313,11 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & 256.6114_dbl_kind, 32.1008_dbl_kind, 143.6804_dbl_kind, & 16.8784_dbl_kind, 160.6835_dbl_kind, 27.5932_dbl_kind, & 348.1074_dbl_kind, 82.6496_dbl_kind/) - - ! Cosine/sine series data for computation of eccentricity and fixed vernal - ! equinox longitude of perihelion (fvelp): amplitude, + + ! Cosine/sine series data for computation of eccentricity and fixed vernal + ! equinox longitude of perihelion (fvelp): amplitude, ! rate (arc seconds/year), phase (degrees). - + real (dbl_kind), parameter :: ecamp (pecclen) = & ! ampl for eccen/fvelp cos/sin series (/ 0.01860798_dbl_kind, 0.01627522_dbl_kind, -0.01300660_dbl_kind, & 0.00988829_dbl_kind, -0.00336700_dbl_kind, 0.00333077_dbl_kind, & @@ -326,7 +326,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & 0.00037800_dbl_kind, -0.00033700_dbl_kind, 0.00027600_dbl_kind, & 0.00018200_dbl_kind, -0.00017400_dbl_kind, -0.00012400_dbl_kind, & 0.00001250_dbl_kind/) - + real (dbl_kind), parameter :: ecrate(pecclen) = & ! rates for eccen/fvelp cos/sin series (/ 4.2072050_dbl_kind, 7.3460910_dbl_kind, 17.8572630_dbl_kind, & 17.2205460_dbl_kind, 16.8467330_dbl_kind, 5.1990790_dbl_kind, & @@ -335,7 +335,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & 18.4939800_dbl_kind, 6.1909530_dbl_kind, 18.8677930_dbl_kind, & 17.4255670_dbl_kind, 6.1860010_dbl_kind, 18.4174410_dbl_kind, & 0.6678630_dbl_kind/) - + real (dbl_kind), parameter :: ecphas(pecclen) = & ! phases for eccen/fvelp cos/sin series (/ 28.620089_dbl_kind, 193.788772_dbl_kind, 308.307024_dbl_kind, & 320.199637_dbl_kind, 279.376984_dbl_kind, 87.195000_dbl_kind, & @@ -344,11 +344,11 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & 296.414411_dbl_kind, 145.769910_dbl_kind, 337.237063_dbl_kind, & 152.092288_dbl_kind, 126.839891_dbl_kind, 210.667199_dbl_kind, & 72.108838_dbl_kind/) - - ! Sine series data for computation of moving vernal equinox longitude of - ! perihelion: amplitude (arc seconds), rate (arc sec/year), phase (degrees). - - real (dbl_kind), parameter :: mvamp (pmvelen) = & ! amplitudes for mvelp sine series + + ! Sine series data for computation of moving vernal equinox longitude of + ! perihelion: amplitude (arc seconds), rate (arc sec/year), phase (degrees). + + real (dbl_kind), parameter :: mvamp (pmvelen) = & ! amplitudes for mvelp sine series (/ 7391.0225890_dbl_kind, 2555.1526947_dbl_kind, 2022.7629188_dbl_kind, & -1973.6517951_dbl_kind, 1240.2321818_dbl_kind, 953.8679112_dbl_kind, & -931.7537108_dbl_kind, 872.3795383_dbl_kind, 606.3544732_dbl_kind, & @@ -375,8 +375,8 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & 11.6018181_dbl_kind, -11.2617293_dbl_kind, -10.4664199_dbl_kind, & 10.4333970_dbl_kind, -10.2377466_dbl_kind, 10.1934446_dbl_kind, & -10.1280191_dbl_kind, 10.0289441_dbl_kind, -10.0034259_dbl_kind/) - - real (dbl_kind), parameter :: mvrate(pmvelen) = & ! rates for mvelp sine series + + real (dbl_kind), parameter :: mvrate(pmvelen) = & ! rates for mvelp sine series (/ 31.609974_dbl_kind, 32.620504_dbl_kind, 24.172203_dbl_kind, & 0.636717_dbl_kind, 31.983787_dbl_kind, 3.138886_dbl_kind, & 30.973257_dbl_kind, 44.828336_dbl_kind, 0.991874_dbl_kind, & @@ -431,7 +431,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & 213.5577_dbl_kind, 154.1631_dbl_kind, 232.7153_dbl_kind, & 138.3034_dbl_kind, 204.6609_dbl_kind, 106.5938_dbl_kind, & 250.4676_dbl_kind, 332.3345_dbl_kind, 27.3039_dbl_kind/) - + !---------------------------Local variables---------------------------------- integer(int_kind) :: i ! Index for series summations real (dbl_kind) :: obsum ! Obliquity series summation @@ -444,9 +444,9 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & real (dbl_kind) :: eccen2 ! eccentricity squared real (dbl_kind) :: eccen3 ! eccentricity cubed real (dbl_kind) :: degrad ! degrees to rad conversion - integer (int_kind), parameter :: s_loglev = 0 + integer (int_kind), parameter :: s_loglev = 0 character(len=*),parameter :: subname='(shr_orb_params)' - + !-------------------------- Formats ----------------------------------------- character(len=*),parameter :: F00 = "('(shr_orb_params) ',4a)" character(len=*),parameter :: F01 = "('(shr_orb_params) ',a,i9)" @@ -458,18 +458,18 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & !call icepack_warnings_add(subname//' ') degrad = pi/180._dbl_kind ! degree to radian conversion factor - + if ( log_print .and. s_loglev > 0 ) then write(warnstr,F00) subname//'Calculate characteristics of the orbit:' call icepack_warnings_add(warnstr) end if - + ! Check for flag to use input orbit parameters - + IF ( iyear_AD == SHR_ORB_UNDEF_INT ) THEN ! Check input obliq, eccen, and mvelp to ensure reasonable - + if( obliq == SHR_ORB_UNDEF_REAL )then write(warnstr,F00) subname//' Have to specify orbital parameters:' call icepack_warnings_add(warnstr) @@ -515,7 +515,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & eccen3 = eccen2*eccen ELSE ! Otherwise calculate based on years before present - + if ( log_print .and. s_loglev > 0) then write(warnstr,F01) subname//'Calculate orbit for year: ' , iyear_AD call icepack_warnings_add(warnstr) @@ -533,7 +533,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & call icepack_warnings_setabort(.true.,__FILE__,__LINE__) call icepack_warnings_add(subname//' unreasonable year') end if - + ! The following calculates the earths obliquity, orbital eccentricity ! (and various powers of it) and vernal equinox mean longitude of ! perihelion for years in the past (future = negative of years past), @@ -555,10 +555,10 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & ! 5-10 million year solution. ! ! Years to time of interest must be negative of years before present - ! (1950) in formulas that follow. - + ! (1950) in formulas that follow. + years = - yb4_1950AD - + ! In the summations below, cosine or sine arguments, which end up in ! degrees, must be converted to radians via multiplication by degrad. ! @@ -567,38 +567,38 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & ! degrees via multiplication by psecdeg (arc seconds to degrees conversion ! factor). For obliq, first term is Berger 1978 epsilon star; second ! term is series summation in degrees. - + obsum = 0.0_dbl_kind do i = 1, poblen obsum = obsum + obamp(i)*psecdeg*cos((obrate(i)*psecdeg*years + & obphas(i))*degrad) end do obliq = 23.320556_dbl_kind + obsum - - ! Summation of cosine and sine series for computation of eccentricity - ! (eccen; e in Berger 1978) and fixed vernal equinox longitude of - ! perihelion (fvelp; pi in Berger 1978), which is used for computation - ! of moving vernal equinox longitude of perihelion. Convert the rates, + + ! Summation of cosine and sine series for computation of eccentricity + ! (eccen; e in Berger 1978) and fixed vernal equinox longitude of + ! perihelion (fvelp; pi in Berger 1978), which is used for computation + ! of moving vernal equinox longitude of perihelion. Convert the rates, ! which are in arc seconds, into degrees via multiplication by psecdeg. - + cossum = 0.0_dbl_kind do i = 1, pecclen cossum = cossum+ecamp(i)*cos((ecrate(i)*psecdeg*years+ecphas(i))*degrad) end do - + sinsum = 0.0_dbl_kind do i = 1, pecclen sinsum = sinsum+ecamp(i)*sin((ecrate(i)*psecdeg*years+ecphas(i))*degrad) end do - + ! Use summations to calculate eccentricity - + eccen2 = cossum*cossum + sinsum*sinsum eccen = sqrt(eccen2) eccen3 = eccen2*eccen - + ! A series of cases for fvelp, which is in radians. - + if (abs(cossum) .le. 1.0E-8_dbl_kind) then if (sinsum .eq. 0.0_dbl_kind) then fvelp = 0.0_dbl_kind @@ -616,25 +616,25 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & fvelp = atan(sinsum/cossum) endif endif - + ! Summation of sin series for computation of moving vernal equinox long ! of perihelion (mvelp; omega bar in Berger 1978) in degrees. For mvelp, - ! first term is fvelp in degrees; second term is Berger 1978 psi bar - ! times years and in degrees; third term is Berger 1978 zeta; fourth + ! first term is fvelp in degrees; second term is Berger 1978 psi bar + ! times years and in degrees; third term is Berger 1978 zeta; fourth ! term is series summation in degrees. Convert the amplitudes and rates, - ! which are in arc seconds, into degrees via multiplication by psecdeg. + ! which are in arc seconds, into degrees via multiplication by psecdeg. ! Series summation plus second and third terms constitute Berger 1978 ! psi, which is the general precession. - + mvsum = 0.0_dbl_kind do i = 1, pmvelen mvsum = mvsum + mvamp(i)*psecdeg*sin((mvrate(i)*psecdeg*years + & mvphas(i))*degrad) end do mvelp = fvelp/degrad + 50.439273_dbl_kind*psecdeg*years + 3.392506_dbl_kind + mvsum - + ! Cases to make sure mvelp is between 0 and 360. - + do while (mvelp .lt. 0.0_dbl_kind) mvelp = mvelp + 360.0_dbl_kind end do @@ -643,11 +643,11 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & end do END IF ! end of test on whether to calculate or use input orbital params - + ! Orbit needs the obliquity in radians - + obliqr = obliq*degrad - + ! 180 degrees must be added to mvelp since observations are made from the ! earth and the sun is considered (wrongly for the algorithm) to go around ! the earth. For a more graphic explanation see Appendix B in: @@ -657,22 +657,22 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & ! ! Additionally, orbit will need this value in radians. So mvelp becomes ! mvelpp (mvelp plus pi) - + mvelpp = (mvelp + 180._dbl_kind)*degrad - + ! Set up an argument used several times in lambm0 calculation ahead. - + beta = sqrt(1._dbl_kind - eccen2) - + ! The mean longitude at the vernal equinox (lambda m nought in Berger - ! 1978; in radians) is calculated from the following formula given in + ! 1978; in radians) is calculated from the following formula given in ! Berger 1978. At the vernal equinox the true longitude (lambda in Berger ! 1978) is 0. lambm0 = 2._dbl_kind*((.5_dbl_kind*eccen + .125_dbl_kind*eccen3)*(1._dbl_kind + beta)*sin(mvelpp) & - .250_dbl_kind*eccen2*(.5_dbl_kind + beta)*sin(2._dbl_kind*mvelpp) & + .125_dbl_kind*eccen3*(1._dbl_kind/3._dbl_kind + beta)*sin(3._dbl_kind*mvelpp)) - + if ( log_print ) then write(warnstr,F03) subname//'------ Computed Orbital Parameters ------' call icepack_warnings_add(warnstr) @@ -691,7 +691,7 @@ SUBROUTINE shr_orb_params( iyear_AD , eccen , obliq , mvelp , & write(warnstr,F03) subname//'-----------------------------------------' call icepack_warnings_add(warnstr) end if - + END SUBROUTINE shr_orb_params !=============================================================================== @@ -714,24 +714,24 @@ SUBROUTINE shr_orb_decl(calday ,eccen ,mvelpp ,lambm0 ,obliqr ,delta ,eccf) real (dbl_kind),intent(in) :: calday ! Calendar day, including fraction real (dbl_kind),intent(in) :: eccen ! Eccentricity real (dbl_kind),intent(in) :: obliqr ! Earths obliquity in radians - real (dbl_kind),intent(in) :: lambm0 ! Mean long of perihelion at the + real (dbl_kind),intent(in) :: lambm0 ! Mean long of perihelion at the ! vernal equinox (radians) real (dbl_kind),intent(in) :: mvelpp ! moving vernal equinox longitude ! of perihelion plus pi (radians) real (dbl_kind),intent(out) :: delta ! Solar declination angle in rad real (dbl_kind),intent(out) :: eccf ! Earth-sun distance factor (ie. (1/r)**2) - + !---------------------------Local variables----------------------------- real (dbl_kind),parameter :: dayspy = 365.0_dbl_kind ! days per year real (dbl_kind),parameter :: ve = 80.5_dbl_kind ! Calday of vernal equinox ! assumes Jan 1 = calday 1 - + real (dbl_kind) :: lambm ! Lambda m, mean long of perihelion (rad) real (dbl_kind) :: lmm ! Intermediate argument involving lambm real (dbl_kind) :: lamb ! Lambda, the earths long of perihelion real (dbl_kind) :: invrho ! Inverse normalized sun/earth distance real (dbl_kind) :: sinl ! Sine of lmm - + character(len=*),parameter :: subname='(shr_orb_decl)' ! Compute eccentricity factor and solar declination using @@ -742,7 +742,7 @@ SUBROUTINE shr_orb_decl(calday ,eccen ,mvelpp ,lambm0 ,obliqr ,delta ,eccf) ! Insolation and Quaternary Climatic Changes. J. of the Atmo. Sci. ! 35:2362-2367. ! - ! To get the earths true longitude (position in orbit; lambda in Berger + ! To get the earths true longitude (position in orbit; lambda in Berger ! 1978) which is necessary to find the eccentricity factor and declination, ! must first calculate the mean longitude (lambda m in Berger 1978) at ! the present day. This is done by adding to lambm0 (the mean longitude @@ -750,37 +750,37 @@ SUBROUTINE shr_orb_decl(calday ,eccen ,mvelpp ,lambm0 ,obliqr ,delta ,eccf) ! an increment (delta lambda m in Berger 1978) that is the number of ! days past or before (a negative increment) the vernal equinox divided by ! the days in a model year times the 2*pi radians in a complete orbit. - + lambm = lambm0 + (calday - ve)*2._dbl_kind*pi/dayspy lmm = lambm - mvelpp - + ! The earths true longitude, in radians, is then found from ! the formula in Berger 1978: - + sinl = sin(lmm) lamb = lambm + eccen*(2._dbl_kind*sinl + eccen*(1.25_dbl_kind*sin(2._dbl_kind*lmm) & + eccen*((13.0_dbl_kind/12.0_dbl_kind)*sin(3._dbl_kind*lmm) - 0.25_dbl_kind*sinl))) - + ! Using the obliquity, eccentricity, moving vernal equinox longitude of ! perihelion (plus), and earths true longitude, the declination (delta) ! and the normalized earth/sun distance (rho in Berger 1978; actually inverse - ! rho will be used), and thus the eccentricity factor (eccf), can be + ! rho will be used), and thus the eccentricity factor (eccf), can be ! calculated from formulas given in Berger 1978. - + invrho = (1._dbl_kind + eccen*cos(lamb - mvelpp)) / (1._dbl_kind - eccen*eccen) - + ! Set solar declination and eccentricity factor - + delta = asin(sin(obliqr)*sin(lamb)) eccf = invrho*invrho - + return - + END SUBROUTINE shr_orb_decl #endif !======================================================================= - + end module icepack_orbital - + !======================================================================= diff --git a/columnphysics/icepack_parameters.F90 b/columnphysics/icepack_parameters.F90 index bd3ffee7b..fbb0870db 100644 --- a/columnphysics/icepack_parameters.F90 +++ b/columnphysics/icepack_parameters.F90 @@ -18,11 +18,18 @@ module icepack_parameters public :: icepack_write_parameters public :: icepack_recompute_constants + !----------------------------------------------------------------- + ! control options + !----------------------------------------------------------------- + + character (char_len), public :: & + argcheck = 'first' ! optional argument checks, 'never','first','always' + !----------------------------------------------------------------- ! parameter constants !----------------------------------------------------------------- - integer (kind=int_kind), parameter, public :: & + integer (kind=int_kind), parameter, public :: & nspint = 3 ! number of solar spectral intervals real (kind=dbl_kind), parameter, public :: & @@ -68,7 +75,7 @@ module icepack_parameters ! derived physical constants ! Lfresh = Lsub-Lvap ,&! latent heat of melting of fresh ice (J/kg) ! cprho = cp_ocn*rhow ,&! for ocean mixed layer (J kg / K m^3) - ! Cp = 0.5_dbl_kind*gravit*(rhow-rhoi)*rhoi/rhow ,&! proport const for PE + ! Cp = 0.5_dbl_kind*gravit*(rhow-rhoi)*rhoi/rhow ,&! proport const for PE !----------------------------------------------------------------- real (kind=dbl_kind), public :: & @@ -78,7 +85,7 @@ module icepack_parameters rad_to_deg = spval_const ,&! conversion factor, radians to degrees Lfresh = spval_const ,&! latent heat of melting of fresh ice (J/kg) cprho = spval_const ,&! for ocean mixed layer (J kg / K m^3) - Cp = spval_const ! proport const for PE + Cp = spval_const ! proport const for PE !----------------------------------------------------------------- ! Densities @@ -194,12 +201,12 @@ module icepack_parameters R_ice = c0 ,&! sea ice tuning parameter; +1 > 1sig increase in albedo R_pnd = c0 ,&! ponded ice tuning parameter; +1 > 1sig increase in albedo R_snw = c1p5 ,&! snow tuning parameter; +1 > ~.01 change in broadband albedo - dT_mlt = c1p5 ,&! change in temp for non-melt to melt snow grain + dT_mlt = c1p5 ,&! change in temp for non-melt to melt snow grain ! radius change (C) rsnw_mlt = 1500._dbl_kind,&! maximum melting snow grain radius (10^-6 m) kalg = 0.60_dbl_kind ! algae absorption coefficient for 0.5 m thick layer ! 0.5 m path of 75 mg Chl a / m2 - ! weights for albedos + ! weights for albedos ! 4 Jan 2007 BPB Following are appropriate for complete cloud ! in a summer polar atmosphere with 1.5m bare sea ice surface: ! .636/.364 vis/nir with only 0.5% direct for each band. @@ -218,7 +225,7 @@ module icepack_parameters ! Parameters for dynamics, including ridging and strength !----------------------------------------------------------------------- - integer (kind=int_kind), public :: & ! defined in namelist + integer (kind=int_kind), public :: & ! defined in namelist kstrength = 1, & ! 0 for simple Hibler (1979) formulation ! 1 for Rothrock (1975) pressure formulation krdg_partic = 1, & ! 0 for Thorndike et al. (1975) formulation @@ -226,7 +233,7 @@ module icepack_parameters krdg_redist = 1 ! 0 for Hibler (1980) formulation ! 1 for exponential redistribution function - real (kind=dbl_kind), public :: & + real (kind=dbl_kind), public :: & Cf = 17._dbl_kind ,&! ratio of ridging work to PE change in ridging Pstar = 2.75e4_dbl_kind ,&! constant in Hibler strength formula ! (kstrength = 0) @@ -317,7 +324,7 @@ module icepack_parameters frzpnd = 'cesm' ! pond refreezing parameterization real (kind=dbl_kind), public :: & - dpscale = c1, & ! alter e-folding time scale for flushing + dpscale = c1, & ! alter e-folding time scale for flushing rfracmin = 0.15_dbl_kind, & ! minimum retained fraction of meltwater rfracmax = 0.85_dbl_kind, & ! maximum retained fraction of meltwater pndaspect = 0.8_dbl_kind, & ! ratio of pond depth to area fraction @@ -369,7 +376,7 @@ module icepack_parameters ! Parameters for biogeochemistry !----------------------------------------------------------------------- - character(char_len), public :: & + character(char_len), public :: & ! skl biology parameters bgc_flux_type = 'Jin2006' ! type of ocean-ice piston velocity (or 'constant') @@ -380,7 +387,7 @@ module icepack_parameters dEdd_algae = .false., & ! if .true., algal absorption of shortwave is computed in the skl_bgc = .false. ! if true, solve skeletal biochemistry - real (kind=dbl_kind), public :: & + real (kind=dbl_kind), public :: & phi_snow = p5 , & ! snow porosity grid_o = c5 , & ! for bottom flux initbio_frac = c1 , & ! fraction of ocean trcr concentration in bio trcrs @@ -420,7 +427,7 @@ module icepack_parameters logical (kind=log_kind), public :: & sw_redist = .false. - real (kind=dbl_kind), public :: & + real (kind=dbl_kind), public :: & sw_frac = 0.9_dbl_kind , & ! Fraction of internal shortwave moved to surface sw_dtemp = 0.02_dbl_kind ! temperature difference from melting @@ -434,7 +441,7 @@ module icepack_parameters ! subroutine to set the column package internal parameters subroutine icepack_init_parameters( & - puny_in, bignum_in, pi_in, secday_in, & + argcheck_in, puny_in, bignum_in, pi_in, secday_in, & rhos_in, rhoi_in, rhow_in, cp_air_in, emissivity_in, & cp_ice_in, cp_ocn_in, hfrazilmin_in, floediam_in, & depressT_in, dragio_in, thickness_ocn_layer1_in, iceruf_ocn_in, albocn_in, gravit_in, viscosity_dyn_in, & @@ -486,6 +493,13 @@ subroutine icepack_init_parameters( & snowage_tau_in, snowage_kappa_in, snowage_drdt0_in, & snw_aging_table_in) + !----------------------------------------------------------------- + ! control settings + !----------------------------------------------------------------- + + character(len=*), intent(in), optional :: & + argcheck_in ! optional argument checking, never, first, or always + !----------------------------------------------------------------- ! parameter constants !----------------------------------------------------------------- @@ -551,7 +565,7 @@ subroutine icepack_init_parameters( & character (len=*), intent(in), optional :: & conduct_in, & ! 'MU71' or 'bubbly' fbot_xfer_type_in ! transfer coefficient type for ice-ocean heat flux - + logical (kind=log_kind), intent(in), optional :: & #ifdef UNDEPRECATE_0LAYER heat_capacity_in, &! if true, ice has nonzero heat capacity @@ -565,7 +579,7 @@ subroutine icepack_init_parameters( & real (kind=dbl_kind), intent(in), optional :: & dts_b_in, & ! zsalinity timestep ustar_min_in ! minimum friction velocity for ice-ocean heat flux - + ! mushy thermo real(kind=dbl_kind), intent(in), optional :: & a_rapid_mode_in , & ! channel radius for rapid drainage mode (m) @@ -574,7 +588,7 @@ subroutine icepack_init_parameters( & dSdt_slow_mode_in , & ! slow mode drainage strength (m s-1 K-1) phi_c_slow_mode_in , & ! liquid fraction porosity cutoff for slow mode phi_i_mushy_in ! liquid fraction of congelation ice - + character(len=*), intent(in), optional :: & tfrz_option_in ! form of ocean freezing temperature ! 'minus1p8' = -1.8 C @@ -592,7 +606,7 @@ subroutine icepack_init_parameters( & stefan_boltzmann_in, & ! W/m^2/K^4 kappav_in, & ! vis extnctn coef in ice, wvlngth<700nm (1/m) hi_ssl_in, & ! ice surface scattering layer thickness (m) - hs_ssl_in, & ! visible, direct + hs_ssl_in, & ! visible, direct awtvdr_in, & ! visible, direct ! for history and awtidr_in, & ! near IR, direct ! diagnostics awtvdf_in, & ! visible, diffuse @@ -610,7 +624,7 @@ subroutine icepack_init_parameters( & albsnowv_in , & ! cold snow albedo, visible albsnowi_in , & ! cold snow albedo, near IR ahmax_in ! thickness above which ice albedo is constant (m) - + ! dEdd tuning parameters, set in namelist real (kind=dbl_kind), intent(in), optional :: & R_ice_in , & ! sea ice tuning parameter; +1 > 1sig increase in albedo @@ -624,7 +638,7 @@ subroutine icepack_init_parameters( & logical (kind=log_kind), intent(in), optional :: & sw_redist_in ! redistribute shortwave - real (kind=dbl_kind), intent(in), optional :: & + real (kind=dbl_kind), intent(in), optional :: & sw_frac_in , & ! Fraction of internal shortwave moved to surface sw_dtemp_in ! temperature difference from melting @@ -633,26 +647,26 @@ subroutine icepack_init_parameters( & !----------------------------------------------------------------------- real(kind=dbl_kind), intent(in), optional :: & - Cf_in, & ! ratio of ridging work to PE change in ridging - Pstar_in, & ! constant in Hibler strength formula - Cstar_in, & ! constant in Hibler strength formula + Cf_in, & ! ratio of ridging work to PE change in ridging + Pstar_in, & ! constant in Hibler strength formula + Cstar_in, & ! constant in Hibler strength formula dragio_in, & ! ice-ocn drag coefficient thickness_ocn_layer1_in, & ! thickness of first ocean level (m) iceruf_ocn_in, & ! under-ice roughness (m) gravit_in, & ! gravitational acceleration (m/s^2) iceruf_in ! ice surface roughness (m) - integer (kind=int_kind), intent(in), optional :: & ! defined in namelist - kstrength_in , & ! 0 for simple Hibler (1979) formulation - ! 1 for Rothrock (1975) pressure formulation - krdg_partic_in, & ! 0 for Thorndike et al. (1975) formulation - ! 1 for exponential participation function - krdg_redist_in ! 0 for Hibler (1980) formulation - ! 1 for exponential redistribution function - - real (kind=dbl_kind), intent(in), optional :: & - mu_rdg_in ! gives e-folding scale of ridged ice (m^.5) - ! (krdg_redist = 1) + integer (kind=int_kind), intent(in), optional :: & ! defined in namelist + kstrength_in , & ! 0 for simple Hibler (1979) formulation + ! 1 for Rothrock (1975) pressure formulation + krdg_partic_in, & ! 0 for Thorndike et al. (1975) formulation + ! 1 for exponential participation function + krdg_redist_in ! 0 for Hibler (1980) formulation + ! 1 for exponential redistribution function + + real (kind=dbl_kind), intent(in), optional :: & + mu_rdg_in ! gives e-folding scale of ridged ice (m^.5) + ! (krdg_redist = 1) logical (kind=log_kind), intent(in), optional :: & calc_dragio_in ! if true, calculate dragio from iceruf_ocn and thickness_ocn_layer1 @@ -661,7 +675,7 @@ subroutine icepack_init_parameters( & ! Parameters for atmosphere !----------------------------------------------------------------------- - real (kind=dbl_kind), intent(in), optional :: & + real (kind=dbl_kind), intent(in), optional :: & cp_air_in, & ! specific heat of air (J/kg/K) cp_wv_in, & ! specific heat of water vapor (J/kg/K) zvir_in, & ! rh2o/rair - 1.0 @@ -673,15 +687,15 @@ subroutine icepack_init_parameters( & character (len=*), intent(in), optional :: & atmbndy_in ! atmo boundary method, 'similarity', 'constant' or 'mixed' - + logical (kind=log_kind), intent(in), optional :: & calc_strair_in, & ! if true, calculate wind stress components formdrag_in, & ! if true, calculate form drag highfreq_in ! if true, use high frequency coupling - + integer (kind=int_kind), intent(in), optional :: & natmiter_in ! number of iterations for boundary layer calculations - + ! Flux convergence tolerance real (kind=dbl_kind), intent(in), optional :: atmiter_conv_in @@ -712,15 +726,15 @@ subroutine icepack_init_parameters( & wave_spec_in ! if true, use wave forcing character (len=*), intent(in), optional :: & - wave_spec_type_in ! type of wave spectrum forcing + wave_spec_type_in ! type of wave spectrum forcing !----------------------------------------------------------------------- ! Parameters for biogeochemistry !----------------------------------------------------------------------- - character (len=*), intent(in), optional :: & - bgc_flux_type_in ! type of ocean-ice piston velocity - ! 'constant', 'Jin2006' + character (len=*), intent(in), optional :: & + bgc_flux_type_in ! type of ocean-ice piston velocity + ! 'constant', 'Jin2006' logical (kind=log_kind), intent(in), optional :: & z_tracers_in, & ! if .true., bgc or aerosol tracers are vertically resolved @@ -729,18 +743,18 @@ subroutine icepack_init_parameters( & dEdd_algae_in, & ! if .true., algal absorptionof Shortwave is computed in the modal_aero_in, & ! if .true., use modal aerosol formulation in shortwave conserv_check_in ! if .true., run conservation checks and abort if checks fail - - logical (kind=log_kind), intent(in), optional :: & + + logical (kind=log_kind), intent(in), optional :: & skl_bgc_in, & ! if true, solve skeletal biochemistry solve_zsal_in ! if true, update salinity profile from solve_S_dt - real (kind=dbl_kind), intent(in), optional :: & - grid_o_in , & ! for bottom flux + real (kind=dbl_kind), intent(in), optional :: & + grid_o_in , & ! for bottom flux l_sk_in , & ! characteristic diffusive scale (zsalinity) (m) - initbio_frac_in, & ! fraction of ocean tracer concentration used to initialize tracer - phi_snow_in ! snow porosity at the ice/snow interface + initbio_frac_in, & ! fraction of ocean tracer concentration used to initialize tracer + phi_snow_in ! snow porosity at the ice/snow interface - real (kind=dbl_kind), intent(in), optional :: & + real (kind=dbl_kind), intent(in), optional :: & grid_oS_in , & ! for bottom flux (zsalinity) l_skS_in ! 0.02 characteristic skeletal layer thickness (m) (zsalinity) real (kind=dbl_kind), intent(in), optional :: & @@ -752,15 +766,15 @@ subroutine icepack_init_parameters( & fsal_in , & ! Salinity limitation (ppt) op_dep_min_in , & ! Light attenuates for optical depths exceeding min fr_graze_s_in , & ! fraction of grazing spilled or slopped - fr_graze_e_in , & ! fraction of assimilation excreted + fr_graze_e_in , & ! fraction of assimilation excreted fr_mort2min_in , & ! fractionation of mortality to Am - fr_dFe_in , & ! fraction of remineralized nitrogen + fr_dFe_in , & ! fraction of remineralized nitrogen ! (in units of algal iron) - k_nitrif_in , & ! nitrification rate (1/day) + k_nitrif_in , & ! nitrification rate (1/day) t_iron_conv_in , & ! desorption loss pFe to dFe (day) - max_loss_in , & ! restrict uptake to % of remaining value - max_dfe_doc1_in , & ! max ratio of dFe to saccharides in the ice - ! (nM Fe/muM C) + max_loss_in , & ! restrict uptake to % of remaining value + max_dfe_doc1_in , & ! max ratio of dFe to saccharides in the ice + ! (nM Fe/muM C) fr_resp_s_in , & ! DMSPd fraction of respiration loss as DMSPd y_sk_DMS_in , & ! fraction conversion given high yield t_sk_conv_in , & ! Stefels conversion time (d) @@ -777,18 +791,18 @@ subroutine icepack_init_parameters( & real (kind=dbl_kind), intent(in), optional :: & hs0_in ! snow depth for transition to bare sea ice (m) - + ! level-ice ponds character (len=*), intent(in), optional :: & frzpnd_in ! pond refreezing parameterization - + real (kind=dbl_kind), intent(in), optional :: & - dpscale_in, & ! alter e-folding time scale for flushing + dpscale_in, & ! alter e-folding time scale for flushing rfracmin_in, & ! minimum retained fraction of meltwater rfracmax_in, & ! maximum retained fraction of meltwater pndaspect_in, & ! ratio of pond depth to pond fraction hs1_in ! tapering parameter for snow on pond ice - + ! topo ponds real (kind=dbl_kind), intent(in), optional :: & hp1_in ! critical parameter for pond ice thickness @@ -834,6 +848,11 @@ subroutine icepack_init_parameters( & character(len=*),parameter :: subname='(icepack_init_parameters)' + if (present(argcheck_in) ) argcheck = argcheck_in + if (present(puny_in) ) puny = puny_in + if (present(bignum_in) ) bignum = bignum_in + if (present(pi_in) ) pi = pi_in + if (present(rhos_in) ) rhos = rhos_in if (present(rhoi_in) ) rhoi = rhoi_in if (present(rhow_in) ) rhow = rhow_in @@ -894,9 +913,6 @@ subroutine icepack_init_parameters( & if (present(TTTice_in) ) TTTice = TTTice_in if (present(qqqocn_in) ) qqqocn = qqqocn_in if (present(TTTocn_in) ) TTTocn = TTTocn_in - if (present(puny_in) ) puny = puny_in - if (present(bignum_in) ) bignum = bignum_in - if (present(pi_in) ) pi = pi_in if (present(secday_in) ) secday = secday_in if (present(ktherm_in) ) ktherm = ktherm_in if (present(conduct_in) ) conduct = conduct_in @@ -1109,6 +1125,13 @@ subroutine icepack_init_parameters( & if (present(sw_frac_in) ) sw_frac = sw_frac_in if (present(sw_dtemp_in) ) sw_dtemp = sw_dtemp_in + ! check settings + + if (argcheck /= 'never' .and. argcheck /= 'first' .and. argcheck /= 'always') then + call icepack_warnings_add(subname//' argcheck must be never, first, or always') + call icepack_warnings_setabort(.true.,__FILE__,__LINE__) + endif + call icepack_recompute_constants() if (icepack_warnings_aborted(subname)) return @@ -1120,7 +1143,7 @@ end subroutine icepack_init_parameters ! subroutine to query the column package internal parameters subroutine icepack_query_parameters( & - puny_out, bignum_out, pi_out, rad_to_deg_out,& + argcheck_out, puny_out, bignum_out, pi_out, rad_to_deg_out,& secday_out, c0_out, c1_out, c1p5_out, c2_out, c3_out, c4_out, & c5_out, c6_out, c8_out, c10_out, c15_out, c16_out, c20_out, & c25_out, c100_out, c180_out, c1000_out, p001_out, p01_out, p1_out, & @@ -1177,6 +1200,13 @@ subroutine icepack_query_parameters( & snowage_tau_out, snowage_kappa_out, snowage_drdt0_out, & snw_aging_table_out) + !----------------------------------------------------------------- + ! control settings + !----------------------------------------------------------------- + + character(len=*), intent(out), optional :: & + argcheck_out ! optional argument checking + !----------------------------------------------------------------- ! parameter constants !----------------------------------------------------------------- @@ -1194,7 +1224,7 @@ subroutine icepack_query_parameters( & rad_to_deg_out, & ! conversion factor from radians to degrees Lfresh_out, & ! latent heat of melting of fresh ice (J/kg) cprho_out, & ! for ocean mixed layer (J kg / K m^3) - Cp_out ! proport const for PE + Cp_out ! proport const for PE !----------------------------------------------------------------- ! densities @@ -1251,7 +1281,7 @@ subroutine icepack_query_parameters( & character (len=*), intent(out), optional :: & conduct_out, & ! 'MU71' or 'bubbly' fbot_xfer_type_out ! transfer coefficient type for ice-ocean heat flux - + logical (kind=log_kind), intent(out), optional :: & #ifdef UNDEPRECATE_0LAYER heat_capacity_out,&! if true, ice has nonzero heat capacity @@ -1265,7 +1295,7 @@ subroutine icepack_query_parameters( & real (kind=dbl_kind), intent(out), optional :: & dts_b_out, & ! zsalinity timestep ustar_min_out ! minimum friction velocity for ice-ocean heat flux - + ! mushy thermo real(kind=dbl_kind), intent(out), optional :: & a_rapid_mode_out , & ! channel radius for rapid drainage mode (m) @@ -1274,7 +1304,7 @@ subroutine icepack_query_parameters( & dSdt_slow_mode_out , & ! slow mode drainage strength (m s-1 K-1) phi_c_slow_mode_out , & ! liquid fraction porosity cutoff for slow mode phi_i_mushy_out ! liquid fraction of congelation ice - + character(len=*), intent(out), optional :: & tfrz_option_out ! form of ocean freezing temperature ! 'minus1p8' = -1.8 C @@ -1292,7 +1322,7 @@ subroutine icepack_query_parameters( & stefan_boltzmann_out, & ! W/m^2/K^4 kappav_out, & ! vis extnctn coef in ice, wvlngth<700nm (1/m) hi_ssl_out, & ! ice surface scattering layer thickness (m) - hs_ssl_out, & ! visible, direct + hs_ssl_out, & ! visible, direct awtvdr_out, & ! visible, direct ! for history and awtidr_out, & ! near IR, direct ! diagnostics awtvdf_out, & ! visible, diffuse @@ -1310,13 +1340,13 @@ subroutine icepack_query_parameters( & albsnowv_out , & ! cold snow albedo, visible albsnowi_out , & ! cold snow albedo, near IR ahmax_out ! thickness above which ice albedo is constant (m) - + ! dEdd tuning parameters, set in namelist real (kind=dbl_kind), intent(out), optional :: & R_ice_out , & ! sea ice tuning parameter; +1 > 1sig increase in albedo R_pnd_out , & ! ponded ice tuning parameter; +1 > 1sig increase in albedo R_snw_out , & ! snow tuning parameter; +1 > ~.01 change in broadband albedo - dT_mlt_out , & ! change in temp for non-melt to melt snow grain + dT_mlt_out , & ! change in temp for non-melt to melt snow grain ! radius change (C) rsnw_mlt_out , & ! maximum melting snow grain radius (10^-6 m) kalg_out ! algae absorption coefficient for 0.5 m thick layer @@ -1324,7 +1354,7 @@ subroutine icepack_query_parameters( & logical (kind=log_kind), intent(out), optional :: & sw_redist_out ! redistribute shortwave - real (kind=dbl_kind), intent(out), optional :: & + real (kind=dbl_kind), intent(out), optional :: & sw_frac_out , & ! Fraction of internal shortwave moved to surface sw_dtemp_out ! temperature difference from melting @@ -1333,26 +1363,26 @@ subroutine icepack_query_parameters( & !----------------------------------------------------------------------- real(kind=dbl_kind), intent(out), optional :: & - Cf_out, & ! ratio of ridging work to PE change in ridging - Pstar_out, & ! constant in Hibler strength formula - Cstar_out, & ! constant in Hibler strength formula + Cf_out, & ! ratio of ridging work to PE change in ridging + Pstar_out, & ! constant in Hibler strength formula + Cstar_out, & ! constant in Hibler strength formula dragio_out, & ! ice-ocn drag coefficient thickness_ocn_layer1_out, & ! thickness of first ocean level (m) iceruf_ocn_out, & ! under-ice roughness (m) gravit_out, & ! gravitational acceleration (m/s^2) iceruf_out ! ice surface roughness (m) - integer (kind=int_kind), intent(out), optional :: & ! defined in namelist - kstrength_out , & ! 0 for simple Hibler (1979) formulation - ! 1 for Rothrock (1975) pressure formulation - krdg_partic_out, & ! 0 for Thorndike et al. (1975) formulation - ! 1 for exponential participation function - krdg_redist_out ! 0 for Hibler (1980) formulation - ! 1 for exponential redistribution function - - real (kind=dbl_kind), intent(out), optional :: & - mu_rdg_out ! gives e-folding scale of ridged ice (m^.5) - ! (krdg_redist = 1) + integer (kind=int_kind), intent(out), optional :: & ! defined in namelist + kstrength_out , & ! 0 for simple Hibler (1979) formulation + ! 1 for Rothrock (1975) pressure formulation + krdg_partic_out, & ! 0 for Thorndike et al. (1975) formulation + ! 1 for exponential participation function + krdg_redist_out ! 0 for Hibler (1980) formulation + ! 1 for exponential redistribution function + + real (kind=dbl_kind), intent(out), optional :: & + mu_rdg_out ! gives e-folding scale of ridged ice (m^.5) + ! (krdg_redist = 1) logical (kind=log_kind), intent(out), optional :: & calc_dragio_out ! if true, compute dragio from iceruf_ocn and thickness_ocn_layer1 @@ -1361,7 +1391,7 @@ subroutine icepack_query_parameters( & ! Parameters for atmosphere !----------------------------------------------------------------------- - real (kind=dbl_kind), intent(out), optional :: & + real (kind=dbl_kind), intent(out), optional :: & cp_air_out, & ! specific heat of air (J/kg/K) cp_wv_out, & ! specific heat of water vapor (J/kg/K) zvir_out, & ! rh2o/rair - 1.0 @@ -1373,15 +1403,15 @@ subroutine icepack_query_parameters( & character (len=*), intent(out), optional :: & atmbndy_out ! atmo boundary method, 'similarity', 'constant' or 'mixed' - + logical (kind=log_kind), intent(out), optional :: & calc_strair_out, & ! if true, calculate wind stress components formdrag_out, & ! if true, calculate form drag highfreq_out ! if true, use high frequency coupling - + integer (kind=int_kind), intent(out), optional :: & natmiter_out ! number of iterations for boundary layer calculations - + ! Flux convergence tolerance real (kind=dbl_kind), intent(out), optional :: atmiter_conv_out @@ -1420,7 +1450,7 @@ subroutine icepack_query_parameters( & character (len=*), intent(out), optional :: & bgc_flux_type_out ! type of ocean-ice piston velocity - ! 'constant', 'Jin2006' + ! 'constant', 'Jin2006' logical (kind=log_kind), intent(out), optional :: & z_tracers_out, & ! if .true., bgc or aerosol tracers are vertically resolved @@ -1429,18 +1459,18 @@ subroutine icepack_query_parameters( & dEdd_algae_out, & ! if .true., algal absorptionof Shortwave is computed in the modal_aero_out, & ! if .true., use modal aerosol formulation in shortwave conserv_check_out ! if .true., run conservation checks and abort if checks fail - - logical (kind=log_kind), intent(out), optional :: & + + logical (kind=log_kind), intent(out), optional :: & skl_bgc_out, & ! if true, solve skeletal biochemistry solve_zsal_out ! if true, update salinity profile from solve_S_dt - real (kind=dbl_kind), intent(out), optional :: & - grid_o_out , & ! for bottom flux + real (kind=dbl_kind), intent(out), optional :: & + grid_o_out , & ! for bottom flux l_sk_out , & ! characteristic diffusive scale (zsalinity) (m) - initbio_frac_out, & ! fraction of ocean tracer concentration used to initialize tracer - phi_snow_out ! snow porosity at the ice/snow interface + initbio_frac_out, & ! fraction of ocean tracer concentration used to initialize tracer + phi_snow_out ! snow porosity at the ice/snow interface - real (kind=dbl_kind), intent(out), optional :: & + real (kind=dbl_kind), intent(out), optional :: & grid_oS_out , & ! for bottom flux (zsalinity) l_skS_out ! 0.02 characteristic skeletal layer thickness (m) (zsalinity) real (kind=dbl_kind), intent(out), optional :: & @@ -1452,15 +1482,15 @@ subroutine icepack_query_parameters( & fsal_out , & ! Salinity limitation (ppt) op_dep_min_out , & ! Light attenuates for optical depths exceeding min fr_graze_s_out , & ! fraction of grazing spilled or slopped - fr_graze_e_out , & ! fraction of assimilation excreted + fr_graze_e_out , & ! fraction of assimilation excreted fr_mort2min_out , & ! fractionation of mortality to Am - fr_dFe_out , & ! fraction of remineralized nitrogen + fr_dFe_out , & ! fraction of remineralized nitrogen ! (in units of algal iron) - k_nitrif_out , & ! nitrification rate (1/day) + k_nitrif_out , & ! nitrification rate (1/day) t_iron_conv_out , & ! desorption loss pFe to dFe (day) - max_loss_out , & ! restrict uptake to % of remaining value - max_dfe_doc1_out , & ! max ratio of dFe to saccharides in the ice - ! (nM Fe/muM C) + max_loss_out , & ! restrict uptake to % of remaining value + max_dfe_doc1_out , & ! max ratio of dFe to saccharides in the ice + ! (nM Fe/muM C) fr_resp_s_out , & ! DMSPd fraction of respiration loss as DMSPd y_sk_DMS_out , & ! fraction conversion given high yield t_sk_conv_out , & ! Stefels conversion time (d) @@ -1477,18 +1507,18 @@ subroutine icepack_query_parameters( & real (kind=dbl_kind), intent(out), optional :: & hs0_out ! snow depth for transition to bare sea ice (m) - + ! level-ice ponds character (len=*), intent(out), optional :: & frzpnd_out ! pond refreezing parameterization - + real (kind=dbl_kind), intent(out), optional :: & - dpscale_out, & ! alter e-folding time scale for flushing + dpscale_out, & ! alter e-folding time scale for flushing rfracmin_out, & ! minimum retained fraction of meltwater rfracmax_out, & ! maximum retained fraction of meltwater pndaspect_out, & ! ratio of pond depth to pond fraction hs1_out ! tapering parameter for snow on pond ice - + ! topo ponds real (kind=dbl_kind), intent(out), optional :: & hp1_out ! critical parameter for pond ice thickness @@ -1533,6 +1563,7 @@ subroutine icepack_query_parameters( & character(len=*),parameter :: subname='(icepack_query_parameters)' + if (present(argcheck_out) ) argcheck_out = argcheck if (present(puny_out) ) puny_out = puny if (present(bignum_out) ) bignum_out = bignum if (present(pi_out) ) pi_out = pi @@ -1634,9 +1665,6 @@ subroutine icepack_query_parameters( & if (present(TTTice_out) ) TTTice_out = TTTice if (present(qqqocn_out) ) qqqocn_out = qqqocn if (present(TTTocn_out) ) TTTocn_out = TTTocn - if (present(puny_out) ) puny_out = puny - if (present(bignum_out) ) bignum_out = bignum - if (present(pi_out) ) pi_out = pi if (present(secday_out) ) secday_out = secday if (present(ktherm_out) ) ktherm_out = ktherm if (present(conduct_out) ) conduct_out = conduct @@ -1835,6 +1863,7 @@ subroutine icepack_write_parameters(iounit) write(iounit,*) " TTTice = ",TTTice write(iounit,*) " qqqocn = ",qqqocn write(iounit,*) " TTTocn = ",TTTocn + write(iounit,*) " argcheck = ",argcheck write(iounit,*) " puny = ",puny write(iounit,*) " bignum = ",bignum write(iounit,*) " secday = ",secday diff --git a/columnphysics/icepack_shortwave.F90 b/columnphysics/icepack_shortwave.F90 index be854823d..f152c7eaf 100644 --- a/columnphysics/icepack_shortwave.F90 +++ b/columnphysics/icepack_shortwave.F90 @@ -4,26 +4,26 @@ ! snow over ice, bare ice and ponded ice. ! ! Presently, two methods are included: -! (1) CCSM3 -! (2) Delta-Eddington +! (1) CCSM3 +! (2) Delta-Eddington ! as two distinct routines. ! Either can be called from the ice driver. ! ! The Delta-Eddington method is described here: ! -! Briegleb, B. P., and B. Light (2007): A Delta-Eddington Multiple -! Scattering Parameterization for Solar Radiation in the Sea Ice -! Component of the Community Climate System Model, NCAR Technical +! Briegleb, B. P., and B. Light (2007): A Delta-Eddington Multiple +! Scattering Parameterization for Solar Radiation in the Sea Ice +! Component of the Community Climate System Model, NCAR Technical ! Note NCAR/TN-472+STR February 2007 ! ! name: originally ice_albedo ! ! authors: Bruce P. Briegleb, NCAR ! Elizabeth C. Hunke and William H. Lipscomb, LANL -! 2005, WHL: Moved absorbed_solar from icepack_therm_vertical to this +! 2005, WHL: Moved absorbed_solar from icepack_therm_vertical to this ! module and changed name from ice_albedo ! 2006, WHL: Added Delta Eddington routines from Bruce Briegleb -! 2006, ECH: Changed data statements in Delta Eddington routines (no +! 2006, ECH: Changed data statements in Delta Eddington routines (no ! longer hardwired) ! Converted to free source form (F90) ! 2007, BPB: Completely updated Delta-Eddington code, so that: @@ -84,7 +84,7 @@ module icepack_shortwave hpmin = 0.005_dbl_kind, & ! minimum allowed melt pond depth (m) hp0 = 0.200_dbl_kind ! pond depth below which transition to bare ice - real (kind=dbl_kind), parameter :: & + real (kind=dbl_kind), parameter :: & exp_argmax = c10 ! maximum argument of exponential !======================================================================= @@ -221,19 +221,19 @@ subroutine shortwave_ccsm3 (aicen, vicen, & alidrni = albocn alvdfni = albocn alidfni = albocn - + alvdrns = albocn alidrns = albocn alvdfns = albocn alidfns = albocn - + alvdrn(n) = albocn alidrn(n) = albocn alvdfn(n) = albocn alidfn(n) = albocn - + albin(n) = c0 - albsn(n) = c0 + albsn(n) = c0 fswsfc(n) = c0 fswint(n) = c0 @@ -384,13 +384,13 @@ subroutine compute_albedos (aicen, vicen, & alidrn , & ! near-ir, direct, avg (fraction) alvdfn , & ! visible, diffuse, avg (fraction) alidfn , & ! near-ir, diffuse, avg (fraction) - albin , & ! bare ice - albsn ! snow + albin , & ! bare ice + albsn ! snow ! local variables real (kind=dbl_kind), parameter :: & - dT_melt = c1 , & ! change in temp to give dalb_mlt + dT_melt = c1 , & ! change in temp to give dalb_mlt ! albedo change dalb_mlt = -0.075_dbl_kind, & ! albedo change per dT_melt change ! in temp for ice @@ -418,7 +418,7 @@ subroutine compute_albedos (aicen, vicen, & !----------------------------------------------------------------- hi = vicen / aicen - hs = vsnon / aicen + hs = vsnon / aicen ! bare ice, thickness dependence fh = min(atan(hi*c4)/fhtan,c1) @@ -472,9 +472,9 @@ subroutine compute_albedos (aicen, vicen, & ! save ice and snow albedos (for history) albin = awtvdr*alvdrni + awtidr*alidrni & - + awtvdf*alvdfni + awtidf*alidfni + + awtvdf*alvdfni + awtidf*alidfni albsn = awtvdr*alvdrns + awtidr*alidrns & - + awtvdf*alvdfns + awtidf*alidfns + + awtvdf*alvdfns + awtidf*alidfns end subroutine compute_albedos @@ -510,8 +510,8 @@ subroutine constant_albedos (aicen, & alidrn , & ! near-ir, direct, avg (fraction) alvdfn , & ! visible, diffuse, avg (fraction) alidfn , & ! near-ir, diffuse, avg (fraction) - albin , & ! bare ice - albsn ! snow + albin , & ! bare ice + albsn ! snow ! local variables @@ -567,9 +567,9 @@ subroutine constant_albedos (aicen, & ! save ice and snow albedos (for history) albin = awtvdr*alvdrni + awtidr*alidrni & - + awtvdf*alvdfni + awtidf*alidfni + + awtvdf*alvdfni + awtidf*alidfni albsn = awtvdr*alvdrns + awtidr*alidrns & - + awtvdf*alvdfns + awtidf*alidfns + + awtvdf*alvdfns + awtidf*alidfns end subroutine constant_albedos @@ -606,7 +606,7 @@ subroutine absorbed_solar (nilyr, aicen, & logical(kind=log_kind), intent(in) :: & heat_capacity ! if true, ice has nonzero heat capacity #endif - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & nilyr ! number of ice layers real (kind=dbl_kind), intent(in) :: & @@ -710,10 +710,10 @@ subroutine absorbed_solar (nilyr, aicen, & ! no penetrating radiation in near IR ! fswpenidr = swidr * (c1-alidrni) * (c1-asnow) * i0nir -! fswpenidf = swidf * (c1-alidfni) * (c1-asnow) * i0nir +! fswpenidf = swidf * (c1-alidfni) * (c1-asnow) * i0nir fswpen = fswpenvdr + fswpenvdf - + fswsfc = swabs - fswpen trantop = c1 ! transmittance at top of ice @@ -757,7 +757,7 @@ subroutine absorbed_solar (nilyr, aicen, & ! if zero-layer model (no heat capacity), no SW is absorbed in ice ! interior, so add to surface absorption !---------------------------------------------------------------- - + if (.not. heat_capacity) then ! SW absorbed at snow/ice surface @@ -775,7 +775,7 @@ end subroutine absorbed_solar !======================================================================= ! Begin Delta-Eddington shortwave method -! Compute initial data for Delta-Eddington method, specifically, +! Compute initial data for Delta-Eddington method, specifically, ! the approximate exponential look-up table. ! ! author: Bruce P. Briegleb, NCAR @@ -794,7 +794,7 @@ subroutine run_dEdd(dt, ncat, & #ifdef UNDEPRECATE_0LAYER heat_capacity, & #endif - tlat, tlon, & + tlat, tlon, & calendar_type, & days_per_year, & nextsw_cday, yday, & @@ -856,16 +856,16 @@ subroutine run_dEdd(dt, ncat, & hp1 , & ! critical parameter for pond ice thickness kalg ! algae absorption coefficient - real (kind=dbl_kind), dimension(:,:), intent(in) :: & + real (kind=dbl_kind), dimension(:,:), intent(in) :: & kaer_tab, & ! aerosol mass extinction cross section (m2/kg) waer_tab, & ! aerosol single scatter albedo (fraction) gaer_tab ! aerosol asymmetry parameter (cos(theta)) - + real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) waer_bc_tab, & ! aerosol single scatter albedo (fraction) gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - + real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment bcenh ! BC absorption enhancement factor @@ -909,7 +909,7 @@ subroutine run_dEdd(dt, ncat, & 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) @@ -918,23 +918,23 @@ subroutine run_dEdd(dt, ncat, & 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 + 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) :: & 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) + Iswabsn , & ! SW radiation absorbed in ice layers (W m-2) fswpenln ! visible SW entering ice layers (W m-2) logical (kind=log_kind), intent(in) :: & @@ -976,7 +976,6 @@ 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) :: & @@ -1040,7 +1039,7 @@ subroutine run_dEdd(dt, ncat, & if (tr_pond_cesm) then ! fraction of ice area fpn = apndn(n) - ! pond depth over fraction fpn + ! pond depth over fraction fpn hpn = hpndn(n) ! snow infiltration if (hsn >= hs_min .and. hs0 > puny) then @@ -1090,25 +1089,25 @@ subroutine run_dEdd(dt, ncat, & 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 - + ! not using ipn assumes that lid ice is perfectly clear ! if (ipn <= 0.3_dbl_kind) then - + ! fraction of ice area - fpn = apndn(n) * alvln(n) + fpn = apndn(n) * alvln(n) ! pond depth over fraction fpn hpn = hpndn(n) - + ! reduce effective pond area absorbing surface heat flux ! due to flux already having been used to melt pond ice fpn = (c1 - ffracn(n)) * fpn - + ! taper pond area with snow on pond ice if (dhs > puny .and. spn >= puny .and. hs1 > puny) then asnow = min(spn/hs1, c1) fpn = (c1 - asnow) * fpn endif - + ! infiltrate snow hp = hpn if (hp > puny) then @@ -1143,7 +1142,7 @@ subroutine run_dEdd(dt, ncat, & fpn = c0 endif if (apndn(n) > puny) then - hpn = hpndn(n) + hpn = hpndn(n) else fpn = c0 hpn = c0 @@ -1153,7 +1152,7 @@ subroutine run_dEdd(dt, ncat, & if (hpn < hpmin) fpn = c0 ! If ponds are present snow fraction reduced to - ! non-ponded part dEdd scheme + ! non-ponded part dEdd scheme fsn = min(fsn, c1-fpn) apeffn(n) = fpn @@ -1164,12 +1163,12 @@ subroutine run_dEdd(dt, ncat, & fsn, fpn, & hpn) if (icepack_warnings_aborted(subname)) return - + apeffn(n) = fpn ! for history fpn = c0 hpn = c0 endif ! pond type - + snowfracn(n) = fsn ! for history call shortwave_dEdd(dEdd_algae, & @@ -1190,7 +1189,7 @@ subroutine run_dEdd(dt, ncat, & kaer_bc_tab, & waer_bc_tab, & gaer_bc_tab, & - bcenh, modal_aero, & + bcenh, modal_aero, & kalg, & swvdr, swvdf, & swidr, swidf, & @@ -1234,33 +1233,33 @@ subroutine run_dEdd(dt, ncat, & deallocate(l_fswthrun_idf) end subroutine run_dEdd - + !======================================================================= ! -! Compute snow/bare ice/ponded ice shortwave albedos, absorbed and transmitted +! Compute snow/bare ice/ponded ice shortwave albedos, absorbed and transmitted ! flux using the Delta-Eddington solar radiation method as described in: ! ! A Delta-Eddington Multiple Scattering Parameterization for Solar Radiation ! in the Sea Ice Component of the Community Climate System Model ! B.P.Briegleb and B.Light NCAR/TN-472+STR February 2007 ! -! Compute shortwave albedos and fluxes for three surface types: -! snow over ice, bare ice and ponded ice. -! -! Albedos and fluxes are output for later use by thermodynamic routines. -! Invokes three calls to compute_dEdd, which sets inherent optical properties -! appropriate for the surface type. Within compute_dEdd, a call to solution_dEdd +! Compute shortwave albedos and fluxes for three surface types: +! snow over ice, bare ice and ponded ice. +! +! Albedos and fluxes are output for later use by thermodynamic routines. +! Invokes three calls to compute_dEdd, which sets inherent optical properties +! appropriate for the surface type. Within compute_dEdd, a call to solution_dEdd ! evaluates the Delta-Eddington solution. The final albedos and fluxes are then -! evaluated in compute_dEdd. Albedos and fluxes are transferred to output in +! evaluated in compute_dEdd. Albedos and fluxes are transferred to output in ! this routine. ! ! NOTE regarding albedo diagnostics: This method yields zero albedo values ! if there is no incoming solar and thus the albedo diagnostics are masked -! out when the sun is below the horizon. To estimate albedo from the history +! out when the sun is below the horizon. To estimate albedo from the history ! output (post-processing), compute ice albedo using ! (1 - albedo)*swdn = swabs. -ECH ! -! author: Bruce P. Briegleb, NCAR +! author: Bruce P. Briegleb, NCAR ! 2013: E Hunke merged with NCAR version ! subroutine shortwave_dEdd (dEdd_algae, & @@ -1271,7 +1270,7 @@ subroutine shortwave_dEdd (dEdd_algae, & coszen, & #endif aice, vice, & - hs, fs, & + hs, fs, & rhosnw, rsnw, & fp, hp, & aero, & @@ -1281,7 +1280,7 @@ subroutine shortwave_dEdd (dEdd_algae, & kaer_bc_tab, & waer_bc_tab, & gaer_bc_tab, & - bcenh, modal_aero, & + bcenh, modal_aero, & kalg, & swvdr, swvdf, & swidr, swidf, & @@ -1309,16 +1308,16 @@ subroutine shortwave_dEdd (dEdd_algae, & #endif dEdd_algae, & ! .true. use prognostic chla in dEdd modal_aero ! .true. use modal aerosol treatment - + real (kind=dbl_kind), dimension(:,:), intent(in) :: & ! Modal aerosol treatment kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) waer_bc_tab, & ! aerosol single scatter albedo (fraction) gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - + real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment bcenh ! BC absorption enhancement factor - real (kind=dbl_kind), dimension(:,:), intent(in) :: & + real (kind=dbl_kind), dimension(:,:), intent(in) :: & kaer_tab, & ! aerosol mass extinction cross section (m2/kg) waer_tab, & ! aerosol single scatter albedo (fraction) gaer_tab ! aerosol asymmetry parameter (cos(theta)) @@ -1327,8 +1326,8 @@ subroutine shortwave_dEdd (dEdd_algae, & kalg , & ! algae absorption coefficient R_ice , & ! sea ice tuning parameter; +1 > 1sig increase in albedo R_pnd , & ! ponded ice tuning parameter; +1 > 1sig increase in albedo - aice , & ! concentration of ice - vice , & ! volume of ice + aice , & ! concentration of ice + vice , & ! volume of ice hs , & ! snow depth fs ! horizontal coverage of snow @@ -1339,19 +1338,19 @@ subroutine shortwave_dEdd (dEdd_algae, & zbio ! shortwave tracers (zaero+chla) real (kind=dbl_kind), intent(in) :: & - fp , & ! pond fractional coverage (0 to 1) - hp , & ! pond depth (m) + fp , & ! pond fractional coverage (0 to 1) + hp , & ! pond depth (m) 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) real (kind=dbl_kind), intent(inout) :: & - coszen , & ! cosine of solar zenith angle - alvdr , & ! visible, direct, albedo (fraction) - alvdf , & ! visible, diffuse, albedo (fraction) - alidr , & ! near-ir, direct, albedo (fraction) - alidf , & ! near-ir, diffuse, albedo (fraction) + coszen , & ! cosine of solar zenith angle + alvdr , & ! visible, direct, albedo (fraction) + alvdf , & ! visible, diffuse, albedo (fraction) + alidr , & ! near-ir, direct, albedo (fraction) + alidf , & ! near-ir, diffuse, albedo (fraction) fswsfc , & ! SW absorbed at snow/bare ice/pondedi ice surface (W m-2) fswint , & ! SW interior absorption (below surface, above ocean,W m-2) fswthru ! SW through snow/bare ice/ponded ice into ocean (W m-2) @@ -1361,16 +1360,16 @@ subroutine shortwave_dEdd (dEdd_algae, & fswthru_vdf , & ! vis dif SW through snow/bare ice/ponded ice into ocean (W m-2) fswthru_idr , & ! nir dir SW through snow/bare ice/ponded ice into ocean (W m-2) fswthru_idf ! nir dif SW through snow/bare ice/ponded ice into ocean (W m-2) - + real (kind=dbl_kind), dimension (:), intent(inout) :: & fswpenl , & ! visible SW entering ice layers (W m-2) Sswabs , & ! SW absorbed in snow layer (W m-2) Iswabs ! SW absorbed in ice layer (W m-2) real (kind=dbl_kind), intent(out) :: & - albice , & ! bare ice albedo, for history - albsno , & ! snow albedo, for history - albpnd ! pond albedo, for history + albice , & ! bare ice albedo, for history + albsno , & ! snow albedo, for history + albpnd ! pond albedo, for history logical (kind=log_kind) , intent(in) :: & l_print_point @@ -1389,7 +1388,7 @@ subroutine shortwave_dEdd (dEdd_algae, & integer (kind=int_kind) :: & srftyp ! surface type over ice: (0=air, 1=snow, 2=pond) - + integer (kind=int_kind) :: & k , & ! level index na , & ! aerosol index @@ -1398,7 +1397,7 @@ subroutine shortwave_dEdd (dEdd_algae, & ! (0 layer is included also) real (kind=dbl_kind) :: & - vsno ! volume of snow + vsno ! volume of snow real (kind=dbl_kind) :: & swdn , & ! swvdr(i,j)+swvdf(i,j)+swidr(i,j)+swidf(i,j) @@ -1407,10 +1406,10 @@ subroutine shortwave_dEdd (dEdd_algae, & ! for history real (kind=dbl_kind) :: & - avdrl , & ! visible, direct, albedo (fraction) - avdfl , & ! visible, diffuse, albedo (fraction) - aidrl , & ! near-ir, direct, albedo (fraction) - aidfl ! near-ir, diffuse, albedo (fraction) + avdrl , & ! visible, direct, albedo (fraction) + avdfl , & ! visible, diffuse, albedo (fraction) + aidrl , & ! near-ir, direct, albedo (fraction) + aidfl ! near-ir, diffuse, albedo (fraction) character(len=*),parameter :: subname='(shortwave_dEdd)' @@ -1452,7 +1451,7 @@ subroutine shortwave_dEdd (dEdd_algae, & Iswabs(:) = c0 ! compute aerosol mass path - + aero_mp(:) = c0 if( tr_aero ) then ! check 4 layers for each aerosol, a snow SSL, snow below SSL, @@ -1474,9 +1473,9 @@ subroutine shortwave_dEdd (dEdd_algae, & enddo ! na endif ! if aerosols - ! compute shortwave radiation accounting for snow/ice (both snow over + ! compute shortwave radiation accounting for snow/ice (both snow over ! ice and bare ice) and ponded ice (if any): - + ! sea ice points with sun above horizon netsw = swvdr + swidr + swvdf + swidf if (netsw > puny) then ! sun above horizon @@ -1489,7 +1488,7 @@ subroutine shortwave_dEdd (dEdd_algae, & ! calculate bare sea ice srftyp = 0 - call compute_dEdd(nilyr, nslyr, klev, klevp, & + call compute_dEdd(nilyr, nslyr, klev, klevp, & zbio, dEdd_algae, & #ifdef UNDEPRECATE_0LAYER heat_capacity, fnidr, coszen, & @@ -1513,7 +1512,7 @@ subroutine shortwave_dEdd (dEdd_algae, & Sswabs, & Iswabs, fswpenl) if (icepack_warnings_aborted(subname)) return - + alvdr = alvdr + avdrl *fi alvdf = alvdf + avdfl *fi alidr = alidr + aidrl *fi @@ -1521,10 +1520,10 @@ subroutine shortwave_dEdd (dEdd_algae, & ! for history albice = albice & + awtvdr*avdrl + awtidr*aidrl & - + awtvdf*avdfl + awtidf*aidfl + + awtvdf*avdfl + awtidf*aidfl endif endif - + ! sea ice points with sun above horizon netsw = swvdr + swidr + swvdf + swidf if (netsw > puny) then ! sun above horizon @@ -1534,7 +1533,7 @@ subroutine shortwave_dEdd (dEdd_algae, & ! calculate snow covered sea ice srftyp = 1 - call compute_dEdd(nilyr, nslyr, klev, klevp, & + call compute_dEdd(nilyr, nslyr, klev, klevp, & zbio, dEdd_algae, & #ifdef UNDEPRECATE_0LAYER heat_capacity, fnidr, coszen, & @@ -1558,7 +1557,7 @@ subroutine shortwave_dEdd (dEdd_algae, & Sswabs, & Iswabs, fswpenl) if (icepack_warnings_aborted(subname)) return - + alvdr = alvdr + avdrl *fs alvdf = alvdf + avdfl *fs alidr = alidr + aidrl *fs @@ -1566,10 +1565,10 @@ subroutine shortwave_dEdd (dEdd_algae, & ! for history albsno = albsno & + awtvdr*avdrl + awtidr*aidrl & - + awtvdf*avdfl + awtidf*aidfl + + awtvdf*avdfl + awtidf*aidfl endif endif - + hi = c0 ! sea ice points with sun above horizon @@ -1580,11 +1579,11 @@ subroutine shortwave_dEdd (dEdd_algae, & ! if nonzero pond fraction and sufficient pond depth ! if( fp > puny .and. hp > hpmin ) then if (fp > puny) then - + ! calculate ponded ice srftyp = 2 - call compute_dEdd(nilyr, nslyr, klev, klevp, & + call compute_dEdd(nilyr, nslyr, klev, klevp, & zbio, dEdd_algae, & #ifdef UNDEPRECATE_0LAYER heat_capacity, fnidr, coszen, & @@ -1595,7 +1594,7 @@ subroutine shortwave_dEdd (dEdd_algae, & kaer_tab, waer_tab, gaer_tab, & kaer_bc_tab, waer_bc_tab, gaer_bc_tab, & bcenh, modal_aero, kalg, & - swvdr, swvdf, swidr, swidf, srftyp, & + swvdr, swvdf, swidr, swidf, srftyp, & hs, rhosnw, rsnw, hi, hp, & fp, aero_mp, avdrl, avdfl, & aidrl, aidfl, & @@ -1608,7 +1607,7 @@ subroutine shortwave_dEdd (dEdd_algae, & Sswabs, & Iswabs, fswpenl) if (icepack_warnings_aborted(subname)) return - + alvdr = alvdr + avdrl *fp alvdf = alvdf + avdfl *fp alidr = alidr + aidrl *fp @@ -1616,7 +1615,7 @@ subroutine shortwave_dEdd (dEdd_algae, & ! for history albpnd = albpnd & + awtvdr*avdrl + awtidr*aidrl & - + awtvdf*avdfl + awtidf*aidfl + + awtvdf*avdfl + awtidf*aidfl endif endif @@ -1676,7 +1675,7 @@ subroutine shortwave_dEdd (dEdd_algae, & swab = fswsfc+fswint+fswthru swalb = (1.-swab/(swdn+.0001)) write(warnstr,*) subname, ' swdn swab swalb = ',swdn,swab,swalb - do k = 1, nslyr + do k = 1, nslyr write(warnstr,*) subname, ' snow layer k = ', k, & ' rhosnw = ', & rhosnw(k), & @@ -1684,12 +1683,12 @@ subroutine shortwave_dEdd (dEdd_algae, & rsnw(k) call icepack_warnings_add(warnstr) enddo - do k = 1, nslyr + do k = 1, nslyr write(warnstr,*) subname, ' snow layer k = ', k, & ' Sswabs(k) = ', Sswabs(k) call icepack_warnings_add(warnstr) enddo - do k = 1, nilyr + do k = 1, nilyr write(warnstr,*) subname, ' sea ice layer k = ', k, & ' Iswabs(k) = ', Iswabs(k) call icepack_warnings_add(warnstr) @@ -1701,10 +1700,10 @@ end subroutine shortwave_dEdd !======================================================================= ! -! Evaluate snow/ice/ponded ice inherent optical properties (IOPs), and +! Evaluate snow/ice/ponded ice inherent optical properties (IOPs), and ! then calculate the multiple scattering solution by calling solution_dEdd. ! -! author: Bruce P. Briegleb, NCAR +! author: Bruce P. Briegleb, NCAR ! 2013: E Hunke merged with NCAR version subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & @@ -1737,19 +1736,19 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & klev , & ! number of radiation layers - 1 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), dimension(:,:), intent(in) :: & ! Modal aerosol treatment kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) waer_bc_tab, & ! aerosol single scatter albedo (fraction) gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - + real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & ! Modal aerosol treatment bcenh ! BC absorption enhancement factor @@ -1758,11 +1757,11 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & R_ice , & ! sea ice tuning parameter; +1 > 1sig increase in albedo R_pnd ! ponded ice tuning parameter; +1 > 1sig increase in albedo - real (kind=dbl_kind), dimension(:,:), intent(in) :: & + real (kind=dbl_kind), dimension(:,:), intent(in) :: & kaer_tab, & ! aerosol mass extinction cross section (m2/kg) waer_tab, & ! aerosol single scatter albedo (fraction) gaer_tab ! aerosol asymmetry parameter (cos(theta)) - + real (kind=dbl_kind), intent(in) :: & kalg , & ! algae absorption coefficient fnidr , & ! fraction of direct to total down flux in nir @@ -1771,10 +1770,10 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & swvdf , & ! shortwave down at surface, visible, diffuse (W/m^2) swidr , & ! shortwave down at surface, near IR, direct (W/m^2) swidf ! shortwave down at surface, near IR, diffuse (W/m^2) - + integer (kind=int_kind), intent(in) :: & srftyp ! surface type over ice: (0=air, 1=snow, 2=pond) - + real (kind=dbl_kind), intent(in) :: & hs ! snow thickness (m) @@ -1788,12 +1787,12 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & hi , & ! ice thickness (m) hp , & ! pond depth (m) fi ! snow/bare ice fractional coverage (0 to 1) - + real (kind=dbl_kind), intent(inout) :: & - alvdr , & ! visible, direct, albedo (fraction) - alvdf , & ! visible, diffuse, albedo (fraction) - alidr , & ! near-ir, direct, albedo (fraction) - alidf , & ! near-ir, diffuse, albedo (fraction) + alvdr , & ! visible, direct, albedo (fraction) + alvdf , & ! visible, diffuse, albedo (fraction) + alidr , & ! near-ir, direct, albedo (fraction) + alidf , & ! near-ir, diffuse, albedo (fraction) fswsfc , & ! SW absorbed at snow/bare ice/pondedi ice surface (W m-2) fswint , & ! SW interior absorption (below surface, above ocean,W m-2) fswthru ! SW through snow/bare ice/ponded ice into ocean (W m-2) @@ -1803,7 +1802,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & fswthru_vdf , & ! vis dif SW through snow/bare ice/ponded ice into ocean (W m-2) fswthru_idr , & ! nir dir SW through snow/bare ice/ponded ice into ocean (W m-2) fswthru_idf ! nir dif SW through snow/bare ice/ponded ice into ocean (W m-2) - + real (kind=dbl_kind), dimension (:), intent(inout) :: & fswpenl , & ! visible SW entering ice layers (W m-2) Sswabs , & ! SW absorbed in snow layer (W m-2) @@ -1811,12 +1810,12 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & !----------------------------------------------------------------------- ! -! Set up optical property profiles, based on snow, sea ice and ponded +! Set up optical property profiles, based on snow, sea ice and ponded ! ice IOPs from: ! -! Briegleb, B. P., and B. Light (2007): A Delta-Eddington Multiple -! Scattering Parameterization for Solar Radiation in the Sea Ice -! Component of the Community Climate System Model, NCAR Technical +! Briegleb, B. P., and B. Light (2007): A Delta-Eddington Multiple +! Scattering Parameterization for Solar Radiation in the Sea Ice +! Component of the Community Climate System Model, NCAR Technical ! Note NCAR/TN-472+STR February 2007 ! ! Computes column Delta-Eddington radiation solution for specific @@ -1825,7 +1824,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! Divides solar spectrum into 3 intervals: 0.2-0.7, 0.7-1.19, and ! 1.19-5.0 micro-meters. The latter two are added (using an assumed ! partition of incident shortwave in the 0.7-5.0 micro-meter band between -! the 0.7-1.19 and 1.19-5.0 micro-meter band) to give the final output +! the 0.7-1.19 and 1.19-5.0 micro-meter band) to give the final output ! of 0.2-0.7 visible and 0.7-5.0 near-infrared albedos and fluxes. ! ! Specifies vertical layer optical properties based on input snow depth, @@ -1840,14 +1839,14 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! Please read the following; otherwise, there is 99.9% chance you ! will be confused about indices at some point in time........ :) ! -! CICE4.0 snow treatment has one snow layer above the sea ice. This +! CICE4.0 snow treatment has one snow layer above the sea ice. This ! snow layer has finite heat capacity, so that surface absorption must ! be distinguished from internal. The Delta-Eddington solar radiation ! thus adds extra surface scattering layers to both snow and sea ice. ! Note that in the following, we assume a fixed vertical layer structure -! for the radiation calculation. In other words, we always have the -! structure shown below for one snow and four sea ice layers, but for -! ponded ice the pond fills "snow" layer 1 over the sea ice, and for +! for the radiation calculation. In other words, we always have the +! structure shown below for one snow and four sea ice layers, but for +! ponded ice the pond fills "snow" layer 1 over the sea ice, and for ! bare sea ice the top layers over sea ice are treated as transparent air. ! ! SSL = surface scattering layer for either snow or sea ice @@ -1901,7 +1900,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! for surface heating, and that absorbed in the sea ice DL is ! used for sea ice layer 1 heating. ! -! Basically, vertical profiles of the layer extinction optical depth (tau), +! Basically, vertical profiles of the layer extinction optical depth (tau), ! single scattering albedo (w0) and asymmetry parameter (g) are required over ! the klev+1 layers, where klev+1 = 2 + nslyr + nilyr. All of the surface type ! information and snow/ice iop properties are evaulated in this routine, so @@ -1924,16 +1923,16 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ksnow , & ! level index for snow density and grain size kii ! level starting index for sea ice (nslyr+1) - integer (kind=int_kind), parameter :: & + integer (kind=int_kind), parameter :: & nmbrad = 32 ! number of snow grain radii in tables - - real (kind=dbl_kind) :: & + + real (kind=dbl_kind) :: & avdr , & ! visible albedo, direct (fraction) avdf , & ! visible albedo, diffuse (fraction) aidr , & ! near-ir albedo, direct (fraction) aidf ! near-ir albedo, diffuse (fraction) - - real (kind=dbl_kind) :: & + + real (kind=dbl_kind) :: & fsfc , & ! shortwave absorbed at snow/bare ice/ponded ice surface (W m-2) fint , & ! shortwave absorbed in interior (W m-2) fthru , & ! shortwave through snow/bare ice/ponded ice to ocean (W/m^2) @@ -1942,28 +1941,28 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & fthruidr, & ! nir dir shortwave through snow/bare ice/ponded ice to ocean (W/m^2) fthruidf ! nir dif shortwave through snow/bare ice/ponded ice to ocean (W/m^2) - real (kind=dbl_kind), dimension(nslyr) :: & + real (kind=dbl_kind), dimension(nslyr) :: & Sabs ! shortwave absorbed in snow layer (W m-2) - real (kind=dbl_kind), dimension(nilyr) :: & + real (kind=dbl_kind), dimension(nilyr) :: & Iabs ! shortwave absorbed in ice layer (W m-2) - - real (kind=dbl_kind), dimension(nilyr+1) :: & + + real (kind=dbl_kind), dimension(nilyr+1) :: & fthrul ! shortwave through to ice layers (W m-2) real (kind=dbl_kind), dimension (nspint) :: & wghtns ! spectral weights - - real (kind=dbl_kind), parameter :: & + + real (kind=dbl_kind), parameter :: & cp67 = 0.67_dbl_kind , & ! nir band weight parameter cp78 = 0.78_dbl_kind , & ! nir band weight parameter cp01 = 0.01_dbl_kind ! for ocean visible albedo - + real (kind=dbl_kind), dimension (0:klev) :: & tau , & ! layer extinction optical depth w0 , & ! layer single scattering albedo g ! layer asymmetry parameter - + ! following arrays are defined at model interfaces; 0 is the top of the ! layer above the sea ice; klevp is the sea ice/ocean interface. real (kind=dbl_kind), dimension (0:klevp) :: & @@ -1973,7 +1972,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & rupdir , & ! reflectivity to direct radiation for layers below rupdif , & ! reflectivity to diffuse radiation for layers below rdndif ! reflectivity to diffuse radiation for layers above - + real (kind=dbl_kind), dimension (0:klevp) :: & dfdir , & ! down-up flux at interface due to direct beam at top surface dfdif ! down-up flux at interface due to diffuse beam at top surface @@ -1987,10 +1986,10 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ws , & ! Snow single scattering albedo gs ! Snow asymmetry parameter - real (kind=dbl_kind), dimension(nslyr) :: & + real (kind=dbl_kind), dimension(nslyr) :: & frsnw ! snow grain radius in snow layer * adjustment factor (m) - ! actual used ice and ponded ice IOPs, allowing for tuning + ! actual used ice and ponded ice IOPs, allowing for tuning ! modifications of the above "_mn" value real (kind=dbl_kind), dimension (nspint) :: & ki_ssl , & ! Surface-scattering-layer ice extinction coefficient (/m) @@ -2017,7 +2016,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & dz_ssl , & ! snow or sea ice surface scattering layer thickness fs ! scaling factor to reduce (nilyr<4) or increase (nilyr>4) DL ! extinction coefficient to maintain DL optical depth constant - ! with changing number of sea ice layers, to approximately + ! with changing number of sea ice layers, to approximately ! conserve computed albedo for constant physical depth of sea ! ice when the number of sea ice layers vary real (kind=dbl_kind) :: & @@ -2034,8 +2033,8 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & real (kind=dbl_kind) :: & albodr , & ! spectral ocean albedo to direct rad albodf ! spectral ocean albedo to diffuse rad - - ! for melt pond transition to bare sea ice for small pond depths + + ! for melt pond transition to bare sea ice for small pond depths real (kind=dbl_kind) :: & sig_i , & ! ice scattering coefficient (/m) sig_p , & ! pond scattering coefficient (/m) @@ -2271,7 +2270,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & kii = nslyr + 1 ! initialize albedos and fluxes to 0 - fthrul = c0 + fthrul = c0 Iabs = c0 kabs_chl(:,:) = c0 tzaer(:,:) = c0 @@ -2289,12 +2288,12 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & fthruvdf = c0 fthruidr = c0 fthruidf = c0 - + ! spectral weights - ! weights 2 (0.7-1.19 micro-meters) and 3 (1.19-5.0 micro-meters) - ! are chosen based on 1D calculations using ratio of direct to total - ! 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 + ! weights 2 (0.7-1.19 micro-meters) and 3 (1.19-5.0 micro-meters) + ! are chosen based on 1D calculations using ratio of direct to total + ! 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) @@ -2322,7 +2321,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & dzk(k) = dz enddo endif - + ! ice dz = hi*rnilyr ! empirical reduction in sea ice ssl thickness for ice thinner than 1.5m; @@ -2334,7 +2333,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! set sea ice ssl thickness to half top layer if sea ice thin enough !ech: note this is highly resolution dependent! dz_ssl = min(dz_ssl, dz/c2) - + dzk(kii) = dz_ssl dzk(kii+1) = dz - dz_ssl if (kii+2 <= klev) then @@ -2422,7 +2421,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ksrf = 1 else ! bare sea ice or ponded ice - ksrf = nslyr + 2 + ksrf = nslyr + 2 endif if (tr_bgc_N .and. dEdd_algae) then ! compute kabs_chl for chlorophyll @@ -2431,17 +2430,17 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & enddo else k = klev - kabs_chl(1,k) = kalg*(0.50_dbl_kind/dzk(k)) + kabs_chl(1,k) = kalg*(0.50_dbl_kind/dzk(k)) endif ! kabs_chl !mgf++ if (modal_aero) then - do k=0,klev + do k=0,klev if (k < nslyr+1) then ! define indices for snow layer ! use top rsnw, rhosnw for snow ssl and rest of top layer ksnow = k - min(k-1,0) tmp_gs = frsnw(ksnow) - + ! get grain size index: ! works for 25 < snw_rds < 1625 um: if (tmp_gs < 125) then @@ -2475,8 +2474,8 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! call icepack_warnings_add(warnstr) enddo ! k - if (tr_zaero .and. dEdd_algae) then ! compute kzaero for chlorophyll - do n = 1,n_zaero + if (tr_zaero .and. dEdd_algae) then ! compute kzaero for chlorophyll + do n = 1,n_zaero if (n == 1) then ! interstitial BC do k = 0, klev do ns = 1,nspint ! not weighted by aice @@ -2492,7 +2491,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & enddo elseif (n==2) then ! within-ice BC do k = 0, klev - do ns = 1,nspint + do ns = 1,nspint tzaer(ns,k) = tzaer(ns,k)+kaer_bc_tab(ns,k_bcins(k)) * & bcenh(ns,k_bcins(k),k_bcini(k))* & zbio(nlt_zaero_sw(n)+k)*dzk(k) @@ -2533,19 +2532,19 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & enddo ! nspint enddo enddo - endif !tr_zaero + endif !tr_zaero endif ! modal_aero !----------------------------------------------------------------------- - + ! begin spectral loop do ns = 1, nspint - + ! set optical properties of air/snow/pond overlying sea ice ! air if( srftyp == 0 ) then - do k=0,nslyr + do k=0,nslyr tau(k) = c0 w0(k) = c0 g(k) = c0 @@ -2592,7 +2591,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! aerosol in snow - if (tr_zaero .and. dEdd_algae) then + if (tr_zaero .and. dEdd_algae) then do k = 0,nslyr gzaer(ns,k) = gzaer(ns,k)/(wzaer(ns,k)+puny) wzaer(ns,k) = wzaer(ns,k)/(tzaer(ns,k)+puny) @@ -2611,7 +2610,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & do na=1,4*n_aero,4 ! mgf++ if (modal_aero) then - if (na == 1) then + if (na == 1) then !interstitial BC taer = taer + & aero_mp(na)*kaer_bc_tab(ns,k_bcexs(k)) @@ -2621,7 +2620,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & gaer = gaer + & aero_mp(na)*kaer_bc_tab(ns,k_bcexs(k))* & waer_bc_tab(ns,k_bcexs(k))*gaer_bc_tab(ns,k_bcexs(k)) - elseif (na == 5)then + elseif (na == 5)then !within-ice BC taer = taer + & aero_mp(na)*kaer_bc_tab(ns,k_bcins(k))* & @@ -2686,7 +2685,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & gaer = gaer + & (aero_mp(na+1)/rnslyr)*kaer_bc_tab(ns,k_bcins(k))* & waer_bc_tab(ns,k_bcins(k))*gaer_bc_tab(ns,k_bcins(k)) - + else ! other species (dust) taer = taer + & @@ -2732,9 +2731,9 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! no aerosol in pond enddo ! k endif ! srftyp - + ! set optical properties of sea ice - + ! bare or snow-covered sea ice layers if( srftyp <= 1 ) then ! ssl @@ -2764,7 +2763,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & if( ns == 1 ) then ! total layer absorption optical depth fixed at value ! of kalg*0.50m, independent of actual layer thickness - kabs = kabs + kabs_chl(ns,k) + kabs = kabs + kabs_chl(ns,k) endif sig = ki_int(ns)*wi_int(ns) tau(k) = (kabs+sig)*dzk(k) @@ -2772,7 +2771,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & g(k) = gi_int(ns) ! aerosol in sea ice if (tr_zaero .and. dEdd_algae) then - do k = kii, klev + do k = kii, klev gzaer(ns,k) = gzaer(ns,k)/(wzaer(ns,k)+puny) wzaer(ns,k) = wzaer(ns,k)/(tzaer(ns,k)+puny) g(k) = (g(k)*w0(k)*tau(k) + gzaer(ns,k)*wzaer(ns,k)*tzaer(ns,k)) / & @@ -2781,7 +2780,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & (tau(k) + tzaer(ns,k)) tau(k) = tau(k) + tzaer(ns,k) enddo - elseif (tr_aero) then + elseif (tr_aero) then k = kii ! sea ice SSL taer = c0 waer = c0 @@ -2809,7 +2808,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & waer_bc_tab(ns,k_bcins(k)) gaer = gaer + & aero_mp(na+2)*kaer_bc_tab(ns,k_bcins(k))* & - waer_bc_tab(ns,k_bcins(k))*gaer_bc_tab(ns,k_bcins(k)) + waer_bc_tab(ns,k_bcins(k))*gaer_bc_tab(ns,k_bcins(k)) else ! other species (dust) taer = taer + & @@ -2869,7 +2868,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & gaer = gaer + & (aero_mp(na+3)/rnilyr)*kaer_bc_tab(ns,k_bcins(k))* & waer_bc_tab(ns,k_bcins(k))*gaer_bc_tab(ns,k_bcins(k)) - + else ! other species (dust) taer = taer + & @@ -2953,40 +2952,40 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & enddo ! k endif endif ! small pond depth transition to bare sea ice - endif ! srftyp - + endif ! srftyp + ! set reflectivities for ocean underlying sea ice rns = real(ns-1, kind=dbl_kind) albodr = cp01 * (c1 - min(rns, c1)) albodf = cp01 * (c1 - min(rns, c1)) - + ! layer input properties now completely specified: tau, w0, g, - ! albodr, albodf; now compute the Delta-Eddington solution + ! albodr, albodf; now compute the Delta-Eddington solution ! reflectivities and transmissivities for each layer; then, ! combine the layers going downwards accounting for multiple - ! scattering between layers, and finally start from the + ! scattering between layers, and finally start from the ! 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, & tau, w0, g, albodr, albodf, & trndir, trntdr, trndif, rupdir, rupdif, & - rdndif) + rdndif) if (icepack_warnings_aborted(subname)) return ! the interface reflectivities and transmissivities required ! to evaluate interface fluxes are returned from solution_dEdd; - ! now compute up and down fluxes for each interface, using the + ! now compute up and down fluxes for each interface, using the ! combined layer properties at each interface: ! ! layers interface ! ! --------------------- k ! k - ! --------------------- - - do k = 0, klevp + ! --------------------- + + do k = 0, klevp ! interface scattering refk = c1/(c1 - rdndif(k)*rupdif(k)) ! dir tran ref from below times interface scattering, plus diff @@ -2995,7 +2994,7 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! (trntdr(k)-trndir(k)) & ! *rupdif(k))*refk ! dir tran plus total diff trans times interface scattering plus - ! dir tran with up dir ref and down dif ref times interface scattering + ! dir tran with up dir ref and down dif ref times interface scattering ! fdirdn(k) = trndir(k) + (trntdr(k) & ! - trndir(k) + trndir(k) & ! *rupdir(k)*rdndif(k))*refk @@ -3012,18 +3011,18 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ! dfdif = fdifdn - fdifup dfdif(k) = trndif(k) * (c1 - rupdif(k)) * refk if (dfdif(k) < puny) dfdif(k) = c0 !echmod necessary? - enddo ! k - + enddo ! k + ! calculate final surface albedos and fluxes- ! all absorbed flux above ksrf is included in surface absorption - + if( ns == 1) then ! visible - + swdr = swvdr swdf = swvdf avdr = rupdir(0) avdf = rupdif(0) - + tmp_0 = dfdir(0 )*swdr + dfdif(0 )*swdf tmp_ks = dfdir(ksrf )*swdr + dfdif(ksrf )*swdf tmp_kl = dfdir(klevp)*swdr + dfdif(klevp)*swdf @@ -3032,13 +3031,13 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & do k = nslyr+2, klevp ! Start at DL layer of ice after SSL scattering fthrul(k-nslyr-1) = dfdir(k)*swdr + dfdif(k)*swdf enddo - + fsfc = fsfc + tmp_0 - tmp_ks fint = fint + tmp_ks - tmp_kl fthru = fthru + tmp_kl fthruvdr = fthruvdr + dfdir(klevp)*swdr fthruvdf = fthruvdf + dfdif(klevp)*swdf - + ! if snow covered ice, set snow internal absorption; else, Sabs=0 if( srftyp == 1 ) then ki = 0 @@ -3053,12 +3052,12 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & - (dfdir(kp)*swdr + dfdif(kp)*swdf) enddo ! k endif - + ! complex indexing to insure proper absorptions for sea ice ki = 0 do k=nslyr+2,nslyr+1+nilyr ! for bare ice, DL absorption for sea ice layer 1 - km = k + km = k kp = km + 1 ! modify for top sea ice layer for snow over sea ice if( srftyp == 1 ) then @@ -3073,9 +3072,9 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & + dfdir(km)*swdr + dfdif(km)*swdf & - (dfdir(kp)*swdr + dfdif(kp)*swdf) enddo ! k - + else !if(ns > 1) then ! near IR - + swdr = swidr swdf = swidf @@ -3114,16 +3113,16 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & ki = ki + 1 Sabs(ki) = Sabs(ki) & + (dfdir(km)*swdr + dfdif(km)*swdf & - - (dfdir(kp)*swdr + dfdif(kp)*swdf)) & + - (dfdir(kp)*swdr + dfdif(kp)*swdf)) & * wghtns(ns) enddo ! k endif - + ! complex indexing to insure proper absorptions for sea ice ki = 0 do k=nslyr+2,nslyr+1+nilyr ! for bare ice, DL absorption for sea ice layer 1 - km = k + km = k kp = km + 1 ! modify for top sea ice layer for snow over sea ice if( srftyp == 1 ) then @@ -3139,9 +3138,9 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & - (dfdir(kp)*swdr + dfdif(kp)*swdf)) & * wghtns(ns) enddo ! k - + endif ! ns = 1, ns > 1 - + enddo ! end spectral loop ns ! accumulate fluxes over bare sea ice @@ -3160,29 +3159,29 @@ subroutine compute_dEdd (nilyr, nslyr, klev, klevp, & do k = 1, nslyr Sswabs(k) = Sswabs(k) + Sabs(k)*fi enddo ! k - + do k = 1, nilyr Iswabs(k) = Iswabs(k) + Iabs(k)*fi - - ! bgc layer + + ! bgc layer fswpenl(k) = fswpenl(k) + fthrul(k)* fi if (k == nilyr) then fswpenl(k+1) = fswpenl(k+1) + fthrul(k+1)*fi endif enddo ! k - + #ifdef UNDEPRECATE_0LAYER !---------------------------------------------------------------- - ! if ice has zero heat capacity, no SW can be absorbed + ! if ice has zero heat capacity, no SW can be absorbed ! in the ice/snow interior, so add to surface absorption. ! Note: nilyr = nslyr = 1 for this case !---------------------------------------------------------------- if (.not. heat_capacity) then - + ! SW absorbed at snow/ice surface fswsfc = fswsfc + Iswabs(1) + Sswabs(1) - + ! SW absorbed in ice interior fswint = c0 Iswabs(1) = c0 @@ -3194,7 +3193,7 @@ end subroutine compute_dEdd !======================================================================= ! -! Given input vertical profiles of optical properties, evaluate the +! Given input vertical profiles of optical properties, evaluate the ! monochromatic Delta-Eddington solution. ! ! author: Bruce P. Briegleb, NCAR @@ -3214,16 +3213,16 @@ subroutine solution_dEdd & 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 w0 , & ! layer single scattering albedo g ! layer asymmetry parameter - + real (kind=dbl_kind), intent(in) :: & albodr , & ! ocean albedo to direct rad albodf ! ocean albedo to diffuse rad - + ! following arrays are defined at model interfaces; 0 is the top of the ! layer above the sea ice; klevp is the sea ice/ocean interface. real (kind=dbl_kind), dimension (0:klevp), intent(out) :: & @@ -3255,7 +3254,7 @@ subroutine solution_dEdd & ! Assumes monochromatic (spectrally uniform) properties across a band ! for the input optical parameters. ! -! If total transmission of the direct beam to the interface above a particular +! If total transmission of the direct beam to the interface above a particular ! layer is less than trmin, then no further Delta-Eddington solutions are ! evaluated for layers below. ! @@ -3263,16 +3262,16 @@ subroutine solution_dEdd & ! ! First, we assume that radiation is refracted when entering either ! sea ice at the base of the surface scattering layer, or water (i.e. melt -! pond); we assume that radiation does not refract when entering snow, nor -! upon entering sea ice from a melt pond, nor upon entering the underlying +! pond); we assume that radiation does not refract when entering snow, nor +! upon entering sea ice from a melt pond, nor upon entering the underlying ! ocean from sea ice. ! ! To handle refraction, we define a "fresnel" layer, which physically -! is of neglible thickness and is non-absorbing, which can be combined to -! any sea ice layer or top of melt pond. The fresnel layer accounts for +! is of neglible thickness and is non-absorbing, which can be combined to +! any sea ice layer or top of melt pond. The fresnel layer accounts for ! refraction of direct beam and associated reflection and transmission for -! solar radiation. A fresnel layer is combined with the top of a melt pond -! or to the surface scattering layer of sea ice if no melt pond lies over it. +! solar radiation. A fresnel layer is combined with the top of a melt pond +! or to the surface scattering layer of sea ice if no melt pond lies over it. ! ! Some caution must be exercised for the fresnel layer, because any layer ! to which it is combined is no longer a homogeneous layer, as are all other @@ -3289,11 +3288,11 @@ subroutine solution_dEdd & integer (kind=int_kind) :: & kfrsnl ! radiation interface index for fresnel layer - + ! following variables are defined for each layer; 0 refers to the top - ! layer. In general we must distinguish directions above and below in + ! layer. In general we must distinguish directions above and below in ! the diffuse reflectivity and transmissivity, as layers are not assumed - ! to be homogeneous (apart from the single layer Delta-Edd solutions); + ! to be homogeneous (apart from the single layer Delta-Edd solutions); ! the direct is always from above. real (kind=dbl_kind), dimension (0:klev) :: & rdir , & ! layer reflectivity to direct radiation @@ -3304,14 +3303,14 @@ subroutine solution_dEdd & tdif_b , & ! layer transmission to diffuse radiation from below trnlay ! solar beam transm for layer (direct beam only) - integer (kind=int_kind) :: & + integer (kind=int_kind) :: & k ! level index - + real (kind=dbl_kind), parameter :: & trmin = 0.001_dbl_kind ! minimum total transmission allowed ! total transmission is that due to the direct beam; i.e. it includes ! both the directly transmitted solar beam and the diffuse downwards - ! transmitted radiation resulting from scattering out of the direct beam + ! transmitted radiation resulting from scattering out of the direct beam real (kind=dbl_kind) :: & tautot , & ! layer optical depth wtot , & ! layer single scattering albedo @@ -3323,9 +3322,9 @@ subroutine solution_dEdd & rintfc , & ! reflection (multiple) at an interface refkp1 , & ! interface multiple scattering for k+1 refkm1 , & ! interface multiple scattering for k-1 - tdrrdir , & ! direct tran times layer direct ref + tdrrdir , & ! direct tran times layer direct ref tdndif ! total down diffuse = tot tran - direct tran - + ! perpendicular and parallel relative to plane of incidence and scattering real (kind=dbl_kind) :: & R1 , & ! perpendicular polarization reflection amplitude @@ -3338,21 +3337,21 @@ subroutine solution_dEdd & Rf_dif_b , & ! fresnel reflection to diff radiation from below Tf_dif_a , & ! fresnel transmission to diff radiation from above Tf_dif_b ! fresnel transmission to diff radiation from below - + ! refractive index for sea ice, water; pre-computed, band-independent, ! diffuse fresnel reflectivities - real (kind=dbl_kind), parameter :: & + real (kind=dbl_kind), parameter :: & refindx = 1.310_dbl_kind , & ! refractive index of sea ice (water also) cp063 = 0.063_dbl_kind , & ! diffuse fresnel reflectivity from above cp455 = 0.455_dbl_kind ! diffuse fresnel reflectivity from below - + real (kind=dbl_kind) :: & mu0 , & ! cosine solar zenith angle incident mu0nij ! cosine solar zenith angle in medium below fresnel level - + real (kind=dbl_kind) :: & mu0n ! cosine solar zenith angle in medium - + real (kind=dbl_kind) :: & alp , & ! temporary for alpha gam , & ! temporary for agamm @@ -3398,7 +3397,7 @@ subroutine solution_dEdd & !----------------------------------------------------------------------- - do k = 0, klevp + do k = 0, klevp trndir(k) = c0 trntdr(k) = c0 trndif(k) = c0 @@ -3407,20 +3406,20 @@ subroutine solution_dEdd & rdndif(k) = c0 enddo - ! initialize top interface of top layer + ! initialize top interface of top layer trndir(0) = c1 trntdr(0) = c1 trndif(0) = c1 rdndif(0) = c0 - ! mu0 is cosine solar zenith angle above the fresnel level; make + ! mu0 is cosine solar zenith angle above the fresnel level; make ! sure mu0 is large enough for stable and meaningful radiation ! solution: .01 is like sun just touching horizon with its lower edge mu0 = max(coszen,p01) ! mu0n is cosine solar zenith angle used to compute the layer ! Delta-Eddington solution; it is initially computed to be the - ! value below the fresnel level, i.e. the cosine solar zenith + ! value below the fresnel level, i.e. the cosine solar zenith ! angle below the fresnel level for the refracted solar beam: mu0nij = sqrt(c1-((c1-mu0**2)/(refindx*refindx))) @@ -3431,7 +3430,7 @@ subroutine solution_dEdd & ! at base of sea ice SSL (and top of the sea ice DL); the ! snow SSL counts for one, then the number of snow layers, ! then the sea ice SSL which also counts for one: - if( srftyp < 2 ) kfrsnl = nslyr + 2 + if( srftyp < 2 ) kfrsnl = nslyr + 2 ! proceed down one layer at a time; if the total transmission to ! the interface just above a given layer is less than trmin, then no @@ -3451,7 +3450,7 @@ subroutine solution_dEdd & ! compute next layer Delta-eddington solution only if total transmission ! of radiation to the interface just above the layer exceeds trmin. - + if (trntdr(k) > trmin ) then ! calculation over layers with penetrating radiation @@ -3490,7 +3489,7 @@ subroutine solution_dEdd & amg = alp - gam rdir(k) = apg*rdif_a(k) + amg*(tdif_a(k)*trnlay(k) - c1) tdir(k) = apg*tdif_a(k) + (amg* rdif_a(k)-apg+c1)*trnlay(k) - + ! recalculate rdif,tdif using direct angular integration over rdir,tdir, ! since Delta-Eddington rdif formula is not well-behaved (it is usually ! biased low and can even be negative); use ngmax angles and gaussian @@ -3517,20 +3516,20 @@ subroutine solution_dEdd & enddo ! ng rdif_a(k) = smr/swt tdif_a(k) = smt/swt - + ! homogeneous layer rdif_b(k) = rdif_a(k) tdif_b(k) = tdif_a(k) - ! add fresnel layer to top of desired layer if either - ! air or snow overlies ice; we ignore refraction in ice + ! add fresnel layer to top of desired layer if either + ! air or snow overlies ice; we ignore refraction in ice ! if a melt pond overlies it: if( k == kfrsnl ) then ! compute fresnel reflection and transmission amplitudes ! for two polarizations: 1=perpendicular and 2=parallel to ! the plane containing incident, reflected and refracted rays. - R1 = (mu0 - refindx*mu0n) / & + R1 = (mu0 - refindx*mu0n) / & (mu0 + refindx*mu0n) R2 = (refindx*mu0 - mu0n) / & (refindx*mu0 + mu0n) @@ -3556,7 +3555,7 @@ subroutine solution_dEdd & Rf_dif_b = cp455 Tf_dif_b = c1 - Rf_dif_b - ! the k = kfrsnl layer properties are updated to combined + ! the k = kfrsnl layer properties are updated to combined ! the fresnel (refractive) layer, always taken to be above ! the present layer k (i.e. be the top interface): @@ -3582,31 +3581,31 @@ subroutine solution_dEdd & endif ! k = kfrsnl endif ! trntdr(k) > trmin - + ! initialize current layer properties to zero; only if total ! transmission to the top interface of the current layer exceeds the ! minimum, will these values be computed below: ! Calculate the solar beam transmission, total transmission, and - ! reflectivity for diffuse radiation from below at interface k, + ! reflectivity for diffuse radiation from below at interface k, ! the top of the current layer k: ! ! layers interface - ! - ! --------------------- k-1 + ! + ! --------------------- k-1 ! k-1 ! --------------------- k ! k - ! --------------------- + ! --------------------- ! For k = klevp ! note that we ignore refraction between sea ice and underlying ocean: ! ! layers interface ! - ! --------------------- k-1 + ! --------------------- k-1 ! k-1 ! --------------------- k ! \\\\\\\ ocean \\\\\\\ - + trndir(k+1) = trndir(k)*trnlay(k) refkm1 = c1/(c1 - rdndif(k)*rdif_a(k)) tdrrdir = trndir(k)*rdir(k) @@ -3619,8 +3618,8 @@ subroutine solution_dEdd & enddo ! k end main level loop - ! compute reflectivity to direct and diffuse radiation for layers - ! below by adding succesive layers starting from the underlying + ! compute reflectivity to direct and diffuse radiation for layers + ! below by adding succesive layers starting from the underlying ! ocean and working upwards: ! ! layers interface @@ -3632,7 +3631,7 @@ subroutine solution_dEdd & ! --------------------- rupdir(klevp) = albodr - rupdif(klevp) = albodf + rupdif(klevp) = albodf do k=klev,0,-1 ! interface scattering @@ -3652,10 +3651,10 @@ end subroutine solution_dEdd !======================================================================= ! -! Set snow horizontal coverage, density and grain radius diagnostically +! Set snow horizontal coverage, density and grain radius diagnostically ! for the Delta-Eddington solar radiation method. ! -! author: Bruce P. Briegleb, NCAR +! author: Bruce P. Briegleb, NCAR ! 2013: E Hunke merged with NCAR version subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & @@ -3666,7 +3665,7 @@ subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & rhosnw, rsnw, & rsnow) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & nslyr ! number of snow layers real (kind=dbl_kind), intent(in) :: & @@ -3677,7 +3676,7 @@ subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & real (kind=dbl_kind), intent(in) :: & aice , & ! concentration of ice vsno , & ! volume of snow - Tsfc , & ! surface temperature + Tsfc , & ! surface temperature hs0 ! snow depth for transition to bare sea ice (m) real (kind=dbl_kind), intent(inout) :: & @@ -3712,12 +3711,12 @@ subroutine shortwave_dEdd_set_snow(nslyr, R_snw, & ! set snow horizontal fraction hs = vsno / aice - + if (hs >= hs_min) then fs = c1 if (hs0 > puny) fs = min(hs/hs0, c1) endif - + if (snwgrain) then ! use snow grain tracer do ks = 1, nslyr @@ -3755,7 +3754,7 @@ end subroutine shortwave_dEdd_set_snow ! Set pond fraction and depth diagnostically for ! the Delta-Eddington solar radiation method. ! -! author: Bruce P. Briegleb, NCAR +! author: Bruce P. Briegleb, NCAR ! 2013: E Hunke merged with NCAR version subroutine shortwave_dEdd_set_pond(Tsfc, & @@ -3789,7 +3788,7 @@ subroutine shortwave_dEdd_set_pond(Tsfc, & ! pond fp = 0.3_dbl_kind*fT*(c1-fs) hp = 0.3_dbl_kind*fT*(c1-fs) - + end subroutine shortwave_dEdd_set_pond ! End Delta-Eddington shortwave method @@ -3806,13 +3805,13 @@ subroutine compute_shortwave_trcr(nslyr, & 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 + nilyr ! number of ice layers real (kind=dbl_kind), dimension (:), intent(in) :: & bgcN , & ! Nit tracer @@ -3822,9 +3821,9 @@ subroutine compute_shortwave_trcr(nslyr, & trcrn_bgcsw ! ice on shortwave grid tracers real (kind=dbl_kind), dimension (:), intent(in) :: & - sw_grid , & ! + sw_grid , & ! i_grid ! CICE bio grid - + real(kind=dbl_kind), intent(in) :: & hin , & ! CICE ice thickness hbri ! brine height @@ -3845,7 +3844,7 @@ subroutine compute_shortwave_trcr(nslyr, & icegrid ! correct for large ice surface layers real (kind=dbl_kind):: & - top_conc ! 1% (min_bgc) of surface concentration + top_conc ! 1% (min_bgc) of surface concentration ! when hin > hbri: just used in sw calculation character(len=*),parameter :: subname='(compute_shortwave_trcr)' @@ -3860,7 +3859,7 @@ subroutine compute_shortwave_trcr(nslyr, & do k = 1,nilyr+1 icegrid(k) = sw_grid(k) - enddo + enddo if (sw_grid(1)*hin*c2 > hi_ssl) then icegrid(1) = hi_ssl/c2/hin endif @@ -3879,7 +3878,7 @@ subroutine compute_shortwave_trcr(nslyr, & R_chl2N(n)*F_abs_chl(n)*bgcN(nt_bgc_N(n)-nt_bgc_N(1)+1 + k-1) enddo ! n enddo ! k - + top_conc = trtmp0(nt_bgc_N(1))*min_bgc call remap_zbgc (nilyr+1, & nt_bgc_N(1), & @@ -3888,7 +3887,7 @@ subroutine compute_shortwave_trcr(nslyr, & 1, nblyr+1, & hin, hbri, & icegrid(1:nilyr+1), & - i_grid(1:nblyr+1), top_conc ) + i_grid(1:nblyr+1), top_conc ) if (icepack_warnings_aborted(subname)) return do k = 1, nilyr+1 @@ -3947,7 +3946,7 @@ subroutine compute_shortwave_trcr(nslyr, & + F_abs_chl(nn)*R_chl2N(nn) & * bgcN(nt_bgc_N(nn)-nt_bgc_N(1)+1)*sk_l/hin & * real(nilyr,kind=dbl_kind) - enddo + enddo endif end subroutine compute_shortwave_trcr @@ -4018,10 +4017,10 @@ subroutine icepack_prep_radiation (ncat, nilyr, nslyr, & ! local variables integer (kind=int_kind) :: & - k , & ! vertical index + k , & ! vertical index n ! thickness category index - real (kind=dbl_kind) :: netsw + real (kind=dbl_kind) :: netsw character(len=*),parameter :: subname='(icepack_prep_radiation)' @@ -4150,26 +4149,26 @@ subroutine icepack_step_radiation (dt, ncat, & yday ! day of the year 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(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (:), intent(in) :: & swgrid ! grid for ice tracers used in dEdd scheme - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & + + real (kind=dbl_kind), dimension(:,:), intent(in) :: & kaer_tab, & ! aerosol mass extinction cross section (m2/kg) waer_tab, & ! aerosol single scatter albedo (fraction) gaer_tab ! aerosol asymmetry parameter (cos(theta)) - real (kind=dbl_kind), dimension(:,:), intent(in) :: & + real (kind=dbl_kind), dimension(:,:), intent(in) :: & kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) waer_bc_tab, & ! aerosol single scatter albedo (fraction) gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & - bcenh + real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & + bcenh real (kind=dbl_kind), dimension(:), intent(in) :: & aicen , & ! ice area fraction in each category @@ -4180,7 +4179,7 @@ subroutine icepack_step_radiation (dt, ncat, & apndn , & ! pond area fraction hpndn , & ! pond depth (m) ipndn , & ! pond refrozen lid thickness (m) - fbri ! brine fraction + fbri ! brine fraction real(kind=dbl_kind), dimension(:,:), intent(in) :: & aeron , & ! aerosols (kg/m^3) @@ -4202,9 +4201,9 @@ subroutine icepack_step_radiation (dt, ncat, & dhsn , & ! depth difference for snow on sea ice and pond ice ffracn , & ! fraction of fsurfn used to melt ipond ! albedo components for history - albicen , & ! bare ice - albsnon , & ! snow - albpndn , & ! pond + albicen , & ! bare ice + albsnon , & ! snow + albpndn , & ! pond apeffn ! effective pond area used for radiation calculation real (kind=dbl_kind), dimension(:), intent(inout), optional :: & @@ -4307,7 +4306,7 @@ subroutine icepack_step_radiation (dt, ncat, & if (calc_Tsfc) then if (trim(shortwave) == 'dEdd') then ! delta Eddington - + call run_dEdd(dt, ncat, & dEdd_algae, & nilyr, nslyr, & @@ -4360,7 +4359,7 @@ subroutine icepack_step_radiation (dt, ncat, & l_print_point=l_print_point, & initonly=linitonly) if (icepack_warnings_aborted(subname)) return - + elseif (trim(shortwave) == 'ccsm3') then call shortwave_ccsm3(aicen, vicen, & @@ -4407,7 +4406,7 @@ subroutine icepack_step_radiation (dt, ncat, & if (tr_pond_topo) then do n = 1, ncat - apeffn(n) = c0 + apeffn(n) = c0 if (aicen(n) > puny) then ! Lid effective if thicker than hp1 if (apndn(n)*aicen(n) > puny .and. ipndn(n) < hp1) then @@ -4418,7 +4417,7 @@ subroutine icepack_step_radiation (dt, ncat, & if (apndn(n) < puny) apeffn(n) = c0 endif enddo ! ncat - + endif ! tr_pond_topo ! Initialize for safety @@ -4532,7 +4531,7 @@ real(kind=dbl_kind) function asys(gg,f) asys = (gg - f)/(c1 - f) end function asys - + !======================================================================= end module icepack_shortwave diff --git a/columnphysics/icepack_therm_0layer.F90 b/columnphysics/icepack_therm_0layer.F90 index 9fca9363d..1105b9eaf 100644 --- a/columnphysics/icepack_therm_0layer.F90 +++ b/columnphysics/icepack_therm_0layer.F90 @@ -131,7 +131,7 @@ subroutine zerolayer_temperature(nilyr, nslyr, & fcondbot = c0 converged = .false. - + dTsf_prev = c0 !----------------------------------------------------------------- @@ -143,12 +143,12 @@ subroutine zerolayer_temperature(nilyr, nslyr, & do niter = 1, nitermax if (.not. converged) then - + !----------------------------------------------------------------- ! Update radiative and turbulent fluxes and their derivatives ! with respect to Tsf. !----------------------------------------------------------------- - + call surface_fluxes (Tsf, fswsfc, & rhoa, flw, & potT, Qa, & @@ -160,12 +160,12 @@ subroutine zerolayer_temperature(nilyr, nslyr, & if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- - ! Compute effective ice thickness (includes snow) and thermal - ! conductivity + ! Compute effective ice thickness (includes snow) and thermal + ! conductivity !----------------------------------------------------------------- kratio = kseaice/ksno - + heff = hilyr + kratio * hslyr kh = kseaice / heff @@ -176,10 +176,10 @@ subroutine zerolayer_temperature(nilyr, nslyr, & !----------------------------------------------------------------- fcondtopn = kh * (Tsf - Tbot) - + if (fsurfn < fcondtopn) & Tsf = min (Tsf, -puny) - + !----------------------------------------------------------------- ! Save surface temperature at start of iteration !----------------------------------------------------------------- @@ -203,9 +203,9 @@ subroutine zerolayer_temperature(nilyr, nslyr, & ! (2) Tsf is not oscillating; i.e., if both dTsf(niter) and ! dTsf(niter-1) have magnitudes greater than puny, then ! dTsf(niter)/dTsf(niter-1) cannot be a negative number - ! with magnitude greater than 0.5. + ! with magnitude greater than 0.5. ! (3) abs(dTsf) < Tsf_errmax - ! (4) If Tsf = 0 C, then the downward turbulent/radiative + ! (4) If Tsf = 0 C, then the downward turbulent/radiative ! flux, fsurfn, must be greater than or equal to the downward ! conductive flux, fcondtopn. !----------------------------------------------------------------- @@ -242,7 +242,7 @@ subroutine zerolayer_temperature(nilyr, nslyr, & .and. abs(dTsf_prev) > puny & .and. -dTsf/(dTsf_prev+puny*puny) > p5) then - avg_Tsf = c1 ! average with starting temp + avg_Tsf = c1 ! average with starting temp dTsf = p5 * dTsf converged = .false. endif @@ -302,7 +302,7 @@ subroutine zerolayer_temperature(nilyr, nslyr, & fcondtopn, fcondbot call icepack_warnings_add(warnstr) call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" zerolayer_temperature: Thermo iteration does not converge" ) + call icepack_warnings_add(subname//" zerolayer_temperature: Thermo iteration does not converge" ) return endif @@ -311,7 +311,7 @@ subroutine zerolayer_temperature(nilyr, nslyr, & !----------------------------------------------------------------- if (l_zerolayerchecks) then - if (Tsf < c0 .and. & + if (Tsf < c0 .and. & abs(fcondtopn-fsurfn) > puny) then write(warnstr,*) subname, 'fcondtopn does not equal fsurfn,' @@ -323,7 +323,7 @@ subroutine zerolayer_temperature(nilyr, nslyr, & write(warnstr,*) subname, 'fsurfn=',fsurfn call icepack_warnings_add(warnstr) call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" zerolayer_temperature: fcondtopn /= fsurfn" ) + call icepack_warnings_add(subname//" zerolayer_temperature: fcondtopn /= fsurfn" ) return endif endif ! l_zerolayerchecks diff --git a/columnphysics/icepack_therm_bl99.F90 b/columnphysics/icepack_therm_bl99.F90 index 1c3a3aabb..7aa553c95 100644 --- a/columnphysics/icepack_therm_bl99.F90 +++ b/columnphysics/icepack_therm_bl99.F90 @@ -55,7 +55,7 @@ module icepack_therm_bl99 ! authors William H. Lipscomb, LANL ! C. M. Bitz, UW - subroutine temperature_changes (dt, & + subroutine temperature_changes (dt, & nilyr, nslyr, & rhoa, flw, & potT, Qa, & @@ -65,7 +65,7 @@ subroutine temperature_changes (dt, & hilyr, hslyr, & zqin, zTin, & zqsn, zTsn, & - zSin, & + zSin, & Tsf, Tbot, & fsensn, flatn, & flwoutn, fsurfn, & @@ -202,7 +202,7 @@ subroutine temperature_changes (dt, & Iswabs_tmp , & ! energy to melt through fraction frac of layer Sswabs_tmp , & ! same for snow dswabs , & ! difference in swabs and swabs_tmp - frac + frac logical (kind=log_kind) :: & converged ! = true when local solution has converged @@ -224,7 +224,7 @@ subroutine temperature_changes (dt, & dTi1_prev = c0 dfsens_dT = c0 dflat_dT = c0 - dflwout_dT = c0 + dflwout_dT = c0 einex = c0 dt_rhoi_hlyr = dt / (rhoi*hilyr) ! hilyr > 0 if (hslyr > hs_min/real(nslyr,kind=dbl_kind)) & @@ -256,21 +256,21 @@ subroutine temperature_changes (dt, & call conductivity (l_snow, & nilyr, nslyr, & hilyr, hslyr, & - zTin, kh, zSin) + zTin, kh, zSin) if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- ! Check for excessive absorbed solar radiation that may result in ! temperature overshoots. Convergence is particularly difficult - ! if the starting temperature is already very close to the melting + ! if the starting temperature is already very close to the melting ! temperature and extra energy is added. In that case, or if the ! amount of energy absorbed is greater than the amount needed to - ! melt through a given fraction of a layer, we put the extra + ! melt through a given fraction of a layer, we put the extra ! energy into the surface. ! NOTE: This option is not available if the atmosphere model ! has already computed fsurf. (Unless we adjust fsurf here) !----------------------------------------------------------------- -!mclaren: Should there be an if calc_Tsfc statement here then?? +!mclaren: Should there be an if calc_Tsfc statement here then?? if (sw_redist) then @@ -381,7 +381,7 @@ subroutine temperature_changes (dt, & if (icepack_warnings_aborted(subname)) return ! derivative of heat flux with respect to surface temperature - call dsurface_heat_flux_dTsf(Tsf , rhoa , & + call dsurface_heat_flux_dTsf(Tsf , rhoa , & shcoef , lhcoef , & dfsurf_dT, dflwout_dT, & dfsens_dT, dflat_dT ) @@ -392,7 +392,7 @@ subroutine temperature_changes (dt, & ! If fsurfn < fcondtopn and Tsf = 0, then reset Tsf to slightly less ! than zero (but not less than -puny). !----------------------------------------------------------------- - + if (l_snow) then fcondtopn = kh(1) * (Tsf - zTsn(1)) else @@ -405,7 +405,7 @@ subroutine temperature_changes (dt, & !----------------------------------------------------------------- ! Save surface temperature at start of iteration !----------------------------------------------------------------- - + Tsf_start = Tsf if (Tsf < c0) then @@ -417,7 +417,7 @@ subroutine temperature_changes (dt, & !----------------------------------------------------------------- ! Compute elements of tridiagonal matrix. !----------------------------------------------------------------- - + call get_matrix_elements_calc_Tsfc (nilyr, nslyr, & l_snow, l_cold, & Tsf, Tbot, & @@ -427,11 +427,11 @@ subroutine temperature_changes (dt, & Iswabs, & etai, etas, & sbdiag, diag, & - spdiag, rhs) + spdiag, rhs) if (icepack_warnings_aborted(subname)) return else - + call get_matrix_elements_know_Tsfc (nilyr, nslyr, & l_snow, Tbot, & Tin_init, Tsn_init, & @@ -464,22 +464,22 @@ subroutine temperature_changes (dt, & ! (2) Tsf is not oscillating; i.e., if both dTsf(niter) and ! dTsf(niter-1) have magnitudes greater than puny, then ! dTsf(niter)/dTsf(niter-1) cannot be a negative number - ! with magnitude greater than 0.5. + ! with magnitude greater than 0.5. ! (3) abs(dTsf) < Tsf_errmax - ! (4) If Tsf = 0 C, then the downward turbulent/radiative + ! (4) If Tsf = 0 C, then the downward turbulent/radiative ! flux, fsurfn, must be greater than or equal to the downward ! conductive flux, fcondtopn. - ! (5) The net energy added to the ice per unit time must equal + ! (5) The net energy added to the ice per unit time must equal ! the net change in internal ice energy per unit time, ! withinic the prescribed error ferrmax. ! ! For briny ice (the standard case), zTsn and zTin are limited ! to prevent them from exceeding their melting temperatures. ! (Note that the specific heat formula for briny ice assumes - ! that T < Tmlt.) + ! that T < Tmlt.) ! For fresh ice there is no limiting, since there are cases ! when the only convergent solution has zTsn > 0 and/or zTin > 0. - ! Above-zero temperatures are then reset to zero (with melting + ! Above-zero temperatures are then reset to zero (with melting ! to conserve energy) in the thickness_changes subroutine. !----------------------------------------------------------------- @@ -505,7 +505,7 @@ subroutine temperature_changes (dt, & ! Average only if test 1 or 2 fails. ! Initialize energy. !----------------------------------------------------------------- - + dTsf = Tsf - Tsf_start avg_Tsf = c0 @@ -533,7 +533,7 @@ subroutine temperature_changes (dt, & .and. -dTsf/(dTsf_prev+puny*puny) > p5) then if (l_brine) then ! average with starting temp - avg_Tsf = c1 + avg_Tsf = c1 avg_Tsi = c1 endif dTsf = p5 * dTsf @@ -611,7 +611,7 @@ subroutine temperature_changes (dt, & if (k==1 .and. .not.calc_Tsfc) then dTi1 = zTin(k) - Tin_start(k) - if (niter > 1 & ! condition 2b + if (niter > 1 & ! condition 2b .and. abs(dTi1) > puny & .and. abs(dTi1_prev) > puny & .and. -dTi1/(dTi1_prev+puny*puny) > p5) then @@ -652,7 +652,7 @@ subroutine temperature_changes (dt, & !----------------------------------------------------------------- ! Condition 3: check for large change in Tsf !----------------------------------------------------------------- - + if (abs(dTsf) > Tsf_errmax) then converged = .false. endif @@ -660,7 +660,7 @@ subroutine temperature_changes (dt, & !----------------------------------------------------------------- ! Condition 4: check for fsurfn < fcondtopn with Tsf >= 0 !----------------------------------------------------------------- - + fsurfn = fsurfn + dTsf*dfsurf_dT if (l_snow) then fcondtopn = kh(1) * (Tsf-zTsn(1)) @@ -685,7 +685,7 @@ subroutine temperature_changes (dt, & (zTin(nilyr) - Tbot) ! Flux extra energy out of the ice - fcondbot = fcondbot + einex/dt + fcondbot = fcondbot + einex/dt ferr = abs( (enew-einit)/dt & - (fcondtopn - fcondbot + fswint) ) @@ -705,7 +705,7 @@ subroutine temperature_changes (dt, & endif enddo - endif ! ferr + endif ! ferr endif ! convergence @@ -788,7 +788,7 @@ subroutine temperature_changes (dt, & write(warnstr,*) subname, (zSin(k),k=1,nilyr) call icepack_warnings_add(warnstr) call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" temperature_changes: Thermo iteration does not converge" ) + call icepack_warnings_add(subname//" temperature_changes: Thermo iteration does not converge" ) return endif @@ -821,7 +821,7 @@ subroutine conductivity (l_snow, & logical (kind=log_kind), intent(in) :: & l_snow ! true if snow temperatures are computed - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & nilyr , & ! number of ice layers nslyr ! number of snow layers @@ -984,7 +984,7 @@ end subroutine surface_fluxes ! C. M. Bitz, UW ! ! March 2004 by William H. Lipscomb for multiple snow layers -! April 2008 by E. C. Hunke, divided into two routines based on calc_Tsfc +! April 2008 by E. C. Hunke, divided into two routines based on calc_Tsfc subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & l_snow, l_cold, & @@ -997,7 +997,7 @@ subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & sbdiag, diag, & spdiag, rhs) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & nilyr , & ! number of ice layers nslyr ! number of snow layers @@ -1056,7 +1056,7 @@ subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & spdiag(k) = c0 rhs (k) = c0 enddo - + !----------------------------------------------------------------- ! Compute matrix elements ! @@ -1165,7 +1165,7 @@ subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & ki = nilyr k = ki + nslyr kr = k + 1 - + sbdiag(kr) = -etai(ki) * kh(k) spdiag(kr) = c0 diag (kr) = c1 & @@ -1173,7 +1173,7 @@ subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & rhs (kr) = Tin_init(ki) & + etai(ki)*Iswabs(ki) & + etai(ki)*kh(k+1)*Tbot - + else ! nilyr = 1 !----------------------------------------------------------------- @@ -1202,7 +1202,7 @@ subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & + etai(ki) * kh(k)*Tsf & + etai(ki) * kh(k+1)*Tbot endif - + endif ! nilyr > 1 !----------------------------------------------------------------- @@ -1210,7 +1210,7 @@ subroutine get_matrix_elements_calc_Tsfc (nilyr, nslyr, & !----------------------------------------------------------------- do ki = 2, nilyr-1 - + k = ki + nslyr kr = k + 1 @@ -1234,7 +1234,7 @@ end subroutine get_matrix_elements_calc_Tsfc ! C. M. Bitz, UW ! ! March 2004 by William H. Lipscomb for multiple snow layers -! April 2008 by E. C. Hunke, divided into two routines based on calc_Tsfc +! April 2008 by E. C. Hunke, divided into two routines based on calc_Tsfc subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & l_snow, Tbot, & @@ -1246,7 +1246,7 @@ subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & spdiag, rhs, & fcondtopn) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & nilyr , & ! number of ice layers nslyr ! number of snow layers @@ -1301,7 +1301,7 @@ subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & spdiag(k) = c0 rhs (k) = c0 enddo - + !----------------------------------------------------------------- ! Compute matrix elements ! @@ -1368,7 +1368,7 @@ subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & + etai(ki) * (kh(k) + kh(k+1)) rhs (kr) = Tin_init(ki) & + etai(ki) * Iswabs(ki) - else + else sbdiag(kr) = c0 spdiag(kr) = -etai(ki) * kh(k+1) diag (kr) = c1 & @@ -1385,7 +1385,7 @@ subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & ki = nilyr k = ki + nslyr kr = k + 1 - + sbdiag(kr) = -etai(ki) * kh(k) spdiag(kr) = c0 diag (kr) = c1 & @@ -1393,7 +1393,7 @@ subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & rhs (kr) = Tin_init(ki) & + etai(ki)*Iswabs(ki) & + etai(ki)*kh(k+1)*Tbot - + else ! nilyr = 1 !----------------------------------------------------------------- @@ -1430,7 +1430,7 @@ subroutine get_matrix_elements_know_Tsfc (nilyr, nslyr, & !----------------------------------------------------------------- do ki = 2, nilyr-1 - + k = ki + nslyr kr = k + 1 diff --git a/columnphysics/icepack_therm_itd.F90 b/columnphysics/icepack_therm_itd.F90 index 901d64ef6..7a701916b 100644 --- a/columnphysics/icepack_therm_itd.F90 +++ b/columnphysics/icepack_therm_itd.F90 @@ -7,13 +7,13 @@ ! First icepack_therm_vertical computes vertical growth rates and coupler ! fluxes. Then icepack_therm_itd does thermodynamic calculations not ! needed for coupling. -! +! ! authors William H. Lipscomb, LANL ! C. M. Bitz, UW ! Elizabeth C. Hunke, LANL ! ! 2003: Vectorized by Clifford Chen (Fujitsu) and William Lipscomb -! 2004: Block structure added by William Lipscomb +! 2004: Block structure added by William Lipscomb ! 2006: Streamlined for efficiency by Elizabeth Hunke ! 2014: Column package created by Elizabeth Hunke ! @@ -49,7 +49,7 @@ module icepack_therm_itd use icepack_warnings, only: warnstr, icepack_warnings_add use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted - use icepack_fsd, only: fsd_weld_thermo, icepack_cleanup_fsd, get_subdt_fsd + use icepack_fsd, only: fsd_weld_thermo, icepack_cleanup_fsd, get_subdt_fsd use icepack_itd, only: reduce_area, cleanup_itd use icepack_itd, only: aggregate_area, shift_ice use icepack_itd, only: column_sum, column_conservation_check @@ -57,10 +57,10 @@ module icepack_therm_itd use icepack_mushy_physics, only: liquidus_temperature_mush, enthalpy_mush use icepack_therm_shared, only: hi_min use icepack_zbgc, only: add_new_ice_bgc - use icepack_zbgc, only: lateral_melt_bgc - + use icepack_zbgc, only: lateral_melt_bgc + implicit none - + private public :: linear_itd, & add_new_ice, & @@ -98,13 +98,13 @@ module icepack_therm_itd subroutine linear_itd (ncat, hin_max, & nilyr, nslyr, & - ntrcr, trcr_depend, & + ntrcr, trcr_depend, & trcr_base, n_trcr_strata,& nt_strata, & - aicen_init, vicen_init, & - aicen, trcrn, & - vicen, vsnon, & - aice, aice0, & + aicen_init, vicen_init, & + aicen, trcrn, & + vicen, vsnon, & + aice, aice0, & fpond ) integer (kind=int_kind), intent(in) :: & @@ -192,7 +192,7 @@ subroutine linear_itd (ncat, hin_max, & vbri_init, vbri_final ! briny ice volume summed over categories ! NOTE: Third index of donor, daice, dvice should be ncat-1, - ! except that compilers would have trouble when ncat = 1 + ! except that compilers would have trouble when ncat = 1 integer (kind=int_kind), dimension(ncat) :: & donor ! donor category index @@ -293,7 +293,7 @@ subroutine linear_itd (ncat, hin_max, & endif ! aicen_init > puny if (aicen (n) > puny) then - hicen (n) = vicen(n) / aicen(n) + hicen (n) = vicen(n) / aicen(n) dhicen(n) = hicen(n) - hicen_init(n) else hicen (n) = c0 @@ -473,7 +473,7 @@ subroutine linear_itd (ncat, hin_max, & aicen(1) = aicen(1) - da0 if (tr_pond_topo) & - fpond = fpond - (da0 * trcrn(nt_apnd,1) & + fpond = fpond - (da0 * trcrn(nt_apnd,1) & * trcrn(nt_hpnd,1)) endif ! etamax > 0 @@ -544,7 +544,7 @@ subroutine linear_itd (ncat, hin_max, & daice(n) = c0 dvice(n) = c0 donor(n) = 0 - endif + endif if (dvice(n) < vicen(nd)*puny) then daice(n) = c0 @@ -586,7 +586,7 @@ subroutine linear_itd (ncat, hin_max, & enddo enddo endif - + call shift_ice (ntrcr, ncat, & trcr_depend, & trcr_base, & @@ -624,7 +624,7 @@ subroutine linear_itd (ncat, hin_max, & hicen(1) = hi_min if (tr_pond_topo) & - fpond = fpond - (da0 * trcrn(nt_apnd,1) & + fpond = fpond - (da0 * trcrn(nt_apnd,1) & * trcrn(nt_hpnd,1)) endif @@ -798,8 +798,8 @@ end subroutine fit_line !======================================================================= ! -! Given some added new ice to the base of the existing ice, recalculate -! vertical tracer so that new grid cells are all the same size. +! Given some added new ice to the base of the existing ice, recalculate +! vertical tracer so that new grid cells are all the same size. ! ! author: A. K. Turner, LANL ! @@ -815,7 +815,7 @@ subroutine update_vertical_tracers(nilyr, trc, h1, h2, trc0) h1, & ! old thickness h2, & ! new thickness trc0 ! tracer value of added ice on ice bottom - + ! local variables real(kind=dbl_kind), dimension(nilyr) :: trc2 ! updated tracer temporary @@ -849,7 +849,7 @@ subroutine update_vertical_tracers(nilyr, trc, h1, h2, trc0) ! calculate upper and lower boundary of old cell z1a = ((k1 - 1) * h1) / rnilyr z1b = (k1 * h1) / rnilyr - + ! calculate overlap between old and new cell overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) @@ -861,7 +861,7 @@ subroutine update_vertical_tracers(nilyr, trc, h1, h2, trc0) ! calculate upper and lower boundary of added new ice at bottom z1a = h1 z1b = h2 - + ! calculate overlap between added ice and new cell overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) ! aggregate added ice contribution to new cell @@ -932,7 +932,7 @@ subroutine lateral_melt (dt, ncat, & fhocn , & ! net heat flux to ocean (W/m^2) meltl , & ! lateral ice melt (m/step-->cm/day) fzsal ! salt flux from zsalinity (kg/m2/s) - + real (kind=dbl_kind), dimension (:), intent(in) :: & floe_rad_c , & ! fsd size bin centre in m (radius) floe_binwidth ! fsd size bin width in m (radius) @@ -942,7 +942,7 @@ subroutine lateral_melt (dt, ncat, & real (kind=dbl_kind), dimension(nbtrcr), & intent(inout) :: & - flux_bio ! biology tracer flux from layer bgc (mmol/m^2/s) + flux_bio ! biology tracer flux from layer bgc (mmol/m^2/s) real (kind=dbl_kind), dimension(:), intent(inout) :: & faero_ocn ! aerosol flux to ocean (kg/m^2/s) @@ -1018,9 +1018,9 @@ subroutine lateral_melt (dt, ncat, & f_flx = c0 if (tr_fsd) then - call icepack_cleanup_fsd (ncat, nfsd, trcrn(nt_fsd:nt_fsd+nfsd-1,:)) + call icepack_cleanup_fsd (ncat, nfsd, trcrn(nt_fsd:nt_fsd+nfsd-1,:)) if (icepack_warnings_aborted(subname)) return - + afsdn = trcrn(nt_fsd:nt_fsd+nfsd-1,:) aicen_init = aicen afsdn_init = afsdn ! for diagnostics @@ -1056,7 +1056,7 @@ subroutine lateral_melt (dt, ncat, & if (G_radialn(n) < -puny) then - + if (any(afsdn(:,n) < c0)) print*,& 'lateral_melt B afsd < 0',n @@ -1073,7 +1073,7 @@ subroutine lateral_melt (dt, ncat, & delta_an(n) = delta_an(n) - cat1_arealoss if (delta_an(n) > c0) print*,'ERROR delta_an > 0', delta_an(n) - + ! following original code, not necessary for fsd if (aicen(n) > c0) rsiden(n) = MIN(-delta_an(n)/aicen(n),c1) @@ -1135,7 +1135,7 @@ subroutine lateral_melt (dt, ncat, & nsubt = nsubt + 1 if (nsubt.gt.100) & print *, 'latm not converging' - + ! finite differences df_flx(:) = c0 f_flx (:) = c0 @@ -1144,7 +1144,7 @@ subroutine lateral_melt (dt, ncat, & end do do k = 1, nfsd - df_flx(k) = f_flx(k+1) - f_flx(k) + df_flx(k) = f_flx(k+1) - f_flx(k) end do if (abs(sum(df_flx(:))) > puny) & @@ -1152,7 +1152,7 @@ subroutine lateral_melt (dt, ncat, & ! this term ensures area conservation tmp = SUM(afsd_tmp(:)/floe_rad_c(:)) - + ! fsd tendency do k = 1, nfsd d_afsd_tmp(k) = -df_flx(k) + c2 * G_radialn(n) * afsd_tmp(k) & @@ -1169,10 +1169,10 @@ subroutine lateral_melt (dt, ncat, & END DO - + afsdn(:,n) = afsd_tmp(:) - + end if ! aicen end if ! rside > 0, otherwise do nothing @@ -1217,7 +1217,7 @@ subroutine lateral_melt (dt, ncat, & !----------------------------------------------------------------- ! Biogeochemistry - !----------------------------------------------------------------- + !----------------------------------------------------------------- if (z_tracers) then ! snow tracers dvssl = min(p5*vsnon(n)/real(nslyr,kind=dbl_kind), hs_ssl*aicen(n)) ! snow surface layer @@ -1374,16 +1374,16 @@ subroutine add_new_ice (ncat, nilyr, & real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate integer (kind=int_kind), intent(in) :: & nbtrcr ! number of biology tracers real (kind=dbl_kind), dimension (:), intent(inout) :: & - flux_bio ! tracer flux to ocean from biology (mmol/m^2/s) - + flux_bio ! tracer flux to ocean from biology (mmol/m^2/s) + real (kind=dbl_kind), dimension (:), intent(in) :: & ocean_bio ! ocean concentration of biological tracer @@ -1437,7 +1437,6 @@ subroutine add_new_ice (ncat, nilyr, & real (kind=dbl_kind) :: & ai0new , & ! area of new ice added to cat 1 vi0new , & ! volume of new ice added to cat 1 - vi0new_lat , & ! volume of new ice added laterally to fsd hsurp , & ! thickness of new ice added to each cat fnew , & ! heat flx to open water for new ice (W/m^2) hi0new , & ! thickness of new ice @@ -1484,11 +1483,7 @@ subroutine add_new_ice (ncat, nilyr, & real (kind=dbl_kind), dimension (ncat) :: & vin0new ! volume of new ice added to any thickness cat - real (kind=dbl_kind), dimension (nfsd) :: & - afsd_ni ! areal mFSTD after new ice added - real (kind=dbl_kind) :: & - tmp, & latsurf_area, & ! fractional area of ice on sides of floes lead_area , & ! fractional area of ice in lead region G_radial , & ! lateral melt rate (m/s) @@ -1614,7 +1609,7 @@ subroutine add_new_ice (ncat, nilyr, & if (update_ocn_f) then if (ktherm <= 1) then - dfresh = -rhoi*vi0new/dt + dfresh = -rhoi*vi0new/dt dfsalt = ice_ref_salinity*p001*dfresh fresh = fresh + dfresh fsalt = fsalt + dfsalt @@ -1702,7 +1697,7 @@ subroutine add_new_ice (ncat, nilyr, & ! ! The mushy formulation (ktherm=2) puts the new ice only at the ! bottom of existing ice and adjusts the layers accordingly. - ! The other formulations distribute the new ice throughout the + ! The other formulations distribute the new ice throughout the ! existing ice column. !----------------------------------------------------------------- @@ -1780,9 +1775,9 @@ subroutine add_new_ice (ncat, nilyr, & trcrn(nt_qice+k-1,n) = & (trcrn(nt_qice+k-1,n)*vtmp + qi0new*vsurp) / vicen(n) ! salinity - if (.not. solve_zsal) & + if (.not. solve_zsal) & trcrn(nt_sice+k-1,n) = & - (trcrn(nt_sice+k-1,n)*vtmp + Sprofile(k)*vsurp) / vicen(n) + (trcrn(nt_sice+k-1,n)*vtmp + Sprofile(k)*vsurp) / vicen(n) endif enddo ! k endif ! ktherm @@ -1802,7 +1797,7 @@ subroutine add_new_ice (ncat, nilyr, & ncats = 1 ! add new ice to category 1 by default if (tr_fsd) ncats = ncat ! add new ice laterally to all categories - + do n = 1, ncats @@ -1812,7 +1807,7 @@ subroutine add_new_ice (ncat, nilyr, & vice1 = vicen(n) ! save area2(n) = aicen_init(n) + d_an_latg(n) ! save area after latg, before newi aicen(n) = aicen(n) + d_an_tot(n) ! after lateral growth and new ice growth - + aice0 = aice0 - d_an_tot(n) vicen(n) = vicen(n) + vin0new(n) @@ -1840,8 +1835,8 @@ subroutine add_new_ice (ncat, nilyr, & afsdn, aicen_init, & aicen, trcrn) - if (icepack_warnings_aborted(subname)) return - + if (icepack_warnings_aborted(subname)) return + if (vicen(n) > puny) then if (tr_iage) & trcrn(nt_iage,n) = (trcrn(nt_iage,n)*vice1 + dt*vin0new(n))/vicen(n) @@ -1943,7 +1938,7 @@ subroutine add_new_ice (ncat, nilyr, & !----------------------------------------------------------------- ! Biogeochemistry - !----------------------------------------------------------------- + !----------------------------------------------------------------- if (tr_brine .or. nbtrcr > 0) & call add_new_ice_bgc(dt, nblyr, & ncat, nilyr, nltrcr, & @@ -2050,9 +2045,9 @@ subroutine icepack_step_therm2 (dt, ncat, nltrcr, & real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), dimension(:), intent(in) :: & salinz , & ! initial salinity profile @@ -2082,7 +2077,7 @@ subroutine icepack_step_therm2 (dt, ncat, nltrcr, & real (kind=dbl_kind), dimension(:,:), intent(inout) :: & trcrn ! tracers - + logical (kind=log_kind), dimension(:), intent(inout) :: & first_ice ! true until ice forms @@ -2171,13 +2166,13 @@ subroutine icepack_step_therm2 (dt, ncat, nltrcr, & call linear_itd (ncat, hin_max, & nilyr, nslyr, & ntrcr, trcr_depend, & - trcr_base, & + trcr_base, & n_trcr_strata, & nt_strata, & aicen_init, & vicen_init, & aicen, & - trcrn, & + trcrn, & vicen, & vsnon, & aice , & @@ -2257,7 +2252,7 @@ subroutine icepack_step_therm2 (dt, ncat, nltrcr, & !----------------------------------------------------------------- ! For the special case of a single category, adjust the area and ! volume (assuming that half the volume change decreases the - ! thickness, and the other half decreases the area). + ! thickness, and the other half decreases the area). !----------------------------------------------------------------- !echmod: test this @@ -2277,7 +2272,7 @@ subroutine icepack_step_therm2 (dt, ncat, nltrcr, & ncat, hin_max, & aicen, trcrn(1:ntrcr,:), & vicen, vsnon, & - aice0, aice, & + aice0, aice, & n_aero, & nbtrcr, nblyr, & tr_aero, & @@ -2292,7 +2287,7 @@ subroutine icepack_step_therm2 (dt, ncat, nltrcr, & fpond, fresh, & fsalt, fhocn, & faero_ocn, l_fiso_ocn, & - fzsal, flux_bio) + fzsal, flux_bio) if (icepack_warnings_aborted(subname)) return if (present(fiso_ocn)) then diff --git a/columnphysics/icepack_therm_mushy.F90 b/columnphysics/icepack_therm_mushy.F90 index 54a228ca3..80abd03f5 100644 --- a/columnphysics/icepack_therm_mushy.F90 +++ b/columnphysics/icepack_therm_mushy.F90 @@ -30,7 +30,7 @@ module icepack_therm_mushy permeability real(kind=dbl_kind), parameter :: & - dTemp_errmax = 5.0e-4_dbl_kind ! max allowed change in temperature + dTemp_errmax = 5.0e-4_dbl_kind ! max allowed change in temperature ! between iterations !======================================================================= @@ -64,10 +64,10 @@ subroutine temperature_changes_salinity(dt, & integer (kind=int_kind), intent(in) :: & nilyr , & ! number of ice layers nslyr ! number of snow layers - + real (kind=dbl_kind), intent(in) :: & dt ! time step (s) - + real (kind=dbl_kind), intent(in) :: & rhoa , & ! air density (kg/m^3) flw , & ! incoming longwave radiation (W/m^2) @@ -77,11 +77,11 @@ subroutine temperature_changes_salinity(dt, & lhcoef , & ! transfer coefficient for latent heat Tbot , & ! ice bottom surfce temperature (deg C) sss ! sea surface salinity (PSU) - + real (kind=dbl_kind), intent(inout) :: & fswsfc , & ! SW absorbed at ice/snow surface (W m-2) fswint ! SW absorbed in ice interior below surface (W m-2) - + real (kind=dbl_kind), intent(inout) :: & hilyr , & ! ice layer thickness (m) hslyr , & ! snow layer thickness (m) @@ -93,14 +93,14 @@ subroutine temperature_changes_salinity(dt, & 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 fcondtop , & ! downward cond flux at top surface (W m-2) fsensn , & ! surface downward sensible heat (W m-2) flatn , & ! surface downward latent heat (W m-2) flwoutn ! upward LW at surface (W m-2) - + real (kind=dbl_kind), intent(out):: & fcondbot , & ! downward cond flux at bottom surface (W m-2) fadvheat , & ! flow of heat to ocean due to advection (W m-2) @@ -115,7 +115,7 @@ subroutine temperature_changes_salinity(dt, & zSin , & ! internal ice layer salinities zqsn , & ! snow layer enthalpy (J m-3) zTsn ! internal snow layer temperatures - + ! local variables real(kind=dbl_kind), dimension(1:nilyr) :: & zqin0 , & ! ice layer enthalpy (J m-3) at start of timestep @@ -189,7 +189,7 @@ subroutine temperature_changes_salinity(dt, & phi, nilyr, & hin, hsn, & hilyr, & - hpond, apond, & + hpond, apond, & dt, w) if (icepack_warnings_aborted(subname)) return @@ -202,7 +202,7 @@ subroutine temperature_changes_salinity(dt, & sss, qocn, & hilyr, hin) if (icepack_warnings_aborted(subname)) return - + ! calculate the conductivities call conductivity_mush_array(nilyr, zqin0, zSin0, km) if (icepack_warnings_aborted(subname)) return @@ -210,15 +210,15 @@ subroutine temperature_changes_salinity(dt, & !----------------------------------------------------------------- ! Check for excessive absorbed solar radiation that may result in ! temperature overshoots. Convergence is particularly difficult - ! if the starting temperature is already very close to the melting + ! if the starting temperature is already very close to the melting ! temperature and extra energy is added. In that case, or if the ! amount of energy absorbed is greater than the amount needed to - ! melt through a given fraction of a layer, we put the extra + ! melt through a given fraction of a layer, we put the extra ! energy into the surface. ! NOTE: This option is not available if the atmosphere model ! has already computed fsurf. (Unless we adjust fsurf here) !----------------------------------------------------------------- -!mclaren: Should there be an if calc_Tsfc statement here then?? +!mclaren: Should there be an if calc_Tsfc statement here then?? dswabs = c0 if (sw_redist) then @@ -288,10 +288,10 @@ subroutine temperature_changes_salinity(dt, & do k = 1, nilyr zTin(k) = temperature_mush_liquid_fraction(zqin(k), phi(k)) - Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) + Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) qbr(k) = enthalpy_brine(zTin(k)) enddo ! k - + else ! case without snow @@ -325,24 +325,24 @@ subroutine temperature_changes_salinity(dt, & call icepack_warnings_add(warnstr) return endif - + ! given the updated enthalpy and bulk salinity calculate other quantities do k = 1, nilyr zTin(k) = temperature_mush_liquid_fraction(zqin(k), phi(k)) - Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) + Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) qbr(k) = enthalpy_brine(zTin(k)) enddo ! k - + endif - ! drain ponds from flushing + ! drain ponds from flushing call flush_pond(w, hpond, apond, dt) if (icepack_warnings_aborted(subname)) return ! flood snow ice call flood_ice(hsn, hin, & - nslyr, nilyr, & - hslyr, hilyr, & + nslyr, nilyr, & + hslyr, hilyr, & zqsn, zqin, & phi, dt, & zSin, Sbr, & @@ -415,7 +415,7 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & Sswabs ! SW radiation absorbed in snow layers (W m-2) real(kind=dbl_kind), dimension(:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) + zqin , & ! ice layer enthalpy (J m-3) zSin , & ! ice layer bulk salinity (ppt) zTin , & ! ice layer temperature (C) phi ! ice layer liquid fraction @@ -496,8 +496,8 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & return else - - ! solution is inconsistent - surface is warmer than melting + + ! solution is inconsistent - surface is warmer than melting ! resolve assuming surface is melting Tsf1 = Tsf @@ -507,7 +507,7 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & zqin = zqin0 zSin = zSin0 - ! solve the system for melting and snow + ! solve the system for melting and snow call picard_solver(nilyr, nslyr, & .true., .false., & Tsf, zqsn, & @@ -534,8 +534,8 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & ! halt if solver failed if (icepack_warnings_aborted(subname)) return - ! check if solution is consistent - ! surface conductive heat flux should be less than + ! check if solution is consistent + ! surface conductive heat flux should be less than ! incoming surface heat flux if (fcondtop - fsurfn < ferrmax) then @@ -548,7 +548,7 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & call two_stage_inconsistency(1, Tsf1, c0, fcondtop, fsurfn) if (icepack_warnings_aborted(subname)) return call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" two_stage_solver_snow: two_stage_inconsistency: cold" ) + call icepack_warnings_add(subname//" two_stage_solver_snow: two_stage_inconsistency: cold" ) return endif ! surface flux consistency @@ -587,9 +587,9 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & ! halt if solver failed if (icepack_warnings_aborted(subname)) return - - ! check if solution is consistent - ! surface conductive heat flux should be less than + + ! check if solution is consistent + ! surface conductive heat flux should be less than ! incoming surface heat flux if (fcondtop - fsurfn < ferrmax) then @@ -609,14 +609,14 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & zqin = zqin0 zSin = zSin0 - ! solve the system for cold and snow + ! solve the system for cold and snow call picard_solver(nilyr, nslyr, & - .true., .true., & + .true., .true., & Tsf, zqsn, & zqin, zSin, & zTin, zTsn, & phi, dt, & - hilyr, hslyr, & + hilyr, hslyr, & km, ks, & Iswabs, Sswabs, & Tbot, & @@ -649,11 +649,11 @@ subroutine two_stage_solver_snow(nilyr, nslyr, & call two_stage_inconsistency(2, Tsf, c0, fcondtop1, fsurfn1) if (icepack_warnings_aborted(subname)) return call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" two_stage_solver_snow: two_stage_inconsistency: melting" ) + call icepack_warnings_add(subname//" two_stage_solver_snow: two_stage_inconsistency: melting" ) return - + endif ! surface temperature consistency - + endif ! surface flux consistency endif @@ -685,7 +685,7 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & fadvheat, & flwoutn, fsensn, & flatn, fsurfn ) - + ! solve the vertical temperature and salt change for case with no snow ! 1) determine what type of surface condition existed previously - cold or melting ! 2) solve the system assuming this condition persists @@ -721,7 +721,7 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & Sswabs ! SW radiation absorbed in snow layers (W m-2) real(kind=dbl_kind), dimension(:), intent(inout) :: & - zqin , & ! ice layer enthalpy (J m-3) + zqin , & ! ice layer enthalpy (J m-3) zSin , & ! ice layer bulk salinity (ppt) zTin , & ! ice layer temperature (C) phi ! ice layer liquid fraction @@ -771,7 +771,7 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & ! initially cold - ! solve the system for cold and no snow + ! solve the system for cold and no snow call picard_solver(nilyr, nslyr, & .false., .true., & Tsf, zqsn, & @@ -805,7 +805,7 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & return else - ! solution is inconsistent - surface is warmer than melting + ! solution is inconsistent - surface is warmer than melting ! resolve assuming surface is melting Tsf1 = Tsf @@ -826,7 +826,7 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & Iswabs, Sswabs, & Tbot, & fswint, fswsfc, & - rhoa, flw, & + rhoa, flw, & potT, Qa, & shcoef, lhcoef, & fcondtop, fcondbot, & @@ -842,8 +842,8 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & ! halt if solver failed if (icepack_warnings_aborted(subname)) return - ! check if solution is consistent - ! surface conductive heat flux should be less than + ! check if solution is consistent + ! surface conductive heat flux should be less than ! incoming surface heat flux if (fcondtop - fsurfn < ferrmax) then @@ -856,7 +856,7 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & call two_stage_inconsistency(3, Tsf1, Tmlt, fcondtop, fsurfn) if (icepack_warnings_aborted(subname)) return call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" two_stage_solver_nosnow: two_stage_inconsistency: cold" ) + call icepack_warnings_add(subname//" two_stage_solver_nosnow: two_stage_inconsistency: cold" ) return endif @@ -867,7 +867,7 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & ! initially melting ! solve the system for melt and no snow - Tsf = Tmlt + Tsf = Tmlt call picard_solver(nilyr, nslyr, & .false., .false., & @@ -896,8 +896,8 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & ! halt if solver failed if (icepack_warnings_aborted(subname)) return - ! check if solution is consistent - ! surface conductive heat flux should be less than + ! check if solution is consistent + ! surface conductive heat flux should be less than ! incoming surface heat flux if (fcondtop - fsurfn < ferrmax) then @@ -956,11 +956,11 @@ subroutine two_stage_solver_nosnow(nilyr, nslyr, & call two_stage_inconsistency(4, Tsf, Tmlt, fcondtop1, fsurfn1) if (icepack_warnings_aborted(subname)) return call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" two_stage_solver_nosnow: two_stage_inconsistency: melting" ) + call icepack_warnings_add(subname//" two_stage_solver_nosnow: two_stage_inconsistency: melting" ) return endif - + endif endif @@ -1021,7 +1021,7 @@ subroutine two_stage_inconsistency(type, Tsf, Tmlt, fcondtop, fsurfn) call icepack_warnings_add(warnstr) else if (type == 4) then - + write(warnstr,*) subname, "First stage : fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax" call icepack_warnings_add(warnstr) write(warnstr,*) subname, " :", fcondtop, fsurfn, ferrmax, fcondtop - fsurfn - ferrmax @@ -1201,7 +1201,7 @@ subroutine picard_solver(nilyr, nslyr, & Spond , & ! melt pond salinity (ppt) sss , & ! sea surface salinity (ppt) w ! vertical flushing Darcy velocity (m/s) - + real(kind=dbl_kind), dimension(nilyr) :: & Sbr , & ! ice layer brine salinity (ppt) qbr , & ! ice layer brine enthalpy (J m-3) @@ -1209,7 +1209,7 @@ subroutine picard_solver(nilyr, nslyr, & zqin0 , & ! ice layer enthalpy (J m-3) at start of timestep zSin0 , & ! ice layer bulk salinity (ppt) at start of timestep zTin_prev ! ice layer temperature at previous iteration - + real(kind=dbl_kind), dimension(nslyr) :: & zqsn0 , & ! snow layer enthalpy (J m-3) at start of timestep zTsn0 , & ! snow layer temperature (C) at start of timestep @@ -1320,7 +1320,7 @@ subroutine picard_solver(nilyr, nslyr, & ! perform convergence check call check_picard_convergence(nilyr, nslyr, & lsnow, & - lconverged, & + lconverged, & Tsf, Tsf_prev, & zTin, zTin_prev,& zTsn, zTsn_prev,& @@ -1348,7 +1348,7 @@ subroutine picard_solver(nilyr, nslyr, & call picard_updates(nilyr, zTin, & Sbr, qbr) if (icepack_warnings_aborted(subname)) return - + ! solve for the salinity call solve_salinity(zSin, Sbr, & Spond, sss, & @@ -1378,7 +1378,7 @@ subroutine picard_solver(nilyr, nslyr, & zqin0, zqin, & phi) if (icepack_warnings_aborted(subname)) return - call icepack_warnings_add(subname//" picard_solver: Picard solver non-convergence" ) + call icepack_warnings_add(subname//" picard_solver: Picard solver non-convergence" ) call icepack_warnings_setabort(.true.,__FILE__,__LINE__) if (icepack_warnings_aborted(subname)) return @@ -1413,8 +1413,8 @@ subroutine picard_nonconvergence(nilyr, nslyr,& zTin , & ! ice layer temperature (C) zSin0 , & ! ice layer bulk salinity (ppt) zSin , & ! ice layer bulk salinity (ppt) - zqin0 , & - zqin , & + zqin0 , & + zqin , & phi ! ice layer liquid fraction integer :: & @@ -1429,12 +1429,12 @@ subroutine picard_nonconvergence(nilyr, nslyr,& call icepack_warnings_add(warnstr) write(warnstr,*) subname, 0, Tsf0, Tsf call icepack_warnings_add(warnstr) - + do k = 1, nslyr write(warnstr,*) subname, k, zTsn0(k), zTsn(k), zqsn(k), zqsn0(k) call icepack_warnings_add(warnstr) - enddo ! k - + enddo ! k + do k = 1, nilyr write(warnstr,*) subname, k, zTin0(k), zTin(k), zSin0(k), zSin(k), phi(k), zqin(k), zqin0(k) call icepack_warnings_add(warnstr) @@ -1446,10 +1446,10 @@ subroutine picard_nonconvergence(nilyr, nslyr,& end subroutine picard_nonconvergence !======================================================================= - + subroutine check_picard_convergence(nilyr, nslyr, & lsnow, & - lconverged, & + lconverged, & Tsf, Tsf_prev, & zTin, zTin_prev,& zTsn, zTsn_prev,& @@ -1500,7 +1500,7 @@ subroutine check_picard_convergence(nilyr, nslyr, & real(kind=dbl_kind), dimension(:), intent(inout) :: & zqsn ! snow layer enthalpy (J m-3) - real(kind=dbl_kind), intent(out) :: & + real(kind=dbl_kind), intent(out) :: & fcondtop , & ! downward cond flux at top surface (W m-2) fcondbot ! downward cond flux at bottom surface (W m-2) @@ -1529,7 +1529,7 @@ subroutine check_picard_convergence(nilyr, nslyr, & call maximum_variables_changes(lsnow, & Tsf, Tsf_prev, dTsf, & - zTsn, zTsn_prev, dzTsn, & + zTsn, zTsn_prev, dzTsn, & zTin, zTin_prev, dzTin) if (icepack_warnings_aborted(subname)) return @@ -1562,7 +1562,7 @@ subroutine picard_drainage_fluxes(fadvheat, q, & real(kind=dbl_kind), intent(out) :: & fadvheat ! flow of heat to ocean due to advection (W m-2) - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & + real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & q ! upward interface vertical Darcy flow (m s-1) real(kind=dbl_kind), dimension(:), intent(in) :: & @@ -1621,7 +1621,7 @@ end subroutine picard_flushing_fluxes subroutine maximum_variables_changes(lsnow, & Tsf, Tsf_prev, dTsf, & - zTsn, zTsn_prev, dzTsn, & + zTsn, zTsn_prev, dzTsn, & zTin, zTin_prev, dzTin) logical, intent(in) :: & @@ -1649,7 +1649,7 @@ subroutine maximum_variables_changes(lsnow, & if (lsnow) then dzTsn = maxval(abs(zTsn - zTsn_prev)) else ! lsnow - dzTsn = c0 + dzTsn = c0 endif ! lsnow dzTin = maxval(abs(zTin - zTin_prev)) @@ -1679,7 +1679,7 @@ subroutine total_energy_content(lsnow, & hilyr , & ! ice layer thickness (m) hslyr ! snow layer thickness (m) - real(kind=dbl_kind), intent(out) :: & + real(kind=dbl_kind), intent(out) :: & energy ! total energy of ice and snow integer :: & @@ -1688,9 +1688,9 @@ subroutine total_energy_content(lsnow, & character(len=*),parameter :: subname='(total_energy_content)' energy = c0 - + if (lsnow) then - + do k = 1, nslyr energy = energy + hslyr * zqsn(k) @@ -1835,7 +1835,7 @@ subroutine calc_intercell_thickness(nilyr, nslyr, lsnow, hilyr, hslyr, dxp) if (lsnow) then dxp(1) = hslyr / c2 - + do l = 2, nslyr dxp(l) = hslyr @@ -1912,7 +1912,7 @@ subroutine calc_intercell_conductivity(lsnow, & if (lsnow) then kcstar(1) = ks(1) - + do l = 2, nslyr k = l @@ -1937,7 +1937,7 @@ subroutine calc_intercell_conductivity(lsnow, & kcstar(1) = km(1) do k = 2, nilyr - + l = k kcstar(l) = (c2 * km(k) * km(k-1)) / (km(k) + km(k-1)) @@ -1956,7 +1956,7 @@ subroutine calc_intercell_conductivity(lsnow, & end subroutine calc_intercell_conductivity !======================================================================= - + subroutine solve_heat_conduction(lsnow, lcold, & nilyr, nslyr, & Tsf, Tbot, & @@ -1984,7 +1984,7 @@ subroutine solve_heat_conduction(lsnow, lcold, & phi , & ! ice layer liquid fraction zqsn0 , & ! snow layer enthalpy (J m-3) at start of timestep Sswabs ! SW radiation absorbed in snow layers (W m-2) - + real(kind=dbl_kind), intent(inout) :: & Tsf ! snow surface temperature (C) @@ -1999,7 +1999,7 @@ subroutine solve_heat_conduction(lsnow, lcold, & fsurfn , & ! net flux to top surface, excluding fcondtop dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & + real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & q ! upward interface vertical Darcy flow (m s-1) real(kind=dbl_kind), dimension(:), intent(in) :: & @@ -2142,7 +2142,7 @@ subroutine update_temperatures(lsnow, lcold, & character(len=*),parameter :: subname='(update_temperatures)' if (lsnow) then - + if (lcold) then Tsf = T(1) @@ -2151,19 +2151,19 @@ subroutine update_temperatures(lsnow, lcold, & l = k + 1 zTsn(k) = T(l) enddo ! k - + do k = 1, nilyr l = k + nslyr + 1 zTin(k) = T(l) enddo ! k else ! lcold - + do k = 1, nslyr l = k zTsn(k) = T(l) enddo ! k - + do k = 1, nilyr l = k + nslyr zTin(k) = T(l) @@ -2172,11 +2172,11 @@ subroutine update_temperatures(lsnow, lcold, & endif ! lcold else ! lsnow - + if (lcold) then Tsf = T(1) - + do k = 1, nilyr l = k + 1 zTin(k) = T(l) @@ -2196,7 +2196,7 @@ subroutine update_temperatures(lsnow, lcold, & end subroutine update_temperatures !======================================================================= - + subroutine matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & nilyr, & Tsf, Tbot, & @@ -2208,7 +2208,7 @@ subroutine matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & dxp, kcstar, & Iswabs, & dt) - + real(kind=dbl_kind), dimension(:), intent(out) :: & Ap , & ! diagonal of tridiagonal matrix As , & ! lower off-diagonal of tridiagonal matrix @@ -2235,7 +2235,7 @@ subroutine matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & qocn , & ! ocean brine enthalpy (J m-3) w ! downwards vertical flushing Darcy velocity (m/s) - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & + real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & q ! upward interface vertical Darcy flow (m s-1) real(kind=dbl_kind), dimension(:), intent(in) :: & @@ -2245,13 +2245,13 @@ subroutine matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & integer :: & k , & ! vertical layer index l ! vertical index - + character(len=*),parameter :: subname='(matrix_elements_nosnow_melt)' ! surface layer k = 1 l = k - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(k+1) / dxp(k+1) + & kcstar(k) / dxp(k) + & @@ -2266,9 +2266,9 @@ subroutine matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & ! interior ice layers do k = 2, nilyr-1 - + l = k - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(k+1) / dxp(k+1) + & kcstar(k) / dxp(k) + & @@ -2281,11 +2281,11 @@ subroutine matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) enddo ! k - + ! bottom layer k = nilyr l = k - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(k+1) / dxp(k+1) + & kcstar(k) / dxp(k) + & @@ -2297,7 +2297,7 @@ subroutine matrix_elements_nosnow_melt(Ap, As, An, b, nyn, & b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & (kcstar(k+1) * Tbot) / dxp(k+1) + & q(k) * qocn - + nyn = nilyr end subroutine matrix_elements_nosnow_melt @@ -2316,7 +2316,7 @@ subroutine matrix_elements_nosnow_cold(Ap, As, An, b, nyn, & Iswabs, & fsurfn, dfsurfn_dTsf, & dt) - + real(kind=dbl_kind), dimension(:), intent(out) :: & Ap , & ! diagonal of tridiagonal matrix As , & ! lower off-diagonal of tridiagonal matrix @@ -2345,7 +2345,7 @@ subroutine matrix_elements_nosnow_cold(Ap, As, An, b, nyn, & fsurfn , & ! net flux to top surface, excluding fcondtop dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & + real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & q ! upward interface vertical Darcy flow (m s-1) real(kind=dbl_kind), dimension(:), intent(in) :: & @@ -2368,7 +2368,7 @@ subroutine matrix_elements_nosnow_cold(Ap, As, An, b, nyn, & ! surface layer k = 1 l = k + 1 - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(k+1) / dxp(k+1) + & kcstar(k) / dxp(k) + & @@ -2382,9 +2382,9 @@ subroutine matrix_elements_nosnow_cold(Ap, As, An, b, nyn, & ! interior ice layers do k = 2, nilyr-1 - + l = k + 1 - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(k+1) / dxp(k+1) + & kcstar(k) / dxp(k) + & @@ -2397,11 +2397,11 @@ subroutine matrix_elements_nosnow_cold(Ap, As, An, b, nyn, & b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) enddo ! k - + ! bottom layer k = nilyr l = k + 1 - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(k+1) / dxp(k+1) + & kcstar(k) / dxp(k) + & @@ -2413,7 +2413,7 @@ subroutine matrix_elements_nosnow_cold(Ap, As, An, b, nyn, & b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & (kcstar(k+1) * Tbot) / dxp(k+1) + & q(k) * qocn - + nyn = nilyr + 1 end subroutine matrix_elements_nosnow_cold @@ -2431,7 +2431,7 @@ subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & dxp, kcstar, & Iswabs, Sswabs, & dt) - + real(kind=dbl_kind), dimension(:), intent(out) :: & Ap , & ! diagonal of tridiagonal matrix As , & ! lower off-diagonal of tridiagonal matrix @@ -2462,7 +2462,7 @@ subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & qocn , & ! ocean brine enthalpy (J m-3) w ! downwards vertical flushing Darcy velocity (m/s) - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & + real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & q ! upward interface vertical Darcy flow (m s-1) real(kind=dbl_kind), dimension(:), intent(in) :: & @@ -2478,7 +2478,7 @@ subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & ! surface layer k = 1 l = k - + Ap(l) = ((rhos * cp_ice) / dt) * hslyr + & kcstar(l+1) / dxp(l+1) + & kcstar(l) / dxp(l) @@ -2489,7 +2489,7 @@ subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & ! interior snow layers do k = 2, nslyr - + l = k Ap(l) = ((rhos * cp_ice) / dt) * hslyr + & @@ -2498,13 +2498,13 @@ subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & As(l) = -kcstar(l+1) / dxp(l+1) An(l) = -kcstar(l) / dxp(l) b (l) = ((rhos * Lfresh + zqsn0(k)) / dt) * hslyr + Sswabs(k) - + enddo ! k - + ! top ice layer k = 1 l = nslyr + k - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(l+1) / dxp(l+1) + & kcstar(l) / dxp(l) + & @@ -2518,9 +2518,9 @@ subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & ! interior ice layers do k = 2, nilyr-1 - + l = nslyr + k - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(l+1) / dxp(l+1) + & kcstar(l) / dxp(l) + & @@ -2531,13 +2531,13 @@ subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & An(l) = -kcstar(l) / dxp(l) - & w * cp_ocn * rhow b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) - + enddo ! k ! bottom layer k = nilyr l = nilyr + nslyr - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(l+1) / dxp(l+1) + & kcstar(l) / dxp(l) + & @@ -2549,7 +2549,7 @@ subroutine matrix_elements_snow_melt(Ap, As, An, b, nyn, & b (l) = (((c1 - phi(k)) * rhoi * Lfresh + zqin0(k)) / dt) * hilyr + Iswabs(k) + & (kcstar(l+1) * Tbot) / dxp(l+1) + & q(k) * qocn - + nyn = nilyr + nslyr end subroutine matrix_elements_snow_melt @@ -2568,7 +2568,7 @@ subroutine matrix_elements_snow_cold(Ap, As, An, b, nyn, & Iswabs, Sswabs, & fsurfn, dfsurfn_dTsf, & dt) - + real(kind=dbl_kind), dimension(:), intent(out) :: & Ap , & ! diagonal of tridiagonal matrix As , & ! lower off-diagonal of tridiagonal matrix @@ -2601,7 +2601,7 @@ subroutine matrix_elements_snow_cold(Ap, As, An, b, nyn, & fsurfn , & ! net flux to top surface, excluding fcondtop dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & + real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & q ! upward interface vertical Darcy flow (m s-1) real(kind=dbl_kind), dimension(:), intent(in) :: & @@ -2626,7 +2626,7 @@ subroutine matrix_elements_snow_cold(Ap, As, An, b, nyn, & k = 1 l = k + 1 m = 1 - + Ap(l) = ((rhos * cp_ice) / dt) * hslyr + & kcstar(m+1) / dxp(m+1) + & kcstar(m) / dxp(m) @@ -2636,7 +2636,7 @@ subroutine matrix_elements_snow_cold(Ap, As, An, b, nyn, & ! interior snow layers do k = 2, nslyr - + l = k + 1 m = k @@ -2648,12 +2648,12 @@ subroutine matrix_elements_snow_cold(Ap, As, An, b, nyn, & b (l) = ((rhos * Lfresh + zqsn0(k)) / dt) * hslyr + Sswabs(k) enddo ! k - + ! top ice layer k = 1 l = nslyr + k + 1 m = k + nslyr - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(m+1) / dxp(m+1) + & kcstar(m) / dxp(m) + & @@ -2667,10 +2667,10 @@ subroutine matrix_elements_snow_cold(Ap, As, An, b, nyn, & ! interior ice layers do k = 2, nilyr-1 - + l = nslyr + k + 1 m = k + nslyr - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(m+1) / dxp(m+1) + & kcstar(m) / dxp(m) + & @@ -2688,7 +2688,7 @@ subroutine matrix_elements_snow_cold(Ap, As, An, b, nyn, & k = nilyr l = nilyr + nslyr + 1 m = k + nslyr - + Ap(l) = ((phi(k) * (cp_ocn * rhow - cp_ice * rhoi) + rhoi * cp_ice) / dt) * hilyr + & kcstar(m+1) / dxp(m+1) + & kcstar(m) / dxp(m) + & @@ -2722,7 +2722,7 @@ subroutine solve_salinity(zSin, Sbr, & real(kind=dbl_kind), dimension(:), intent(in) :: & Sbr , & ! ice layer brine salinity (ppt) dSdt ! gravity drainage desalination rate for slow mode (ppt s-1) - + real(kind=dbl_kind), dimension(0:nilyr), intent(in) :: & q ! upward interface vertical Darcy flow (m s-1) @@ -2738,7 +2738,7 @@ subroutine solve_salinity(zSin, Sbr, & real(kind=dbl_kind), parameter :: & S_min = p01 - + real(kind=dbl_kind), dimension(nilyr) :: & zSin0 @@ -2777,7 +2777,7 @@ subroutine solve_salinity(zSin, Sbr, & call icepack_warnings_add(warnstr) do k = 1, nilyr - + write(warnstr,*) subname, k, zSin(k), zSin0(k) call icepack_warnings_add(warnstr) @@ -2793,7 +2793,7 @@ end subroutine solve_salinity !======================================================================= subroutine tdma_solve_sparse(nilyr, nslyr, a, b, c, d, x, n) - + ! perform a tri-diagonal solve with TDMA using a sparse tridiagoinal matrix integer (kind=int_kind), intent(in) :: & @@ -2802,13 +2802,13 @@ subroutine tdma_solve_sparse(nilyr, nslyr, a, b, c, d, x, n) integer(kind=int_kind), intent(in) :: & n ! matrix size - + real(kind=dbl_kind), dimension(:), intent(in) :: & a , & ! matrix lower off-diagonal b , & ! matrix diagonal c , & ! matrix upper off-diagonal d ! right hand side vector - + real(kind=dbl_kind), dimension(:), intent(out) :: & x ! solution vector @@ -2818,7 +2818,7 @@ subroutine tdma_solve_sparse(nilyr, nslyr, a, b, c, d, x, n) integer(kind=int_kind) :: & i ! vector index - + character(len=*),parameter :: subname='(tdma_solve_sparse)' ! forward sweep @@ -2826,7 +2826,7 @@ subroutine tdma_solve_sparse(nilyr, nslyr, a, b, c, d, x, n) do i = 2, n-1 cp(i) = c(i) / (b(i) - cp(i-1)*a(i)) enddo - + dp(1) = d(1) / b(1) do i = 2, n dp(i) = (d(i) - dp(i-1)*a(i)) / (b(i) - cp(i-1)*a(i)) @@ -2854,7 +2854,7 @@ function permeability(phi) result(perm) real(kind=dbl_kind) :: & perm ! permeability (m2) - + real(kind=dbl_kind), parameter :: & phic = p05 ! critical liquid fraction for impermeability @@ -2945,7 +2945,7 @@ subroutine explicit_flow_velocities(nilyr, zSin, & ! initial downward sweep - determine derived physical quantities do k = 1, nilyr - + Sbr(k) = liquidus_brine_salinity_mush(zTin(k)) phi(k) = icepack_mushy_liquid_fraction(zTin(k), zSin(k)) qbr(k) = enthalpy_brine(zTin(k)) @@ -2989,7 +2989,7 @@ subroutine explicit_flow_velocities(nilyr, zSin, & rho_pipe = p5 * (rho(k) + rho(k-1)) drho = max(rho(k) - rho_ocn, c0) - ! mush Rayleigh number + ! mush Rayleigh number Ra = drho * (hin-z) * perm_min * ra_constants ! height of mush layer to layer k @@ -3046,7 +3046,7 @@ subroutine flushing_velocity(zTin, & hilyr, & hpond, apond, & dt, w) - + ! calculate the vertical flushing Darcy velocity (positive downward) integer (kind=int_kind), intent(in) :: & @@ -3068,8 +3068,8 @@ subroutine flushing_velocity(zTin, & w ! vertical flushing Darcy flow rate (m s-1) real(kind=dbl_kind), parameter :: & - advection_limit = 0.005_dbl_kind ! limit to fraction of brine in - ! any layer that can be advected + advection_limit = 0.005_dbl_kind ! limit to fraction of brine in + ! any layer that can be advected real(kind=dbl_kind) :: & perm , & ! ice layer permeability (m2) @@ -3077,7 +3077,7 @@ subroutine flushing_velocity(zTin, & perm_harm , & ! harmonic mean of ice permeability (m2) hocn , & ! ocean surface height above ice base (m) hbrine , & ! brine surface height above ice base (m) - w_down_max , & ! maximum downward flushing Darcy flow rate (m s-1) + w_down_max , & ! maximum downward flushing Darcy flow rate (m s-1) phi_min , & ! minimum porosity in the mush wlimit , & ! limit to w to avoid advecting all brine in layer dhhead ! hydraulic head (m) @@ -3117,7 +3117,7 @@ subroutine flushing_velocity(zTin, & ice_mass = ice_mass * hilyr - perm_harm = real(nilyr,dbl_kind) / perm_harm + perm_harm = real(nilyr,dbl_kind) / perm_harm ! calculate ocean surface height above bottom of ice hocn = (ice_mass + hpond * apond * rhow + hsn * rhos) / rhow @@ -3165,7 +3165,7 @@ subroutine flush_pond(w, hpond, apond, dt) real(kind=dbl_kind), intent(inout) :: & hpond ! melt pond thickness (m) - + real(kind=dbl_kind), parameter :: & lambda_pond = c1 / (10.0_dbl_kind * 24.0_dbl_kind * 3600.0_dbl_kind), & hpond0 = 0.01_dbl_kind @@ -3174,17 +3174,17 @@ subroutine flush_pond(w, hpond, apond, dt) if (tr_pond) then if (apond > c0 .and. hpond > c0) then - + ! flush pond through mush hpond = hpond - w * dt / apond - + hpond = max(hpond, c0) - + ! exponential decay of pond hpond = hpond - lambda_pond * dt * (hpond + hpond0) - + hpond = max(hpond, c0) - + endif endif @@ -3193,8 +3193,8 @@ end subroutine flush_pond !======================================================================= subroutine flood_ice(hsn, hin, & - nslyr, nilyr, & - hslyr, hilyr, & + nslyr, nilyr, & + hslyr, hilyr, & zqsn, zqin, & phi, dt, & zSin, Sbr, & @@ -3250,12 +3250,12 @@ 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) +! 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) wadded , & ! mass rate of water used from ocean (kg/m^2/s) - eadded ! energy rate of water used from ocean (W/m^2) + eadded ! energy rate of water used from ocean (W/m^2) ! real(kind=dbl_kind) :: & ! sadded ! salt rate of water used from ocean (kg/m^2/s) @@ -3269,7 +3269,7 @@ subroutine flood_ice(hsn, hin, & ! check we have snow if (hsn > puny) then - + rho_ocn = icepack_mushy_density_brine(sss) ! ice mass @@ -3375,7 +3375,7 @@ end subroutine flood_ice subroutine enthalpy_snow_snowice(nslyr, dh, hsn, zqsn, zqsn_snowice) ! determine enthalpy of the snow being converted to snow ice - + integer (kind=int_kind), intent(in) :: & nslyr ! number of snow layers @@ -3419,14 +3419,14 @@ subroutine enthalpy_snow_snowice(nslyr, dh, hsn, zqsn, zqsn_snowice) end subroutine enthalpy_snow_snowice !======================================================================= - + subroutine update_vertical_tracers_snow(nslyr, trc, hlyr1, hlyr2) ! given some snow ice formation regrid snow layers integer (kind=int_kind), intent(in) :: & nslyr ! number of snow layers - + real(kind=dbl_kind), dimension(:), intent(inout) :: & trc ! vertical tracer @@ -3436,58 +3436,58 @@ subroutine update_vertical_tracers_snow(nslyr, trc, hlyr1, hlyr2) real(kind=dbl_kind), dimension(1:nslyr) :: & trc2 ! temporary array for updated tracer - + ! vertical indexes for old and new grid integer(kind=int_kind) :: & k1 , & ! vertical index for old grid k2 ! vertical index for new grid - + real(kind=dbl_kind) :: & z1a , & ! lower boundary of old cell z1b , & ! upper boundary of old cell z2a , & ! lower boundary of new cell z2b , & ! upper boundary of new cell overlap ! overlap between old and new cell - + character(len=*),parameter :: subname='(update_vertical_tracers_snow)' ! loop over new grid cells do k2 = 1, nslyr - + ! initialize new tracer trc2(k2) = c0 - + ! calculate upper and lower boundary of new cell z2a = (k2 - 1) * hlyr2 z2b = k2 * hlyr2 - + ! loop over old grid cells do k1 = 1, nslyr - + ! calculate upper and lower boundary of old cell z1a = (k1 - 1) * hlyr1 z1b = k1 * hlyr1 - + ! calculate overlap between old and new cell overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - + ! aggregate old grid cell contribution to new cell trc2(k2) = trc2(k2) + overlap * trc(k1) - + enddo ! k1 ! renormalize new grid cell trc2(k2) = trc2(k2) / hlyr2 - + enddo ! k2 - + ! update vertical tracer array with the adjusted tracer trc = trc2 end subroutine update_vertical_tracers_snow !======================================================================= - + subroutine update_vertical_tracers_ice(nilyr, trc, hlyr1, hlyr2, & h1, h2, trc0) @@ -3498,36 +3498,36 @@ subroutine update_vertical_tracers_ice(nilyr, trc, hlyr1, hlyr2, & real(kind=dbl_kind), dimension(:), intent(inout) :: & trc ! vertical tracer - + real(kind=dbl_kind), intent(in) :: & hlyr1 , & ! old cell thickness hlyr2 , & ! new cell thickness h1 , & ! old total thickness h2 , & ! new total thickness trc0 ! tracer value of added snow ice on ice top - + real(kind=dbl_kind), dimension(1:nilyr) :: & trc2 ! temporary array for updated tracer - + integer(kind=int_kind) :: & k1 , & ! vertical indexes for old grid k2 ! vertical indexes for new grid - + real(kind=dbl_kind) :: & z1a , & ! lower boundary of old cell z1b , & ! upper boundary of old cell z2a , & ! lower boundary of new cell z2b , & ! upper boundary of new cell overlap ! overlap between old and new cell - + character(len=*),parameter :: subname='(update_vertical_tracers_ice)' ! loop over new grid cells do k2 = 1, nilyr - + ! initialize new tracer trc2(k2) = c0 - + ! calculate upper and lower boundary of new cell z2a = (k2 - 1) * hlyr2 z2b = k2 * hlyr2 @@ -3535,33 +3535,33 @@ subroutine update_vertical_tracers_ice(nilyr, trc, hlyr1, hlyr2, & ! calculate upper and lower boundary of added snow ice at top z1a = c0 z1b = h2 - h1 - + ! calculate overlap between added ice and new cell overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - + ! aggregate added ice contribution to new cell trc2(k2) = trc2(k2) + overlap * trc0 ! loop over old grid cells do k1 = 1, nilyr - + ! calculate upper and lower boundary of old cell z1a = (k1 - 1) * hlyr1 + h2 - h1 z1b = k1 * hlyr1 + h2 - h1 - + ! calculate overlap between old and new cell overlap = max(min(z1b, z2b) - max(z1a, z2a), c0) - + ! aggregate old grid cell contribution to new cell trc2(k2) = trc2(k2) + overlap * trc(k1) - + enddo ! k1 ! renormalize new grid cell trc2(k2) = trc2(k2) / hlyr2 - + enddo ! k2 - + ! update vertical tracer array with the adjusted tracer trc = trc2 diff --git a/columnphysics/icepack_therm_shared.F90 b/columnphysics/icepack_therm_shared.F90 index d3f938dc9..4bcb6259b 100644 --- a/columnphysics/icepack_therm_shared.F90 +++ b/columnphysics/icepack_therm_shared.F90 @@ -26,7 +26,7 @@ module icepack_therm_shared use icepack_mushy_physics, only: enthalpy_snow use icepack_mushy_physics, only: icepack_mushy_temperature_mush use icepack_mushy_physics, only: liquidus_temperature_mush - + implicit none private @@ -83,7 +83,7 @@ function calculate_Tin_from_qin (qin, Tmltk) & if (l_brine) then aa1 = cp_ice - bb1 = (cp_ocn-cp_ice)*Tmltk - qin/rhoi - Lfresh + bb1 = (cp_ocn-cp_ice)*Tmltk - qin/rhoi - Lfresh cc1 = Lfresh * Tmltk Tin = min((-bb1 - sqrt(bb1*bb1 - c4*aa1*cc1)) / & (c2*aa1),Tmltk) @@ -91,7 +91,7 @@ function calculate_Tin_from_qin (qin, Tmltk) & else ! fresh ice Tin = (Lfresh + qin/rhoi) / cp_ice endif - + end function calculate_Tin_from_qin !======================================================================= @@ -99,7 +99,7 @@ end function calculate_Tin_from_qin !======================================================================= ! heat flux into ice - + subroutine surface_heat_flux(Tsf, fswsfc, & rhoa, flw, & potT, Qa, & @@ -110,7 +110,7 @@ subroutine surface_heat_flux(Tsf, fswsfc, & ! input surface temperature real(kind=dbl_kind), intent(in) :: & Tsf ! ice/snow surface temperature (C) - + ! input variables real(kind=dbl_kind), intent(in) :: & fswsfc , & ! SW absorbed at ice/snow surface (W m-2) @@ -120,14 +120,14 @@ subroutine surface_heat_flux(Tsf, fswsfc, & Qa , & ! specific humidity (kg/kg) shcoef , & ! transfer coefficient for sensible heat lhcoef ! transfer coefficient for latent heat - + ! output real(kind=dbl_kind), intent(out) :: & fsensn , & ! surface downward sensible heat (W m-2) flatn , & ! surface downward latent heat (W m-2) flwoutn , & ! upward LW at surface (W m-2) fsurfn ! net flux to top surface, excluding fcondtopn - + ! local variables real(kind=dbl_kind) :: & TsfK , & ! ice/snow surface temperature (K) @@ -135,85 +135,85 @@ subroutine surface_heat_flux(Tsf, fswsfc, & qsat , & ! the saturation humidity of air (kg/m^3) flwdabs , & ! downward longwave absorbed heat flx (W/m^2) tmpvar ! 1/TsfK - + character(len=*),parameter :: subname='(surface_heat_flux)' ! ice surface temperature in Kelvin TsfK = Tsf + Tffresh ! TsfK = max(Tsf + Tffresh, c1) tmpvar = c1/TsfK - + ! saturation humidity qsat = qqqice * exp(-TTTice*tmpvar) Qsfc = qsat / rhoa - + ! longwave radiative flux flwdabs = emissivity * flw flwoutn = -emissivity * stefan_boltzmann * TsfK**4 - + ! downward latent and sensible heat fluxes fsensn = shcoef * (potT - TsfK) flatn = lhcoef * (Qa - Qsfc) - + ! combine fluxes fsurfn = fswsfc + flwdabs + flwoutn + fsensn + flatn end subroutine surface_heat_flux !======================================================================= - + subroutine dsurface_heat_flux_dTsf(Tsf, rhoa, & shcoef, lhcoef, & dfsurfn_dTsf, dflwoutn_dTsf, & dfsensn_dTsf, dflatn_dTsf) - + ! input surface temperature real(kind=dbl_kind), intent(in) :: & Tsf ! ice/snow surface temperature (C) - + ! input variables real(kind=dbl_kind), intent(in) :: & rhoa , & ! air density (kg/m^3) shcoef , & ! transfer coefficient for sensible heat lhcoef ! transfer coefficient for latent heat - + ! output real(kind=dbl_kind), intent(out) :: & dfsurfn_dTsf ! derivative of net flux to top surface, excluding fcondtopn - + real(kind=dbl_kind), intent(out) :: & dflwoutn_dTsf , & ! derivative of longwave flux wrt surface temperature dfsensn_dTsf , & ! derivative of sensible heat flux wrt surface temperature dflatn_dTsf ! derivative of latent heat flux wrt surface temperature - + ! local variables real(kind=dbl_kind) :: & TsfK , & ! ice/snow surface temperature (K) dQsfc_dTsf , & ! saturated surface specific humidity (kg/kg) qsat , & ! the saturation humidity of air (kg/m^3) tmpvar ! 1/TsfK - + character(len=*),parameter :: subname='(dsurface_heat_flux_dTsf)' ! ice surface temperature in Kelvin ! TsfK = max(Tsf + Tffresh, c1) TsfK = Tsf + Tffresh tmpvar = c1/TsfK - + ! saturation humidity qsat = qqqice * exp(-TTTice*tmpvar) dQsfc_dTsf = TTTice * tmpvar * tmpvar * (qsat / rhoa) - + ! longwave radiative flux dflwoutn_dTsf = -emissivity * stefan_boltzmann * c4*TsfK**3 - + ! downward latent and sensible heat fluxes dfsensn_dTsf = -shcoef dflatn_dTsf = -lhcoef * dQsfc_dTsf - + ! combine fluxes dfsurfn_dTsf = dflwoutn_dTsf + dfsensn_dTsf + dflatn_dTsf - + end subroutine dsurface_heat_flux_dTsf !======================================================================= @@ -250,7 +250,7 @@ subroutine icepack_init_thermo(nilyr, sprofile) !----------------------------------------------------------------- #ifdef UNDEPRECATE_0LAYER - heat_capacity = .true. + heat_capacity = .true. if (ktherm == 0) heat_capacity = .false. ! 0-layer thermodynamics l_brine = .false. @@ -323,11 +323,11 @@ subroutine icepack_init_trcr(Tair, Tf, & ! surface temperature Tsfc = Tf ! default if (calc_Tsfc) Tsfc = min(Tsmelt, Tair - Tffresh) ! deg C - + #ifdef UNDEPRECATE_0LAYER if (heat_capacity) then #endif - + ! ice enthalpy do k = 1, nilyr ! assume linear temp profile and compute enthalpy @@ -341,24 +341,24 @@ subroutine icepack_init_trcr(Tair, Tf, & + Lfresh*(c1-Tprofile(k)/Ti) - cp_ocn*Tprofile(k))) endif enddo ! nilyr - + ! snow enthalpy do k = 1, nslyr Ti = min(c0, Tsfc) qsn(k) = -rhos*(Lfresh - cp_ice*Ti) enddo ! nslyr - + #ifdef UNDEPRECATE_0LAYER else ! one layer with zero heat capacity - + ! ice energy - qin(1) = -rhoi * Lfresh - + qin(1) = -rhoi * Lfresh + ! snow energy - qsn(1) = -rhos * Lfresh - + qsn(1) = -rhos * Lfresh + endif ! heat_capacity -#endif +#endif end subroutine icepack_init_trcr !======================================================================= @@ -402,7 +402,7 @@ function icepack_sea_freezing_temperature(sss) result(Tf) if (trim(tfrz_option) == 'mushy') then Tf = icepack_liquidus_temperature(sss) ! deg C - + elseif (trim(tfrz_option) == 'linear_salt') then Tf = -depressT * sss ! deg C diff --git a/columnphysics/icepack_therm_vertical.F90 b/columnphysics/icepack_therm_vertical.F90 index 6889bb4fe..7329fe373 100644 --- a/columnphysics/icepack_therm_vertical.F90 +++ b/columnphysics/icepack_therm_vertical.F90 @@ -158,9 +158,9 @@ subroutine thermo_vertical (nilyr, nslyr, & real (kind=dbl_kind), & intent(in) :: & flw , & ! incoming longwave radiation (W/m^2) - potT , & ! air potential temperature (K) - Qa , & ! specific humidity (kg/kg) - rhoa , & ! air density (kg/m^3) + potT , & ! air potential temperature (K) + Qa , & ! specific humidity (kg/kg) + rhoa , & ! air density (kg/m^3) fsnow , & ! snowfall rate (kg m-2 s-1) shcoef , & ! transfer coefficient for sensible heat lhcoef ! transfer coefficient for latent heat @@ -183,15 +183,15 @@ subroutine thermo_vertical (nilyr, nslyr, & ! coupler fluxes to atmosphere real (kind=dbl_kind), intent(out):: & - flwoutn , & ! outgoing longwave radiation (W/m^2) - evapn , & ! evaporative water flux (kg/m^2/s) - evapsn , & ! evaporative water flux over snow (kg/m^2/s) - evapin ! evaporative water flux over ice (kg/m^2/s) + flwoutn , & ! outgoing longwave radiation (W/m^2) + evapn , & ! evaporative water flux (kg/m^2/s) + evapsn , & ! evaporative water flux over snow (kg/m^2/s) + evapin ! evaporative water flux over ice (kg/m^2/s) ! Note: these are intent out if calc_Tsfc = T, otherwise intent in real (kind=dbl_kind), intent(inout):: & - fsensn , & ! sensible heat flux (W/m^2) - flatn , & ! latent heat flux (W/m^2) + fsensn , & ! sensible heat flux (W/m^2) + flatn , & ! latent heat flux (W/m^2) fsurfn , & ! net flux to top surface, excluding fcondtopn fcondtopn, & ! downward cond flux at top surface (W m-2) fcondbotn ! downward cond flux at bottom surface (W m-2) @@ -200,21 +200,21 @@ subroutine thermo_vertical (nilyr, nslyr, & real (kind=dbl_kind), intent(out):: & freshn , & ! fresh water flux to ocean (kg/m^2/s) fsaltn , & ! salt flux to ocean (kg/m^2/s) - fhocnn ! net heat flux to ocean (W/m^2) + fhocnn ! net heat flux to ocean (W/m^2) ! diagnostic fields real (kind=dbl_kind), & intent(inout):: & Tsnice , & ! snow ice interface temperature (deg C) - meltt , & ! top ice melt (m/step-->cm/day) - melts , & ! snow melt (m/step-->cm/day) + 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) - dsnow , & ! change in snow thickness (m/step-->cm/day) - mlt_onset, & ! day of year that sfc melting begins - frz_onset ! day of year that freezing begins (congel or frazil) + meltb , & ! basal ice melt (m/step-->cm/day) + congel , & ! basal ice growth (m/step-->cm/day) + snoice , & ! snow-ice formation (m/step-->cm/day) + dsnow , & ! change in snow thickness (m/step-->cm/day) + mlt_onset, & ! day of year that sfc melting begins + frz_onset ! day of year that freezing begins (congel or frazil) real (kind=dbl_kind), intent(in) :: & yday ! day of year @@ -316,7 +316,7 @@ subroutine thermo_vertical (nilyr, nslyr, & #endif if (ktherm == 2) then - call temperature_changes_salinity(dt, & + call temperature_changes_salinity(dt, & nilyr, nslyr, & rhoa, flw, & potT, Qa, & @@ -345,7 +345,7 @@ subroutine thermo_vertical (nilyr, nslyr, & else ! ktherm - call temperature_changes(dt, & + call temperature_changes(dt, & nilyr, nslyr, & rhoa, flw, & potT, Qa, & @@ -364,11 +364,11 @@ subroutine thermo_vertical (nilyr, nslyr, & if (icepack_warnings_aborted(subname)) return endif ! ktherm - + #ifdef UNDEPRECATE_0LAYER else - if (calc_Tsfc) then + if (calc_Tsfc) then call zerolayer_temperature(nilyr, nslyr, & rhoa, flw, & @@ -389,14 +389,14 @@ subroutine thermo_vertical (nilyr, nslyr, & ! fcondtop is set in call to set_sfcflux in step_therm1 !------------------------------------------------------------ - fcondbotn = fcondtopn ! zero layer - + fcondbotn = fcondtopn ! zero layer + endif ! calc_Tsfc endif ! heat_capacity #endif ! intermediate energy for error check - + einter = c0 do k = 1, nslyr einter = einter + hslyr * zqsn(k) @@ -420,7 +420,7 @@ subroutine thermo_vertical (nilyr, nslyr, & ! Compute growth and/or melting at the top and bottom surfaces. ! Add new snowfall. ! Repartition ice into equal-thickness layers, conserving energy. - !----------------------------------------------------------------- + !----------------------------------------------------------------- call thickness_changes(nilyr, nslyr, & dt, yday, & @@ -477,25 +477,25 @@ subroutine thermo_vertical (nilyr, nslyr, & ! evapn < 0 => sublimation, evapn > 0 => condensation ! aerosol flux is accounted for in icepack_aerosol.F90 !----------------------------------------------------------------- - + dhi = hin - worki dhs = hsn - works - hsn_new - + freshn = freshn + evapn - (rhoi*dhi + rhos*dhs) / dt fsaltn = fsaltn - rhoi*dhi*ice_ref_salinity*p001/dt - fhocnn = fhocnn + fadvocn ! for ktherm=2 + fhocnn = fhocnn + fadvocn ! for ktherm=2 if (hin == c0) then if (tr_pond_topo) fpond = fpond - aicen * apond * hpond endif !----------------------------------------------------------------- - ! Given the vertical thermo state variables, compute the new ice + ! Given the vertical thermo state variables, compute the new ice ! state variables. !----------------------------------------------------------------- call update_state_vthermo(nilyr, nslyr, & - Tbot, Tsf, & + Tbot, Tsf, & hin, hsn, & zqin, zSin, & zqsn, & @@ -519,7 +519,7 @@ subroutine frzmlt_bottom_lateral (dt, ncat, & aice, frzmlt, & vicen, vsnon, & qicen, qsnon, & - sst, Tf, & + sst, Tf, & ustar_min, & fbot_xfer_type, & strocnxT, strocnyT, & @@ -604,20 +604,20 @@ subroutine frzmlt_bottom_lateral (dt, ncat, & wlat = c0 if (aice > puny .and. frzmlt < c0) then ! ice can melt - + !----------------------------------------------------------------- ! Use boundary layer theory for fbot. ! See Maykut and McPhee (1995): JGR, 100, 24,691-24,703. !----------------------------------------------------------------- deltaT = max((sst-Tbot),c0) - + ! strocnx has units N/m^2 so strocnx/rho has units m^2/s^2 ustar = sqrt (sqrt(strocnxT**2+strocnyT**2)/rhow) ustar = max (ustar,ustar_min) if (trim(fbot_xfer_type) == 'Cdn_ocn') then - ! Note: Cdn_ocn has already been used for calculating ustar + ! Note: Cdn_ocn has already been used for calculating ustar ! (formdrag only) --- David Schroeder (CPOM) cpchr = -cp_ocn*rhow*Cdn_ocn else ! fbot_xfer_type == 'constant' @@ -627,7 +627,7 @@ subroutine frzmlt_bottom_lateral (dt, ncat, & fbot = cpchr * deltaT * ustar ! < 0 fbot = max (fbot, frzmlt) ! frzmlt < fbot < 0 - + !!! uncomment to use all frzmlt for standalone runs ! fbot = min (c0, frzmlt) @@ -646,41 +646,41 @@ subroutine frzmlt_bottom_lateral (dt, ncat, & !----------------------------------------------------------------- do n = 1, ncat - + etot = c0 qavg = c0 - + ! melting energy/unit area in each column, etot < 0 - + do k = 1, nslyr etot = etot + qsnon(k,n) * vsnon(n)/real(nslyr,kind=dbl_kind) qavg = qavg + qsnon(k,n) enddo - + do k = 1, nilyr etot = etot + qicen(k,n) * vicen(n)/real(nilyr,kind=dbl_kind) qavg = qavg + qicen(k,n) enddo ! nilyr - + ! lateral heat flux, fside < 0 if (tr_fsd) then ! floe size distribution fside = fside + wlat*qavg else ! default floe size fside = fside + rside*etot/dt endif - + enddo ! n - + !----------------------------------------------------------------- ! Limit bottom and lateral heat fluxes if necessary. !----------------------------------------------------------------- - - xtmp = frzmlt/(fbot + fside + puny) + + xtmp = frzmlt/(fbot + fside + puny) xtmp = min(xtmp, c1) fbot = fbot * xtmp rside = rside * xtmp fside = fside * xtmp - + endif end subroutine frzmlt_bottom_lateral @@ -712,12 +712,12 @@ subroutine init_vertical_profile(nilyr, nslyr, & aicen , & ! concentration of ice vicen , & ! volume per unit area of ice (m) vsnon ! volume per unit area of snow (m) - + real (kind=dbl_kind), intent(out):: & hilyr , & ! ice layer thickness hslyr , & ! snow layer thickness einit ! initial energy of melting (J m-2) - + real (kind=dbl_kind), intent(out):: & hin , & ! ice thickness (m) hsn ! snow thickness (m) @@ -728,7 +728,7 @@ subroutine init_vertical_profile(nilyr, nslyr, & real (kind=dbl_kind), dimension (:), intent(in) :: & zSin ! internal ice layer salinities - + real (kind=dbl_kind), dimension (:), & intent(inout) :: & zqsn , & ! snow enthalpy @@ -765,7 +765,7 @@ subroutine init_vertical_profile(nilyr, nslyr, & tice_low = .false. einit = c0 - + !----------------------------------------------------------------- ! Surface temperature, ice and snow thickness ! Initialize internal energy @@ -798,7 +798,7 @@ subroutine init_vertical_profile(nilyr, nslyr, & #else if (hslyr > hs_min/rnslyr) then #endif - ! zqsn < 0 + ! zqsn < 0 Tmax = -zqsn(k)*puny*rnslyr / & (rhos*cp_ice*vsnon) else @@ -853,7 +853,7 @@ subroutine init_vertical_profile(nilyr, nslyr, & write(warnstr,*) subname, 'zqsn',zqsn(k),-Lfresh*rhos,zqsn(k)+Lfresh*rhos call icepack_warnings_add(warnstr) call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, zTsn > Tmax" ) + call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, zTsn > Tmax" ) return endif @@ -883,7 +883,7 @@ subroutine init_vertical_profile(nilyr, nslyr, & write(warnstr,*) subname, hsn call icepack_warnings_add(warnstr) call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, zTsn < Tmin" ) + call icepack_warnings_add(subname//" init_vertical_profile: Starting thermo, zTsn < Tmin" ) return endif @@ -920,10 +920,10 @@ subroutine init_vertical_profile(nilyr, nslyr, & write(warnstr,*) subname, 'min_salin =', min_salin call icepack_warnings_add(warnstr) call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" init_vertical_profile: Starting zSin < min_salin, layer" ) + call icepack_warnings_add(subname//" init_vertical_profile: Starting zSin < min_salin, layer" ) return endif - + if (ktherm == 2) then Tmlts(k) = liquidus_temperature_mush(zSin(k)) else @@ -941,7 +941,7 @@ subroutine init_vertical_profile(nilyr, nslyr, & !----------------------------------------------------------------- ! Compute ice temperatures from enthalpies using quadratic formula !----------------------------------------------------------------- - + if (ktherm == 2) then zTin(k) = icepack_mushy_temperature_mush(zqin(k),zSin(k)) else @@ -990,7 +990,7 @@ subroutine init_vertical_profile(nilyr, nslyr, & 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)) @@ -1050,7 +1050,7 @@ subroutine init_vertical_profile(nilyr, nslyr, & ! initial energy per unit area of ice/snow, relative to 0 C !----------------------------------------------------------------- - einit = einit + hilyr*zqin(k) + einit = einit + hilyr*zqin(k) enddo ! nilyr @@ -1066,7 +1066,7 @@ end subroutine init_vertical_profile subroutine thickness_changes (nilyr, nslyr, & dt, yday, & - efinal, & + efinal, & hin, hilyr, & hsn, hslyr, & zqin, zqsn, & @@ -1081,7 +1081,7 @@ subroutine thickness_changes (nilyr, nslyr, & meltt, melts, & meltsliq, frain, & meltb, & - congel, snoice, & + congel, snoice, & mlt_onset, frz_onset,& zSin, sss, & dsnow, rsnw) @@ -1153,7 +1153,7 @@ subroutine thickness_changes (nilyr, nslyr, & zSin ! ice layer salinity (ppt) real (kind=dbl_kind), intent(in) :: & - sss ! ocean salinity (PSU) + sss ! ocean salinity (PSU) ! local variables @@ -1244,7 +1244,7 @@ subroutine thickness_changes (nilyr, nslyr, & ! For l_brine = true, this should not be necessary. !----------------------------------------------------------------- - if (.not. l_brine) then + if (.not. l_brine) then do k = 1, nslyr Ts = (Lfresh + zqsn(k)/rhos) / cp_ice @@ -1319,7 +1319,7 @@ subroutine thickness_changes (nilyr, nslyr, & evapn = evapn + dhi*rhoi evapin = evapin + dhi*rhoi ! enthalpy of melt water - emlt_atm = emlt_atm - qmlt(1) * dhi + emlt_atm = emlt_atm - qmlt(1) * dhi endif !-------------------------------------------------------------- @@ -1340,7 +1340,7 @@ subroutine thickness_changes (nilyr, nslyr, & else - Tmlts = -zSin(nilyr) * depressT + Tmlts = -zSin(nilyr) * depressT ! enthalpy of new ice growing at bottom surface #ifdef UNDEPRECATE_0LAYER @@ -1390,9 +1390,9 @@ subroutine thickness_changes (nilyr, nslyr, & do k = 1, nslyr !-------------------------------------------------------------- - ! Remove internal snow melt + ! Remove internal snow melt !-------------------------------------------------------------- - + ! more efficient formulation using Ts, dhs > 0 (not BFB) ! Ts = (Lfresh + zqsn(k)/rhos) / cp_ice ! if (ktherm == 2 .and. Ts > c0) then @@ -1469,12 +1469,12 @@ subroutine thickness_changes (nilyr, nslyr, & esub = max(esub, c0) evapn = evapn + dhi*rhoi evapin = evapin + dhi*rhoi - emlt_ocn = emlt_ocn - qmlt(k) * dhi + emlt_ocn = emlt_ocn - qmlt(k) * dhi !-------------------------------------------------------------- ! Melt ice (top) !-------------------------------------------------------------- - + if (qm(k) < c0) then dhi = max(-dzi(k), etop_mlt/qm(k)) else @@ -1510,7 +1510,7 @@ subroutine thickness_changes (nilyr, nslyr, & dzi(k) = dzi(k) + dhi ! zqin < 0, dhi < 0 ebot_mlt = max(ebot_mlt - dhi*qm(k), c0) - ! history diagnostics + ! history diagnostics meltb = meltb -dhi enddo ! nilyr @@ -1520,7 +1520,7 @@ subroutine thickness_changes (nilyr, nslyr, & !-------------------------------------------------------------- ! Melt snow (only if all the ice has melted) !-------------------------------------------------------------- - + dhs = max(-dzs(k), ebot_mlt/zqsn(k)) mass = massice(k) + massliq(k) @@ -1679,7 +1679,7 @@ subroutine thickness_changes (nilyr, nslyr, & !----------------------------------------------------------------- ! Compute desired layer thicknesses. !----------------------------------------------------------------- - + if (hin > c0) then hilyr = hin / real(nilyr,kind=dbl_kind) else @@ -1715,18 +1715,18 @@ subroutine thickness_changes (nilyr, nslyr, & !----------------------------------------------------------------- ! Conserving energy, compute the enthalpy of the new equal layers. !----------------------------------------------------------------- - + call adjust_enthalpy (nilyr, & zi1, zi2, & hilyr, hin, & - zqin) + zqin) if (icepack_warnings_aborted(subname)) return if (ktherm == 2) & call adjust_enthalpy (nilyr, & zi1, zi2, & hilyr, hin, & - zSin) + zSin) if (icepack_warnings_aborted(subname)) return #ifdef UNDEPRECATE_0LAYER @@ -1734,7 +1734,7 @@ subroutine thickness_changes (nilyr, nslyr, & zqin(1) = -rhoi * Lfresh zqsn(1) = -rhos * Lfresh - + endif #endif if (nslyr > 1) then @@ -1746,10 +1746,10 @@ subroutine thickness_changes (nilyr, nslyr, & zs1(1) = c0 zs1(1+nslyr) = hsn - + zs2(1) = c0 zs2(1+nslyr) = hsn - + do k = 1, nslyr-1 zs1(k+1) = zs1(k) + dzs(k) zs2(k+1) = zs2(k) + hslyr @@ -1763,7 +1763,7 @@ subroutine thickness_changes (nilyr, nslyr, & call adjust_enthalpy (nslyr, & zs1, zs2, & hslyr, hsn, & - zqsn) + zqsn) if (snwgrain) then call adjust_enthalpy (nslyr, & @@ -1902,7 +1902,7 @@ subroutine freeboard (nslyr, & !----------------------------------------------------------------- ! Determine whether snow lies below freeboard. !----------------------------------------------------------------- - + dhin = c0 dhsn = c0 hqs = c0 @@ -1949,7 +1949,7 @@ subroutine freeboard (nslyr, & ! update ice age due to freezing (new ice age = dt) ! if (tr_iage) & ! iage = (iage*hin+dt*dhin)/(hin+dhin) - + wk1 = dzi(1) + dhin hin = hin + dhin zqin(1) = (dzi(1)*zqin(1) + hqs) / wk1 @@ -1990,7 +1990,7 @@ subroutine conservation_check_vthermo(dt, & fsnow , & ! snowfall rate (kg m-2 s-1) fcondtopn , & fadvocn , & - fbot + fbot real (kind=dbl_kind), intent(in) :: & einit , & ! initial energy of melting (J m-2) @@ -2016,14 +2016,14 @@ subroutine conservation_check_vthermo(dt, & ! is the energy change in the system ice + vapor, and the latent ! heat lost by the ice is equal to that gained by the vapor. !----------------------------------------------------------------- - + einp = (fsurfn - flatn + fswint - fhocnn & - fsnow*Lfresh - fadvocn) * dt ferr = abs(efinal-einit-einp) / dt if (ferr > 1.1_dbl_kind*ferrmax) then call icepack_warnings_setabort(.true.,__FILE__,__LINE__) - call icepack_warnings_add(subname//" conservation_check_vthermo: Thermo energy conservation error" ) + call icepack_warnings_add(subname//" conservation_check_vthermo: Thermo energy conservation error" ) write(warnstr,*) subname, 'Thermo energy conservation error' call icepack_warnings_add(warnstr) @@ -2069,7 +2069,7 @@ subroutine conservation_check_vthermo(dt, & ! write(warnstr,*) subname, fsurfn,flatn,fswint,fhocnn ! call icepack_warnings_add(warnstr) - + write(warnstr,*) subname, 'dt*(fsurfn, flatn, fswint, fhocn, fsnow*Lfresh, fadvocn):' call icepack_warnings_add(warnstr) write(warnstr,*) subname, fsurfn*dt, flatn*dt, & @@ -2151,7 +2151,7 @@ subroutine update_state_vthermo(nilyr, nslyr, & vicen = aicen * hin vsnon = aicen * hsn endif - + end subroutine update_state_vthermo !======================================================================= @@ -2209,15 +2209,15 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & fcondtop , fcondtopn , & fcondbot , fcondbotn , & fswsfcn , fswintn , & - fswthrun , & - fswthrun_vdr, & - fswthrun_vdf, & - fswthrun_idr, & - fswthrun_idf, & + fswthrun , & + fswthrun_vdr, & + fswthrun_vdf, & + fswthrun_idr, & + fswthrun_idf, & fswabs , & flwout , & Sswabsn , Iswabsn , & - flw , & + flw , & fsens , fsensn , & flat , flatn , & evap , & @@ -2261,7 +2261,7 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & uvel , & ! x-component of velocity (m/s) vvel , & ! y-component of velocity (m/s) strax , & ! wind stress components (N/m^2) - stray , & ! + stray , & ! yday ! day of year logical (kind=log_kind), intent(in) :: & @@ -2735,13 +2735,13 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & if (aicen_init(n) > puny) then - if (calc_Tsfc .or. calc_strair) then + if (calc_Tsfc .or. calc_strair) then !----------------------------------------------------------------- ! Atmosphere boundary layer calculation; compute coefficients ! for sensible and latent heat fluxes. ! - ! NOTE: The wind stress is computed here for later use if + ! NOTE: The wind stress is computed here for later use if ! calc_strair = .true. Otherwise, the wind stress ! components are set to the data values. !----------------------------------------------------------------- @@ -2771,7 +2771,7 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & strairxn = strax strairyn = stray #else - ! NEMO wind stress is supplied on u grid, multipied + ! NEMO wind stress is supplied on u grid, multipied ! by ice concentration and set directly in evp, so ! strairxT/yT = 0. Zero u-components here for safety. strairxn = c0 @@ -2794,14 +2794,14 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & !----------------------------------------------------------------- ! Vertical thermodynamics: Heat conduction, growth and melting. - !----------------------------------------------------------------- + !----------------------------------------------------------------- if (.not.(calc_Tsfc)) then - ! If not calculating surface temperature and fluxes, set - ! surface fluxes (flatn, fsurfn, and fcondtopn) to be used + ! If not calculating surface temperature and fluxes, set + ! surface fluxes (flatn, fsurfn, and fcondtopn) to be used ! in thickness_changes - + ! hadgem routine sets fluxes to default values in ice-only mode call set_sfcflux(aicen (n), & flatn_f (n), fsensn_f (n), & @@ -2880,7 +2880,7 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & nilyr = nilyr, nslyr = nslyr, & meltt = melttn(n),melts = meltsn(n), & meltb = meltbn(n),congel=congeln(n), & - snoice=snoicen(n),evap=evapn, & + snoice=snoicen(n),evap=evapn, & fsnow=fsnow, Tsfc=Tsfc(n), & Qref_iso=Qrefn_iso(:), & isosno=l_isosno(:,n),isoice=l_isoice(:,n), & @@ -2919,10 +2919,10 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & !call ice_timer_start(timer_ponds) if (tr_pond) then - + #ifdef UNDEPRECATE_CESMPONDS if (tr_pond_cesm) then - rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) + rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) call compute_ponds_cesm(dt=dt, & hi_min=hi_min, & rfrac=rfrac, & @@ -2936,7 +2936,7 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & hpnd=hpnd (n), & meltsliqn=l_meltsliqn(n)) if (icepack_warnings_aborted(subname)) return - + elseif (tr_pond_lvl) then #else if (tr_pond_lvl) then @@ -2968,10 +2968,10 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & ipnd=ipnd (n), & meltsliqn=l_meltsliqn(n)) if (icepack_warnings_aborted(subname)) return - + elseif (tr_pond_topo) then if (aicen_init(n) > puny) then - + ! collect liquid water in ponds ! assume salt still runs off rfrac = rfracmin + (rfracmax-rfracmin) * aicen(n) @@ -3004,7 +3004,7 @@ subroutine icepack_step_therm1(dt, ncat, nilyr, nslyr, & if (aicen_init(n) > puny) & call merge_fluxes (aicen=aicen_init(n), & - flw=flw, & + flw=flw, & strairxn=strairxn, strairyn=strairyn,& Cdn_atm_ratio_n=Cdn_atm_ratio_n, & fsurfn=fsurfn(n), fcondtopn=fcondtopn(n),& diff --git a/columnphysics/icepack_tracers.F90 b/columnphysics/icepack_tracers.F90 index 18d63e4bc..9af512f17 100644 --- a/columnphysics/icepack_tracers.F90 +++ b/columnphysics/icepack_tracers.F90 @@ -1,5 +1,5 @@ !======================================================================= -! Indices and flags associated with the tracer infrastructure. +! Indices and flags associated with the tracer infrastructure. ! Grid-dependent and max_trcr-dependent arrays are declared in ice_state.F90. ! ! author Elizabeth C. Hunke, LANL @@ -88,11 +88,11 @@ module icepack_tracers nt_isoice = 0, & ! starting index for isotopes in ice nt_aero = 0, & ! starting index for aerosols in ice nt_bgc_Nit = 0, & ! nutrients - nt_bgc_Am = 0, & ! + nt_bgc_Am = 0, & ! nt_bgc_Sil = 0, & ! nt_bgc_DMSPp = 0, & ! trace gases (skeletal layer) - nt_bgc_DMSPd = 0, & ! - nt_bgc_DMS = 0, & ! + nt_bgc_DMSPd = 0, & ! + nt_bgc_DMS = 0, & ! nt_bgc_PON = 0, & ! zooplankton and detritus nt_bgc_hum = 0, & ! humic material nt_zbgc_frac = 0, & ! fraction of tracer in the mobile phase @@ -118,7 +118,7 @@ module icepack_tracers ! biogeochemistry !----------------------------------------------------------------- - logical (kind=log_kind), public :: & + logical (kind=log_kind), public :: & tr_zaero = .false., & ! if .true., black carbon as tracers (n_zaero) tr_bgc_Nit = .false., & ! if .true. Nitrate tracer in ice tr_bgc_N = .false., & ! if .true., algal nitrogen tracers (n_algae) @@ -139,11 +139,11 @@ module icepack_tracers integer (kind=int_kind), dimension(max_aero), public :: & nlt_zaero_sw = 0 ! points to aerosol in trcrn_sw - + integer (kind=int_kind), dimension(max_algae), public :: & nlt_bgc_N = 0, & ! algae - nlt_bgc_C = 0, & ! - nlt_bgc_chl = 0 ! + nlt_bgc_C = 0, & ! + nlt_bgc_chl = 0 ! integer (kind=int_kind), dimension(max_doc), public :: & nlt_bgc_DOC = 0 ! disolved organic carbon @@ -163,11 +163,11 @@ module icepack_tracers integer (kind=int_kind), public :: & nlt_bgc_Nit = 0, & ! nutrients - nlt_bgc_Am = 0, & ! + nlt_bgc_Am = 0, & ! nlt_bgc_Sil = 0, & ! nlt_bgc_DMSPp= 0, & ! trace gases (skeletal layer) - nlt_bgc_DMSPd= 0, & ! - nlt_bgc_DMS = 0, & ! + nlt_bgc_DMSPd= 0, & ! + nlt_bgc_DMS = 0, & ! nlt_bgc_PON = 0, & ! zooplankton and detritus nlt_bgc_hum = 0 ! humic material @@ -176,7 +176,7 @@ module icepack_tracers nt_bgc_C = 0, & ! diatoms, phaeocystis, pico/small nt_bgc_chl = 0 ! diatoms, phaeocystis, pico/small - integer (kind=int_kind), dimension(max_doc), public :: & + integer (kind=int_kind), dimension(max_doc), public :: & nt_bgc_DOC = 0 ! dissolved organic carbon integer (kind=int_kind), dimension(max_don), public :: & @@ -191,13 +191,13 @@ module icepack_tracers integer (kind=int_kind), dimension(max_aero), public :: & nt_zaero = 0 ! black carbon and other aerosols - + integer (kind=int_kind), dimension(max_nbtrcr), public :: & bio_index_o = 0 ! relates nlt_bgc_NO to ocean concentration index ! see ocean_bio_all integer (kind=int_kind), dimension(max_nbtrcr), public :: & - bio_index = 0 ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N + bio_index = 0 ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N !======================================================================= @@ -235,17 +235,17 @@ subroutine icepack_init_tracer_flags(& tr_aero_in , & ! if .true., use aerosol tracers tr_brine_in , & ! if .true., brine height differs from ice thickness tr_zaero_in , & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit_in , & ! if .true., Nitrate tracer in ice + tr_bgc_Nit_in , & ! if .true., Nitrate tracer in ice tr_bgc_N_in , & ! if .true., algal nitrogen tracers (n_algae) tr_bgc_DON_in , & ! if .true., DON pools are tracers (n_don) - tr_bgc_C_in , & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl_in , & ! if .true., algal chlorophyll tracers - tr_bgc_Am_in , & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil_in , & ! if .true., silicon as nutrient tracer - tr_bgc_DMS_in , & ! if .true., DMS as product tracer - tr_bgc_Fe_in , & ! if .true., Fe as product tracer - tr_bgc_hum_in , & ! if .true., hum as product tracer - tr_bgc_PON_in ! if .true., PON as product tracer + tr_bgc_C_in , & ! if .true., algal carbon tracers + DOC and DIC + tr_bgc_chl_in , & ! if .true., algal chlorophyll tracers + tr_bgc_Am_in , & ! if .true., ammonia/um as nutrient tracer + tr_bgc_Sil_in , & ! if .true., silicon as nutrient tracer + tr_bgc_DMS_in , & ! if .true., DMS as product tracer + tr_bgc_Fe_in , & ! if .true., Fe as product tracer + tr_bgc_hum_in , & ! if .true., hum as product tracer + tr_bgc_PON_in ! if .true., PON as product tracer !autodocument_end @@ -265,18 +265,18 @@ subroutine icepack_init_tracer_flags(& if (present(tr_iso_in) ) tr_iso = tr_iso_in if (present(tr_aero_in) ) tr_aero = tr_aero_in if (present(tr_brine_in) ) tr_brine = tr_brine_in - if (present(tr_zaero_in) ) tr_zaero = tr_zaero_in + if (present(tr_zaero_in) ) tr_zaero = tr_zaero_in if (present(tr_bgc_Nit_in)) tr_bgc_Nit = tr_bgc_Nit_in - if (present(tr_bgc_N_in) ) tr_bgc_N = tr_bgc_N_in + if (present(tr_bgc_N_in) ) tr_bgc_N = tr_bgc_N_in if (present(tr_bgc_DON_in)) tr_bgc_DON = tr_bgc_DON_in - if (present(tr_bgc_C_in) ) tr_bgc_C = tr_bgc_C_in + if (present(tr_bgc_C_in) ) tr_bgc_C = tr_bgc_C_in if (present(tr_bgc_chl_in)) tr_bgc_chl = tr_bgc_chl_in if (present(tr_bgc_Am_in) ) tr_bgc_Am = tr_bgc_Am_in if (present(tr_bgc_Sil_in)) tr_bgc_Sil = tr_bgc_Sil_in if (present(tr_bgc_DMS_in)) tr_bgc_DMS = tr_bgc_DMS_in - if (present(tr_bgc_Fe_in )) tr_bgc_Fe = tr_bgc_Fe_in + if (present(tr_bgc_Fe_in )) tr_bgc_Fe = tr_bgc_Fe_in if (present(tr_bgc_hum_in)) tr_bgc_hum = tr_bgc_hum_in - if (present(tr_bgc_PON_in)) tr_bgc_PON = tr_bgc_PON_in + if (present(tr_bgc_PON_in)) tr_bgc_PON = tr_bgc_PON_in end subroutine icepack_init_tracer_flags @@ -312,17 +312,17 @@ subroutine icepack_query_tracer_flags(& tr_aero_out , & ! if .true., use aerosol tracers tr_brine_out , & ! if .true., brine height differs from ice thickness tr_zaero_out , & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit_out , & ! if .true., Nitrate tracer in ice + tr_bgc_Nit_out , & ! if .true., Nitrate tracer in ice tr_bgc_N_out , & ! if .true., algal nitrogen tracers (n_algae) tr_bgc_DON_out , & ! if .true., DON pools are tracers (n_don) - tr_bgc_C_out , & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl_out , & ! if .true., algal chlorophyll tracers - tr_bgc_Am_out , & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil_out , & ! if .true., silicon as nutrient tracer - tr_bgc_DMS_out , & ! if .true., DMS as product tracer - tr_bgc_Fe_out , & ! if .true., Fe as product tracer - tr_bgc_hum_out , & ! if .true., hum as product tracer - tr_bgc_PON_out ! if .true., PON as product tracer + tr_bgc_C_out , & ! if .true., algal carbon tracers + DOC and DIC + tr_bgc_chl_out , & ! if .true., algal chlorophyll tracers + tr_bgc_Am_out , & ! if .true., ammonia/um as nutrient tracer + tr_bgc_Sil_out , & ! if .true., silicon as nutrient tracer + tr_bgc_DMS_out , & ! if .true., DMS as product tracer + tr_bgc_Fe_out , & ! if .true., Fe as product tracer + tr_bgc_hum_out , & ! if .true., hum as product tracer + tr_bgc_PON_out ! if .true., PON as product tracer !autodocument_end @@ -371,29 +371,29 @@ subroutine icepack_write_tracer_flags(iounit) write(iounit,*) subname//":" write(iounit,*) " tr_iage = ",tr_iage - write(iounit,*) " tr_FY = ",tr_FY - write(iounit,*) " tr_lvl = ",tr_lvl + write(iounit,*) " tr_FY = ",tr_FY + write(iounit,*) " tr_lvl = ",tr_lvl write(iounit,*) " tr_pond = ",tr_pond #ifdef UNDEPRECATE_CESMPONDS write(iounit,*) " tr_pond_cesm = ",tr_pond_cesm #endif - write(iounit,*) " tr_pond_lvl = ",tr_pond_lvl + 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_iso = ",tr_iso write(iounit,*) " tr_aero = ",tr_aero - write(iounit,*) " tr_brine = ",tr_brine - write(iounit,*) " tr_zaero = ",tr_zaero + write(iounit,*) " tr_brine = ",tr_brine + write(iounit,*) " tr_zaero = ",tr_zaero write(iounit,*) " tr_bgc_Nit = ",tr_bgc_Nit - write(iounit,*) " tr_bgc_N = ",tr_bgc_N + write(iounit,*) " tr_bgc_N = ",tr_bgc_N write(iounit,*) " tr_bgc_DON = ",tr_bgc_DON - write(iounit,*) " tr_bgc_C = ",tr_bgc_C + write(iounit,*) " tr_bgc_C = ",tr_bgc_C write(iounit,*) " tr_bgc_chl = ",tr_bgc_chl - write(iounit,*) " tr_bgc_Am = ",tr_bgc_Am + write(iounit,*) " tr_bgc_Am = ",tr_bgc_Am write(iounit,*) " tr_bgc_Sil = ",tr_bgc_Sil write(iounit,*) " tr_bgc_DMS = ",tr_bgc_DMS - write(iounit,*) " tr_bgc_Fe = ",tr_bgc_Fe + write(iounit,*) " tr_bgc_Fe = ",tr_bgc_Fe write(iounit,*) " tr_bgc_hum = ",tr_bgc_hum write(iounit,*) " tr_bgc_PON = ",tr_bgc_PON @@ -405,7 +405,7 @@ end subroutine icepack_write_tracer_flags 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_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, & @@ -442,37 +442,37 @@ subroutine icepack_init_tracer_indices(& nt_isosno_in, & ! starting index for isotopes in snow nt_isoice_in, & ! starting index for isotopes in ice nt_aero_in, & ! starting index for aerosols in ice - nt_bgc_Nit_in, & ! nutrients - nt_bgc_Am_in, & ! + nt_bgc_Nit_in, & ! nutrients + nt_bgc_Am_in, & ! nt_bgc_Sil_in, & ! nt_bgc_DMSPp_in,&! trace gases (skeletal layer) - nt_bgc_DMSPd_in,&! - nt_bgc_DMS_in, & ! - nt_bgc_hum_in, & ! - nt_bgc_PON_in, & ! zooplankton and detritus - nlt_bgc_Nit_in,& ! nutrients - nlt_bgc_Am_in, & ! + nt_bgc_DMSPd_in,&! + nt_bgc_DMS_in, & ! + nt_bgc_hum_in, & ! + nt_bgc_PON_in, & ! zooplankton and detritus + nlt_bgc_Nit_in,& ! nutrients + nlt_bgc_Am_in, & ! nlt_bgc_Sil_in,& ! nlt_bgc_DMSPp_in,&! trace gases (skeletal layer) - nlt_bgc_DMSPd_in,&! - nlt_bgc_DMS_in,& ! - nlt_bgc_hum_in,& ! - nlt_bgc_PON_in,& ! zooplankton and detritus + nlt_bgc_DMSPd_in,&! + nlt_bgc_DMS_in,& ! + nlt_bgc_hum_in,& ! + nlt_bgc_PON_in,& ! zooplankton and detritus nt_zbgc_frac_in,&! fraction of tracer in the mobile phase nt_bgc_S_in, & ! Bulk salinity in fraction ice with dynamic salinity (Bio grid)) nlt_chl_sw_in ! points to total chla in trcrn_sw integer (kind=int_kind), dimension(:), intent(in), optional :: & - bio_index_o_in, & - bio_index_in + bio_index_o_in, & + bio_index_in integer (kind=int_kind), dimension(:), intent(in), optional :: & - nt_bgc_N_in , & ! diatoms, phaeocystis, pico/small - nt_bgc_C_in , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl_in, & ! diatoms, phaeocystis, pico/small - nlt_bgc_N_in , & ! diatoms, phaeocystis, pico/small - nlt_bgc_C_in , & ! diatoms, phaeocystis, pico/small - nlt_bgc_chl_in ! diatoms, phaeocystis, pico/small + nt_bgc_N_in , & ! diatoms, phaeocystis, pico/small + nt_bgc_C_in , & ! diatoms, phaeocystis, pico/small + nt_bgc_chl_in, & ! diatoms, phaeocystis, pico/small + nlt_bgc_N_in , & ! diatoms, phaeocystis, pico/small + nlt_bgc_C_in , & ! diatoms, phaeocystis, pico/small + nlt_bgc_chl_in ! diatoms, phaeocystis, pico/small integer (kind=int_kind), dimension(:), intent(in), optional :: & nt_bgc_DOC_in, & ! dissolved organic carbon @@ -500,7 +500,7 @@ subroutine icepack_init_tracer_indices(& !autodocument_end ! local - integer (kind=int_kind) :: k, nsiz + integer (kind=int_kind) :: nsiz character(len=*),parameter :: subname='(icepack_init_tracer_indices)' if (present(nt_Tsfc_in)) nt_Tsfc = nt_Tsfc_in @@ -767,7 +767,7 @@ end subroutine icepack_init_tracer_indices 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_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, & @@ -804,37 +804,37 @@ subroutine icepack_query_tracer_indices(& nt_isosno_out, & ! starting index for isotopes in snow nt_isoice_out, & ! starting index for isotopes in ice nt_aero_out, & ! starting index for aerosols in ice - nt_bgc_Nit_out, & ! nutrients - nt_bgc_Am_out, & ! + nt_bgc_Nit_out, & ! nutrients + nt_bgc_Am_out, & ! nt_bgc_Sil_out, & ! nt_bgc_DMSPp_out,&! trace gases (skeletal layer) - nt_bgc_DMSPd_out,&! - nt_bgc_DMS_out, & ! - nt_bgc_hum_out, & ! - nt_bgc_PON_out, & ! zooplankton and detritus - nlt_bgc_Nit_out,& ! nutrients - nlt_bgc_Am_out, & ! + nt_bgc_DMSPd_out,&! + nt_bgc_DMS_out, & ! + nt_bgc_hum_out, & ! + nt_bgc_PON_out, & ! zooplankton and detritus + nlt_bgc_Nit_out,& ! nutrients + nlt_bgc_Am_out, & ! nlt_bgc_Sil_out,& ! nlt_bgc_DMSPp_out,&! trace gases (skeletal layer) - nlt_bgc_DMSPd_out,&! - nlt_bgc_DMS_out,& ! - nlt_bgc_hum_out,& ! - nlt_bgc_PON_out,& ! zooplankton and detritus + nlt_bgc_DMSPd_out,&! + nlt_bgc_DMS_out,& ! + nlt_bgc_hum_out,& ! + nlt_bgc_PON_out,& ! zooplankton and detritus nt_zbgc_frac_out,&! fraction of tracer in the mobile phase nt_bgc_S_out, & ! Bulk salinity in fraction ice with dynamic salinity (Bio grid)) nlt_chl_sw_out ! points to total chla in trcrn_sw integer (kind=int_kind), dimension(:), intent(out), optional :: & - bio_index_o_out, & - bio_index_out + bio_index_o_out, & + bio_index_out integer (kind=int_kind), dimension(:), intent(out), optional :: & - nt_bgc_N_out , & ! diatoms, phaeocystis, pico/small - nt_bgc_C_out , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl_out, & ! diatoms, phaeocystis, pico/small - nlt_bgc_N_out , & ! diatoms, phaeocystis, pico/small - nlt_bgc_C_out , & ! diatoms, phaeocystis, pico/small - nlt_bgc_chl_out ! diatoms, phaeocystis, pico/small + nt_bgc_N_out , & ! diatoms, phaeocystis, pico/small + nt_bgc_C_out , & ! diatoms, phaeocystis, pico/small + nt_bgc_chl_out, & ! diatoms, phaeocystis, pico/small + nlt_bgc_N_out , & ! diatoms, phaeocystis, pico/small + nlt_bgc_C_out , & ! diatoms, phaeocystis, pico/small + nlt_bgc_chl_out ! diatoms, phaeocystis, pico/small integer (kind=int_kind), dimension(:), intent(out), optional :: & nt_bgc_DOC_out, & ! dissolved organic carbon @@ -905,25 +905,25 @@ subroutine icepack_query_tracer_indices(& if (present(bio_index_o_out) ) bio_index_o_out = bio_index_o if (present(bio_index_out) ) bio_index_out = bio_index - if (present(nt_bgc_N_out) ) nt_bgc_N_out = nt_bgc_N - if (present(nlt_bgc_N_out) ) nlt_bgc_N_out = nlt_bgc_N - if (present(nt_bgc_C_out) ) nt_bgc_C_out = nt_bgc_C - if (present(nlt_bgc_C_out) ) nlt_bgc_C_out = nlt_bgc_C - if (present(nt_bgc_chl_out) ) nt_bgc_chl_out = nt_bgc_chl - if (present(nlt_bgc_chl_out) ) nlt_bgc_chl_out = nlt_bgc_chl - if (present(nt_bgc_DOC_out) ) nt_bgc_DOC_out = nt_bgc_DOC - if (present(nlt_bgc_DOC_out) ) nlt_bgc_DOC_out = nlt_bgc_DOC - if (present(nt_bgc_DON_out) ) nt_bgc_DON_out = nt_bgc_DON - if (present(nlt_bgc_DON_out) ) nlt_bgc_DON_out = nlt_bgc_DON - if (present(nt_bgc_DIC_out) ) nt_bgc_DIC_out = nt_bgc_DIC - if (present(nlt_bgc_DIC_out) ) nlt_bgc_DIC_out = nlt_bgc_DIC - if (present(nt_bgc_Fed_out) ) nt_bgc_Fed_out = nt_bgc_Fed - if (present(nlt_bgc_Fed_out) ) nlt_bgc_Fed_out = nlt_bgc_Fed - if (present(nt_bgc_Fep_out) ) nt_bgc_Fep_out = nt_bgc_Fep - if (present(nlt_bgc_Fep_out) ) nlt_bgc_Fep_out = nlt_bgc_Fep - if (present(nt_zaero_out) ) nt_zaero_out = nt_zaero - if (present(nlt_zaero_out) ) nlt_zaero_out = nlt_zaero - if (present(nlt_zaero_sw_out)) nlt_zaero_sw_out = nlt_zaero_sw + if (present(nt_bgc_N_out) ) nt_bgc_N_out = nt_bgc_N + if (present(nlt_bgc_N_out) ) nlt_bgc_N_out = nlt_bgc_N + if (present(nt_bgc_C_out) ) nt_bgc_C_out = nt_bgc_C + if (present(nlt_bgc_C_out) ) nlt_bgc_C_out = nlt_bgc_C + if (present(nt_bgc_chl_out) ) nt_bgc_chl_out = nt_bgc_chl + if (present(nlt_bgc_chl_out) ) nlt_bgc_chl_out = nlt_bgc_chl + if (present(nt_bgc_DOC_out) ) nt_bgc_DOC_out = nt_bgc_DOC + if (present(nlt_bgc_DOC_out) ) nlt_bgc_DOC_out = nlt_bgc_DOC + if (present(nt_bgc_DON_out) ) nt_bgc_DON_out = nt_bgc_DON + if (present(nlt_bgc_DON_out) ) nlt_bgc_DON_out = nlt_bgc_DON + if (present(nt_bgc_DIC_out) ) nt_bgc_DIC_out = nt_bgc_DIC + if (present(nlt_bgc_DIC_out) ) nlt_bgc_DIC_out = nlt_bgc_DIC + if (present(nt_bgc_Fed_out) ) nt_bgc_Fed_out = nt_bgc_Fed + if (present(nlt_bgc_Fed_out) ) nlt_bgc_Fed_out = nlt_bgc_Fed + if (present(nt_bgc_Fep_out) ) nt_bgc_Fep_out = nt_bgc_Fep + if (present(nlt_bgc_Fep_out) ) nlt_bgc_Fep_out = nlt_bgc_Fep + if (present(nt_zaero_out) ) nt_zaero_out = nt_zaero + if (present(nlt_zaero_out) ) nlt_zaero_out = nlt_zaero + if (present(nlt_zaero_sw_out)) nlt_zaero_sw_out = nlt_zaero_sw end subroutine icepack_query_tracer_indices @@ -933,7 +933,7 @@ end subroutine icepack_query_tracer_indices subroutine icepack_write_tracer_indices(iounit) - integer, intent(in), optional :: iounit + integer, intent(in), optional :: iounit !autodocument_end @@ -948,7 +948,7 @@ subroutine icepack_write_tracer_indices(iounit) write(iounit,*) " nt_sice = ",nt_sice write(iounit,*) " nt_fbri = ",nt_fbri write(iounit,*) " nt_iage = ",nt_iage - write(iounit,*) " nt_FY = ",nt_FY + write(iounit,*) " nt_FY = ",nt_FY write(iounit,*) " nt_alvl = ",nt_alvl write(iounit,*) " nt_vlvl = ",nt_vlvl write(iounit,*) " nt_apnd = ",nt_apnd @@ -962,30 +962,30 @@ subroutine icepack_write_tracer_indices(iounit) write(iounit,*) " nt_isosno = ",nt_isosno write(iounit,*) " nt_isoice = ",nt_isoice write(iounit,*) " nt_aero = ",nt_aero - write(iounit,*) " nt_bgc_Nit = ",nt_bgc_Nit - write(iounit,*) " nt_bgc_Am = ",nt_bgc_Am - write(iounit,*) " nt_bgc_Sil = ",nt_bgc_Sil - write(iounit,*) " nt_bgc_DMSPp = ",nt_bgc_DMSPp - write(iounit,*) " nt_bgc_DMSPd = ",nt_bgc_DMSPd - write(iounit,*) " nt_bgc_DMS = ",nt_bgc_DMS - write(iounit,*) " nt_bgc_hum = ",nt_bgc_hum - write(iounit,*) " nt_bgc_PON = ",nt_bgc_PON - write(iounit,*) " nlt_bgc_Nit = ",nlt_bgc_Nit - write(iounit,*) " nlt_bgc_Am = ",nlt_bgc_Am - write(iounit,*) " nlt_bgc_Sil = ",nlt_bgc_Sil + write(iounit,*) " nt_bgc_Nit = ",nt_bgc_Nit + write(iounit,*) " nt_bgc_Am = ",nt_bgc_Am + write(iounit,*) " nt_bgc_Sil = ",nt_bgc_Sil + write(iounit,*) " nt_bgc_DMSPp = ",nt_bgc_DMSPp + write(iounit,*) " nt_bgc_DMSPd = ",nt_bgc_DMSPd + write(iounit,*) " nt_bgc_DMS = ",nt_bgc_DMS + write(iounit,*) " nt_bgc_hum = ",nt_bgc_hum + write(iounit,*) " nt_bgc_PON = ",nt_bgc_PON + write(iounit,*) " nlt_bgc_Nit = ",nlt_bgc_Nit + write(iounit,*) " nlt_bgc_Am = ",nlt_bgc_Am + write(iounit,*) " nlt_bgc_Sil = ",nlt_bgc_Sil write(iounit,*) " nlt_bgc_DMSPp = ",nlt_bgc_DMSPp write(iounit,*) " nlt_bgc_DMSPd = ",nlt_bgc_DMSPd - write(iounit,*) " nlt_bgc_DMS = ",nlt_bgc_DMS - write(iounit,*) " nlt_bgc_hum = ",nlt_bgc_hum - write(iounit,*) " nlt_bgc_PON = ",nlt_bgc_PON - write(iounit,*) " nlt_chl_sw = ",nlt_chl_sw - write(iounit,*) " nt_zbgc_frac = ",nt_zbgc_frac - write(iounit,*) " nt_bgc_S = ",nt_bgc_S + write(iounit,*) " nlt_bgc_DMS = ",nlt_bgc_DMS + write(iounit,*) " nlt_bgc_hum = ",nlt_bgc_hum + write(iounit,*) " nlt_bgc_PON = ",nlt_bgc_PON + write(iounit,*) " nlt_chl_sw = ",nlt_chl_sw + write(iounit,*) " nt_zbgc_frac = ",nt_zbgc_frac + write(iounit,*) " nt_bgc_S = ",nt_bgc_S write(iounit,*) " max_nbtrcr = ",max_nbtrcr do k = 1, max_nbtrcr write(iounit,*) " bio_index_o(k) = ",k,bio_index_o(k) - write(iounit,*) " bio_index(k) = ",k,bio_index(k) + write(iounit,*) " bio_index(k) = ",k,bio_index(k) enddo write(iounit,*) " max_algae = ",max_algae @@ -994,40 +994,40 @@ subroutine icepack_write_tracer_indices(iounit) write(iounit,*) " nlt_bgc_N(k) = ",k,nlt_bgc_N(k) write(iounit,*) " nt_bgc_C(k) = ",k,nt_bgc_C(k) write(iounit,*) " nlt_bgc_C(k) = ",k,nlt_bgc_C(k) - write(iounit,*) " nt_bgc_chl(k) = ",k,nt_bgc_chl(k) + write(iounit,*) " nt_bgc_chl(k) = ",k,nt_bgc_chl(k) write(iounit,*) " nlt_bgc_chl(k) = ",k,nlt_bgc_chl(k) enddo write(iounit,*) " max_DOC = ",max_DOC do k = 1, max_DOC - write(iounit,*) " nt_bgc_DOC(k) = ",k,nt_bgc_DOC(k) + write(iounit,*) " nt_bgc_DOC(k) = ",k,nt_bgc_DOC(k) write(iounit,*) " nlt_bgc_DOC(k) = ",k,nlt_bgc_DOC(k) enddo write(iounit,*) " max_DON = ",max_DON do k = 1, max_DON - write(iounit,*) " nt_bgc_DON(k) = ",k,nt_bgc_DON(k) + write(iounit,*) " nt_bgc_DON(k) = ",k,nt_bgc_DON(k) write(iounit,*) " nlt_bgc_DON(k) = ",k,nlt_bgc_DON(k) enddo write(iounit,*) " max_DIC = ",max_DIC do k = 1, max_DIC - write(iounit,*) " nt_bgc_DIC(k) = ",k,nt_bgc_DIC(k) + write(iounit,*) " nt_bgc_DIC(k) = ",k,nt_bgc_DIC(k) write(iounit,*) " nlt_bgc_DIC(k) = ",k,nlt_bgc_DIC(k) enddo write(iounit,*) " max_fe = ",max_fe do k = 1, max_fe - write(iounit,*) " nt_bgc_Fed(k) = ",k,nt_bgc_Fed(k) + write(iounit,*) " nt_bgc_Fed(k) = ",k,nt_bgc_Fed(k) write(iounit,*) " nlt_bgc_Fed(k) = ",k,nlt_bgc_Fed(k) - write(iounit,*) " nt_bgc_Fep(k) = ",k,nt_bgc_Fep(k) + write(iounit,*) " nt_bgc_Fep(k) = ",k,nt_bgc_Fep(k) write(iounit,*) " nlt_bgc_Fep(k) = ",k,nlt_bgc_Fep(k) enddo write(iounit,*) " max_aero = ",max_aero do k = 1, max_aero - write(iounit,*) " nt_zaero(k) = ",k,nt_zaero(k) - write(iounit,*) " nlt_zaero(k) = ",k,nlt_zaero(k) + write(iounit,*) " nt_zaero(k) = ",k,nt_zaero(k) + write(iounit,*) " nlt_zaero(k) = ",k,nlt_zaero(k) write(iounit,*) " nlt_zaero_sw(k) = ",k,nlt_zaero_sw(k) enddo @@ -1054,7 +1054,7 @@ subroutine icepack_init_tracer_sizes(& n_DON_in , & ! n_DIC_in , & ! n_fed_in , & ! - n_fep_in , & ! + n_fep_in , & ! n_zaero_in, & ! n_iso_in , & ! n_aero_in , & ! @@ -1125,7 +1125,7 @@ subroutine icepack_query_tracer_sizes(& n_DON_out , & ! n_DIC_out , & ! n_fed_out , & ! - n_fep_out , & ! + n_fep_out , & ! n_zaero_out, & ! n_iso_out , & ! n_aero_out , & ! @@ -1282,7 +1282,7 @@ subroutine icepack_compute_tracers (ntrcr, trcr_depend, & divisor(3) = trcr_base(it,3)*vsnon if (trcr_depend(it) == 0) then ! ice area tracers - if (aicen > puny) then + if (aicen > puny) then trcrn(it) = atrcrn(it) / aicen else trcrn(it) = c0 diff --git a/columnphysics/icepack_warnings.F90 b/columnphysics/icepack_warnings.F90 index cf0faf82d..d8e403a60 100644 --- a/columnphysics/icepack_warnings.F90 +++ b/columnphysics/icepack_warnings.F90 @@ -92,12 +92,12 @@ subroutine icepack_warnings_clear() end subroutine icepack_warnings_clear !======================================================================= - + subroutine icepack_warnings_getall(warningsOut) character(len=char_len_long), dimension(:), allocatable, intent(out) :: & warningsOut - + integer :: iWarning character(len=*),parameter :: subname='(icepack_warnings_getall)' @@ -159,7 +159,7 @@ subroutine icepack_warnings_add(warning) character(len=*), intent(in) :: warning ! warning to add to array of warnings - ! local + ! local character(len=char_len_long), dimension(:), allocatable :: warningsTmp integer :: & @@ -182,10 +182,10 @@ subroutine icepack_warnings_add(warning) ! find the size of the warnings array at the start nWarningsArray = size(warnings) - + ! check to see if need more space in warnings array if (nWarnings + 1 > nWarningsArray) then - + ! allocate the temporary warning storage allocate(warningsTmp(nWarningsArray)) @@ -207,7 +207,7 @@ subroutine icepack_warnings_add(warning) deallocate(warningsTmp) endif - + endif ! increase warning number diff --git a/columnphysics/icepack_wavefracspec.F90 b/columnphysics/icepack_wavefracspec.F90 index eb6f4b6a3..540ab6722 100644 --- a/columnphysics/icepack_wavefracspec.F90 +++ b/columnphysics/icepack_wavefracspec.F90 @@ -3,28 +3,28 @@ ! ! Theory based on: ! -! Horvat, C., & Tziperman, E. (2015). A prognostic model of the sea-ice +! Horvat, C., & Tziperman, E. (2015). A prognostic model of the sea-ice ! floe size and thickness distribution. The Cryosphere, 9(6), 2119–2134. ! doi:10.5194/tc-9-2119-2015 ! ! and implementation described in: ! ! Roach, L. A., Horvat, C., Dean, S. M., & Bitz, C. M. (2018). An emergent -! sea ice floe size distribution in a global coupled ocean--sea ice model. -! Journal of Geophysical Research: Oceans, 123(6), 4322–4337. +! sea ice floe size distribution in a global coupled ocean--sea ice model. +! Journal of Geophysical Research: Oceans, 123(6), 4322–4337. ! doi:10.1029/2017JC013692 ! ! now with some modifications to allow direct input of ocean surface wave spectrum. ! -! We calculate the fractures that would occur if waves enter a fully ice-covered -! region defined in one dimension in the direction of propagation, and then apply +! We calculate the fractures that would occur if waves enter a fully ice-covered +! region defined in one dimension in the direction of propagation, and then apply ! the outcome proportionally to the ice-covered fraction in each grid cell. Assuming ! that sea ice flexes with the sea surface height field, strains are computed on this ! sub-grid-scale 1D domain. If the strain between successive extrema exceeds a critical ! value new floes are formed with diameters equal to the distance between the extrema. ! ! authors: 2016-8 Lettie Roach, NIWA/VUW -! +! ! module icepack_wavefracspec @@ -34,7 +34,7 @@ module icepack_wavefracspec use icepack_tracers, only: nt_fsd use icepack_warnings, only: warnstr, icepack_warnings_add, icepack_warnings_aborted use icepack_fsd - + implicit none private public :: icepack_init_wave, icepack_step_wavefracture @@ -46,12 +46,12 @@ module icepack_wavefracspec dx = c1, & ! domain spacing threshold = c10 ! peak-finding threshold - ! points are defined to be extrema if they - ! are a local max or min over a distance - ! of 10m on both sides, based on the - ! observations of Toyota et al. (2011) who - ! find this to be the order of the smallest + ! are a local max or min over a distance + ! of 10m on both sides, based on the + ! observations of Toyota et al. (2011) who + ! find this to be the order of the smallest ! floe size affected by wave fracture - + integer (kind=int_kind), parameter :: & nx = 10000 ! number of points in domain @@ -95,14 +95,14 @@ subroutine icepack_init_wave(nfreq, & ! FOR TESTING ONLY - do not use for actual runs!! wave_spectrum_data(1) = 0.00015429197810590267 - wave_spectrum_data(2) = 0.002913531381636858 + wave_spectrum_data(2) = 0.002913531381636858 wave_spectrum_data(3) = 0.02312942035496235 wave_spectrum_data(4) = 0.07201970368623734 - wave_spectrum_data(5) = 0.06766948103904724 + wave_spectrum_data(5) = 0.06766948103904724 wave_spectrum_data(6) = 0.005527883302420378 - wave_spectrum_data(7) = 3.326293881400488e-05 - wave_spectrum_data(8) = 6.815936703929992e-10 - wave_spectrum_data(9) = 2.419401186610744e-20 + wave_spectrum_data(7) = 3.326293881400488e-05 + wave_spectrum_data(8) = 6.815936703929992e-10 + wave_spectrum_data(9) = 2.419401186610744e-20 do k = 1, nfreq wave_spectrum_profile(k) = wave_spectrum_data(k) @@ -117,7 +117,7 @@ subroutine icepack_init_wave(nfreq, & 0.17201911, 0.18922101, 0.20814312, 0.22895744, 0.25185317, & 0.27703848, 0.30474234, 0.33521661, 0.36873826, 0.40561208/) - ! boundaries of bin n are at f(n)*sqrt(1/C) and f(n)*sqrt(C) + ! boundaries of bin n are at f(n)*sqrt(1/C) and f(n)*sqrt(C) dwavefreq(:) = wavefreq(:)*(SQRT(1.1_dbl_kind) - SQRT(c1/1.1_dbl_kind)) end subroutine icepack_init_wave @@ -154,13 +154,13 @@ function get_dafsd_wave(nfsd, afsd_init, fracture_hist, frac) & do k = 1, nfsd ! fracture_hist is already normalized - omega(k) = afsd_init(k)*SUM(fracture_hist(1:k-1)) + omega(k) = afsd_init(k)*SUM(fracture_hist(1:k-1)) end do loss = omega do k =1,nfsd - gain(k) = SUM(omega*frac(:,k)) + gain(k) = SUM(omega*frac(:,k)) end do d_afsd(:) = gain(:) - loss(:) @@ -176,8 +176,8 @@ end function get_dafsd_wave !======================================================================= !autodocument_start icepack_step_wavefracture -! -! Given fracture histogram computed from local wave spectrum, evolve +! +! Given fracture histogram computed from local wave spectrum, evolve ! the floe size distribution ! ! authors: 2018 Lettie Roach, NIWA/VUW @@ -230,15 +230,12 @@ subroutine icepack_step_wavefracture(wave_spec_type, & !autodocument_end ! local variables - integer (kind=int_kind) :: & - n, k, t, & - nsubt ! number of subcycles - - real (kind=dbl_kind), dimension(nfsd,ncat) :: & - afsdn ! floe size and thickness distribution + integer (kind=int_kind) :: & + n, k, & + nsubt ! number of subcycles real (kind=dbl_kind), dimension (nfsd, nfsd) :: & - frac + frac real (kind=dbl_kind) :: & hbar , & ! mean ice thickness @@ -257,7 +254,7 @@ subroutine icepack_step_wavefracture(wave_spec_type, & !------------------------------------ - ! initialize + ! initialize d_afsd_wave (:) = c0 d_afsdn_wave (:,:) = c0 fracture_hist (:) = c0 @@ -265,12 +262,12 @@ subroutine icepack_step_wavefracture(wave_spec_type, & ! if all ice is not in first floe size category if (.NOT. ALL(trcrn(nt_fsd,:).ge.c1-puny)) then - + ! do not try to fracture for minimal ice concentration or zero wave spectrum if ((aice > p01).and.(MAXVAL(wave_spectrum(:)) > puny)) then hbar = vice / aice - + ! calculate fracture histogram call wave_frac(nfsd, nfreq, wave_spec_type, & floe_rad_l, floe_rad_c, & @@ -284,12 +281,12 @@ subroutine icepack_step_wavefracture(wave_spec_type, & ! protect against small numerical errors call icepack_cleanup_fsd (ncat, nfsd, trcrn(nt_fsd:nt_fsd+nfsd-1,:) ) if (icepack_warnings_aborted(subname)) return - + do n = 1, ncat - + afsd_init(:) = trcrn(nt_fsd:nt_fsd+nfsd-1,n) - ! if there is ice, and a FSD, and not all ice is the smallest floe size + ! if there is ice, and a FSD, and not all ice is the smallest floe size if ((aicen(n) > puny) .and. (SUM(afsd_init(:)) > puny) & .and. (afsd_init(1) < c1)) then @@ -312,11 +309,11 @@ subroutine icepack_step_wavefracture(wave_spec_type, & nsubt = nsubt + 1 ! if all floes in smallest category already, exit - if (afsd_tmp(1).ge.c1-puny) EXIT + if (afsd_tmp(1).ge.c1-puny) EXIT ! calculate d_afsd using current afstd d_afsd_tmp = get_dafsd_wave(nfsd, afsd_tmp, fracture_hist, frac) - + ! check in case wave fracture struggles to converge if (nsubt>100) then write(warnstr,*) subname, & @@ -329,7 +326,7 @@ subroutine icepack_step_wavefracture(wave_spec_type, & subdt = MIN(subdt, dt) ! update afsd - afsd_tmp = afsd_tmp + subdt * d_afsd_tmp(:) + afsd_tmp = afsd_tmp + subdt * d_afsd_tmp(:) ! check conservation and negatives if (MINVAL(afsd_tmp) < -puny) then @@ -342,15 +339,15 @@ subroutine icepack_step_wavefracture(wave_spec_type, & endif ! update time - elapsed_t = elapsed_t + subdt + elapsed_t = elapsed_t + subdt END DO ! elapsed_t < dt - + ! In some cases---particularly for strong fracturing---the equation ! for wave fracture does not quite conserve area. ! With the dummy wave forcing, this happens < 2% of the time (in ! 1997) and is always less than 10^-7. - ! Simply renormalizing may cause the first floe size + ! Simply renormalizing may cause the first floe size ! category to reduce, which is not physically allowed ! to happen. So we adjust here cons_error = SUM(afsd_tmp) - c1 @@ -359,7 +356,7 @@ subroutine icepack_step_wavefracture(wave_spec_type, & if (cons_error.lt.c0) then afsd_tmp(1) = afsd_tmp(1) - cons_error else - ! area gain: take it from the largest possible category + ! area gain: take it from the largest possible category do k = nfsd, 1, -1 if (afsd_tmp(k).gt.cons_error) then afsd_tmp(k) = afsd_tmp(k) - cons_error @@ -374,7 +371,7 @@ subroutine icepack_step_wavefracture(wave_spec_type, & if (icepack_warnings_aborted(subname)) return ! for diagnostics - d_afsdn_wave(:,n) = afsd_tmp(:) - afsd_init(:) + d_afsdn_wave(:,n) = afsd_tmp(:) - afsd_init(:) d_afsd_wave (:) = d_afsd_wave(:) + aicen(n)*d_afsdn_wave(:,n) endif ! aicen > puny enddo ! n @@ -387,15 +384,15 @@ end subroutine icepack_step_wavefracture !======================================================================= ! -! Calculates functions to describe the change in the FSD when waves +! Calculates functions to describe the change in the FSD when waves ! fracture ice, given a wave spectrum (1D frequency, nfreq (default 25) ! frequency bins) ! -! We calculate extrema and if these are successive maximum, -! minimum, maximum or vice versa, and have strain greater than a +! We calculate extrema and if these are successive maximum, +! minimum, maximum or vice versa, and have strain greater than a ! critical strain, break ice and create new floes with lengths equal ! to these distances. Based on MatLab code written by Chris Horvat, -! from Horvat & Tziperman (2015). +! from Horvat & Tziperman (2015). ! ! Note that a realization of sea surface height requires a random phase. ! @@ -421,7 +418,7 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & floe_rad_c ! fsd size bin centre in m (radius) real (kind=dbl_kind), dimension (:), intent(in) :: & - wavefreq, & ! wave frequencies (s^-1) + wavefreq, & ! wave frequencies (s^-1) dwavefreq, & ! wave frequency bin widths (s^-1) spec_efreq ! wave spectrum (m^2 s) @@ -430,7 +427,7 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & ! local variables - integer (kind=int_kind) :: i, j, k, iter, loop_max_iter + integer (kind=int_kind) :: j, k, iter, loop_max_iter real (kind=dbl_kind) :: & fracerror ! difference between successive histograms @@ -464,7 +461,7 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & else loop_max_iter = 1 end if - + ! spatial domain do j = 1, nx X(j)= j*dx @@ -474,7 +471,7 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & lambda (:) = gravit/(c2*pi*wavefreq (:)**2) ! spectral coefficients - spec_coeff = sqrt(c2*spec_efreq*dwavefreq) + spec_coeff = sqrt(c2*spec_efreq*dwavefreq) ! initialize frac lengths fraclengths(:) = c0 @@ -497,22 +494,22 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & rand_array(:) = p5 endif phi = c2*pi*rand_array - + do j = 1, nx ! SSH field in space (sum over wavelengths, no attenuation) summand = spec_coeff*COS(2*pi*X(j)/lambda+phi) eta(j) = SUM(summand) end do - fraclengths(:) = c0 - if ((SUM(ABS(eta)) > puny).and.(hbar > puny)) then + fraclengths(:) = c0 + if ((SUM(ABS(eta)) > puny).and.(hbar > puny)) then call get_fraclengths(X, eta, fraclengths, hbar) if (icepack_warnings_aborted(subname)) return end if ! convert from diameter to radii fraclengths(:) = fraclengths(:)/c2 - + if (ALL(fraclengths.lt.floe_rad_l(1))) then frac_local(:) = c0 else @@ -537,7 +534,7 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & ! normalize if (SUM(frac_local) /= c0) frac_local(:) = frac_local(:) / SUM(frac_local(:)) - end if + end if ! wave fracture run to convergence if (trim(wave_spec_type).eq.'random') then @@ -547,7 +544,7 @@ subroutine wave_frac(nfsd, nfreq, wave_spec_type, & ! save histogram for next iteration prev_frac_local = frac_local - + end if END DO @@ -566,7 +563,7 @@ end subroutine wave_frac ! If this strain is greater than the critical strain, ice can fracture ! and new floes are formed with sizes equal to the distances between ! extrema. Based on MatLab code written by Chris Horvat, -! from Horvat & Tziperman (2015). +! from Horvat & Tziperman (2015). ! ! authors: 2016 Lettie Roach, NIWA/VUW ! @@ -594,7 +591,7 @@ subroutine get_fraclengths(X, eta, fraclengths, hbar) n_above ! number of points where strain is above critical real (kind=dbl_kind), dimension(nx) :: & - fracdistances, & ! distances in space where fracture has occurred + fracdistances, & ! distances in space where fracture has occurred strain ! the strain between triplets of extrema logical (kind=log_kind), dimension(nx) :: & @@ -620,7 +617,7 @@ subroutine get_fraclengths(X, eta, fraclengths, hbar) is_triplet = .false. strain = c0 j_neg = 0 - j_pos = 0 + j_pos = 0 fraclengths(:) = c0 ! search for local max and min within spacing @@ -658,7 +655,7 @@ subroutine get_fraclengths(X, eta, fraclengths, hbar) end if end do end if - + do k = j+1, nx if (is_extremum(k)) then j_pos = k @@ -666,8 +663,8 @@ subroutine get_fraclengths(X, eta, fraclengths, hbar) end if end do - ! find triplets of max and min - if ((j_neg > 0).and.(j_pos > 0)) then + ! find triplets of max and min + if ((j_neg > 0).and.(j_pos > 0)) then if (is_max(j_neg).and.is_min(j).and.is_max(j_pos)) & is_triplet(j) = .true. if (is_min(j_neg).and.is_max(j).and.is_min(j_pos)) & @@ -683,9 +680,9 @@ subroutine get_fraclengths(X, eta, fraclengths, hbar) ! This equation differs from HT2015 by a factor 2 in numerator ! and eta(j_pos). This is the correct form of the equation. - + denominator = delta*delta_pos*(delta+delta_pos) - + if (denominator.ne.c0) & strain(j) = ABS(hbar*(eta(j_neg)* delta_pos & - eta(j )*(delta_pos+delta) & @@ -721,7 +718,7 @@ subroutine get_fraclengths(X, eta, fraclengths, hbar) end subroutine get_fraclengths !======================================================================= - + end module icepack_wavefracspec !======================================================================= diff --git a/columnphysics/icepack_zbgc.F90 b/columnphysics/icepack_zbgc.F90 index 077268797..54b33f22e 100644 --- a/columnphysics/icepack_zbgc.F90 +++ b/columnphysics/icepack_zbgc.F90 @@ -18,10 +18,10 @@ module icepack_zbgc use icepack_parameters, only: scale_bgc, ktherm, skl_bgc, solve_zsal use icepack_parameters, only: z_tracers, fsal, conserv_check - use icepack_tracers, only: nt_sice, nt_bgc_S, bio_index + use icepack_tracers, only: nt_sice, nt_bgc_S, bio_index use icepack_tracers, only: tr_brine, nt_fbri, nt_qice, nt_Tsfc use icepack_tracers, only: nt_zbgc_frac - use icepack_tracers, only: bio_index_o, bio_index + use icepack_tracers, only: bio_index_o, bio_index use icepack_zbgc_shared, only: zbgc_init_frac use icepack_zbgc_shared, only: zbgc_frac_init @@ -41,13 +41,13 @@ module icepack_zbgc use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted use icepack_brine, only: preflushing_changes, compute_microS_mushy - use icepack_brine, only: update_hbrine, compute_microS + use icepack_brine, only: update_hbrine, compute_microS use icepack_algae, only: zbio, sklbio use icepack_therm_shared, only: calculate_Tin_from_qin use icepack_itd, only: column_sum, column_conservation_check use icepack_zsalinity, only: zsalinity - implicit none + implicit none private public :: add_new_ice_bgc, & @@ -89,9 +89,9 @@ subroutine add_new_ice_bgc (dt, nblyr, & real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), intent(in) :: & dt ! time step (s) @@ -122,8 +122,8 @@ subroutine add_new_ice_bgc (dt, nblyr, & real (kind=dbl_kind), dimension (:), & intent(inout) :: & - flux_bio ! tracer flux to ocean from biology (mmol/m^2/s) - + flux_bio ! tracer flux to ocean from biology (mmol/m^2/s) + real (kind=dbl_kind), dimension (:), & intent(in) :: & ocean_bio ! ocean concentration of biological tracer @@ -143,10 +143,10 @@ subroutine add_new_ice_bgc (dt, nblyr, & real (kind=dbl_kind) :: & vsurp , & ! volume of new ice added to each cat vtmp ! total volume of new and old ice - + real (kind=dbl_kind), dimension (ncat) :: & - vbrin ! trcrn(nt_fbri,n)*vicen(n) - + vbrin ! trcrn(nt_fbri,n)*vicen(n) + real (kind=dbl_kind) :: & vice_new ! vicen_init + vsurp @@ -158,7 +158,7 @@ subroutine add_new_ice_bgc (dt, nblyr, & character(len=*),parameter :: subname='(add_new_ice_bgc)' - !----------------------------------------------------------------- + !----------------------------------------------------------------- ! brine !----------------------------------------------------------------- vbrin(:) = c0 @@ -166,33 +166,33 @@ subroutine add_new_ice_bgc (dt, nblyr, & vbrin(n) = vicen_init(n) if (tr_brine) vbrin(n) = trcrn(nt_fbri,n)*vicen_init(n) enddo - + call column_sum (ncat, vbrin, vbri_init) if (icepack_warnings_aborted(subname)) return vbri_init = vbri_init + vi0_init - do k = 1, nbtrcr + do k = 1, nbtrcr flux_bio(k) = flux_bio(k) & - vi0_init/dt*ocean_bio(k)*zbgc_init_frac(k) enddo !----------------------------------------------------------------- - ! Distribute bgc in new ice volume among all ice categories by + ! Distribute bgc in new ice volume among all ice categories by ! increasing ice thickness, leaving ice area unchanged. !----------------------------------------------------------------- ! Diffuse_bio handles concentration changes from ice growth/melt ! ice area does not change - ! add salt to the bottom , location = 1 + ! add salt to the bottom , location = 1 vsurp = c0 vtmp = c0 do n = 1,ncat - + if (hsurp > c0) then vtmp = vbrin(n) - vsurp = hsurp * aicen_init(n) + vsurp = hsurp * aicen_init(n) vbrin(n) = vbrin(n) + vsurp vice_new = vicen_init(n) + vsurp if (tr_brine .and. vicen(n) > c0) then @@ -201,8 +201,8 @@ subroutine add_new_ice_bgc (dt, nblyr, & trcrn(nt_fbri,n) = c1 endif - if (nltrcr > 0) then - location = 1 + if (nltrcr > 0) then + location = 1 call adjust_tracer_profile(nbtrcr, dt, ntrcr, & aicen_init(n), & vbrin(n), & @@ -211,35 +211,35 @@ subroutine add_new_ice_bgc (dt, nblyr, & vtmp, & vsurp, sss, & nilyr, nblyr, & - solve_zsal, bgrid, & + solve_zsal, bgrid, & cgrid, & ocean_bio, igrid, & location) if (icepack_warnings_aborted(subname)) return - endif ! nltrcr + endif ! nltrcr endif ! hsurp > 0 enddo ! n !----------------------------------------------------------------- ! Combine bgc in new ice grown in open water with category 1 ice. !----------------------------------------------------------------- - + if (vi0new > c0) then - vbri1 = vbrin(1) + vbri1 = vbrin(1) vbrin(1) = vbrin(1) + vi0new if (tr_brine .and. vicen(1) > c0) then trcrn(nt_fbri,1) = vbrin(1)/vicen(1) elseif (tr_brine .and. vicen(1) <= c0) then trcrn(nt_fbri,1) = c1 endif - + ! Diffuse_bio handles concentration changes from ice growth/melt ! ice area changes ! add salt throughout, location = 0 - if (nltrcr > 0) then - location = 0 + if (nltrcr > 0) then + location = 0 call adjust_tracer_profile(nbtrcr, dt, ntrcr, & aicen(1), & vbrin(1), & @@ -257,7 +257,7 @@ subroutine add_new_ice_bgc (dt, nblyr, & if (solve_zsal .and. vsnon1 .le. c0) then Tmlts = -trcrn(nt_sice,1)*depressT trcrn(nt_Tsfc,1) = calculate_Tin_from_qin(trcrn(nt_qice,1),Tmlts) - endif ! solve_zsal + endif ! solve_zsal endif ! nltrcr > 0 endif ! vi0new > 0 @@ -304,7 +304,7 @@ subroutine lateral_melt_bgc (dt, & real (kind=dbl_kind), intent(inout) :: & fzsal ! salt flux from layer Salinity (kg/m^2/s) - + real (kind=dbl_kind), dimension(:), intent(inout) :: & flux_bio ! biology tracer flux from layer bgc (mmol/m^2/s) @@ -342,11 +342,11 @@ subroutine lateral_melt_bgc (dt, & enddo enddo - end subroutine lateral_melt_bgc + end subroutine lateral_melt_bgc !======================================================================= ! -! Add new ice tracers to the ice bottom and adjust the vertical profile +! Add new ice tracers to the ice bottom and adjust the vertical profile ! ! author: Nicole Jeffery, LANL @@ -383,9 +383,9 @@ subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & real (kind=dbl_kind), intent(in) :: & vbrin ! fbri*volume per unit area of ice (m) - + logical (kind=log_kind), intent(in) :: & - solve_zsal + solve_zsal real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! zbio grid @@ -399,32 +399,32 @@ subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & real (kind=dbl_kind), dimension (ntrcr), & intent(inout) :: & trcrn ! ice tracers - + ! local variables real (kind=dbl_kind), dimension (ntrcr+2) :: & trtmp0, & ! temporary, remapped tracers trtmp ! temporary, remapped tracers - + real (kind=dbl_kind) :: & hin , & ! ice height hinS_new, & ! brine height - temp_S + temp_S integer (kind=int_kind) :: & - k, m + k, m - real (kind=dbl_kind), dimension (nblyr+1) :: & + real (kind=dbl_kind), dimension (nblyr+1) :: & C_stationary ! stationary bulk concentration*h (mmol/m^2) - real (kind=dbl_kind), dimension (nblyr) :: & + real (kind=dbl_kind), dimension (nblyr) :: & S_stationary ! stationary bulk concentration*h (ppt*m) real(kind=dbl_kind) :: & top_conc , & ! salinity or bgc ocean concentration of frazil fluxb , & ! needed for regrid (set to zero here) hbri_old , & ! previous timestep brine height - hbri ! brine height + hbri ! brine height character(len=*),parameter :: subname='(adjust_tracer_profile)' @@ -438,7 +438,7 @@ subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & hbri_old = vtmp if (solve_zsal) then top_conc = sss * salt_loss - do k = 1, nblyr + do k = 1, nblyr S_stationary(k) = trcrn(nt_bgc_S+k-1)* hbri_old enddo call regrid_stationary (S_stationary, hbri_old, & @@ -447,7 +447,7 @@ subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & nblyr-1, top_conc, & bgrid(2:nblyr+1), fluxb ) if (icepack_warnings_aborted(subname)) return - do k = 1, nblyr + do k = 1, nblyr trcrn(nt_bgc_S+k-1) = S_stationary(k)/hbri trtmp0(nt_sice+k-1) = trcrn(nt_bgc_S+k-1) enddo @@ -455,7 +455,7 @@ subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & do m = 1, nbtrcr top_conc = ocean_bio(m)*zbgc_init_frac(m) - do k = 1, nblyr+1 + do k = 1, nblyr+1 C_stationary(k) = trcrn(bio_index(m) + k-1)* hbri_old enddo !k call regrid_stationary (C_stationary, hbri_old, & @@ -464,9 +464,9 @@ subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & nblyr, top_conc, & igrid, fluxb ) if (icepack_warnings_aborted(subname)) return - do k = 1, nblyr+1 + do k = 1, nblyr+1 trcrn(bio_index(m) + k-1) = C_stationary(k)/hbri - enddo !k + enddo !k enddo !m if (solve_zsal) then @@ -487,7 +487,7 @@ subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & bgrid(2:nblyr+1), temp_S ) if (icepack_warnings_aborted(subname)) return do k = 1, nilyr - trcrn(nt_sice+k-1) = trtmp(nt_sice+k-1) + trcrn(nt_sice+k-1) = trtmp(nt_sice+k-1) enddo ! k endif ! solve_zsal @@ -519,11 +519,11 @@ subroutine adjust_tracer_profile (nbtrcr, dt, ntrcr, & trtmp0(1:ntrcr), trtmp, & 1, nblyr, & hin, hinS_new, & - cgrid(2:nilyr+1), & + cgrid(2:nilyr+1), & bgrid(2:nblyr+1),temp_S ) if (icepack_warnings_aborted(subname)) return do k = 1, nilyr - trcrn(nt_sice+k-1) = trtmp(nt_sice+k-1) + trcrn(nt_sice+k-1) = trtmp(nt_sice+k-1) enddo !k endif ! solve_zsal @@ -545,18 +545,18 @@ subroutine icepack_init_bgc(ncat, nblyr, nilyr, ntrcr_o, & ntrcr_o,& ! number of tracers not including bgc ntrcr , & ! number of tracers in use nbtrcr ! number of bio tracers in use - + real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(inout) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), dimension(nilyr, ncat), intent(in) :: & sicen ! salinity on the cice grid real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! subset of tracer array (only bgc) + trcrn ! subset of tracer array (only bgc) real (kind=dbl_kind), intent(in) :: & sss ! sea surface salinity (ppt) @@ -569,35 +569,35 @@ subroutine icepack_init_bgc(ncat, nblyr, nilyr, ntrcr_o, & ! local variables integer (kind=int_kind) :: & - k , & ! vertical index - n , & ! category index + k , & ! vertical index + n , & ! category index mm ! bio tracer index - real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp ! temporary, remapped tracers - + real (kind=dbl_kind), dimension (ntrcr+2) :: & + trtmp ! temporary, remapped tracers + character(len=*),parameter :: subname='(icepack_init_bgc)' - !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- ! Skeletal Layer Model ! All bgc tracers are Bulk quantities in units of mmol or mg per m^3 - ! The skeletal layer model assumes a constant + ! The skeletal layer model assumes a constant ! layer depth (sk_l) and porosity (phi_sk) - !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- if (skl_bgc) then - + do n = 1,ncat do mm = 1,nbtrcr ! bulk concentration (mmol or mg per m^3, or 10^-3 mmol/m^3) trcrn(bio_index(mm)-ntrcr_o, n) = ocean_bio_all(bio_index_o(mm)) enddo ! nbtrcr - enddo ! n + enddo ! n - !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- ! zbgc Model ! All bgc tracers are Bulk quantities in units of mmol or mg per m^3 ! The vertical layer model uses prognosed porosity and layer depth - !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- else ! not skl_bgc @@ -607,20 +607,20 @@ subroutine icepack_init_bgc(ncat, nblyr, nilyr, ntrcr_o, & do k = 2, nblyr trcrn(bio_index(mm)+k-1-ntrcr_o,n) = & (p5*(trcrn(nt_bgc_S+k-1-ntrcr_o,n)+ trcrn(nt_bgc_S+k-2-ntrcr_o,n)) & - / sss*ocean_bio_all(bio_index_o(mm))) + / sss*ocean_bio_all(bio_index_o(mm))) enddo !k trcrn(nt_zbgc_frac-1+mm-ntrcr_o,n) = zbgc_frac_init(mm) trcrn(bio_index(mm)-ntrcr_o,n) = (trcrn(nt_bgc_S-ntrcr_o,n) & - / sss*ocean_bio_all(bio_index_o(mm))) + / sss*ocean_bio_all(bio_index_o(mm))) trcrn(bio_index(mm)+nblyr-ntrcr_o,n) = (trcrn(nt_bgc_S+nblyr-1-ntrcr_o,n) & / sss*ocean_bio_all(bio_index_o(mm))) trcrn(bio_index(mm)+nblyr+1-ntrcr_o:bio_index(mm)+nblyr+2-ntrcr_o,n) = c0 ! snow enddo ! mm - enddo ! n - + enddo ! n + elseif (scale_bgc .and. ktherm == 2) then trtmp(:) = c0 - do n = 1,ncat + do n = 1,ncat call remap_zbgc(nilyr, & 1, & sicen(:,n), trtmp, & @@ -632,27 +632,27 @@ subroutine icepack_init_bgc(ncat, nblyr, nilyr, ntrcr_o, & if (icepack_warnings_aborted(subname)) return do mm = 1,nbtrcr - do k = 1, nblyr + 1 + do k = 1, nblyr + 1 trcrn(bio_index(mm)+k-1-ntrcr_o,n) = & (trtmp(k)/sss*ocean_bio_all(bio_index_o(mm))) trcrn(bio_index(mm)+nblyr+1-ntrcr_o:bio_index(mm)+nblyr+2-ntrcr_o,n) = c0 ! snow enddo ! k enddo ! mm - enddo ! n + enddo ! n + + elseif (nbtrcr > 0 .and. nt_fbri > 0) then ! not scale_bgc - elseif (nbtrcr > 0 .and. nt_fbri > 0) then ! not scale_bgc - do n = 1,ncat do mm = 1,nbtrcr do k = 1, nblyr+1 trcrn(bio_index(mm)+k-1-ntrcr_o,n) = ocean_bio_all(bio_index_o(mm)) & - * zbgc_init_frac(mm) + * zbgc_init_frac(mm) trcrn(bio_index(mm)+nblyr+1-ntrcr_o:bio_index(mm)+nblyr+2-ntrcr_o,n) = c0 ! snow enddo ! k trcrn(nt_zbgc_frac-1+mm-ntrcr_o,n) = zbgc_frac_init(mm) enddo ! mm - enddo ! n - + enddo ! n + endif ! scale_bgc endif ! skl_bgc @@ -679,7 +679,7 @@ subroutine icepack_init_zbgc ( & real (kind=dbl_kind), optional :: R_chl2N_in(:) ! 3 algal chlorophyll to N (mg/mmol) real (kind=dbl_kind), optional :: F_abs_chl_in(:) ! to scale absorption in Dedd real (kind=dbl_kind), optional :: R_C2N_DON_in(:) ! increase compare to algal R_Fe2C - real (kind=dbl_kind), optional :: R_Si2N_in(:) ! algal Sil to N (mole/mole) + real (kind=dbl_kind), optional :: R_Si2N_in(:) ! algal Sil to N (mole/mole) real (kind=dbl_kind), optional :: R_S2N_in(:) ! algal S to N (mole/mole) real (kind=dbl_kind), optional :: R_Fe2C_in(:) ! algal Fe to carbon (umol/mmol) real (kind=dbl_kind), optional :: R_Fe2N_in(:) ! algal Fe to N (umol/mmol) @@ -716,8 +716,8 @@ subroutine icepack_init_zbgc ( & real (kind=dbl_kind), optional :: mort_pre_in(:) ! mortality (1/day) real (kind=dbl_kind), optional :: mort_Tdep_in(:) ! T dependence of mortality (1/C) real (kind=dbl_kind), optional :: k_exude_in(:) ! algal carbon exudation rate (1/d) - real (kind=dbl_kind), optional :: K_Nit_in(:) ! nitrate half saturation (mmol/m^3) - real (kind=dbl_kind), optional :: K_Am_in(:) ! ammonium half saturation (mmol/m^3) + real (kind=dbl_kind), optional :: K_Nit_in(:) ! nitrate half saturation (mmol/m^3) + real (kind=dbl_kind), optional :: K_Am_in(:) ! ammonium half saturation (mmol/m^3) real (kind=dbl_kind), optional :: K_Sil_in(:) ! silicon half saturation (mmol/m^3) real (kind=dbl_kind), optional :: K_Fe_in(:) ! iron half saturation or micromol/m^3 real (kind=dbl_kind), optional :: f_don_in(:) ! fraction of spilled grazing to DON @@ -725,7 +725,7 @@ subroutine icepack_init_zbgc ( & real (kind=dbl_kind), optional :: f_don_Am_in(:) ! fraction of remineralized DON to Am real (kind=dbl_kind), optional :: f_doc_in(:) ! fraction of mort_N that goes to each doc pool real (kind=dbl_kind), optional :: f_exude_in(:) ! fraction of exuded carbon to each DOC pool - real (kind=dbl_kind), optional :: k_bac_in(:) ! Bacterial degredation of DOC (1/d) + real (kind=dbl_kind), optional :: k_bac_in(:) ! Bacterial degredation of DOC (1/d) real (kind=dbl_kind), optional :: zbgc_frac_init_in(:) ! initializes mobile fraction real (kind=dbl_kind), optional :: bgc_tracer_type_in(:) ! described tracer in mobile or stationary phases @@ -837,7 +837,7 @@ subroutine icepack_biogeochemistry(dt, & real (kind=dbl_kind), dimension (:), intent(inout) :: & bgrid , & ! biology nondimensional vertical grid points igrid , & ! biology vertical interface points - cgrid , & ! CICE vertical coordinate + cgrid , & ! CICE vertical coordinate icgrid , & ! interface grid for CICE (shortwave variable) ocean_bio , & ! contains all the ocean bgc tracer concentrations fbio_snoice , & ! fluxes from snow to ice @@ -846,9 +846,9 @@ subroutine icepack_biogeochemistry(dt, & dhbr_bot , & ! brine bottom change darcy_V , & ! darcy velocity positive up (m/s) hin_old , & ! old ice thickness - sice_rho , & ! avg sea ice density (kg/m^3) - ice_bio_net , & ! depth integrated tracer (mmol/m^2) - snow_bio_net , & ! depth integrated snow tracer (mmol/m^2) + sice_rho , & ! avg sea ice density (kg/m^3) + ice_bio_net , & ! depth integrated tracer (mmol/m^2) + snow_bio_net , & ! depth integrated snow tracer (mmol/m^2) flux_bio ! all bio fluxes to ocean logical (kind=log_kind), dimension (:), intent(inout) :: & @@ -860,25 +860,25 @@ subroutine icepack_biogeochemistry(dt, & real (kind=dbl_kind), dimension (:,:), intent(inout) :: & Zoo , & ! N losses accumulated in timestep (ie. zooplankton/bacteria) ! mmol/m^3 - bphi , & ! porosity of layers + bphi , & ! porosity of layers bTiz , & ! layer temperatures interpolated on bio grid (C) zfswin , & ! Shortwave flux into layers interpolated on bio grid (W/m^2) - iDi , & ! igrid Diffusivity (m^2/s) - iki , & ! Ice permeability (m^2) - trcrn ! tracers + iDi , & ! igrid Diffusivity (m^2/s) + iki , & ! Ice permeability (m^2) + trcrn ! tracers real (kind=dbl_kind), intent(inout) :: & grow_net , & ! Specific growth rate (/s) per grid cell PP_net , & ! Total production (mg C/m^2/s) per grid cell hbri , & ! brine height, area-averaged for comparison with hi (m) - zsal_tot , & ! Total ice salinity in per grid cell (g/m^2) + zsal_tot , & ! Total ice salinity in per grid cell (g/m^2) fzsal , & ! Total flux of salt to ocean at time step for conservation fzsal_g , & ! Total gravity drainage flux upNO , & ! nitrate uptake rate (mmol/m^2/d) times aice upNH ! ammonium uptake rate (mmol/m^2/d) times aice logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. means Ra_c was reached + Rayleigh_criteria ! .true. means Ra_c was reached real (kind=dbl_kind), dimension (:,:), intent(in) :: & fswpenln ! visible SW entering ice layers (W m-2) @@ -890,10 +890,10 @@ subroutine icepack_biogeochemistry(dt, & meltbn , & ! bottom melt in category n (m) congeln , & ! congelation ice formation in category n (m) snoicen , & ! snow-ice formation in category n (m) - flux_bio_atm, & ! all bio fluxes to ice from atmosphere + flux_bio_atm, & ! all bio fluxes to ice from atmosphere aicen_init , & ! initial ice concentration, for linear ITD vicen_init , & ! initial ice volume (m), for linear ITD - vsnon_init , & ! initial snow volume (m), for aerosol + vsnon_init , & ! initial snow volume (m), for aerosol aicen , & ! concentration of ice vicen , & ! volume per unit area of ice (m) vsnon ! volume per unit area of snow (m) @@ -920,7 +920,7 @@ subroutine icepack_biogeochemistry(dt, & hbr_old , & ! old brine thickness before growh/melt dhice , & ! change due to sublimation/condensation (m) kavg , & ! average ice permeability (m^2) - bphi_o , & ! surface ice porosity + bphi_o , & ! surface ice porosity hbrin , & ! brine height dh_direct ! surface flooding or runoff @@ -932,19 +932,19 @@ subroutine icepack_biogeochemistry(dt, & real (kind=dbl_kind), dimension (nblyr+1) :: & ! Defined on Bio Grid interfaces - iphin , & ! porosity + iphin , & ! porosity ibrine_sal , & ! brine salinity (ppt) ibrine_rho , & ! brine_density (kg/m^3) iTin ! Temperature on the interface grid (oC) - real (kind=dbl_kind) :: & + real (kind=dbl_kind) :: & sloss ! brine flux contribution from surface runoff (g/m^2) ! for bgc sk - real (kind=dbl_kind) :: & + real (kind=dbl_kind) :: & dh_bot_chl , & ! Chlorophyll may or may not flush dh_top_chl , & ! Chlorophyll may or may not flush - darcy_V_chl + darcy_V_chl character(len=*),parameter :: subname='(icepack_biogeochemistry)' @@ -955,7 +955,7 @@ subroutine icepack_biogeochemistry(dt, & ! initialize !----------------------------------------------------------------- hin_old(n) = c0 - if (aicen_init(n) > puny) then + if (aicen_init(n) > puny) then hin_old(n) = vicen_init(n) & / aicen_init(n) else @@ -971,7 +971,7 @@ subroutine icepack_biogeochemistry(dt, & endif if (aicen(n) > puny) then - + dh_top_chl = c0 dh_bot_chl = c0 darcy_V_chl= c0 @@ -982,7 +982,7 @@ subroutine icepack_biogeochemistry(dt, & kavg = c0 bphi_o = c0 sloss = c0 - + !----------------------------------------------------------------- ! brine dynamics !----------------------------------------------------------------- @@ -990,7 +990,7 @@ subroutine icepack_biogeochemistry(dt, & dhbr_top(n) = c0 dhbr_bot(n) = c0 - if (tr_brine) then + if (tr_brine) then if (trcrn(nt_fbri,n) .le. c0) trcrn(nt_fbri,n) = c1 dhice = c0 @@ -998,14 +998,14 @@ subroutine icepack_biogeochemistry(dt, & vicen (n), vsnon (n), & meltbn (n), melttn (n), & congeln (n), snoicen(n), & - hin_old (n), dhice, & + hin_old (n), dhice, & trcrn(nt_fbri,n), & dhbr_top(n), dhbr_bot(n), & hbr_old, hin, & hsn, first_ice(n) ) if (icepack_warnings_aborted(subname)) return - if (solve_zsal) then + if (solve_zsal) then call compute_microS (n, nilyr, nblyr, & bgrid, cgrid, igrid, & @@ -1017,7 +1017,7 @@ subroutine icepack_biogeochemistry(dt, & brine_rho, iphin, ibrine_rho, & ibrine_sal, sice_rho(n), sloss) if (icepack_warnings_aborted(subname)) return - else + else ! Requires the average ice permeability = kavg(:) ! and the surface ice porosity = zphi_o(:) @@ -1028,7 +1028,7 @@ subroutine icepack_biogeochemistry(dt, & call compute_microS_mushy (nilyr, nblyr, & bgrid, cgrid, igrid, & trcrn(:,n), hin_old(n), hbr_old, & - sss, sst, bTiz(:,n), & + sss, sst, bTiz(:,n), & iTin(:), bphi(:,n), kavg, & bphi_o, bSin(:), & brine_sal(:), brine_rho(:), iphin(:), & @@ -1036,7 +1036,7 @@ subroutine icepack_biogeochemistry(dt, & iDi(:,n) ) if (icepack_warnings_aborted(subname)) return - endif ! solve_zsal + endif ! solve_zsal call update_hbrine (melttn(n), & meltsn (n), dt, & @@ -1046,19 +1046,19 @@ subroutine icepack_biogeochemistry(dt, & hbr_old, & trcrn(nt_fbri,n), & dhbr_top(n), dhbr_bot(n), & - dh_top_chl, dh_bot_chl, & + dh_top_chl, dh_bot_chl, & kavg, bphi_o, & - darcy_V (n), darcy_V_chl, & + darcy_V (n), darcy_V_chl, & bphi(2,n), aice0, & dh_direct) if (icepack_warnings_aborted(subname)) return - - hbri = hbri + hbrin * aicen(n) - if (solve_zsal) then + hbri = hbri + hbrin * aicen(n) + + if (solve_zsal) then call zsalinity (n, dt, & - nilyr, bgrid, & + nilyr, bgrid, & cgrid, igrid, & trcrn(nt_bgc_S:nt_bgc_S+nblyr-1,n), & trcrn(nt_qice:nt_qice+nilyr-1,n), & @@ -1069,17 +1069,17 @@ subroutine icepack_biogeochemistry(dt, & iki(:,n), hbr_old, & hbrin, hin, & hin_old(n), iDi(:,n), & - darcy_V(n), brine_sal, & - brine_rho, ibrine_sal, & + darcy_V(n), brine_sal, & + brine_rho, ibrine_sal, & ibrine_rho, dh_direct, & Rayleigh_criteria, & first_ice(n), sss, & sst, dhbr_top(n), & dhbr_bot(n), & fzsal, fzsal_g, & - bphi_o, nblyr, & + bphi_o, nblyr, & vicen(n), aicen_init(n), & - zsal_tot) + zsal_tot) if (icepack_warnings_aborted(subname)) return endif ! solve_zsal @@ -1090,13 +1090,13 @@ subroutine icepack_biogeochemistry(dt, & ! biogeochemistry !----------------------------------------------------------------- - if (z_tracers) then - + if (z_tracers) then + call zbio (dt, nblyr, & nslyr, nilyr, & melttn(n), & meltsn(n), meltbn (n), & - congeln(n), snoicen(n), & + congeln(n), snoicen(n), & nbtrcr, fsnow, & ntrcr, trcrn(1:ntrcr,n), & bio_index(1:nbtrcr), aicen_init(n), & @@ -1109,7 +1109,7 @@ subroutine icepack_biogeochemistry(dt, & n_fed, n_fep, & n_zaero, first_ice(n), & hin_old(n), ocean_bio(1:nbtrcr), & - bphi(:,n), iphin, & + bphi(:,n), iphin, & iDi(:,n), & fswpenln(:,n), & dhbr_top(n), dhbr_bot(n), & @@ -1128,7 +1128,7 @@ subroutine icepack_biogeochemistry(dt, & PP_net, ice_bio_net (1:nbtrcr), & snow_bio_net(1:nbtrcr),grow_net ) if (icepack_warnings_aborted(subname)) return - + elseif (skl_bgc) then call sklbio (dt, ntrcr, & @@ -1164,16 +1164,16 @@ subroutine icepack_load_ocean_bio_array(max_nbtrcr, & doc, don, dic, fed, fep, zaeros, ocean_bio_all, hum) integer (kind=int_kind), intent(in) :: & - max_algae , & ! maximum number of algal types - max_dic , & ! maximum number of dissolved inorganic carbon types + max_algae , & ! maximum number of algal types + max_dic , & ! maximum number of dissolved inorganic carbon types max_doc , & ! maximum number of dissolved organic carbon types max_don , & ! maximum number of dissolved organic nitrogen types max_fe , & ! maximum number of iron types - max_aero , & ! maximum number of aerosols + max_aero , & ! maximum number of aerosols max_nbtrcr ! maximum number of bio tracers real (kind=dbl_kind), intent(in) :: & - nit , & ! ocean nitrate (mmol/m^3) + nit , & ! ocean nitrate (mmol/m^3) amm , & ! ammonia/um (mmol/m^3) sil , & ! silicate (mmol/m^3) dmsp , & ! dmsp (mmol/m^3) @@ -1187,16 +1187,16 @@ subroutine icepack_load_ocean_bio_array(max_nbtrcr, & doc ! ocean doc (mmol/m^3) (proteins, EPS, lipid) real (kind=dbl_kind), dimension (max_don), intent(in) :: & - don ! ocean don (mmol/m^3) + don ! ocean don (mmol/m^3) real (kind=dbl_kind), dimension (max_dic), intent(in) :: & - dic ! ocean dic (mmol/m^3) + dic ! ocean dic (mmol/m^3) real (kind=dbl_kind), dimension (max_fe), intent(in) :: & - fed, fep ! ocean disolved and particulate fe (nM) + fed, fep ! ocean disolved and particulate fe (nM) real (kind=dbl_kind), dimension (max_aero), intent(in) :: & - zaeros ! ocean aerosols (mmol/m^3) + zaeros ! ocean aerosols (mmol/m^3) real (kind=dbl_kind), dimension (max_nbtrcr), intent(inout) :: & ocean_bio_all ! fixed order, all values even for tracers false @@ -1212,25 +1212,25 @@ subroutine icepack_load_ocean_bio_array(max_nbtrcr, & ocean_bio_all(:) = c0 - do k = 1, max_algae + do k = 1, max_algae ocean_bio_all(k) = algalN(k) ! N ks = max_algae + max_doc + max_dic + 1 ocean_bio_all(ks + k) = R_chl2N(k)*algalN(k)!chl - enddo + enddo ks = max_algae + 1 do k = 1, max_doc ocean_bio_all(ks + k) = doc(k) ! doc - enddo + enddo ks = ks + max_doc do k = 1, max_dic ocean_bio_all(ks + k) = dic(k) ! dic - enddo + enddo ks = 2*max_algae + max_doc + max_dic + 7 do k = 1, max_don ocean_bio_all(ks + k) = don(k) ! don - enddo + enddo ks = max_algae + 1 ocean_bio_all(ks) = nit ! nit @@ -1242,7 +1242,7 @@ subroutine icepack_load_ocean_bio_array(max_nbtrcr, & ks = ks + 1 ocean_bio_all(ks) = R_S2N(1)*algalN(1) & ! DMSPp + R_S2N(2)*algalN(2) & - + R_S2N(3)*algalN(3) + + R_S2N(3)*algalN(3) ks = ks + 1 ocean_bio_all(ks) = dmsp ! DMSPd ks = ks + 1 @@ -1252,16 +1252,16 @@ subroutine icepack_load_ocean_bio_array(max_nbtrcr, & ks = 2*max_algae + max_doc + 7 + max_dic + max_don do k = 1, max_fe ocean_bio_all(ks + k) = fed(k) ! fed - enddo + enddo ks = ks + max_fe do k = 1, max_fe ocean_bio_all(ks + k) = fep(k) ! fep - enddo + enddo ks = ks + max_fe do k = 1, max_aero ocean_bio_all(ks+k) = zaeros(k) ! zaero enddo - ks = ks + max_aero + 1 + ks = ks + max_aero + 1 ocean_bio_all(ks) = hum ! humics end subroutine icepack_load_ocean_bio_array @@ -1306,53 +1306,53 @@ subroutine icepack_init_ocean_bio (amm, dmsp, dms, algalN, doc, dic, don, & ! local variables integer (kind=int_kind) :: & - k + k character(len=*),parameter :: subname='(icepack_init_ocean_bio)' if (present(CToN)) then CToN(1) = R_C2N(1) - CToN(2) = R_C2N(2) - CToN(3) = R_C2N(3) + CToN(2) = R_C2N(2) + CToN(3) = R_C2N(3) endif if (present(CToN_DON)) then CToN_DON(1) = R_C2N_DON(1) endif - amm = c1 ! ISPOL < 1 mmol/m^3 - dmsp = p1 - dms = p1 - algalN(1) = c1 !0.0026_dbl_kind ! ISPOL, Lannuzel 2013(pennate) + amm = c1 ! ISPOL < 1 mmol/m^3 + dmsp = p1 + dms = p1 + algalN(1) = c1 !0.0026_dbl_kind ! ISPOL, Lannuzel 2013(pennate) algalN(2) = 0.0057_dbl_kind ! ISPOL, Lannuzel 2013(small plankton) algalN(3) = 0.0027_dbl_kind ! ISPOL, Lannuzel 2013(Phaeocystis) - ! 0.024_dbl_kind ! 5% of 1 mgchl/m^3 + ! 0.024_dbl_kind ! 5% of 1 mgchl/m^3 doc(1) = 16.2_dbl_kind ! 18% saccharides doc(2) = 9.0_dbl_kind ! lipids - doc(3) = c1 ! + doc(3) = c1 ! do k = 1, max_dic dic(k) = c1 - enddo + enddo do k = 1, max_don - don(k) = 12.9_dbl_kind + don(k) = 12.9_dbl_kind ! 64.3_dbl_kind ! 72% Total DOC~90 mmolC/m^3 ISPOL with N:C of 0.2 - enddo + enddo !ki = 1 !if (trim(fe_data_type) == 'clim') ki = 2 do k = 1, max_fe ! ki, max_fe - fed(k) = 0.4_dbl_kind ! c1 (nM) Lannuzel2007 DFe, + fed(k) = 0.4_dbl_kind ! c1 (nM) Lannuzel2007 DFe, ! range 0.14-2.6 (nM) van der Merwe 2011 ! Tagliabue 2012 (0.4 nM) fep(k) = c2 ! (nM) van der Merwe 2011 ! (0.6 to 2.9 nM ocean) - enddo + enddo hum = c1 ! mmol C/m^3 nit = 12.0_dbl_kind sil = 25.0_dbl_kind do k = 1, max_aero zaeros(k) = c0 enddo - + end subroutine icepack_init_ocean_bio diff --git a/columnphysics/icepack_zbgc_shared.F90 b/columnphysics/icepack_zbgc_shared.F90 index 68200b621..770180782 100644 --- a/columnphysics/icepack_zbgc_shared.F90 +++ b/columnphysics/icepack_zbgc_shared.F90 @@ -11,7 +11,7 @@ module icepack_zbgc_shared use icepack_kinds use icepack_parameters, only: p5, c0, c1, secday, puny use icepack_parameters, only: hs_ssl, sk_l - use icepack_parameters, only: rhoi, cp_ocn, cp_ice, Lfresh + use icepack_parameters, only: rhoi, cp_ocn, cp_ice, Lfresh use icepack_parameters, only: solve_zbgc use icepack_parameters, only: fr_resp use icepack_tracers, only: max_nbtrcr, max_algae, max_doc @@ -20,7 +20,7 @@ module icepack_zbgc_shared use icepack_warnings, only: warnstr, icepack_warnings_add use icepack_warnings, only: icepack_warnings_setabort, icepack_warnings_aborted - implicit none + implicit none private public :: calculate_qin_from_Sin, & @@ -48,7 +48,7 @@ module icepack_zbgc_shared !------------------------------------------------------------- ! bio parameters for algal_dyn - + real (kind=dbl_kind), dimension(max_algae), public :: & R_C2N , & ! algal C to N (mole/mole) R_chl2N , & ! 3 algal chlorophyll to N (mg/mmol) @@ -58,16 +58,16 @@ module icepack_zbgc_shared R_C2N_DON real (kind=dbl_kind), dimension(max_algae), public :: & - R_Si2N , & ! algal Sil to N (mole/mole) + R_Si2N , & ! algal Sil to N (mole/mole) R_S2N , & ! algal S to N (mole/mole) ! Marchetti et al 2006, 3 umol Fe/mol C for iron limited Pseudo-nitzschia R_Fe2C , & ! algal Fe to carbon (umol/mmol) R_Fe2N ! algal Fe to N (umol/mmol) - real (kind=dbl_kind), dimension(max_don), public :: & + real (kind=dbl_kind), dimension(max_don), public :: & R_Fe2DON ! Fe to N of DON (nmol/umol) - real (kind=dbl_kind), dimension(max_doc), public :: & + real (kind=dbl_kind), dimension(max_doc), public :: & R_Fe2DOC ! Fe to C of DOC (nmol/umol) real (kind=dbl_kind), parameter, public :: & @@ -102,15 +102,15 @@ module icepack_zbgc_shared real (kind=dbl_kind), dimension(max_nbtrcr), public :: & zbgc_frac_init,&! initializes mobile fraction - bgc_tracer_type ! described tracer in mobile or stationary phases + bgc_tracer_type ! described tracer in mobile or stationary phases ! < 0 is purely mobile (eg. nitrate) - ! > 0 has timescales for transitions between + ! > 0 has timescales for transitions between ! phases based on whether the ice is melting or growing - real (kind=dbl_kind), dimension(max_nbtrcr), public :: & + real (kind=dbl_kind), dimension(max_nbtrcr), public :: & zbgc_init_frac, & ! fraction of ocean tracer concentration in new ice tau_ret, & ! retention timescale (s), mobile to stationary phase - tau_rel ! release timescale (s), stationary to mobile phase + tau_rel ! release timescale (s), stationary to mobile phase !----------------------------------------------------------------- ! From algal_dyn in icepack_algae.F90 but not in namelist @@ -126,11 +126,11 @@ module icepack_zbgc_shared mort_pre , & ! mortality (1/day) mort_Tdep , & ! T dependence of mortality (1/C) k_exude , & ! algal carbon exudation rate (1/d) - K_Nit , & ! nitrate half saturation (mmol/m^3) - K_Am , & ! ammonium half saturation (mmol/m^3) + K_Nit , & ! nitrate half saturation (mmol/m^3) + K_Am , & ! ammonium half saturation (mmol/m^3) K_Sil , & ! silicon half saturation (mmol/m^3) K_Fe ! iron half saturation or micromol/m^3 - + real (kind=dbl_kind), dimension(max_DON), public :: & f_don , & ! fraction of spilled grazing to DON kn_bac , & ! Bacterial degredation of DON (1/d) @@ -139,30 +139,30 @@ module icepack_zbgc_shared real (kind=dbl_kind), dimension(max_DOC), public :: & f_doc , & ! fraction of mort_N that goes to each doc pool f_exude , & ! fraction of exuded carbon to each DOC pool - k_bac ! Bacterial degredation of DOC (1/d) + k_bac ! Bacterial degredation of DOC (1/d) !----------------------------------------------------------------- ! brine !----------------------------------------------------------------- integer (kind=int_kind), parameter, public :: & - exp_h = 3 ! power law for hierarchical model + exp_h = 3 ! power law for hierarchical model - real (kind=dbl_kind), parameter, public :: & + real (kind=dbl_kind), parameter, public :: & k_o = 3.e-8_dbl_kind, & ! permeability scaling factor (m^2) thinS = 0.05_dbl_kind ! minimum ice thickness for brine - real (kind=dbl_kind), public :: & + real (kind=dbl_kind), public :: & flood_frac ! fraction of ocean/meltwater that floods !***** - real (kind=dbl_kind), parameter, public :: & + real (kind=dbl_kind), parameter, public :: & bphimin = 0.03_dbl_kind ! minimum porosity for zbgc only !----------------------------------------------------------------------- ! Parameters for zsalinity !----------------------------------------------------------------------- - real (kind=dbl_kind), parameter, public :: & + real (kind=dbl_kind), parameter, public :: & viscos_dynamic = 2.2_dbl_kind , & ! 1.8e-3_dbl_kind (pure water at 0^oC) (kg/m/s) Dm = 1.0e-9_dbl_kind, & ! molecular diffusion (m^2/s) Ra_c = 0.05_dbl_kind ! critical Rayleigh number for bottom convection @@ -172,13 +172,13 @@ module icepack_zbgc_shared contains !======================================================================= -! +! ! Compute the internal ice enthalpy using new salinity and Tin ! function calculate_qin_from_Sin (Tin, Tmltk) & result(qin) - + real (kind=dbl_kind), intent(in) :: & Tin ,& ! internal temperature Tmltk ! melting temperature at one level @@ -186,7 +186,7 @@ function calculate_qin_from_Sin (Tin, Tmltk) & ! local variables real (kind=dbl_kind) :: & - qin ! melting temperature at one level + qin ! melting temperature at one level character(len=*),parameter :: subname='(calculate_qin_from_Sin)' @@ -197,7 +197,7 @@ end function calculate_qin_from_Sin !======================================================================= ! ! Remaps tracer fields in a given category from one set of layers to another. -! Grids can be very different and so can vertical spaces. +! Grids can be very different and so can vertical spaces. subroutine remap_zbgc(nlyrn, & it, & @@ -227,8 +227,8 @@ subroutine remap_zbgc(nlyrn, & real(kind=dbl_kind), intent(in) :: & hice , & ! CICE ice thickness - hinS , & ! brine height - S_min ! for salinity on CICE grid + hinS , & ! brine height + S_min ! for salinity on CICE grid ! local variables @@ -239,8 +239,8 @@ subroutine remap_zbgc(nlyrn, & n_nr, n_plus ! number of layers in receiver real (kind=dbl_kind), dimension (nbyrn+3+nlyrn) :: & - trdr , & ! combined tracer - trgrid ! combined grid + trdr , & ! combined tracer + trgrid ! combined grid real (kind=dbl_kind), dimension (nbyrn+nlyrn+3) :: & tracer , & ! temporary, ice tracers values @@ -254,19 +254,19 @@ subroutine remap_zbgc(nlyrn, & call icepack_warnings_add(subname//' ice: remap_layers_bgc error') return endif - + if (nr0 == 0) then ! cice to bio n_nd = nlyrn n_nr = nbyrn n_plus = 2 - dgrid (1) = min(-hice+hinS, -hinS+hice, c0) - dgrid (nlyrn+2) = min(hinS, hice) + dgrid (1) = min(-hice+hinS, -hinS+hice, c0) + dgrid (nlyrn+2) = min(hinS, hice) tracer(1) = trcrn(it) tracer(nlyrn+2) = trcrn(it+nlyrn-1) rgrid (nbyrn+2) = min(hinS, hice) if (hice > hinS) then - rgrid(1) = c0 + rgrid(1) = c0 do kr = 1,n_nr rgrid(kr+1) = bio_grid(kr)*hinS enddo @@ -275,7 +275,7 @@ subroutine remap_zbgc(nlyrn, & tracer(kd+1) = trcrn(it+kd-1) enddo else - rgrid(1) = -hinS + hice + rgrid(1) = -hinS + hice do kr = 1,n_nr rgrid(kr+1) = (bio_grid(kr)-c1)*hinS + hice enddo @@ -284,17 +284,17 @@ subroutine remap_zbgc(nlyrn, & tracer(kd+1) = trcrn(it+kd-1) enddo endif - + else ! bio to cice n_nd = nbyrn n_nr = nlyrn if (hice > hinS) then ! add S_min to top layer - n_plus = 3 + n_plus = 3 tracer(1) = S_min tracer(2) = S_min rgrid (1) = -hice + hinS - rgrid (nlyrn+n_plus-1) = hinS + rgrid (nlyrn+n_plus-1) = hinS do kr = 1,n_nr rgrid(kr+1) = (ice_grid(kr)-c1)*hice+ hinS enddo @@ -331,7 +331,7 @@ subroutine remap_zbgc(nlyrn, & endif kdr = 0 ! combined indices - kdi = 1 + kdi = 1 do kr = 1, n_nr do kd = kdi, n_nd+n_plus @@ -347,13 +347,13 @@ subroutine remap_zbgc(nlyrn, & + (rgrid(kr+1) - trgrid(kdr-1)) & * (tracer(kd) - trdr(kdr-1)) & / (dgrid(kd) - trgrid(kdr-1)) - trdr(kdr) = trtmp(it+kr-1) + trdr(kdr) = trtmp(it+kr-1) EXIT else kdr = kdr+1 kdi = kd+1 trgrid(kdr) = rgrid(kr+1) - trtmp (it+kr-1) = tracer(kd) + trtmp (it+kr-1) = tracer(kd) trdr (kdr) = tracer(kd) EXIT endif @@ -392,7 +392,7 @@ subroutine zap_small_bgc (zlevels, dflux_bio, & do k = 1, zlevels dflux_bio = dflux_bio + btrcr(k)*zvol(k)/dt enddo - + end subroutine zap_small_bgc !======================================================================= @@ -405,25 +405,25 @@ subroutine regrid_stationary (C_stationary, hbri_old, & top_conc, igrid, & flux_bio, & melt_b, con_gel) - + integer (kind=int_kind), intent(in) :: & ntrcr, & ! number of tracers nblyr ! number of bio layers real (kind=dbl_kind), intent(inout) :: & flux_bio ! ocean tracer flux (mmol/m^2/s) positive into ocean - - real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & + + real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & C_stationary ! stationary bulk concentration*h (mmol/m^2) real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - igrid ! CICE bio grid - + igrid ! CICE bio grid + real(kind=dbl_kind), intent(in) :: & dt , & ! time step top_conc , & ! c0 or frazil concentration hbri_old , & ! previous timestep brine height - hbri ! brine height + hbri ! brine height real(kind=dbl_kind), intent(in), optional :: & melt_b, & ! bottom melt (m) @@ -444,7 +444,7 @@ subroutine regrid_stationary (C_stationary, hbri_old, & dflux, & ! regrid flux correction (mmol/m^2) sum_i, & ! total tracer before melt loss sum_f, & ! total tracer after melt - hice, & + hice, & hbio real (kind=dbl_kind), dimension(nblyr+1):: & @@ -471,12 +471,12 @@ subroutine regrid_stationary (C_stationary, hbri_old, & !--------------------- ! compute initial sum !---------------------- - + do k = 1, nblyr+1 sum_i = sum_i + C_stationary(k)*zspace(k) - + enddo - + if (present(melt_b)) then meltb = melt_b endif @@ -493,7 +493,7 @@ subroutine regrid_stationary (C_stationary, hbri_old, & htemp = c0 if (meltb > c0) then - htemp = hbri_old-meltb + htemp = hbri_old-meltb nr = 0 hice = hbri_old hbio = htemp @@ -508,7 +508,7 @@ subroutine regrid_stationary (C_stationary, hbri_old, & hice = htemp hbio = hbri_old endif - + !----------------------------------------------------------------- ! Regrid C_stationary to add or remove bottom layer(s) !----------------------------------------------------------------- @@ -517,17 +517,17 @@ subroutine regrid_stationary (C_stationary, hbri_old, & nt, & trtmp0(1:ntrcr), & trtmp, & - nr, nblyr+1, & - hice, hbio, & + nr, nblyr+1, & + hice, hbio, & igrid(1:nblyr+1), & igrid(1:nblyr+1), top_conc ) if (icepack_warnings_aborted(subname)) return - + trtmp0(:) = c0 do k = 1,nblyr+1 trtmp0(nblyr+2-k) = trtmp(nt + k-1) enddo !k - + do k = 1, nblyr+1 C_stationary(k) = trtmp0(k)*htemp sum_f = sum_f + C_stationary(k)*zspace(k) @@ -541,8 +541,8 @@ subroutine regrid_stationary (C_stationary, hbri_old, & sum_f = sum_f + C_stationary(k)*zspace(k) enddo endif - - flux_bio = flux_bio + (sum_i -sum_f)/dt + + flux_bio = flux_bio + (sum_i -sum_f)/dt endif end subroutine regrid_stationary @@ -555,7 +555,7 @@ end subroutine regrid_stationary subroutine merge_bgc_fluxes (dt, nblyr, & nslyr, & bio_index, n_algae, & - nbtrcr, aicen, & + nbtrcr, aicen, & vicen, vsnon, & iphin, & trcrn, & @@ -567,8 +567,8 @@ subroutine merge_bgc_fluxes (dt, nblyr, & PP_net, ice_bio_net,& snow_bio_net, grow_alg, & grow_net) - - real (kind=dbl_kind), intent(in) :: & + + real (kind=dbl_kind), intent(in) :: & dt ! timestep (s) integer (kind=int_kind), intent(in) :: & @@ -578,42 +578,42 @@ subroutine merge_bgc_fluxes (dt, nblyr, & nbtrcr ! number of biology tracer tracers integer (kind=int_kind), dimension(:), intent(in) :: & - bio_index ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N + bio_index ! relates bio indices, ie. nlt_bgc_N to nt_bgc_N real (kind=dbl_kind), dimension (:), intent(in) :: & trcrn , & ! input tracer fields iphin ! porosity - real (kind=dbl_kind), intent(in):: & + real (kind=dbl_kind), intent(in):: & aicen , & ! concentration of ice vicen , & ! volume of ice (m) vsnon ! volume of snow(m) ! single category rates real (kind=dbl_kind), dimension(:), intent(in):: & - zbgc_snown , & ! bio flux from snow to ice per cat (mmol/m^3*m) + zbgc_snown , & ! bio flux from snow to ice per cat (mmol/m^3*m) zbgc_atmn , & ! bio flux from atm to ice per cat (mmol/m^3*m) flux_bion ! single category rates real (kind=dbl_kind), dimension(:,:), intent(in):: & upNOn , & ! nitrate uptake rate per cat (mmol/m^3/s) - upNHn , & ! ammonium uptake rate per cat (mmol/m^3/s) + upNHn , & ! ammonium uptake rate per cat (mmol/m^3/s) grow_alg ! algal growth rate per cat (mmolN/m^3/s) ! cumulative fluxes - real (kind=dbl_kind), dimension(:), intent(inout):: & - flux_bio , & ! - zbgc_snow , & ! bio flux from snow to ice per cat (mmol/m^2/s) + real (kind=dbl_kind), dimension(:), intent(inout):: & + flux_bio , & ! + zbgc_snow , & ! bio flux from snow to ice per cat (mmol/m^2/s) zbgc_atm , & ! bio flux from atm to ice per cat (mmol/m^2/s) ice_bio_net, & ! integrated ice tracers mmol or mg/m^2) snow_bio_net ! integrated snow tracers mmol or mg/m^2) ! cumulative variables and rates - real (kind=dbl_kind), intent(inout):: & + real (kind=dbl_kind), intent(inout):: & PP_net , & ! net PP (mg C/m^2/d) times aice grow_net , & ! net specific growth (m/d) times vice - upNO , & ! tot nitrate uptake rate (mmol/m^2/d) times aice + upNO , & ! tot nitrate uptake rate (mmol/m^2/d) times aice upNH ! tot ammonium uptake rate (mmol/m^2/d) times aice ! local variables @@ -626,7 +626,7 @@ subroutine merge_bgc_fluxes (dt, nblyr, & integer (kind=int_kind) :: & k, mm ! tracer indice - real (kind=dbl_kind), dimension (nblyr+1) :: & + real (kind=dbl_kind), dimension (nblyr+1) :: & zspace character(len=*),parameter :: subname='(merge_bgc_fluxes)' @@ -645,7 +645,7 @@ subroutine merge_bgc_fluxes (dt, nblyr, & * trcrn(nt_fbri) & * vicen*zspace(k) enddo ! k - + !----------------------------------------------------------------- ! Merge fluxes !----------------------------------------------------------------- @@ -662,12 +662,12 @@ subroutine merge_bgc_fluxes (dt, nblyr, & if (solve_zbgc) then do mm = 1, n_algae do k = 1, nblyr+1 - tmp = iphin(k)*trcrn(nt_fbri)*vicen*zspace(k)*secday + tmp = iphin(k)*trcrn(nt_fbri)*vicen*zspace(k)*secday PP_net = PP_net + grow_alg(k,mm)*tmp & - * (c1-fr_resp)* R_C2N(mm)*R_gC2molC + * (c1-fr_resp)* R_C2N(mm)*R_gC2molC grow_net = grow_net + grow_alg(k,mm)*tmp & / (trcrn(nt_bgc_N(mm)+k-1)+puny) - upNO = upNO + upNOn (k,mm)*tmp + upNO = upNO + upNOn (k,mm)*tmp upNH = upNH + upNHn (k,mm)*tmp enddo ! k enddo ! mm @@ -695,30 +695,30 @@ subroutine merge_bgc_fluxes_skl (nbtrcr, n_algae, & n_algae ! number of autotrophs ! single category fluxes - real (kind=dbl_kind), intent(in):: & + real (kind=dbl_kind), intent(in):: & aicen ! category ice area fraction real (kind=dbl_kind), dimension (:), intent(in) :: & trcrn ! Bulk tracer concentration (mmol N or mg/m^3) - + real (kind=dbl_kind), dimension(:), intent(in):: & flux_bion ! all bio fluxes to ocean, on categories real (kind=dbl_kind), dimension(:), intent(inout):: & flux_bio ! all bio fluxes to ocean, aggregated - real (kind=dbl_kind), dimension(:), intent(in):: & - grow_alg, & ! algal growth rate (mmol/m^3/s) + real (kind=dbl_kind), dimension(:), intent(in):: & + grow_alg, & ! algal growth rate (mmol/m^3/s) upNOn , & ! nitrate uptake rate per cat (mmol/m^3/s) - upNHn ! ammonium uptake rate per cat (mmol/m^3/s) + upNHn ! ammonium uptake rate per cat (mmol/m^3/s) ! history output - real (kind=dbl_kind), intent(inout):: & + real (kind=dbl_kind), intent(inout):: & PP_net , & ! Bulk net PP (mg C/m^2/d) grow_net, & ! net specific growth (/d) - upNO , & ! tot nitrate uptake rate (mmol/m^2/d) + upNO , & ! tot nitrate uptake rate (mmol/m^2/d) upNH ! tot ammonium uptake rate (mmol/m^2/d) - + ! local variables integer (kind=int_kind) :: & @@ -726,7 +726,7 @@ subroutine merge_bgc_fluxes_skl (nbtrcr, n_algae, & real (kind=dbl_kind) :: & tmp ! temporary - + character(len=*),parameter :: subname='(merge_bgc_fluxes_skl)' !----------------------------------------------------------------- @@ -738,10 +738,10 @@ subroutine merge_bgc_fluxes_skl (nbtrcr, n_algae, & enddo do mm = 1, n_algae - tmp = phi_sk * sk_l * aicen * secday + tmp = phi_sk * sk_l * aicen * secday PP_net = PP_net & + grow_alg(mm) * tmp & - * R_C2N(mm) * R_gC2molC * (c1-fr_resp) + * R_C2N(mm) * R_gC2molC * (c1-fr_resp) grow_net = grow_net & + grow_alg(mm) * tmp & / (trcrn(nt_bgc_N(mm))+puny) diff --git a/columnphysics/icepack_zsalinity.F90 b/columnphysics/icepack_zsalinity.F90 index 3632bdde4..20035804c 100644 --- a/columnphysics/icepack_zsalinity.F90 +++ b/columnphysics/icepack_zsalinity.F90 @@ -5,8 +5,8 @@ ! The CICE Bitz and Lipscomb thermodynamics is solved on the cgrid with height ! vicen/aicen. ! Gravity drainage is parameterized as nonlinear advection -! Flushing is incorporated in the boundary changes and a darcy flow. -! (see Jeffery et al., JGR, 2011). +! Flushing is incorporated in the boundary changes and a darcy flow. +! (see Jeffery et al., JGR, 2011). ! ! authors: Nicole Jeffery, LANL ! Elizabeth C. Hunke, LANL @@ -32,9 +32,9 @@ module icepack_zsalinity private public :: zsalinity - real (kind=dbl_kind), parameter :: & + real (kind=dbl_kind), parameter :: & max_salin = 200.0_dbl_kind, & !(ppt) maximum bulk salinity - lapidus_g = 0.3_dbl_kind ! constant for artificial + lapidus_g = 0.3_dbl_kind ! constant for artificial ! viscosity/diffusion during growth ! lapidus_m = 0.007_dbl_kind ! constant for artificial diffusion during melt @@ -65,22 +65,22 @@ subroutine zsalinity (n_cat, dt, & fzsal, & fzsal_g, bphi_min, & nblyr, vicen, & - aicen, zsal_tot) - + aicen, zsal_tot) + integer (kind=int_kind), intent(in) :: & nilyr , & ! number of ice layers nblyr , & ! number of bio layers ntrcr , & ! number of tracers - n_cat ! category number - + n_cat ! category number + real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & bgrid ! biology nondimensional vertical grid points real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), intent(in) :: & sss , & ! ocean salinity (ppt) @@ -119,25 +119,25 @@ subroutine zsalinity (n_cat, dt, & real (kind=dbl_kind), dimension (nilyr), & intent(inout) :: & - trcrn_q , & ! enthalpy tracer + trcrn_q , & ! enthalpy tracer trcrn_Si ! salinity on CICE grid logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. if minimun ice thickness (Ra_c) was reached - + Rayleigh_criteria ! .true. if minimun ice thickness (Ra_c) was reached + logical (kind=log_kind), intent(in) :: & - first_ice ! for first category ice only .true. - !initialized values should be used + first_ice ! for first category ice only .true. + !initialized values should be used real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & iDin , & ! Diffusivity on the igrid (1/s) - ikin ! permeability on the igrid + ikin ! permeability on the igrid real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - iphin , & ! porosity on the igrid - ibrine_rho , & ! brine rho on interface - ibrine_sal ! brine sal on interface - + iphin , & ! porosity on the igrid + ibrine_rho , & ! brine rho on interface + ibrine_sal ! brine sal on interface + ! local variables real (kind=dbl_kind) :: & @@ -177,15 +177,15 @@ subroutine zsalinity (n_cat, dt, & call merge_zsal_fluxes (aicen, & zsal_totn, zsal_tot, & fzsal, fzsaln, & - fzsal_g, fzsaln_g) + fzsal_g, fzsaln_g) if (icepack_warnings_aborted(subname)) return end subroutine zsalinity !======================================================================= ! -! update vertical salinity -! +! update vertical salinity +! subroutine solve_zsalinity (nilyr, nblyr, & n_cat, dt, & bgrid, cgrid, igrid, & @@ -202,7 +202,7 @@ subroutine solve_zsalinity (nilyr, nblyr, & Rayleigh_criteria, & first_ice, sss, & sst, dh_top, & - dh_bot, & + dh_bot, & fzsaln, & fzsaln_g, bphi_min) @@ -210,8 +210,8 @@ subroutine solve_zsalinity (nilyr, nblyr, & nilyr, & ! number of ice layers nblyr, & ! number of bio layers ntrcr, & ! number of tracers - n_cat ! category number - + n_cat ! category number + real (kind=dbl_kind), intent(in) :: & dt ! time step @@ -220,9 +220,9 @@ subroutine solve_zsalinity (nilyr, nblyr, & real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), intent(in) :: & sss , & ! ocean salinity (ppt) @@ -230,7 +230,7 @@ subroutine solve_zsalinity (nilyr, nblyr, & hin_old , & ! old ice thickness (m) dh_top , & ! brine change in top and bottom for diagnostics (m) dh_bot , & - darcy_V + darcy_V real (kind=dbl_kind), intent(in) :: & hbr_old , & ! old brine height (m) @@ -238,7 +238,7 @@ subroutine solve_zsalinity (nilyr, nblyr, & hbrin , & ! new brine height (m) bphi_min , & ! dh_direct ! flooded or runoff amount (m) - + real (kind=dbl_kind), intent(out) :: & fzsaln , & ! total flux of salt out of ice over timestep(kg/m^2/s) fzsaln_g ! gravity drainage flux of salt over timestep(kg/m^2/s) @@ -258,35 +258,35 @@ subroutine solve_zsalinity (nilyr, nblyr, & real (kind=dbl_kind), dimension (nilyr), & intent(inout) :: & - trcrn_q , & ! enthalpy tracer + trcrn_q , & ! enthalpy tracer trcrn_Si ! salinity on CICE grid logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. if minimun ice thickness (Ra_c) was reached - + Rayleigh_criteria ! .true. if minimun ice thickness (Ra_c) was reached + logical (kind=log_kind), intent(in) :: & - first_ice ! for first category ice only .true. - !initialized values should be used + first_ice ! for first category ice only .true. + !initialized values should be used real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & iDin , & ! Diffusivity on the igrid (1/s) - ikin ! permeability on the igrid + ikin ! permeability on the igrid real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & - iphin , & ! porosity on the igrid - ibrine_rho , & ! brine rho on interface - ibrine_sal ! brine sal on interface - + iphin , & ! porosity on the igrid + ibrine_rho , & ! brine rho on interface + ibrine_sal ! brine sal on interface + ! local variables integer (kind=int_kind) :: & - k, nint ! vertical biology layer index + k, nint ! vertical biology layer index real (kind=dbl_kind) :: & surface_S ! salinity of ice above hin > hbrin - + real (kind=dbl_kind), dimension(2) :: & - S_bot + S_bot real (kind=dbl_kind) :: & Tmlts , & ! melting temperature @@ -294,12 +294,12 @@ subroutine solve_zsalinity (nilyr, nblyr, & logical (kind=log_kind) :: & Rayleigh - + real (kind=dbl_kind):: & Ttemp ! initial temp profile on the CICE grid real (kind=dbl_kind), dimension (ntrcr+2) :: & - trtmp0 , & ! temporary, remapped tracers !need extra + trtmp0 , & ! temporary, remapped tracers !need extra trtmp ! temporary, remapped tracers ! logical (kind=log_kind) :: & @@ -312,41 +312,41 @@ subroutine solve_zsalinity (nilyr, nblyr, & !----------------------------------------------------------------- dts = dts_b - nint = max(1,INT(dt/dts)) + nint = max(1,INT(dt/dts)) dts = dt/nint !---------------------------------------------------------------- ! Update boundary conditions !---------------------------------------------------------------- - + surface_S = min_salin Rayleigh = .true. if (n_cat == 1 .AND. hbr_old < Ra_c) then - Rayleigh = Rayleigh_criteria ! only category 1 ice can be false + Rayleigh = Rayleigh_criteria ! only category 1 ice can be false endif - if (dh_bot + darcy_V*dt > c0) then - + if (dh_bot + darcy_V*dt > c0) then + bSin (nblyr+2) = sss bTin (nblyr+2) = sst - brine_sal(nblyr+2) = sss + brine_sal(nblyr+2) = sss brine_rho(nblyr+2) = rhow - bphin (nblyr+2) = c1 + bphin (nblyr+2) = c1 S_bot (1) = c0 - S_bot (2) = c1 - + S_bot (2) = c1 + ! bottom melt - else - bSin (nblyr+2) = bSin(nblyr+1) - Tmlts = -bSin(nblyr+2)* depressT + else + bSin (nblyr+2) = bSin(nblyr+1) + Tmlts = -bSin(nblyr+2)* depressT bTin (nblyr+2) = bTin(nblyr+1) bphin(nblyr+2) = iphin(nblyr+1) S_bot(1) = c1 S_bot(2) = c0 endif - if (abs(dh_top) > puny .AND. abs(darcy_V) > puny) then + if (abs(dh_top) > puny .AND. abs(darcy_V) > puny) then bSin(1) = max(min_salin,-(brine_rho(2)*brine_sal(2)/rhosi & * darcy_V*dt - (dh_top + darcy_V*dt/bphi_min - dh_direct)*min_salin & + max(c0,-dh_direct) * sss )/dh_top) @@ -356,7 +356,7 @@ subroutine solve_zsalinity (nilyr, nblyr, & else bSin(1) = min_salin endif - + !----------------------------------------------------------------- ! Solve for S using CICE T. If solve_zsal = .true., then couple back ! to the thermodynamics @@ -379,14 +379,14 @@ subroutine solve_zsalinity (nilyr, nblyr, & fzsaln , fzsaln_g , & S_bot ) if (icepack_warnings_aborted(subname)) return - + if (n_cat == 1) Rayleigh_criteria = Rayleigh trtmp0(:) = c0 trtmp (:) = c0 - - do k = 1,nblyr ! back to bulk quantity - trcrn_S(k) = bSin(k+1) + + do k = 1,nblyr ! back to bulk quantity + trcrn_S(k) = bSin(k+1) trtmp0(nt_sice+k-1) = trcrn_S(k) enddo ! k @@ -400,22 +400,22 @@ subroutine solve_zsalinity (nilyr, nblyr, & bgrid(2:nblyr+1), & surface_S ) if (icepack_warnings_aborted(subname)) return - + do k = 1, nilyr Tmlts = -trcrn_Si(k)*depressT Ttemp = min(-(min_salin+puny)*depressT, & - calculate_Tin_from_qin(trcrn_q(k),Tmlts)) + calculate_Tin_from_qin(trcrn_q(k),Tmlts)) trcrn_Si(k) = min(-Ttemp/depressT, max(min_salin, & trtmp(nt_sice+k-1))) - Tmlts = - trcrn_Si(k)*depressT - ! if (cflag) trcrn_q(k) = calculate_qin_from_Sin(Ttemp,Tmlts) + Tmlts = - trcrn_Si(k)*depressT + ! if (cflag) trcrn_q(k) = calculate_qin_from_Sin(Ttemp,Tmlts) enddo ! k end subroutine solve_zsalinity !======================================================================= ! -! solves salt continuity explicitly using +! solves salt continuity explicitly using ! Lax-Wendroff-type scheme (MacCormack) ! (Mendez-Nunez and Carroll, Monthly Weather Review, 1993) ! @@ -449,9 +449,9 @@ subroutine solve_S_dt (cflag, nblyr, nint, & dht , & ! change in the ice top (positive for melting) dhb , & ! change in the ice bottom (positive for freezing) hice_old , & ! old ice thickness (m) - hbri_old , & ! brine thickness (m) + hbri_old , & ! brine thickness (m) hbrin , & ! new brine thickness (m) - darcy_V ! Darcy velocity due to a pressure head (m/s) or melt + darcy_V ! Darcy velocity due to a pressure head (m/s) or melt real (kind=dbl_kind), intent(out) :: & fzsaln , & ! salt flux +ive to ocean (kg/m^2/s) @@ -466,8 +466,8 @@ subroutine solve_S_dt (cflag, nblyr, nint, & real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & brine_sal , & ! Internal brine salinity (ppt) brine_rho , & ! Internal brine density (kg/m^3) - bgrid , & ! biology nondimensional grid layer points - bTin ! Temperature of ice layers on bio grid for history (C) + bgrid , & ! biology nondimensional grid layer points + bTin ! Temperature of ice layers on bio grid for history (C) real (kind=dbl_kind), dimension (nblyr+2), intent(inout) :: & bphin , & ! Porosity of layers @@ -475,9 +475,9 @@ subroutine solve_S_dt (cflag, nblyr, nint, & ! and ocean ss real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & - ibrine_rho , & ! brine rho on interface - ibrine_sal , & ! brine sal on interface - igrid ! biology grid interface points + ibrine_rho , & ! brine rho on interface + ibrine_sal , & ! brine sal on interface + igrid ! biology grid interface points real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & iphin ! Porosity of layers on interface @@ -488,14 +488,14 @@ subroutine solve_S_dt (cflag, nblyr, nint, & real (kind=dbl_kind), dimension (2), intent(in) :: & S_bot - + ! local variables integer (kind=int_kind) :: & - k, m ! vertical biology layer index + k, m ! vertical biology layer index real (kind=dbl_kind), dimension (nblyr+1) :: & - iDin_p , & ! Diffusivity on the igrid (1/s)/bphi^3 + iDin_p , & ! Diffusivity on the igrid (1/s)/bphi^3 dSbdx , & ! gradient of brine rho on grid drho , & ! brine difference rho_a-rho_b (kg/m^3) ! Ci_s , & ! @@ -504,18 +504,18 @@ subroutine solve_S_dt (cflag, nblyr, nint, & ivel real (kind=dbl_kind), dimension (nblyr+2) :: & - Din_p , & ! Diffusivity on the igrid (1/s)/bphi^3 + Din_p , & ! Diffusivity on the igrid (1/s)/bphi^3 Sintemp , & ! initial salinity pre_sin , & ! estimate of salinity of layers pre_sinb , & ! estimate of salinity of layers - bgrid_temp , & ! biology nondimensional grid layer points - ! with boundary values + bgrid_temp , & ! biology nondimensional grid layer points + ! with boundary values Q_s, C_s , & ! Functions in continuity equation - V_s, U_s, F_s + V_s, U_s, F_s real (kind=dbl_kind) :: & dh , & ! (m) change in hbrine over dts - dbgrid , & ! ratio of grid space to spacing across boundary + dbgrid , & ! ratio of grid space to spacing across boundary ! i.e. 1/nilyr/(dbgrid(2)-dbgrid(1)) lapidus , & ! artificial viscosity: use lapidus_g for growth Ssum_old,Ssum_new, & ! depth integrated salt before and after timestep @@ -530,13 +530,13 @@ subroutine solve_S_dt (cflag, nblyr, nint, & real (kind=dbl_kind), dimension (nblyr) :: & vel , & ! advective velocity times dt (m) - lapidus_diff , & ! lapidus term and + lapidus_diff , & ! lapidus term and flux_corr , & lapA , & - lapB + lapB - logical (kind=log_kind) :: & - test_conservation ! test that salt change is balanced by fluxes + logical (kind=log_kind) :: & + test_conservation ! test that salt change is balanced by fluxes character(len=*),parameter :: subname='(solve_S_dt)' @@ -545,9 +545,9 @@ subroutine solve_S_dt (cflag, nblyr, nint, & !----------------------------------------------------------------- cflag = .false. - test_conservation = .false. - iDin_p(:) = c0 - Din_p(:) = c0 + test_conservation = .false. + iDin_p(:) = c0 + Din_p(:) = c0 lapA(:) = c1 lapB(:) = c1 lapA(nblyr) = c0 @@ -572,14 +572,14 @@ subroutine solve_S_dt (cflag, nblyr, nint, & !----------------------------------------------------------------- call calculate_drho(nblyr, igrid, bgrid,& - brine_rho, ibrine_rho, drho) + brine_rho, ibrine_rho, drho) if (icepack_warnings_aborted(subname)) return !----------------------------------------------------------------- ! Calculate bphi diffusivity on the grid points ! rhosi = 919-974 kg/m^2 set in bio_in ! rhow = 1026.0 density of sea water: uses kinematic viscosity (m^2/s) in Q18 - ! dynamic viscosity divided by density = kinematic. + ! dynamic viscosity divided by density = kinematic. !----------------------------------------------------------------- do k = 2, nblyr+1 @@ -589,8 +589,8 @@ subroutine solve_S_dt (cflag, nblyr, nint, & enddo !k !----------------------------------------------------------------- - ! Critical Ra_c value is only for the onset of convection in thinS - ! ice and not throughout, therefore I need a flag to indicate the + ! Critical Ra_c value is only for the onset of convection in thinS + ! ice and not throughout, therefore I need a flag to indicate the ! Ra_c was reached for a particular ice block. ! Using a thickness minimum (Ra_c) for simplicity. !----------------------------------------------------------------- @@ -598,8 +598,8 @@ subroutine solve_S_dt (cflag, nblyr, nint, & bgrid_temp(:) = bgrid(:) Din_p(nblyr+2) = iDin_p(nblyr+1) if (.NOT. Rayleigh .AND. hbrin < Ra_c) then - Din_p(:) = c0 - iDin_p(:) = c0 + Din_p(:) = c0 + iDin_p(:) = c0 else Rayleigh = .true. endif @@ -616,11 +616,11 @@ subroutine solve_S_dt (cflag, nblyr, nint, & !----------------------------------- ! surface boundary terms !----------------------------------- - + lapidus = lapidus_g/real(nblyr,kind=dbl_kind)**2 ivel(1) = dht/hbri_old - U_s (1) = ivel(1)/dt*dts - Ui_s(1) = U_s(1) + U_s (1) = ivel(1)/dt*dts + Ui_s(1) = U_s(1) ! Ci_s(1) = c0 F_s (1) = brine_rho(2)*brine_sal(2)/rhosi*darcy_V*dts/hbri_old/bSin(1) @@ -628,8 +628,8 @@ subroutine solve_S_dt (cflag, nblyr, nint, & ! bottom boundary terms !----------------------------------- - ivel(nblyr+1) = dhb/hbri_old - Ui_s(nblyr+1) = ivel(nblyr+1)/dt*dts + ivel(nblyr+1) = dhb/hbri_old + Ui_s(nblyr+1) = ivel(nblyr+1)/dt*dts dSbdx(nblyr) = (ibrine_sal(nblyr+1)*ibrine_rho(nblyr+1) & - ibrine_sal(nblyr)*ibrine_rho(nblyr)) & / (igrid(nblyr+1)-igrid(nblyr)) @@ -638,35 +638,35 @@ subroutine solve_S_dt (cflag, nblyr, nint, & - ibrine_sal(nblyr)*ibrine_rho(nblyr)) & / (igrid(nblyr+1)-igrid(nblyr)) F_s(nblyr+1) = darcy_V*dts/hbri_old/bphin(nblyr+1) - F_s(nblyr+2) = darcy_V*dts/hbri_old/bphin(nblyr+2) + F_s(nblyr+2) = darcy_V*dts/hbri_old/bphin(nblyr+2) vel(nblyr) =(bgrid(nblyr+1)*(dhb) -(bgrid(nblyr+1) - c1)*dht)/hbri_old - U_s(nblyr+1) = vel(nblyr)/dt*dts + U_s(nblyr+1) = vel(nblyr)/dt*dts V_s(nblyr+1) = Din_p(nblyr+1)/rhosi & * (rhosi/brine_sal(nblyr+1)/brine_rho(nblyr+1))**exp_h & - * dts*dSbdx(nblyr) + * dts*dSbdx(nblyr) dSbdx(nblyr+1) = (brine_sal(nblyr+2)*brine_rho(nblyr+2) & - brine_sal(nblyr+1)*brine_rho(nblyr+1)) & - / (bgrid(nblyr+2)-bgrid(nblyr+1)+ grid_oS/hbri_old ) + / (bgrid(nblyr+2)-bgrid(nblyr+1)+ grid_oS/hbri_old ) C_s( nblyr+2) = Dm/brine_sal(nblyr+2)/brine_rho(nblyr+2)*dts/hbri_old**2 & - * (brine_sal(nblyr+2)*brine_rho(nblyr+2) & + * (brine_sal(nblyr+2)*brine_rho(nblyr+2) & - brine_sal(nblyr+1)*brine_rho(nblyr+1)) & - / (bgrid(nblyr+2)-bgrid(nblyr+1) + grid_oS/hbri_old ) - U_s(nblyr+2) = ivel(nblyr+1)/dt*dts + / (bgrid(nblyr+2)-bgrid(nblyr+1) + grid_oS/hbri_old ) + U_s(nblyr+2) = ivel(nblyr+1)/dt*dts V_s(nblyr+2) = Din_p(nblyr+2)/rhosi & * (bphin(nblyr+1)/bSin(nblyr+2))**exp_h & * dts*dSbdx(nblyr+1) ! Ci_s(nblyr+1) = C_s(nblyr+2) -! Vi_s(nblyr+1) = V_s(nblyr+2) +! Vi_s(nblyr+1) = V_s(nblyr+2) dh = (dhb-dht)/dt*dts - do k = 2, nblyr + do k = 2, nblyr ivel(k) = (igrid(k)*dhb - (igrid(k)-c1)*dht)/hbri_old - Ui_s(k) = ivel(k)/dt*dts + Ui_s(k) = ivel(k)/dt*dts ! Vi_s(k) = iDin_p(k)/rhosi & ! *(rhosi/ibrine_rho(k)/ibrine_sal(k))**exp_h*dts & ! * (brine_sal(k+1)*brine_rho(k+1) & ! - brine_sal(k)*brine_rho(k)) & -! / (bgrid(k+1)-bgrid(k)) +! / (bgrid(k+1)-bgrid(k)) dSbdx(k-1) = (ibrine_sal(k)*ibrine_rho(k) & - ibrine_sal(k-1)*ibrine_rho(k-1))/(igrid(k)-igrid(k-1)) F_s(k) = darcy_V*dts/hbri_old/bphin(k) @@ -677,9 +677,9 @@ subroutine solve_S_dt (cflag, nblyr, nint, & ! * (brine_sal(k+1)*brine_rho(k+1) & ! - brine_sal(k)*brine_rho(k))/(bgrid(k+1)-bgrid(k)) vel(k-1) = (bgrid(k)*(dhb) - (bgrid(k) - c1)* dht)/hbri_old - U_s(k) = vel(k-1)/dt*dts + U_s(k) = vel(k-1)/dt*dts V_s(k) = Din_p(k)/rhosi & - * (rhosi/brine_sal(k)/brine_rho(k))**exp_h*dts*dSbdx(k-1) + * (rhosi/brine_sal(k)/brine_rho(k))**exp_h*dts*dSbdx(k-1) C_s(2) = c0 V_s(2) = c0 enddo !k @@ -688,14 +688,14 @@ subroutine solve_S_dt (cflag, nblyr, nint, & ! Solve !----------------------------------------------------------------- - do m = 1, nint + do m = 1, nint Sintemp(:) = bSin(:) - pre_sin(:) = bSin(:) + pre_sin(:) = bSin(:) pre_sinb(:) = bSin(:) Ssum_old = bSin(nblyr+1)*(igrid(nblyr+1)-igrid(nblyr)) - ! forward-difference + ! forward-difference do k = 2, nblyr Ssum_old = Ssum_old + bSin(k)*(igrid(k)-igrid(k-1)) @@ -703,7 +703,7 @@ subroutine solve_S_dt (cflag, nblyr, nint, & pre_sin(k) =bSin(k) + (Ui_s(k)*(bSin(k+1) - bSin(k)) + & V_s(k+1)*bSin(k+1)**3 - V_s(k)*bSin(k)**3 + & (C_s(k+1)+F_s(k+1))*bSin(k+1)-& - (C_s(k)+F_s(k))*bSin(k))/(bgrid_temp(k+1)-bgrid_temp(k)) + (C_s(k)+F_s(k))*bSin(k))/(bgrid_temp(k+1)-bgrid_temp(k)) enddo !k pre_sin(nblyr+1) = bSin(nblyr+1) + (Ui_s(nblyr+1)*(bSin(nblyr+2) - & @@ -711,15 +711,15 @@ subroutine solve_S_dt (cflag, nblyr, nint, & V_s(nblyr+1)*bSin(nblyr+1)**3+ (C_s(nblyr+2)+F_s(nblyr+2))*& bSin(nblyr+2)-(C_s(nblyr+1)+F_s(nblyr+1))*bSin(nblyr+1) )/& (bgrid_temp(nblyr+2)- bgrid_temp(nblyr+1)) - - ! backward-difference + + ! backward-difference pre_sinb(2) = p5*(bSin(2) + pre_sin(2) + (Ui_s(1)& *(pre_sin(2) -pre_sin(1)) + & V_s(2)*pre_sin(2)**3 - & V_s(1)*pre_sin(1)**3 + (C_s(2)+F_s(2))*pre_sin(2)-& (C_s(1)+F_s(1))*pre_sin(1) )/(bgrid_temp(2)-bgrid_temp(1)) ) - + do k = nblyr+1, 3, -1 !nblyr+1 pre_sinb(k) =p5*(bSin(k) + pre_sin(k) + (Ui_s(k-1)& *(pre_sin(k) - pre_sin(k-1)) + & @@ -727,12 +727,12 @@ subroutine solve_S_dt (cflag, nblyr, nint, & V_s(k-1)*pre_sin(k-1)**3 + (C_s(k)+F_s(k))*pre_sin(k)-& (C_s(k-1)+F_s(k-1))*pre_sin(k-1))/(bgrid_temp(k)-bgrid_temp(k-1)) ) - Q_s(k) = V_s(k)*pre_sin(k)**2 + U_s(k) + C_s(k) + F_s(k) + Q_s(k) = V_s(k)*pre_sin(k)**2 + U_s(k) + C_s(k) + F_s(k) enddo !k Q_s(2) = V_s(2)*pre_sin(2)**2 + U_s(2) + C_s(2) + F_s(2) Q_s(1) = V_s(1)*pre_sin(2)**2 + Ui_s(1) + C_s(1)+ F_s(1) - Q_s(nblyr+2) = V_s(nblyr+2)*pre_sin(nblyr+1)**2 + & + Q_s(nblyr+2) = V_s(nblyr+2)*pre_sin(nblyr+1)**2 + & Ui_s(nblyr+1) + C_s(nblyr+2) + F_s(nblyr+2) !----------------------------------------------------------------- @@ -749,7 +749,7 @@ subroutine solve_S_dt (cflag, nblyr, nint, & fluxb = c0 fluxm = c0 - do k = 2, nblyr+1 + do k = 2, nblyr+1 lapidus_diff(k-1) = lapidus/& ! lapidus/real(nblyr,kind=dbl_kind)**2/& (igrid(k)-igrid(k-1))* & @@ -757,12 +757,12 @@ subroutine solve_S_dt (cflag, nblyr, nint, & (bgrid_temp(k+1)-bgrid_temp(k) )**2 - & lapB(k-1)*ABS(Q_s(k)-Q_s(k-1))*(abs(pre_sinb(k))-abs(pre_sinb(k-1)))/& (bgrid_temp(k)-bgrid_temp(k-1))**2) - + bSin(k) = pre_sinb(k) + lapidus_diff(k-1) if (bSin(k) < min_salin) then flux_corr(k-1) = min_salin - bSin(k) ! flux into the ice - bSin(k) = min_salin + bSin(k) = min_salin elseif (bSin(k) > -bTin(k)/depressT) then flux_corr(k-1) = bSin(k)+bTin(k)/depressT ! flux into the ice bSin(k) = -bTin(k)/depressT @@ -770,9 +770,9 @@ subroutine solve_S_dt (cflag, nblyr, nint, & call icepack_warnings_setabort(.true.,__FILE__,__LINE__) call icepack_warnings_add(subname//' bSin(k) > max_salin') endif - + if (k == nblyr+1) bSin(nblyr+2) = S_bot(1)*bSin(nblyr+1) & - + S_bot(2)*bSin(nblyr+2) + + S_bot(2)*bSin(nblyr+2) Ssum_new = Ssum_new + bSin(k)*(igrid(k)-igrid(k-1)) fluxcorr = fluxcorr + (flux_corr(k-1) & @@ -800,19 +800,19 @@ subroutine solve_S_dt (cflag, nblyr, nint, & enddo !m - else ! add/melt ice only + else ! add/melt ice only sum_old = c0 sum_new = c0 dh_dt = hbrin-hbri_old dS_dt = c0 - if (dh_dt > c0) then + if (dh_dt > c0) then dS_dt = sss*dh_dt*salt_loss - do k = 2, nblyr+1 + do k = 2, nblyr+1 bSin(k) = max(min_salin,(bSin(k)*hbri_old + dS_dt)/hbrin) enddo !k else - do k = 2, nblyr+1 + do k = 2, nblyr+1 sum_old = sum_old + bSin(k)*hbri_old*(igrid(k)-igrid(k-1)) bSin(k) = max(min_salin,bSin(k) * (c1-abs(dh_dt)/hbri_old)) sum_new = sum_new + bSin(k)*hbrin*(igrid(k)-igrid(k-1)) @@ -822,39 +822,39 @@ subroutine solve_S_dt (cflag, nblyr, nint, & fzsaln_g = c0 endif ! (hbri_old > thinS .AND. hbrin > thinS & - ! .and. hice_old > thinS .AND. .NOT. first_ice) + ! .and. hice_old > thinS .AND. .NOT. first_ice) !----------------------------------------------------------------- ! Move this to bgc calculation if using tr_salinity - ! Calculate bphin, iphin, ikin, iDin and iDin_N + ! Calculate bphin, iphin, ikin, iDin and iDin_N !----------------------------------------------------------------- iDin(:) = c0 iphin(:) = c1 - ikin(:) = c0 + ikin(:) = c0 do k = 1, nblyr+1 if (k < nblyr+1) bphin(k+1) = min(c1,max(puny, & - bSin(k+1)*rhosi/(brine_sal(k+1)*brine_rho(k+1)))) - if (k == 1) then - bphin(k) = min(c1,max(puny, bSin(k)*rhosi/(brine_sal(k)*brine_rho(k)))) + bSin(k+1)*rhosi/(brine_sal(k+1)*brine_rho(k+1)))) + if (k == 1) then + bphin(k) = min(c1,max(puny, bSin(k)*rhosi/(brine_sal(k)*brine_rho(k)))) iphin(k) = bphin(2) elseif (k == nblyr+1) then iphin(nblyr+1) = bphin(nblyr+1) else iphin(k) = min(c1, max(c0,(bphin(k+1) - bphin(k))/(bgrid(k+1) & - bgrid(k))*(igrid(k)-bgrid(k)) + bphin(k))) - endif - ikin(k) = k_o*iphin(k)**exp_h + endif + ikin(k) = k_o*iphin(k)**exp_h enddo !k if (cflag) then - + do k = 2, nblyr+1 - iDin(k) = iphin(k)*Dm/hbri_old**2 + iDin(k) = iphin(k)*Dm/hbri_old**2 if (Rayleigh .AND. hbrin .GE. Ra_c) & iDin(k) = iDin(k) + l_sk*ikin(k)*gravit/viscos_dynamic & - * drho(k)/hbri_old**2 + * drho(k)/hbri_old**2 enddo !k else ! .not. cflag do k = 2, nblyr+1 @@ -867,7 +867,7 @@ end subroutine solve_S_dt !======================================================================= ! ! Calculate salt fluxes -! +! subroutine calc_salt_fluxes (mint, nblyr, & Ui_s,dh,dbgrid,hbri_old,Sintemp,pre_sin,& fluxb,fluxg,fluxm,V_s,& @@ -883,12 +883,12 @@ subroutine calc_salt_fluxes (mint, nblyr, & dts , & ! halodynamic timesteps (s) ! hbrin , & ! new brine height after all iterations (m) dh , & ! (m) change in hbrine over dts - dbgrid , & ! ratio of grid space to spacing across boundary + dbgrid , & ! ratio of grid space to spacing across boundary ! ie. 1/nilyr/(dbgrid(2)-dbgrid(1)) ! fluxcorr , & ! flux correction to ensure S >= min_salin hbri_old ! initial brine height (m) - real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & + real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & Ui_s ! interface function real (kind=dbl_kind), dimension (nblyr+2), intent(in) :: & @@ -899,7 +899,7 @@ subroutine calc_salt_fluxes (mint, nblyr, & V_s real (kind=dbl_kind), intent(in) :: & - Ssum_old , & ! initial integrated salt content (ppt)/h + Ssum_old , & ! initial integrated salt content (ppt)/h Ssum_new ! next integrated salt content(ppt)/h real (kind=dbl_kind), intent(inout) :: & @@ -929,7 +929,7 @@ subroutine calc_salt_fluxes (mint, nblyr, & !----------------------------------------------------------------- ! boundary fluxes (positive into the ice) !--------------------------------------------- - ! without higher order numerics corrections + ! without higher order numerics corrections ! fluxb = (Ui_s(nblyr+1) + F_s(nblyr+2))*Sintemp(nblyr+2) - (Ui_s(1) + F_s(1))*Sintemp(1) !----------------------------------------------------------------- @@ -947,11 +947,11 @@ subroutine calc_salt_fluxes (mint, nblyr, & F_s(2)*(dhtmp*Sintemp(2) & +(c1-dbgrid)*pre_sin(2))) - fluxb = fluxb_b + fluxb_t + fluxb = fluxb_b + fluxb_t !----------------------------------------------------------------- ! gravity drainage fluxes (positive into the ice) - ! without higher order numerics corrections + ! without higher order numerics corrections ! fluxg = V_s(nblyr+2)*Sintemp(nblyr+1)**3 !----------------------------------------------------------------- @@ -960,16 +960,16 @@ subroutine calc_salt_fluxes (mint, nblyr, & V_s(nblyr+1)*(pre_sin(nblyr+1)**3 - & dhtmp*(dbgrid - c1)* & Sintemp(nblyr+1)**3)) - + fluxg_t = -p5*(dbgrid*V_s(1)*pre_sin(1)**3 + & V_s(2)*(dhtmp*Sintemp(2)**3- & (dbgrid-c1)*pre_sin(2)**3)) - + fluxg = fluxg_b + fluxg_t - + !----------------------------------------------------------------- ! diffusion fluxes (positive into the ice) - ! without higher order numerics corrections + ! without higher order numerics corrections ! fluxm = C_s(nblyr+2)*Sintemp(nblyr+2) !----------------------------------------------------------------- @@ -979,20 +979,20 @@ subroutine calc_salt_fluxes (mint, nblyr, & fluxm_t = -p5 * (C_s(1) * pre_sin(1)*dbgrid & + C_s(2) * (pre_sin(2)*(c1-dbgrid) + dhtmp*Sintemp(2))) - + fluxm = fluxm_b + fluxm_t - - Ssum_corr = (-dh/hbri_old + p5*(dh/hbri_old)**2)*Ssum_old + + Ssum_corr = (-dh/hbri_old + p5*(dh/hbri_old)**2)*Ssum_old Ssum_corr_flux = dh*Ssum_old/hin_next + Ssum_corr Ssum_corr = Ssum_corr_flux - + fzsaln_g = fzsaln_g - hin_next * fluxg_b & * rhosi*p001/dts - + !approximate fluxes !fzsaln = fzsaln - hin_next * (fluxg & - ! + fluxb + fluxm + fluxcorr + Ssum_corr_flux) & - ! * rhosi*p001/dts + ! + fluxb + fluxm + fluxcorr + Ssum_corr_flux) & + ! * rhosi*p001/dts fzsaln = fzsaln + (Ssum_old*hin_old - Ssum_new*hin_next) & * rhosi*p001/dts ! positive into the ocean @@ -1000,11 +1000,11 @@ subroutine calc_salt_fluxes (mint, nblyr, & end subroutine calc_salt_fluxes !======================================================================= -! -! Test salt conservation: flux conservative form d(hSin)/dt = -dF(x,Sin)/dx -! +! +! Test salt conservation: flux conservative form d(hSin)/dt = -dF(x,Sin)/dx +! subroutine check_conserve_salt (mmax, mint, dt, & - Ssum_old, Ssum_new, Ssum_corr, & + Ssum_old, Ssum_new, Ssum_corr, & fluxcorr, fluxb, fluxg, fluxm, & hbrin, hbri_old) @@ -1014,7 +1014,7 @@ subroutine check_conserve_salt (mmax, mint, dt, & real (kind=dbl_kind), intent(in) :: & dt , & ! thermodynamic and halodynamic timesteps (s) - hbrin , & ! (m) final brine height + hbrin , & ! (m) final brine height hbri_old , & ! (m) initial brine height Ssum_old , & ! initial integrated salt content Ssum_new , & ! final integrated salt content @@ -1022,7 +1022,7 @@ subroutine check_conserve_salt (mmax, mint, dt, & Ssum_corr , & ! boundary flux correction due to numerics fluxb , & ! total boundary salt flux into the ice (+ into ice) fluxg , & ! total gravity drainage salt flux into the ice (+ into ice) - fluxm ! + fluxm ! ! local variables @@ -1034,7 +1034,7 @@ subroutine check_conserve_salt (mmax, mint, dt, & dh real (kind=dbl_kind), parameter :: & - accuracy = 1.0e-7_dbl_kind ! g/kg/m^2/s difference between boundary fluxes + accuracy = 1.0e-7_dbl_kind ! g/kg/m^2/s difference between boundary fluxes character(len=*),parameter :: subname='(check_conserve_salt)' @@ -1048,7 +1048,7 @@ subroutine check_conserve_salt (mmax, mint, dt, & order = abs(dh/min(hbri_old,hbrin)) if (abs(dsum_flux) > accuracy) then diff2 = abs(dsum_flux - flux_tot) - if (diff2 > puny .AND. diff2 > order ) then + if (diff2 > puny .AND. diff2 > order ) then call icepack_warnings_setabort(.true.,__FILE__,__LINE__) write(warnstr,*) subname, 'Poor salt conservation: check_conserve_salt' call icepack_warnings_add(warnstr) @@ -1080,12 +1080,12 @@ end subroutine check_conserve_salt ! Aggregate flux information from all ice thickness categories ! subroutine merge_zsal_fluxes(aicenS, & - zsal_totn, zsal_tot, & + zsal_totn, zsal_tot, & fzsal, fzsaln, & fzsal_g, fzsaln_g) ! single category fluxes - real (kind=dbl_kind), intent(in):: & + real (kind=dbl_kind), intent(in):: & aicenS , & ! concentration of ice fzsaln , & ! salt flux (kg/m**2/s) fzsaln_g ! gravity drainage salt flux (kg/m**2/s) @@ -1093,7 +1093,7 @@ subroutine merge_zsal_fluxes(aicenS, & real (kind=dbl_kind), intent(in):: & zsal_totn ! tot salinity in category (psu*volume*rhosi) - real (kind=dbl_kind), intent(inout):: & + real (kind=dbl_kind), intent(inout):: & zsal_tot, & ! tot salinity (psu*rhosi*total vol ice) fzsal , & ! salt flux (kg/m**2/s) fzsal_g ! gravity drainage salt flux (kg/m**2/s) @@ -1123,7 +1123,7 @@ subroutine column_sum_zsal (zsal_totn, nblyr, & integer (kind=int_kind), intent(in) :: & nblyr ! number of layers - real (kind=dbl_kind), intent(in):: & + real (kind=dbl_kind), intent(in):: & vicenS , & ! volume of ice (m) fbri ! brine height to ice thickness ratio diff --git a/configuration/scripts/icepack.batch.csh b/configuration/scripts/icepack.batch.csh index 52b280ed3..80d19f4fa 100755 --- a/configuration/scripts/icepack.batch.csh +++ b/configuration/scripts/icepack.batch.csh @@ -140,6 +140,19 @@ cat >> ${jobfile} << EOFB #SBATCH --qos=standby EOFB +else if (${ICE_MACHINE} =~ discover*) then +cat >> ${jobfile} << EOFB +#SBATCH -J ${ICE_CASENAME} +#SBATCH -t ${ICE_RUNLENGTH} +#SBATCH -A ${acct} +#SBATCH -N ${nnodes} +#SBATCH -e slurm%j.err +#SBATCH -o slurm%j.out +###SBATCH --mail-type END,FAIL +###SBATCH --mail-user=eclare@lanl.gov +#SBATCH --qos=debug +EOFB + else if (${ICE_MACHINE} =~ daley* || ${ICE_MACHINE} =~ banting* ) then cat >> ${jobfile} << EOFB #PBS -N ${ICE_CASENAME} diff --git a/configuration/scripts/machines/Macros.discover_intel b/configuration/scripts/machines/Macros.discover_intel new file mode 100644 index 000000000..60fe33bba --- /dev/null +++ b/configuration/scripts/machines/Macros.discover_intel @@ -0,0 +1,42 @@ +#============================================================================== +# Makefile macros for NASA NCCS discover, intel compiler +#============================================================================== + +CPP := fpp +CPPDEFS := -DFORTRANUNDERSCORE ${ICE_CPPDEFS} +CFLAGS := -c -O2 -fp-model precise -xHost + +FIXEDFLAGS := -132 +FREEFLAGS := -FR +FFLAGS := -fp-model precise -convert big_endian -assume byterecl -ftz -traceback -xHost +FFLAGS_NOOPT:= -O0 + +ifeq ($(ICE_BLDDEBUG), true) + FFLAGS += -O0 -g -check uninit -check bounds -check pointers -fpe0 -check noarg_temp_created +else + FFLAGS += -O2 +endif + +SCC := mpiicc +SFC := mpiifort +CC := $(SCC) +FC := $(SFC) +LD := $(FC) + +NETCDF_INCLUDES := $(shell $BASEDIR/Linux/bin/nf-config --cflags) +NETCDF_LIBS := $(shell $BASEDIR/Linux/bin/nf-config --flibs) + +INCLDIR := $(INCLDIR) +INCLDIR += $(NETCDF_INCLUDES) + +LIB_NETCDF := $(NETCDF_LIBS) +#LIB_MPI := $(IMPILIBDIR) + +SLIBS := $(LIB_NETCDF) + +ifeq ($(ICE_THREADED), true) + LDFLAGS += -qopenmp + CFLAGS += -qopenmp + FFLAGS += -qopenmp +endif + diff --git a/configuration/scripts/machines/env.discover_intel b/configuration/scripts/machines/env.discover_intel new file mode 100755 index 000000000..4f13d1a5b --- /dev/null +++ b/configuration/scripts/machines/env.discover_intel @@ -0,0 +1,54 @@ +#!/bin/csh -f + +set inp = "undefined" +if ($#argv == 1) then + set inp = $1 +endif + +if ("$inp" != "-nomodules") then + +source /usr/share/modules/init/csh + +module use -a /discover/swdev/gmao_SIteam/modulefiles-SLES12 + +module purge +module load GEOSenv +module load comp/gcc/10.1.0 +module load comp/intel/2021.3.0 +module load mpi/impi/2021.3.0 +module load python/GEOSpyD/Min4.11.0_py3.9 + +endif + +## Baselibs + +set basedir = /discover/swdev/gmao_SIteam/Baselibs/ESMA-Baselibs-6.2.13/x86_64-pc-linux-gnu/ifort_2021.3.0-intelmpi_2021.3.0 +setenv BASEDIR $basedir + +set arch = `uname -s` +if ($?LD_LIBRARY_PATH) then + echo $LD_LIBRARY_PATH | grep $BASEDIR/$arch/lib > /dev/null + if ($status) then # == 1, if not found + setenv LD_LIBRARY_PATH ${LD_LIBRARY_PATH}:$BASEDIR/$arch/lib + endif +else + setenv LD_LIBRARY_PATH $BASEDIR/$arch/lib +endif + +setenv PATH $BASEDIR/$arch/bin:$PATH + + +setenv ICE_MACHINE_MACHNAME discover +setenv ICE_MACHINE_MACHINFO "Discover" +setenv ICE_MACHINE_ENVNAME intel +setenv ICE_MACHINE_ENVINFO "ifort (IFORT) 2021.3.0 20210609" +setenv ICE_MACHINE_MAKE gmake +setenv ICE_MACHINE_WKDIR /discover/nobackup/$user/ICEPACK_RUNS +setenv ICE_MACHINE_INPUTDATA /discover/nobackup/sakella/icepack_data +setenv ICE_MACHINE_BASELINE /discover/nobackup/$user/ICEPACK_BASELINE +setenv ICE_MACHINE_SUBMIT "sbatch" +setenv ICE_MACHINE_ACCT g0613 +setenv ICE_MACHINE_QUEUE "share" +setenv ICE_MACHINE_TPNODE 36 +setenv ICE_MACHINE_BLDTHRDS 1 +setenv ICE_MACHINE_QSTAT "squeue " diff --git a/configuration/scripts/options/set_env.bgcISPOL b/configuration/scripts/options/set_env.bgcispol similarity index 100% rename from configuration/scripts/options/set_env.bgcISPOL rename to configuration/scripts/options/set_env.bgcispol diff --git a/configuration/scripts/options/set_env.bgcNICE b/configuration/scripts/options/set_env.bgcnice similarity index 100% rename from configuration/scripts/options/set_env.bgcNICE rename to configuration/scripts/options/set_env.bgcnice diff --git a/configuration/scripts/options/set_env.bgcsklNICE b/configuration/scripts/options/set_env.bgcsklnice similarity index 100% rename from configuration/scripts/options/set_env.bgcsklNICE rename to configuration/scripts/options/set_env.bgcsklnice diff --git a/configuration/scripts/options/set_env.snwITDrdg b/configuration/scripts/options/set_env.snwitdrdg similarity index 100% rename from configuration/scripts/options/set_env.snwITDrdg rename to configuration/scripts/options/set_env.snwitdrdg diff --git a/configuration/scripts/options/set_nml.bgcISPOL b/configuration/scripts/options/set_nml.bgcispol similarity index 100% rename from configuration/scripts/options/set_nml.bgcISPOL rename to configuration/scripts/options/set_nml.bgcispol diff --git a/configuration/scripts/options/set_nml.bgcNICE b/configuration/scripts/options/set_nml.bgcnice similarity index 100% rename from configuration/scripts/options/set_nml.bgcNICE rename to configuration/scripts/options/set_nml.bgcnice diff --git a/configuration/scripts/options/set_nml.bgcsklNICE b/configuration/scripts/options/set_nml.bgcsklnice similarity index 100% rename from configuration/scripts/options/set_nml.bgcsklNICE rename to configuration/scripts/options/set_nml.bgcsklnice diff --git a/configuration/scripts/options/set_nml.snwITDrdg b/configuration/scripts/options/set_nml.snwitdrdg similarity index 100% rename from configuration/scripts/options/set_nml.snwITDrdg rename to configuration/scripts/options/set_nml.snwitdrdg diff --git a/configuration/scripts/tests/base_suite.ts b/configuration/scripts/tests/base_suite.ts index a027fbc49..3b61b312d 100644 --- a/configuration/scripts/tests/base_suite.ts +++ b/configuration/scripts/tests/base_suite.ts @@ -1,9 +1,9 @@ # Test Grid PEs Sets BFB-compare smoke col 1x1 diag1,run1year smoke col 1x1 debug,run1year -smoke col 1x1 debug,bgcISPOL -smoke col 1x1 debug,bgcNICE -smoke col 1x1 debug,bgcsklNICE +smoke col 1x1 debug,bgcispol +smoke col 1x1 debug,bgcnice +smoke col 1x1 debug,bgcsklnice smoke col 1x1 debug,run1year,zsal smoke col 1x1 debug,run1year,thermo1 smoke col 1x1 debug,run1year,swredist @@ -17,13 +17,13 @@ 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,snwitdrdg smoke col 1x1 debug,run1year,calcdragio restart col 1x1 debug restart col 1x1 diag1 restart col 1x1 pondlvl restart col 1x1 pondtopo -restart col 1x1 bgcISPOL +restart col 1x1 bgcispol restart col 1x1 zsal restart col 1x1 thermo1 restart col 1x1 swccsm3 @@ -34,5 +34,5 @@ restart col 1x1 alt03 restart col 1x1 alt04 restart col 1x1 dyn restart col 1x1 fsd12 -restart col 1x1 snwITDrdg,snwgrain +restart col 1x1 snwitdrdg,snwgrain diff --git a/configuration/scripts/tests/travis_suite.ts b/configuration/scripts/tests/travis_suite.ts index 181f3166d..ac00c509c 100644 --- a/configuration/scripts/tests/travis_suite.ts +++ b/configuration/scripts/tests/travis_suite.ts @@ -1,9 +1,9 @@ # Test Grid PEs Sets BFB-compare smoke col 1x1 diag1,run1year smoke col 1x1 debug,run1year -smoke col 1x1 debug,bgcISPOL -smoke col 1x1 debug,bgcNICE -smoke col 1x1 debug,bgcsklNICE +smoke col 1x1 debug,bgcispol +smoke col 1x1 debug,bgcnice +smoke col 1x1 debug,bgcsklnice smoke col 1x1 debug,run1year,thermo1 smoke col 1x1 debug,run1year,swccsm3 smoke col 1x1 debug,run1year,alt01 @@ -13,7 +13,7 @@ restart col 1x1 debug restart col 1x1 diag1 restart col 1x1 pondlvl restart col 1x1 pondtopo -restart col 1x1 bgcISPOL +restart col 1x1 bgcispol restart col 1x1 thermo1 restart col 1x1 swccsm3 restart col 1x1 alt01 diff --git a/doc/source/icepack_index.rst b/doc/source/icepack_index.rst index 4cde0efbf..e79c52afb 100755 --- a/doc/source/icepack_index.rst +++ b/doc/source/icepack_index.rst @@ -47,6 +47,7 @@ either Celsius or Kelvin units). "apondn", "area concentration of melt ponds", "" "araftn", "area fraction of rafted ice", "" "ardgn", "fractional area of ridged ice", "" + "argcheck", "optional argument setting", "first" "aspect_rapid_mode", ":math:`\bullet` brine convection aspect ratio", "1" "astar", "e-folding scale for participation function", "0.05" "atmiter_conv", ":math:`\bullet` convergence criteria for ustar", "0.0" diff --git a/doc/source/user_guide/interfaces.include b/doc/source/user_guide/interfaces.include index b9204a9bc..c4739f32d 100644 --- a/doc/source/user_guide/interfaces.include +++ b/doc/source/user_guide/interfaces.include @@ -8,7 +8,7 @@ icepack_atm_boundary ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran - ! + ! subroutine icepack_atm_boundary(sfctype, & Tsf, potT, & @@ -97,9 +97,9 @@ icepack_init_hbrine real (kind=dbl_kind), dimension (nblyr+1), intent(out) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(out) :: & - cgrid , & ! CICE vertical coordinate + cgrid , & ! CICE vertical coordinate icgrid , & ! interface grid for CICE (shortwave variable) swgrid ! grid for ice tracers used in dEdd scheme @@ -181,7 +181,7 @@ icepack_init_fsd .. code-block:: fortran ! - ! Initialize the FSD + ! Initialize the FSD ! ! authors: Lettie Roach, NIWA/VUW @@ -405,7 +405,7 @@ icepack_aggregate aice0, & ntrcr, & trcr_depend, & - trcr_base, & + trcr_base, & n_trcr_strata, & nt_strata) @@ -472,7 +472,7 @@ icepack_ice_strength vicen, & strength) - integer (kind=int_kind), intent(in) :: & + integer (kind=int_kind), intent(in) :: & ncat ! number of thickness categories real (kind=dbl_kind), intent(in) :: & @@ -579,7 +579,7 @@ icepack_step_ridge aparticn , & ! participation function krdgn , & ! mean ridge thickness/thickness of ridging ice araftn , & ! rafting ice area - vraftn , & ! rafting ice volume + vraftn , & ! rafting ice volume aredistn , & ! redistribution function: fraction of new ridge area vredistn , & ! redistribution function: fraction of new ridge volume faero_ocn, & ! aerosol flux to ocean (kg/m^2/s) @@ -733,7 +733,7 @@ icepack_init_parameters ! subroutine to set the column package internal parameters subroutine icepack_init_parameters( & - puny_in, bignum_in, pi_in, secday_in, & + argcheck_in, puny_in, bignum_in, pi_in, secday_in, & rhos_in, rhoi_in, rhow_in, cp_air_in, emissivity_in, & cp_ice_in, cp_ocn_in, hfrazilmin_in, floediam_in, & depressT_in, dragio_in, thickness_ocn_layer1_in, iceruf_ocn_in, albocn_in, gravit_in, viscosity_dyn_in, & @@ -785,6 +785,13 @@ icepack_init_parameters snowage_tau_in, snowage_kappa_in, snowage_drdt0_in, & snw_aging_table_in) + !----------------------------------------------------------------- + ! control settings + !----------------------------------------------------------------- + + character(len=*), intent(in), optional :: & + argcheck_in ! optional argument checking + !----------------------------------------------------------------- ! parameter constants !----------------------------------------------------------------- @@ -850,7 +857,7 @@ icepack_init_parameters character (len=*), intent(in), optional :: & conduct_in, & ! 'MU71' or 'bubbly' fbot_xfer_type_in ! transfer coefficient type for ice-ocean heat flux - + logical (kind=log_kind), intent(in), optional :: & #ifdef UNDEPRECATE_0LAYER heat_capacity_in, &! if true, ice has nonzero heat capacity @@ -864,7 +871,7 @@ icepack_init_parameters real (kind=dbl_kind), intent(in), optional :: & dts_b_in, & ! zsalinity timestep ustar_min_in ! minimum friction velocity for ice-ocean heat flux - + ! mushy thermo real(kind=dbl_kind), intent(in), optional :: & a_rapid_mode_in , & ! channel radius for rapid drainage mode (m) @@ -873,7 +880,7 @@ icepack_init_parameters dSdt_slow_mode_in , & ! slow mode drainage strength (m s-1 K-1) phi_c_slow_mode_in , & ! liquid fraction porosity cutoff for slow mode phi_i_mushy_in ! liquid fraction of congelation ice - + character(len=*), intent(in), optional :: & tfrz_option_in ! form of ocean freezing temperature ! 'minus1p8' = -1.8 C @@ -891,7 +898,7 @@ icepack_init_parameters stefan_boltzmann_in, & ! W/m^2/K^4 kappav_in, & ! vis extnctn coef in ice, wvlngth<700nm (1/m) hi_ssl_in, & ! ice surface scattering layer thickness (m) - hs_ssl_in, & ! visible, direct + hs_ssl_in, & ! visible, direct awtvdr_in, & ! visible, direct ! for history and awtidr_in, & ! near IR, direct ! diagnostics awtvdf_in, & ! visible, diffuse @@ -909,7 +916,7 @@ icepack_init_parameters albsnowv_in , & ! cold snow albedo, visible albsnowi_in , & ! cold snow albedo, near IR ahmax_in ! thickness above which ice albedo is constant (m) - + ! dEdd tuning parameters, set in namelist real (kind=dbl_kind), intent(in), optional :: & R_ice_in , & ! sea ice tuning parameter; +1 > 1sig increase in albedo @@ -923,7 +930,7 @@ icepack_init_parameters logical (kind=log_kind), intent(in), optional :: & sw_redist_in ! redistribute shortwave - real (kind=dbl_kind), intent(in), optional :: & + real (kind=dbl_kind), intent(in), optional :: & sw_frac_in , & ! Fraction of internal shortwave moved to surface sw_dtemp_in ! temperature difference from melting @@ -932,26 +939,26 @@ icepack_init_parameters !----------------------------------------------------------------------- real(kind=dbl_kind), intent(in), optional :: & - Cf_in, & ! ratio of ridging work to PE change in ridging - Pstar_in, & ! constant in Hibler strength formula - Cstar_in, & ! constant in Hibler strength formula + Cf_in, & ! ratio of ridging work to PE change in ridging + Pstar_in, & ! constant in Hibler strength formula + Cstar_in, & ! constant in Hibler strength formula dragio_in, & ! ice-ocn drag coefficient thickness_ocn_layer1_in, & ! thickness of first ocean level (m) iceruf_ocn_in, & ! under-ice roughness (m) gravit_in, & ! gravitational acceleration (m/s^2) iceruf_in ! ice surface roughness (m) - integer (kind=int_kind), intent(in), optional :: & ! defined in namelist - kstrength_in , & ! 0 for simple Hibler (1979) formulation - ! 1 for Rothrock (1975) pressure formulation - krdg_partic_in, & ! 0 for Thorndike et al. (1975) formulation - ! 1 for exponential participation function - krdg_redist_in ! 0 for Hibler (1980) formulation - ! 1 for exponential redistribution function - - real (kind=dbl_kind), intent(in), optional :: & - mu_rdg_in ! gives e-folding scale of ridged ice (m^.5) - ! (krdg_redist = 1) + integer (kind=int_kind), intent(in), optional :: & ! defined in namelist + kstrength_in , & ! 0 for simple Hibler (1979) formulation + ! 1 for Rothrock (1975) pressure formulation + krdg_partic_in, & ! 0 for Thorndike et al. (1975) formulation + ! 1 for exponential participation function + krdg_redist_in ! 0 for Hibler (1980) formulation + ! 1 for exponential redistribution function + + real (kind=dbl_kind), intent(in), optional :: & + mu_rdg_in ! gives e-folding scale of ridged ice (m^.5) + ! (krdg_redist = 1) logical (kind=log_kind), intent(in), optional :: & calc_dragio_in ! if true, calculate dragio from iceruf_ocn and thickness_ocn_layer1 @@ -960,7 +967,7 @@ icepack_init_parameters ! Parameters for atmosphere !----------------------------------------------------------------------- - real (kind=dbl_kind), intent(in), optional :: & + real (kind=dbl_kind), intent(in), optional :: & cp_air_in, & ! specific heat of air (J/kg/K) cp_wv_in, & ! specific heat of water vapor (J/kg/K) zvir_in, & ! rh2o/rair - 1.0 @@ -972,15 +979,15 @@ icepack_init_parameters character (len=*), intent(in), optional :: & atmbndy_in ! atmo boundary method, 'similarity', 'constant' or 'mixed' - + logical (kind=log_kind), intent(in), optional :: & calc_strair_in, & ! if true, calculate wind stress components formdrag_in, & ! if true, calculate form drag highfreq_in ! if true, use high frequency coupling - + integer (kind=int_kind), intent(in), optional :: & natmiter_in ! number of iterations for boundary layer calculations - + ! Flux convergence tolerance real (kind=dbl_kind), intent(in), optional :: atmiter_conv_in @@ -1011,15 +1018,15 @@ icepack_init_parameters wave_spec_in ! if true, use wave forcing character (len=*), intent(in), optional :: & - wave_spec_type_in ! type of wave spectrum forcing + wave_spec_type_in ! type of wave spectrum forcing !----------------------------------------------------------------------- ! Parameters for biogeochemistry !----------------------------------------------------------------------- - character (len=*), intent(in), optional :: & - bgc_flux_type_in ! type of ocean-ice piston velocity - ! 'constant', 'Jin2006' + character (len=*), intent(in), optional :: & + bgc_flux_type_in ! type of ocean-ice piston velocity + ! 'constant', 'Jin2006' logical (kind=log_kind), intent(in), optional :: & z_tracers_in, & ! if .true., bgc or aerosol tracers are vertically resolved @@ -1028,18 +1035,18 @@ icepack_init_parameters dEdd_algae_in, & ! if .true., algal absorptionof Shortwave is computed in the modal_aero_in, & ! if .true., use modal aerosol formulation in shortwave conserv_check_in ! if .true., run conservation checks and abort if checks fail - - logical (kind=log_kind), intent(in), optional :: & + + logical (kind=log_kind), intent(in), optional :: & skl_bgc_in, & ! if true, solve skeletal biochemistry solve_zsal_in ! if true, update salinity profile from solve_S_dt - real (kind=dbl_kind), intent(in), optional :: & - grid_o_in , & ! for bottom flux + real (kind=dbl_kind), intent(in), optional :: & + grid_o_in , & ! for bottom flux l_sk_in , & ! characteristic diffusive scale (zsalinity) (m) - initbio_frac_in, & ! fraction of ocean tracer concentration used to initialize tracer - phi_snow_in ! snow porosity at the ice/snow interface + initbio_frac_in, & ! fraction of ocean tracer concentration used to initialize tracer + phi_snow_in ! snow porosity at the ice/snow interface - real (kind=dbl_kind), intent(in), optional :: & + real (kind=dbl_kind), intent(in), optional :: & grid_oS_in , & ! for bottom flux (zsalinity) l_skS_in ! 0.02 characteristic skeletal layer thickness (m) (zsalinity) real (kind=dbl_kind), intent(in), optional :: & @@ -1051,15 +1058,15 @@ icepack_init_parameters fsal_in , & ! Salinity limitation (ppt) op_dep_min_in , & ! Light attenuates for optical depths exceeding min fr_graze_s_in , & ! fraction of grazing spilled or slopped - fr_graze_e_in , & ! fraction of assimilation excreted + fr_graze_e_in , & ! fraction of assimilation excreted fr_mort2min_in , & ! fractionation of mortality to Am - fr_dFe_in , & ! fraction of remineralized nitrogen + fr_dFe_in , & ! fraction of remineralized nitrogen ! (in units of algal iron) - k_nitrif_in , & ! nitrification rate (1/day) + k_nitrif_in , & ! nitrification rate (1/day) t_iron_conv_in , & ! desorption loss pFe to dFe (day) - max_loss_in , & ! restrict uptake to % of remaining value - max_dfe_doc1_in , & ! max ratio of dFe to saccharides in the ice - ! (nM Fe/muM C) + max_loss_in , & ! restrict uptake to % of remaining value + max_dfe_doc1_in , & ! max ratio of dFe to saccharides in the ice + ! (nM Fe/muM C) fr_resp_s_in , & ! DMSPd fraction of respiration loss as DMSPd y_sk_DMS_in , & ! fraction conversion given high yield t_sk_conv_in , & ! Stefels conversion time (d) @@ -1076,18 +1083,18 @@ icepack_init_parameters real (kind=dbl_kind), intent(in), optional :: & hs0_in ! snow depth for transition to bare sea ice (m) - + ! level-ice ponds character (len=*), intent(in), optional :: & frzpnd_in ! pond refreezing parameterization - + real (kind=dbl_kind), intent(in), optional :: & - dpscale_in, & ! alter e-folding time scale for flushing + dpscale_in, & ! alter e-folding time scale for flushing rfracmin_in, & ! minimum retained fraction of meltwater rfracmax_in, & ! maximum retained fraction of meltwater pndaspect_in, & ! ratio of pond depth to pond fraction hs1_in ! tapering parameter for snow on pond ice - + ! topo ponds real (kind=dbl_kind), intent(in), optional :: & hp1_in ! critical parameter for pond ice thickness @@ -1140,7 +1147,7 @@ icepack_query_parameters ! subroutine to query the column package internal parameters subroutine icepack_query_parameters( & - puny_out, bignum_out, pi_out, rad_to_deg_out,& + argcheck_out, puny_out, bignum_out, pi_out, rad_to_deg_out,& secday_out, c0_out, c1_out, c1p5_out, c2_out, c3_out, c4_out, & c5_out, c6_out, c8_out, c10_out, c15_out, c16_out, c20_out, & c25_out, c100_out, c180_out, c1000_out, p001_out, p01_out, p1_out, & @@ -1197,6 +1204,13 @@ icepack_query_parameters snowage_tau_out, snowage_kappa_out, snowage_drdt0_out, & snw_aging_table_out) + !----------------------------------------------------------------- + ! control settings + !----------------------------------------------------------------- + + character(len=*), intent(out), optional :: & + argcheck_out ! optional argument checking + !----------------------------------------------------------------- ! parameter constants !----------------------------------------------------------------- @@ -1214,7 +1228,7 @@ icepack_query_parameters rad_to_deg_out, & ! conversion factor from radians to degrees Lfresh_out, & ! latent heat of melting of fresh ice (J/kg) cprho_out, & ! for ocean mixed layer (J kg / K m^3) - Cp_out ! proport const for PE + Cp_out ! proport const for PE !----------------------------------------------------------------- ! densities @@ -1271,7 +1285,7 @@ icepack_query_parameters character (len=*), intent(out), optional :: & conduct_out, & ! 'MU71' or 'bubbly' fbot_xfer_type_out ! transfer coefficient type for ice-ocean heat flux - + logical (kind=log_kind), intent(out), optional :: & #ifdef UNDEPRECATE_0LAYER heat_capacity_out,&! if true, ice has nonzero heat capacity @@ -1285,7 +1299,7 @@ icepack_query_parameters real (kind=dbl_kind), intent(out), optional :: & dts_b_out, & ! zsalinity timestep ustar_min_out ! minimum friction velocity for ice-ocean heat flux - + ! mushy thermo real(kind=dbl_kind), intent(out), optional :: & a_rapid_mode_out , & ! channel radius for rapid drainage mode (m) @@ -1294,7 +1308,7 @@ icepack_query_parameters dSdt_slow_mode_out , & ! slow mode drainage strength (m s-1 K-1) phi_c_slow_mode_out , & ! liquid fraction porosity cutoff for slow mode phi_i_mushy_out ! liquid fraction of congelation ice - + character(len=*), intent(out), optional :: & tfrz_option_out ! form of ocean freezing temperature ! 'minus1p8' = -1.8 C @@ -1312,7 +1326,7 @@ icepack_query_parameters stefan_boltzmann_out, & ! W/m^2/K^4 kappav_out, & ! vis extnctn coef in ice, wvlngth<700nm (1/m) hi_ssl_out, & ! ice surface scattering layer thickness (m) - hs_ssl_out, & ! visible, direct + hs_ssl_out, & ! visible, direct awtvdr_out, & ! visible, direct ! for history and awtidr_out, & ! near IR, direct ! diagnostics awtvdf_out, & ! visible, diffuse @@ -1330,13 +1344,13 @@ icepack_query_parameters albsnowv_out , & ! cold snow albedo, visible albsnowi_out , & ! cold snow albedo, near IR ahmax_out ! thickness above which ice albedo is constant (m) - + ! dEdd tuning parameters, set in namelist real (kind=dbl_kind), intent(out), optional :: & R_ice_out , & ! sea ice tuning parameter; +1 > 1sig increase in albedo R_pnd_out , & ! ponded ice tuning parameter; +1 > 1sig increase in albedo R_snw_out , & ! snow tuning parameter; +1 > ~.01 change in broadband albedo - dT_mlt_out , & ! change in temp for non-melt to melt snow grain + dT_mlt_out , & ! change in temp for non-melt to melt snow grain ! radius change (C) rsnw_mlt_out , & ! maximum melting snow grain radius (10^-6 m) kalg_out ! algae absorption coefficient for 0.5 m thick layer @@ -1344,7 +1358,7 @@ icepack_query_parameters logical (kind=log_kind), intent(out), optional :: & sw_redist_out ! redistribute shortwave - real (kind=dbl_kind), intent(out), optional :: & + real (kind=dbl_kind), intent(out), optional :: & sw_frac_out , & ! Fraction of internal shortwave moved to surface sw_dtemp_out ! temperature difference from melting @@ -1353,26 +1367,26 @@ icepack_query_parameters !----------------------------------------------------------------------- real(kind=dbl_kind), intent(out), optional :: & - Cf_out, & ! ratio of ridging work to PE change in ridging - Pstar_out, & ! constant in Hibler strength formula - Cstar_out, & ! constant in Hibler strength formula + Cf_out, & ! ratio of ridging work to PE change in ridging + Pstar_out, & ! constant in Hibler strength formula + Cstar_out, & ! constant in Hibler strength formula dragio_out, & ! ice-ocn drag coefficient thickness_ocn_layer1_out, & ! thickness of first ocean level (m) iceruf_ocn_out, & ! under-ice roughness (m) gravit_out, & ! gravitational acceleration (m/s^2) iceruf_out ! ice surface roughness (m) - integer (kind=int_kind), intent(out), optional :: & ! defined in namelist - kstrength_out , & ! 0 for simple Hibler (1979) formulation - ! 1 for Rothrock (1975) pressure formulation - krdg_partic_out, & ! 0 for Thorndike et al. (1975) formulation - ! 1 for exponential participation function - krdg_redist_out ! 0 for Hibler (1980) formulation - ! 1 for exponential redistribution function - - real (kind=dbl_kind), intent(out), optional :: & - mu_rdg_out ! gives e-folding scale of ridged ice (m^.5) - ! (krdg_redist = 1) + integer (kind=int_kind), intent(out), optional :: & ! defined in namelist + kstrength_out , & ! 0 for simple Hibler (1979) formulation + ! 1 for Rothrock (1975) pressure formulation + krdg_partic_out, & ! 0 for Thorndike et al. (1975) formulation + ! 1 for exponential participation function + krdg_redist_out ! 0 for Hibler (1980) formulation + ! 1 for exponential redistribution function + + real (kind=dbl_kind), intent(out), optional :: & + mu_rdg_out ! gives e-folding scale of ridged ice (m^.5) + ! (krdg_redist = 1) logical (kind=log_kind), intent(out), optional :: & calc_dragio_out ! if true, compute dragio from iceruf_ocn and thickness_ocn_layer1 @@ -1381,7 +1395,7 @@ icepack_query_parameters ! Parameters for atmosphere !----------------------------------------------------------------------- - real (kind=dbl_kind), intent(out), optional :: & + real (kind=dbl_kind), intent(out), optional :: & cp_air_out, & ! specific heat of air (J/kg/K) cp_wv_out, & ! specific heat of water vapor (J/kg/K) zvir_out, & ! rh2o/rair - 1.0 @@ -1393,15 +1407,15 @@ icepack_query_parameters character (len=*), intent(out), optional :: & atmbndy_out ! atmo boundary method, 'similarity', 'constant' or 'mixed' - + logical (kind=log_kind), intent(out), optional :: & calc_strair_out, & ! if true, calculate wind stress components formdrag_out, & ! if true, calculate form drag highfreq_out ! if true, use high frequency coupling - + integer (kind=int_kind), intent(out), optional :: & natmiter_out ! number of iterations for boundary layer calculations - + ! Flux convergence tolerance real (kind=dbl_kind), intent(out), optional :: atmiter_conv_out @@ -1440,7 +1454,7 @@ icepack_query_parameters character (len=*), intent(out), optional :: & bgc_flux_type_out ! type of ocean-ice piston velocity - ! 'constant', 'Jin2006' + ! 'constant', 'Jin2006' logical (kind=log_kind), intent(out), optional :: & z_tracers_out, & ! if .true., bgc or aerosol tracers are vertically resolved @@ -1449,18 +1463,18 @@ icepack_query_parameters dEdd_algae_out, & ! if .true., algal absorptionof Shortwave is computed in the modal_aero_out, & ! if .true., use modal aerosol formulation in shortwave conserv_check_out ! if .true., run conservation checks and abort if checks fail - - logical (kind=log_kind), intent(out), optional :: & + + logical (kind=log_kind), intent(out), optional :: & skl_bgc_out, & ! if true, solve skeletal biochemistry solve_zsal_out ! if true, update salinity profile from solve_S_dt - real (kind=dbl_kind), intent(out), optional :: & - grid_o_out , & ! for bottom flux + real (kind=dbl_kind), intent(out), optional :: & + grid_o_out , & ! for bottom flux l_sk_out , & ! characteristic diffusive scale (zsalinity) (m) - initbio_frac_out, & ! fraction of ocean tracer concentration used to initialize tracer - phi_snow_out ! snow porosity at the ice/snow interface + initbio_frac_out, & ! fraction of ocean tracer concentration used to initialize tracer + phi_snow_out ! snow porosity at the ice/snow interface - real (kind=dbl_kind), intent(out), optional :: & + real (kind=dbl_kind), intent(out), optional :: & grid_oS_out , & ! for bottom flux (zsalinity) l_skS_out ! 0.02 characteristic skeletal layer thickness (m) (zsalinity) real (kind=dbl_kind), intent(out), optional :: & @@ -1472,15 +1486,15 @@ icepack_query_parameters fsal_out , & ! Salinity limitation (ppt) op_dep_min_out , & ! Light attenuates for optical depths exceeding min fr_graze_s_out , & ! fraction of grazing spilled or slopped - fr_graze_e_out , & ! fraction of assimilation excreted + fr_graze_e_out , & ! fraction of assimilation excreted fr_mort2min_out , & ! fractionation of mortality to Am - fr_dFe_out , & ! fraction of remineralized nitrogen + fr_dFe_out , & ! fraction of remineralized nitrogen ! (in units of algal iron) - k_nitrif_out , & ! nitrification rate (1/day) + k_nitrif_out , & ! nitrification rate (1/day) t_iron_conv_out , & ! desorption loss pFe to dFe (day) - max_loss_out , & ! restrict uptake to % of remaining value - max_dfe_doc1_out , & ! max ratio of dFe to saccharides in the ice - ! (nM Fe/muM C) + max_loss_out , & ! restrict uptake to % of remaining value + max_dfe_doc1_out , & ! max ratio of dFe to saccharides in the ice + ! (nM Fe/muM C) fr_resp_s_out , & ! DMSPd fraction of respiration loss as DMSPd y_sk_DMS_out , & ! fraction conversion given high yield t_sk_conv_out , & ! Stefels conversion time (d) @@ -1497,18 +1511,18 @@ icepack_query_parameters real (kind=dbl_kind), intent(out), optional :: & hs0_out ! snow depth for transition to bare sea ice (m) - + ! level-ice ponds character (len=*), intent(out), optional :: & frzpnd_out ! pond refreezing parameterization - + real (kind=dbl_kind), intent(out), optional :: & - dpscale_out, & ! alter e-folding time scale for flushing + dpscale_out, & ! alter e-folding time scale for flushing rfracmin_out, & ! minimum retained fraction of meltwater rfracmax_out, & ! maximum retained fraction of meltwater pndaspect_out, & ! ratio of pond depth to pond fraction hs1_out ! tapering parameter for snow on pond ice - + ! topo ponds real (kind=dbl_kind), intent(out), optional :: & hp1_out ! critical parameter for pond ice thickness @@ -1733,26 +1747,26 @@ icepack_step_radiation yday ! day of the year 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(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (:), intent(in) :: & swgrid ! grid for ice tracers used in dEdd scheme - - real (kind=dbl_kind), dimension(:,:), intent(in) :: & + + real (kind=dbl_kind), dimension(:,:), intent(in) :: & kaer_tab, & ! aerosol mass extinction cross section (m2/kg) waer_tab, & ! aerosol single scatter albedo (fraction) gaer_tab ! aerosol asymmetry parameter (cos(theta)) - real (kind=dbl_kind), dimension(:,:), intent(in) :: & + real (kind=dbl_kind), dimension(:,:), intent(in) :: & kaer_bc_tab, & ! aerosol mass extinction cross section (m2/kg) waer_bc_tab, & ! aerosol single scatter albedo (fraction) gaer_bc_tab ! aerosol asymmetry parameter (cos(theta)) - real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & - bcenh + real (kind=dbl_kind), dimension(:,:,:), intent(in) :: & + bcenh real (kind=dbl_kind), dimension(:), intent(in) :: & aicen , & ! ice area fraction in each category @@ -1763,7 +1777,7 @@ icepack_step_radiation apndn , & ! pond area fraction hpndn , & ! pond depth (m) ipndn , & ! pond refrozen lid thickness (m) - fbri ! brine fraction + fbri ! brine fraction real(kind=dbl_kind), dimension(:,:), intent(in) :: & aeron , & ! aerosols (kg/m^3) @@ -1785,9 +1799,9 @@ icepack_step_radiation dhsn , & ! depth difference for snow on sea ice and pond ice ffracn , & ! fraction of fsurfn used to melt ipond ! albedo components for history - albicen , & ! bare ice - albsnon , & ! snow - albpndn , & ! pond + albicen , & ! bare ice + albsnon , & ! snow + albpndn , & ! pond apeffn ! effective pond area used for radiation calculation real (kind=dbl_kind), dimension(:), intent(inout), optional :: & @@ -1993,9 +2007,9 @@ icepack_step_therm2 real (kind=dbl_kind), dimension (nblyr+1), intent(in) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(in) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), dimension(:), intent(in) :: & salinz , & ! initial salinity profile @@ -2025,7 +2039,7 @@ icepack_step_therm2 real (kind=dbl_kind), dimension(:,:), intent(inout) :: & trcrn ! tracers - + logical (kind=log_kind), dimension(:), intent(inout) :: & first_ice ! true until ice forms @@ -2247,15 +2261,15 @@ icepack_step_therm1 fcondtop , fcondtopn , & fcondbot , fcondbotn , & fswsfcn , fswintn , & - fswthrun , & - fswthrun_vdr, & - fswthrun_vdf, & - fswthrun_idr, & - fswthrun_idf, & + fswthrun , & + fswthrun_vdr, & + fswthrun_vdf, & + fswthrun_idr, & + fswthrun_idf, & fswabs , & flwout , & Sswabsn , Iswabsn , & - flw , & + flw , & fsens , fsensn , & flat , flatn , & evap , & @@ -2299,7 +2313,7 @@ icepack_step_therm1 uvel , & ! x-component of velocity (m/s) vvel , & ! y-component of velocity (m/s) strax , & ! wind stress components (N/m^2) - stray , & ! + stray , & ! yday ! day of year logical (kind=log_kind), intent(in) :: & @@ -2508,17 +2522,17 @@ icepack_init_tracer_flags tr_aero_in , & ! if .true., use aerosol tracers tr_brine_in , & ! if .true., brine height differs from ice thickness tr_zaero_in , & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit_in , & ! if .true., Nitrate tracer in ice + tr_bgc_Nit_in , & ! if .true., Nitrate tracer in ice tr_bgc_N_in , & ! if .true., algal nitrogen tracers (n_algae) tr_bgc_DON_in , & ! if .true., DON pools are tracers (n_don) - tr_bgc_C_in , & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl_in , & ! if .true., algal chlorophyll tracers - tr_bgc_Am_in , & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil_in , & ! if .true., silicon as nutrient tracer - tr_bgc_DMS_in , & ! if .true., DMS as product tracer - tr_bgc_Fe_in , & ! if .true., Fe as product tracer - tr_bgc_hum_in , & ! if .true., hum as product tracer - tr_bgc_PON_in ! if .true., PON as product tracer + tr_bgc_C_in , & ! if .true., algal carbon tracers + DOC and DIC + tr_bgc_chl_in , & ! if .true., algal chlorophyll tracers + tr_bgc_Am_in , & ! if .true., ammonia/um as nutrient tracer + tr_bgc_Sil_in , & ! if .true., silicon as nutrient tracer + tr_bgc_DMS_in , & ! if .true., DMS as product tracer + tr_bgc_Fe_in , & ! if .true., Fe as product tracer + tr_bgc_hum_in , & ! if .true., hum as product tracer + tr_bgc_PON_in ! if .true., PON as product tracer @@ -2558,17 +2572,17 @@ icepack_query_tracer_flags tr_aero_out , & ! if .true., use aerosol tracers tr_brine_out , & ! if .true., brine height differs from ice thickness tr_zaero_out , & ! if .true., black carbon is tracers (n_zaero) - tr_bgc_Nit_out , & ! if .true., Nitrate tracer in ice + tr_bgc_Nit_out , & ! if .true., Nitrate tracer in ice tr_bgc_N_out , & ! if .true., algal nitrogen tracers (n_algae) tr_bgc_DON_out , & ! if .true., DON pools are tracers (n_don) - tr_bgc_C_out , & ! if .true., algal carbon tracers + DOC and DIC - tr_bgc_chl_out , & ! if .true., algal chlorophyll tracers - tr_bgc_Am_out , & ! if .true., ammonia/um as nutrient tracer - tr_bgc_Sil_out , & ! if .true., silicon as nutrient tracer - tr_bgc_DMS_out , & ! if .true., DMS as product tracer - tr_bgc_Fe_out , & ! if .true., Fe as product tracer - tr_bgc_hum_out , & ! if .true., hum as product tracer - tr_bgc_PON_out ! if .true., PON as product tracer + tr_bgc_C_out , & ! if .true., algal carbon tracers + DOC and DIC + tr_bgc_chl_out , & ! if .true., algal chlorophyll tracers + tr_bgc_Am_out , & ! if .true., ammonia/um as nutrient tracer + tr_bgc_Sil_out , & ! if .true., silicon as nutrient tracer + tr_bgc_DMS_out , & ! if .true., DMS as product tracer + tr_bgc_Fe_out , & ! if .true., Fe as product tracer + tr_bgc_hum_out , & ! if .true., hum as product tracer + tr_bgc_PON_out ! if .true., PON as product tracer @@ -2596,7 +2610,7 @@ icepack_init_tracer_indices 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_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, & @@ -2633,37 +2647,37 @@ icepack_init_tracer_indices nt_isosno_in, & ! starting index for isotopes in snow nt_isoice_in, & ! starting index for isotopes in ice nt_aero_in, & ! starting index for aerosols in ice - nt_bgc_Nit_in, & ! nutrients - nt_bgc_Am_in, & ! + nt_bgc_Nit_in, & ! nutrients + nt_bgc_Am_in, & ! nt_bgc_Sil_in, & ! nt_bgc_DMSPp_in,&! trace gases (skeletal layer) - nt_bgc_DMSPd_in,&! - nt_bgc_DMS_in, & ! - nt_bgc_hum_in, & ! - nt_bgc_PON_in, & ! zooplankton and detritus - nlt_bgc_Nit_in,& ! nutrients - nlt_bgc_Am_in, & ! + nt_bgc_DMSPd_in,&! + nt_bgc_DMS_in, & ! + nt_bgc_hum_in, & ! + nt_bgc_PON_in, & ! zooplankton and detritus + nlt_bgc_Nit_in,& ! nutrients + nlt_bgc_Am_in, & ! nlt_bgc_Sil_in,& ! nlt_bgc_DMSPp_in,&! trace gases (skeletal layer) - nlt_bgc_DMSPd_in,&! - nlt_bgc_DMS_in,& ! - nlt_bgc_hum_in,& ! - nlt_bgc_PON_in,& ! zooplankton and detritus + nlt_bgc_DMSPd_in,&! + nlt_bgc_DMS_in,& ! + nlt_bgc_hum_in,& ! + nlt_bgc_PON_in,& ! zooplankton and detritus nt_zbgc_frac_in,&! fraction of tracer in the mobile phase nt_bgc_S_in, & ! Bulk salinity in fraction ice with dynamic salinity (Bio grid)) nlt_chl_sw_in ! points to total chla in trcrn_sw integer (kind=int_kind), dimension(:), intent(in), optional :: & - bio_index_o_in, & - bio_index_in + bio_index_o_in, & + bio_index_in integer (kind=int_kind), dimension(:), intent(in), optional :: & - nt_bgc_N_in , & ! diatoms, phaeocystis, pico/small - nt_bgc_C_in , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl_in, & ! diatoms, phaeocystis, pico/small - nlt_bgc_N_in , & ! diatoms, phaeocystis, pico/small - nlt_bgc_C_in , & ! diatoms, phaeocystis, pico/small - nlt_bgc_chl_in ! diatoms, phaeocystis, pico/small + nt_bgc_N_in , & ! diatoms, phaeocystis, pico/small + nt_bgc_C_in , & ! diatoms, phaeocystis, pico/small + nt_bgc_chl_in, & ! diatoms, phaeocystis, pico/small + nlt_bgc_N_in , & ! diatoms, phaeocystis, pico/small + nlt_bgc_C_in , & ! diatoms, phaeocystis, pico/small + nlt_bgc_chl_in ! diatoms, phaeocystis, pico/small integer (kind=int_kind), dimension(:), intent(in), optional :: & nt_bgc_DOC_in, & ! dissolved organic carbon @@ -2700,7 +2714,7 @@ icepack_query_tracer_indices 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_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, & @@ -2737,37 +2751,37 @@ icepack_query_tracer_indices nt_isosno_out, & ! starting index for isotopes in snow nt_isoice_out, & ! starting index for isotopes in ice nt_aero_out, & ! starting index for aerosols in ice - nt_bgc_Nit_out, & ! nutrients - nt_bgc_Am_out, & ! + nt_bgc_Nit_out, & ! nutrients + nt_bgc_Am_out, & ! nt_bgc_Sil_out, & ! nt_bgc_DMSPp_out,&! trace gases (skeletal layer) - nt_bgc_DMSPd_out,&! - nt_bgc_DMS_out, & ! - nt_bgc_hum_out, & ! - nt_bgc_PON_out, & ! zooplankton and detritus - nlt_bgc_Nit_out,& ! nutrients - nlt_bgc_Am_out, & ! + nt_bgc_DMSPd_out,&! + nt_bgc_DMS_out, & ! + nt_bgc_hum_out, & ! + nt_bgc_PON_out, & ! zooplankton and detritus + nlt_bgc_Nit_out,& ! nutrients + nlt_bgc_Am_out, & ! nlt_bgc_Sil_out,& ! nlt_bgc_DMSPp_out,&! trace gases (skeletal layer) - nlt_bgc_DMSPd_out,&! - nlt_bgc_DMS_out,& ! - nlt_bgc_hum_out,& ! - nlt_bgc_PON_out,& ! zooplankton and detritus + nlt_bgc_DMSPd_out,&! + nlt_bgc_DMS_out,& ! + nlt_bgc_hum_out,& ! + nlt_bgc_PON_out,& ! zooplankton and detritus nt_zbgc_frac_out,&! fraction of tracer in the mobile phase nt_bgc_S_out, & ! Bulk salinity in fraction ice with dynamic salinity (Bio grid)) nlt_chl_sw_out ! points to total chla in trcrn_sw integer (kind=int_kind), dimension(:), intent(out), optional :: & - bio_index_o_out, & - bio_index_out + bio_index_o_out, & + bio_index_out integer (kind=int_kind), dimension(:), intent(out), optional :: & - nt_bgc_N_out , & ! diatoms, phaeocystis, pico/small - nt_bgc_C_out , & ! diatoms, phaeocystis, pico/small - nt_bgc_chl_out, & ! diatoms, phaeocystis, pico/small - nlt_bgc_N_out , & ! diatoms, phaeocystis, pico/small - nlt_bgc_C_out , & ! diatoms, phaeocystis, pico/small - nlt_bgc_chl_out ! diatoms, phaeocystis, pico/small + nt_bgc_N_out , & ! diatoms, phaeocystis, pico/small + nt_bgc_C_out , & ! diatoms, phaeocystis, pico/small + nt_bgc_chl_out, & ! diatoms, phaeocystis, pico/small + nlt_bgc_N_out , & ! diatoms, phaeocystis, pico/small + nlt_bgc_C_out , & ! diatoms, phaeocystis, pico/small + nlt_bgc_chl_out ! diatoms, phaeocystis, pico/small integer (kind=int_kind), dimension(:), intent(out), optional :: & nt_bgc_DOC_out, & ! dissolved organic carbon @@ -2804,7 +2818,7 @@ icepack_write_tracer_indices subroutine icepack_write_tracer_indices(iounit) - integer, intent(in), optional :: iounit + integer, intent(in), optional :: iounit @@ -2833,7 +2847,7 @@ icepack_init_tracer_sizes n_DON_in , & ! n_DIC_in , & ! n_fed_in , & ! - n_fep_in , & ! + n_fep_in , & ! n_zaero_in, & ! n_iso_in , & ! n_aero_in , & ! @@ -2883,7 +2897,7 @@ icepack_query_tracer_sizes n_DON_out , & ! n_DIC_out , & ! n_fed_out , & ! - n_fep_out , & ! + n_fep_out , & ! n_zaero_out, & ! n_iso_out , & ! n_aero_out , & ! @@ -3042,8 +3056,8 @@ icepack_step_wavefracture ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ .. code-block:: fortran - ! - ! Given fracture histogram computed from local wave spectrum, evolve + ! + ! Given fracture histogram computed from local wave spectrum, evolve ! the floe size distribution ! ! authors: 2018 Lettie Roach, NIWA/VUW @@ -3117,18 +3131,18 @@ icepack_init_bgc ntrcr_o,& ! number of tracers not including bgc ntrcr , & ! number of tracers in use nbtrcr ! number of bio tracers in use - + real (kind=dbl_kind), dimension (nblyr+1), intent(inout) :: & igrid ! biology vertical interface points - + real (kind=dbl_kind), dimension (nilyr+1), intent(inout) :: & - cgrid ! CICE vertical coordinate + cgrid ! CICE vertical coordinate real (kind=dbl_kind), dimension(nilyr, ncat), intent(in) :: & sicen ! salinity on the cice grid real (kind=dbl_kind), dimension (:,:), intent(inout) :: & - trcrn ! subset of tracer array (only bgc) + trcrn ! subset of tracer array (only bgc) real (kind=dbl_kind), intent(in) :: & sss ! sea surface salinity (ppt) @@ -3163,7 +3177,7 @@ icepack_init_zbgc real (kind=dbl_kind), optional :: R_chl2N_in(:) ! 3 algal chlorophyll to N (mg/mmol) real (kind=dbl_kind), optional :: F_abs_chl_in(:) ! to scale absorption in Dedd real (kind=dbl_kind), optional :: R_C2N_DON_in(:) ! increase compare to algal R_Fe2C - real (kind=dbl_kind), optional :: R_Si2N_in(:) ! algal Sil to N (mole/mole) + real (kind=dbl_kind), optional :: R_Si2N_in(:) ! algal Sil to N (mole/mole) real (kind=dbl_kind), optional :: R_S2N_in(:) ! algal S to N (mole/mole) real (kind=dbl_kind), optional :: R_Fe2C_in(:) ! algal Fe to carbon (umol/mmol) real (kind=dbl_kind), optional :: R_Fe2N_in(:) ! algal Fe to N (umol/mmol) @@ -3200,8 +3214,8 @@ icepack_init_zbgc real (kind=dbl_kind), optional :: mort_pre_in(:) ! mortality (1/day) real (kind=dbl_kind), optional :: mort_Tdep_in(:) ! T dependence of mortality (1/C) real (kind=dbl_kind), optional :: k_exude_in(:) ! algal carbon exudation rate (1/d) - real (kind=dbl_kind), optional :: K_Nit_in(:) ! nitrate half saturation (mmol/m^3) - real (kind=dbl_kind), optional :: K_Am_in(:) ! ammonium half saturation (mmol/m^3) + real (kind=dbl_kind), optional :: K_Nit_in(:) ! nitrate half saturation (mmol/m^3) + real (kind=dbl_kind), optional :: K_Am_in(:) ! ammonium half saturation (mmol/m^3) real (kind=dbl_kind), optional :: K_Sil_in(:) ! silicon half saturation (mmol/m^3) real (kind=dbl_kind), optional :: K_Fe_in(:) ! iron half saturation or micromol/m^3 real (kind=dbl_kind), optional :: f_don_in(:) ! fraction of spilled grazing to DON @@ -3209,7 +3223,7 @@ icepack_init_zbgc real (kind=dbl_kind), optional :: f_don_Am_in(:) ! fraction of remineralized DON to Am real (kind=dbl_kind), optional :: f_doc_in(:) ! fraction of mort_N that goes to each doc pool real (kind=dbl_kind), optional :: f_exude_in(:) ! fraction of exuded carbon to each DOC pool - real (kind=dbl_kind), optional :: k_bac_in(:) ! Bacterial degredation of DOC (1/d) + real (kind=dbl_kind), optional :: k_bac_in(:) ! Bacterial degredation of DOC (1/d) real (kind=dbl_kind), optional :: zbgc_frac_init_in(:) ! initializes mobile fraction real (kind=dbl_kind), optional :: bgc_tracer_type_in(:) ! described tracer in mobile or stationary phases @@ -3261,7 +3275,7 @@ icepack_biogeochemistry real (kind=dbl_kind), dimension (:), intent(inout) :: & bgrid , & ! biology nondimensional vertical grid points igrid , & ! biology vertical interface points - cgrid , & ! CICE vertical coordinate + cgrid , & ! CICE vertical coordinate icgrid , & ! interface grid for CICE (shortwave variable) ocean_bio , & ! contains all the ocean bgc tracer concentrations fbio_snoice , & ! fluxes from snow to ice @@ -3270,9 +3284,9 @@ icepack_biogeochemistry dhbr_bot , & ! brine bottom change darcy_V , & ! darcy velocity positive up (m/s) hin_old , & ! old ice thickness - sice_rho , & ! avg sea ice density (kg/m^3) - ice_bio_net , & ! depth integrated tracer (mmol/m^2) - snow_bio_net , & ! depth integrated snow tracer (mmol/m^2) + sice_rho , & ! avg sea ice density (kg/m^3) + ice_bio_net , & ! depth integrated tracer (mmol/m^2) + snow_bio_net , & ! depth integrated snow tracer (mmol/m^2) flux_bio ! all bio fluxes to ocean logical (kind=log_kind), dimension (:), intent(inout) :: & @@ -3284,25 +3298,25 @@ icepack_biogeochemistry real (kind=dbl_kind), dimension (:,:), intent(inout) :: & Zoo , & ! N losses accumulated in timestep (ie. zooplankton/bacteria) ! mmol/m^3 - bphi , & ! porosity of layers + bphi , & ! porosity of layers bTiz , & ! layer temperatures interpolated on bio grid (C) zfswin , & ! Shortwave flux into layers interpolated on bio grid (W/m^2) - iDi , & ! igrid Diffusivity (m^2/s) - iki , & ! Ice permeability (m^2) - trcrn ! tracers + iDi , & ! igrid Diffusivity (m^2/s) + iki , & ! Ice permeability (m^2) + trcrn ! tracers real (kind=dbl_kind), intent(inout) :: & grow_net , & ! Specific growth rate (/s) per grid cell PP_net , & ! Total production (mg C/m^2/s) per grid cell hbri , & ! brine height, area-averaged for comparison with hi (m) - zsal_tot , & ! Total ice salinity in per grid cell (g/m^2) + zsal_tot , & ! Total ice salinity in per grid cell (g/m^2) fzsal , & ! Total flux of salt to ocean at time step for conservation fzsal_g , & ! Total gravity drainage flux upNO , & ! nitrate uptake rate (mmol/m^2/d) times aice upNH ! ammonium uptake rate (mmol/m^2/d) times aice logical (kind=log_kind), intent(inout) :: & - Rayleigh_criteria ! .true. means Ra_c was reached + Rayleigh_criteria ! .true. means Ra_c was reached real (kind=dbl_kind), dimension (:,:), intent(in) :: & fswpenln ! visible SW entering ice layers (W m-2) @@ -3314,10 +3328,10 @@ icepack_biogeochemistry meltbn , & ! bottom melt in category n (m) congeln , & ! congelation ice formation in category n (m) snoicen , & ! snow-ice formation in category n (m) - flux_bio_atm, & ! all bio fluxes to ice from atmosphere + flux_bio_atm, & ! all bio fluxes to ice from atmosphere aicen_init , & ! initial ice concentration, for linear ITD vicen_init , & ! initial ice volume (m), for linear ITD - vsnon_init , & ! initial snow volume (m), for aerosol + vsnon_init , & ! initial snow volume (m), for aerosol aicen , & ! concentration of ice vicen , & ! volume per unit area of ice (m) vsnon ! volume per unit area of snow (m) @@ -3347,16 +3361,16 @@ icepack_load_ocean_bio_array doc, don, dic, fed, fep, zaeros, ocean_bio_all, hum) integer (kind=int_kind), intent(in) :: & - max_algae , & ! maximum number of algal types - max_dic , & ! maximum number of dissolved inorganic carbon types + max_algae , & ! maximum number of algal types + max_dic , & ! maximum number of dissolved inorganic carbon types max_doc , & ! maximum number of dissolved organic carbon types max_don , & ! maximum number of dissolved organic nitrogen types max_fe , & ! maximum number of iron types - max_aero , & ! maximum number of aerosols + max_aero , & ! maximum number of aerosols max_nbtrcr ! maximum number of bio tracers real (kind=dbl_kind), intent(in) :: & - nit , & ! ocean nitrate (mmol/m^3) + nit , & ! ocean nitrate (mmol/m^3) amm , & ! ammonia/um (mmol/m^3) sil , & ! silicate (mmol/m^3) dmsp , & ! dmsp (mmol/m^3) @@ -3370,16 +3384,16 @@ icepack_load_ocean_bio_array doc ! ocean doc (mmol/m^3) (proteins, EPS, lipid) real (kind=dbl_kind), dimension (max_don), intent(in) :: & - don ! ocean don (mmol/m^3) + don ! ocean don (mmol/m^3) real (kind=dbl_kind), dimension (max_dic), intent(in) :: & - dic ! ocean dic (mmol/m^3) + dic ! ocean dic (mmol/m^3) real (kind=dbl_kind), dimension (max_fe), intent(in) :: & - fed, fep ! ocean disolved and particulate fe (nM) + fed, fep ! ocean disolved and particulate fe (nM) real (kind=dbl_kind), dimension (max_aero), intent(in) :: & - zaeros ! ocean aerosols (mmol/m^3) + zaeros ! ocean aerosols (mmol/m^3) real (kind=dbl_kind), dimension (max_nbtrcr), intent(inout) :: & ocean_bio_all ! fixed order, all values even for tracers false