diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 31718ae37b..e2e966e3b4 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1834,6 +1834,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & integer :: first_direction ! An integer that indicates which direction is to be ! updated first in directionally split parts of the ! calculation. + logical :: use_KPP ! If true, diabatic is using KPP vertical mixing integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. @@ -2360,13 +2361,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_tracer(CS%tv%T, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_T, registry_diags=.true., flux_nameroot='T', & flux_units='W', flux_longname='Heat', & + net_surfflux_name='KPP_QminusSW', NLT_budget_name='KPP_NLT_temp_budget', & + net_surfflux_longname='Net temperature flux ignoring short-wave, as used by [CVMix] KPP', & flux_scale=conv2watt, convergence_units='W m-2', & - convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2) + convergence_scale=conv2watt, CMOR_tendprefix="opottemp", diag_form=2, & + Tr_out=CS%tv%tr_T) call register_tracer(CS%tv%S, CS%tracer_Reg, param_file, HI, GV, & tr_desc=vd_S, registry_diags=.true., flux_nameroot='S', & flux_units=S_flux_units, flux_longname='Salt', & + net_surfflux_name='KPP_netSalt', NLT_budget_name='KPP_NLT_saln_budget', & flux_scale=conv2salt, convergence_units='kg m-2 s-1', & - convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2) + convergence_scale=0.001*GV%H_to_kg_m2, CMOR_tendprefix="osalt", diag_form=2, & + Tr_out=CS%tv%tr_S) endif endif @@ -2840,8 +2846,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call register_surface_diags(Time, G, US, CS%sfc_IDs, CS%diag, CS%tv) call register_diags(Time, G, GV, US, CS%IDs, CS%diag) call register_transport_diags(Time, G, GV, US, CS%transport_IDs, CS%diag) + call extract_diabatic_member(CS%diabatic_CSp, use_KPP=use_KPP) call register_tracer_diagnostics(CS%tracer_Reg, CS%h, Time, diag, G, GV, US, & - CS%use_ALE_algorithm) + CS%use_ALE_algorithm, use_KPP) if (CS%use_ALE_algorithm) then call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp) endif diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index dbc45830cb..1af57549f6 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -99,20 +99,21 @@ module MOM_forcing_type ! water mass fluxes into the ocean [R Z T-1 ~> kg m-2 s-1]; these fluxes impact the ocean mass real, pointer, dimension(:,:) :: & - evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [R Z T-1 ~> kg m-2 s-1] - lprec => NULL(), & !< precipitating liquid water into the ocean [R Z T-1 ~> kg m-2 s-1] - fprec => NULL(), & !< precipitating frozen water into the ocean [R Z T-1 ~> kg m-2 s-1] - vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1] - lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1] - frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1] - seaice_melt => NULL() !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] + evap => NULL(), & !< (-1)*fresh water flux evaporated out of the ocean [R Z T-1 ~> kg m-2 s-1] + lprec => NULL(), & !< precipitating liquid water into the ocean [R Z T-1 ~> kg m-2 s-1] + fprec => NULL(), & !< precipitating frozen water into the ocean [R Z T-1 ~> kg m-2 s-1] + vprec => NULL(), & !< virtual liquid precip associated w/ SSS restoring [R Z T-1 ~> kg m-2 s-1] + lrunoff => NULL(), & !< liquid river runoff entering ocean [R Z T-1 ~> kg m-2 s-1] + frunoff => NULL(), & !< frozen river runoff (calving) entering ocean [R Z T-1 ~> kg m-2 s-1] + seaice_melt => NULL() !< snow/seaice melt (positive) or formation (negative) [R Z T-1 ~> kg m-2 s-1] ! Integrated water mass fluxes into the ocean, used for passive tracer sources [H ~> m or kg m-2] real, pointer, dimension(:,:) :: & - netMassIn => NULL(), & !< Sum of water mass fluxes into the ocean integrated over a - !! forcing timestep [H ~> m or kg m-2] - netMassOut => NULL() !< Net water mass flux out of the ocean integrated over a forcing timestep, - !! with negative values for water leaving the ocean [H ~> m or kg m-2] + netMassIn => NULL(), & !< Sum of water mass fluxes into the ocean integrated over a + !! forcing timestep [H ~> m or kg m-2] + netMassOut => NULL(), & !< Net water mass flux out of the ocean integrated over a forcing timestep, + !! with negative values for water leaving the ocean [H ~> m or kg m-2] + KPP_salt_flux => NULL() !< KPP effective salt flux [ppt m s-1] ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & @@ -191,8 +192,8 @@ module MOM_forcing_type ! CFC-related arrays needed in the MOM_CFC_cap module real, pointer, dimension(:,:) :: & - cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1] - cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU R Z T-1 kg m-3 ~> mol m-2 s-1] + cfc11_flux => NULL(), & !< flux of cfc_11 into the ocean [CU R Z T-1 ~> mol m-2 s-1] + cfc12_flux => NULL(), & !< flux of cfc_12 into the ocean [CU R Z T-1 ~> mol m-2 s-1] ice_fraction => NULL(), & !< fraction of sea ice coverage at h-cells, from 0 to 1 [nondim]. u10_sqr => NULL() !< wind magnitude at 10 m squared [L2 T-2 ~> m2 s-2] @@ -3554,8 +3555,6 @@ subroutine homogenize_forcing(fluxes, G) call homogenize_field_t(fluxes%seaice_melt, G) call homogenize_field_t(fluxes%netMassOut, G) call homogenize_field_t(fluxes%netMassIn, G) - !This was removed and I don't think replaced. Not needed? - !call homogenize_field_t(fluxes%netSalt, G) endif if (do_heat) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a9bf6c3dcf..43f4d26b5d 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -13,6 +13,7 @@ module MOM_variables use MOM_grid, only : ocean_grid_type use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type +use MOM_tracer_types, only : tracer_type implicit none ; private @@ -124,6 +125,8 @@ module MOM_variables real, pointer :: varS(:,:,:) => NULL() !< SGS variance of salinity [ppt2]. real, pointer :: covarTS(:,:,:) => NULL() !< SGS covariance of salinity and potential !! temperature [degC ppt]. + type(tracer_type), pointer :: tr_T => NULL() !< pointer to temp in tracer registry + type(tracer_type), pointer :: tr_S => NULL() !< pointer to salinty in tracer registry end type thermo_var_ptrs !> Pointers to all of the prognostic variables allocated in MOM_variables.F90 and MOM.F90. diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 4d37cc85b3..3fc0b01943 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -19,6 +19,7 @@ module MOM_CVMix_KPP use MOM_domains, only : pass_var use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_MODULE, CLOCK_ROUTINE +use MOM_tracer_types, only : tracer_type use CVMix_kpp, only : CVMix_init_kpp, CVMix_put_kpp, CVMix_get_kpp_real use CVMix_kpp, only : CVMix_coeffs_kpp @@ -39,6 +40,7 @@ module MOM_CVMix_KPP public :: KPP_end public :: KPP_NonLocalTransport_temp public :: KPP_NonLocalTransport_saln +public :: KPP_NonLocalTransport public :: KPP_get_BLD ! Enumerated constants @@ -92,7 +94,7 @@ module MOM_CVMix_KPP logical :: debug !< If True, calculate checksums and write debugging information character(len=30) :: MatchTechnique !< Method used in CVMix for setting diffusivity and NLT profile functions integer :: NLT_shape !< MOM6 over-ride of CVMix NLT shape function - logical :: applyNonLocalTrans !< If True, apply non-local transport to heat and scalars + logical :: applyNonLocalTrans !< If True, apply non-local transport to all tracers integer :: n_smooth !< Number of times smoothing operator is applied on OBLdepth. logical :: deepen_only !< If true, apply OBLdepth smoothing at a cell only if the OBLdepth gets deeper. logical :: KPPzeroDiffusivity !< If True, will set diffusivity and viscosity from KPP to zero @@ -127,7 +129,6 @@ module MOM_CVMix_KPP integer :: id_Ws = -1, id_Vt2 = -1 integer :: id_BulkUz2 = -1, id_BulkDrho = -1 integer :: id_uStar = -1, id_buoyFlux = -1 - integer :: id_QminusSW = -1, id_netS = -1 integer :: id_sigma = -1, id_Kv_KPP = -1 integer :: id_Kt_KPP = -1, id_Ks_KPP = -1 integer :: id_Tsurf = -1, id_Ssurf = -1 @@ -135,10 +136,6 @@ module MOM_CVMix_KPP integer :: id_Kd_in = -1 integer :: id_NLTt = -1 integer :: id_NLTs = -1 - integer :: id_NLT_dSdt = -1 - integer :: id_NLT_dTdt = -1 - integer :: id_NLT_temp_budget = -1 - integer :: id_NLT_saln_budget = -1 integer :: id_EnhK = -1, id_EnhVt2 = -1 integer :: id_EnhW = -1 integer :: id_La_SL = -1 @@ -227,7 +224,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) if (present(passive)) passive=CS%passiveMode ! This is passed back to the caller so ! the caller knows to not use KPP output call get_param(paramFile, mdl, 'APPLY_NONLOCAL_TRANSPORT', CS%applyNonLocalTrans, & - 'If True, applies the non-local transport to heat and scalars. '// & + 'If True, applies the non-local transport to all tracers. '// & 'If False, calculates the non-local transport and tendencies but '//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) @@ -537,10 +534,6 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) - CS%id_QminusSW = register_diag_field('ocean_model', 'KPP_QminusSW', diag%axesT1, Time, & - 'Net temperature flux ignoring short-wave, as used by [CVMix] KPP', 'K m/s', conversion=GV%H_to_m*US%s_to_T) - CS%id_netS = register_diag_field('ocean_model', 'KPP_netSalt', diag%axesT1, Time, & - 'Effective net surface salt flux, as used by [CVMix] KPP', 'ppt m/s', conversion=GV%H_to_m*US%s_to_T) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', 'm2/s') CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & @@ -553,18 +546,6 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVMix] KPP', 'nondim') CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') - CS%id_NLT_dTdt = register_diag_field('ocean_model', 'KPP_NLT_dTdt', diag%axesTL, Time, & - 'Temperature tendency due to non-local transport of heat, as calculated by [CVMix] KPP', & - 'K/s', conversion=US%s_to_T) - CS%id_NLT_dSdt = register_diag_field('ocean_model', 'KPP_NLT_dSdt', diag%axesTL, Time, & - 'Salinity tendency due to non-local transport of salt, as calculated by [CVMix] KPP', & - 'ppt/s', conversion=US%s_to_T) - CS%id_NLT_temp_budget = register_diag_field('ocean_model', 'KPP_NLT_temp_budget', diag%axesTL, Time, & - 'Heat content change due to non-local transport, as calculated by [CVMix] KPP', & - 'W/m^2', conversion=US%QRZ_T_to_W_m2) - CS%id_NLT_saln_budget = register_diag_field('ocean_model', 'KPP_NLT_saln_budget', diag%axesTL, Time, & - 'Salt content change due to non-local transport, as calculated by [CVMix] KPP', & - 'kg/(sec*m^2)', conversion=US%RZ_T_to_kg_m2s) CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', 'C') CS%id_Ssurf = register_diag_field('ocean_model', 'KPP_Ssurf', diag%axesT1, Time, & @@ -1384,10 +1365,75 @@ subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units) end subroutine KPP_get_BLD -!> Apply KPP non-local transport of surface fluxes for temperature. -subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & - dt, scalar, C_p) +!> Apply KPP non-local transport of surface fluxes for a given tracer +subroutine KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, & + dt, diag, tr_ptr, scalar, flux_scale) + type(KPP_CS), intent(in) :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of scalar + !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] + real, intent(in) :: dt !< Time-step [T ~> s] + type(diag_ctrl), target, intent(in) :: diag !< Diagnostics + type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Scalar (scalar units [conc]) + real, optional, intent(in) :: flux_scale !< Scale factor to get surfFlux + !! into proper units + + integer :: i, j, k + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dtracer ! Rate of tracer change [conc T-1 ~> conc s-1] + real, dimension(SZI_(G),SZJ_(G)) :: surfFlux_loc + + ! term used to scale + if (present(flux_scale)) then + do j = G%jsc, G%jec ; do i = G%isc, G%iec + surfFlux_loc(i,j) = surfFlux(i,j) * flux_scale + enddo ; enddo + else + surfFlux_loc(:,:) = surfFlux(:,:) + endif + + ! Post surface flux diagnostic + if (tr_ptr%id_net_surfflux > 0) call post_data(tr_ptr%id_net_surfflux, surfFlux_loc(:,:), diag) + + ! Only continue if we are applying the nonlocal tendency + ! or the nonlocal tendency diagnostic has been requested + if ((tr_ptr%id_NLT_tendency > 0) .or. (CS%applyNonLocalTrans)) then + + !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux_loc) + do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec + dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / & + ( h(i,j,k) + GV%H_subroundoff ) * surfFlux_loc(i,j) + enddo ; enddo ; enddo + + ! Update tracer due to non-local redistribution of surface flux + if (CS%applyNonLocalTrans) then + !$OMP parallel do default(none) shared(G, GV, dt, scalar, dtracer) + do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec + scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k) + enddo ; enddo ; enddo + endif + if (tr_ptr%id_NLT_tendency > 0) call post_data(tr_ptr%id_NLT_tendency, dtracer, diag) + + endif + + + if (tr_ptr%id_NLT_budget > 0) then + !$OMP parallel do default(none) shared(G, GV, dtracer, nonLocalTrans, surfFlux_loc) + do k = 1, GV%ke ; do j = G%jsc, G%jec ; do i = G%isc, G%iec + ! Here dtracer has units of [Q R Z T-1 ~> W m-2]. + dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * surfFlux_loc(i,j) + enddo ; enddo ; enddo + call post_data(tr_ptr%id_NLT_budget, dtracer(:,:,:), diag) + endif + +end subroutine KPP_NonLocalTransport + +!> Apply KPP non-local transport of surface fluxes for temperature. +subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, dt, tr_ptr, scalar, C_p) type(KPP_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid @@ -1396,116 +1442,32 @@ subroutine KPP_NonLocalTransport_temp(CS, G, GV, h, nonLocalTrans, surfFlux, & real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of temperature !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] real, intent(in) :: dt !< Time-step [T ~> s] + type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< temperature [degC] real, intent(in) :: C_p !< Seawater specific heat capacity !! [Q degC-1 ~> J kg-1 degC-1] - integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [degC T-1 ~> degC s-1] - - - dtracer(:,:,:) = 0.0 - !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / & - ( h(i,j,k) + GV%H_subroundoff ) * surfFlux(i,j) - enddo - enddo - enddo - - ! Update tracer due to non-local redistribution of surface flux - if (CS%applyNonLocalTrans) then - !$OMP parallel do default(none) shared(dt, scalar, dtracer, G, GV) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k) - enddo - enddo - enddo - endif - - ! Diagnostics - if (CS%id_QminusSW > 0) call post_data(CS%id_QminusSW, surfFlux, CS%diag) - if (CS%id_NLT_dTdt > 0) call post_data(CS%id_NLT_dTdt, dtracer, CS%diag) - if (CS%id_NLT_temp_budget > 0) then - dtracer(:,:,:) = 0.0 - !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, surfFlux, C_p, G, GV) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - ! Here dtracer has units of [Q R Z T-1 ~> W m-2]. - dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & - surfFlux(i,j) * C_p * GV%H_to_RZ - enddo - enddo - enddo - call post_data(CS%id_NLT_temp_budget, dtracer, CS%diag) - endif + call KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, dt, CS%diag, & + tr_ptr, scalar) end subroutine KPP_NonLocalTransport_temp !> Apply KPP non-local transport of surface fluxes for salinity. -!> This routine is a useful prototype for other material tracers. -subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, scalar) - - type(KPP_CS), intent(in) :: CS !< Control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] +subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, tr_ptr, scalar) + type(KPP_CS), intent(in) :: CS !< Control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: nonLocalTrans !< Non-local transport [nondim] - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: surfFlux !< Surface flux of salt !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] - real, intent(in) :: dt !< Time-step [T ~> s] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt] - - integer :: i, j, k - real, dimension( SZI_(G), SZJ_(G),SZK_(GV) ) :: dtracer ! Rate of tracer change [ppt T-1 ~> ppt s-1] - - - dtracer(:,:,:) = 0.0 - !$OMP parallel do default(none) shared(dtracer, nonLocalTrans, h, G, GV, surfFlux) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - dtracer(i,j,k) = ( nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1) ) / & - ( h(i,j,k) + GV%H_subroundoff ) * surfFlux(i,j) - enddo - enddo - enddo + real, intent(in) :: dt !< Time-step [T ~> s] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: scalar !< Salinity [ppt] + type(tracer_type), pointer, intent(in) :: tr_ptr !< tracer_type has diagnostic ids on it - ! Update tracer due to non-local redistribution of surface flux - if (CS%applyNonLocalTrans) then - !$OMP parallel do default(none) shared(G, GV, dt, scalar, dtracer) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - scalar(i,j,k) = scalar(i,j,k) + dt * dtracer(i,j,k) - enddo - enddo - enddo - endif - - ! Diagnostics - if (CS%id_netS > 0) call post_data(CS%id_netS, surfFlux, CS%diag) - if (CS%id_NLT_dSdt > 0) call post_data(CS%id_NLT_dSdt, dtracer, CS%diag) - if (CS%id_NLT_saln_budget > 0) then - dtracer(:,:,:) = 0.0 - !$OMP parallel do default(none) shared(G, GV, dtracer, nonLocalTrans, surfFlux) - do k = 1, GV%ke - do j = G%jsc, G%jec - do i = G%isc, G%iec - ! Here dtracer has units of [ppt R Z T-1 ~> ppt kg m-2 s-1] - dtracer(i,j,k) = (nonLocalTrans(i,j,k) - nonLocalTrans(i,j,k+1)) * & - surfFlux(i,j) * GV%H_to_RZ - enddo - enddo - enddo - call post_data(CS%id_NLT_saln_budget, dtracer, CS%diag) - endif + call KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, dt, CS%diag, & + tr_ptr, scalar) end subroutine KPP_NonLocalTransport_saln diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 7b180f1d65..7813800619 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -251,7 +251,7 @@ module MOM_diabatic_driver real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux !! [degC H T-1 ~> degC m s-1 or degC kg m-2 s-1] - real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux + real, pointer, dimension(:,:) :: KPP_salt_flux => NULL() !< KPP effective salt flux !! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) @@ -742,9 +742,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - dt, tv%T, tv%C_p) + dt, tv%tr_T, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - dt, tv%S) + dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -754,6 +754,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif + if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! This is the "old" method for applying differential diffusion. @@ -1061,7 +1062,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, & G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit = CS%evap_CFL_limit, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar, & + evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) call cpu_clock_end(id_clock_tracers) @@ -1318,9 +1321,9 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - dt, tv%T, tv%C_p) + dt, tv%tr_T, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - dt, tv%S) + dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -1330,6 +1333,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif + if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! Calculate vertical mixing due to convection (computed via CVMix) @@ -1568,6 +1572,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, & G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar, & evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) @@ -1921,7 +1927,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) endif - + if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! Add vertical diff./visc. due to convection (computed via CVMix) @@ -1940,9 +1946,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & - dt, tv%T, tv%C_p) + dt, tv%tr_T, tv%T, tv%C_p) call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & - dt, tv%S) + dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") if (CS%debugConservation) call MOM_state_stats('KPP_applyNonLocalTransport', u, v, h, tv%T, tv%S, G, GV, US) @@ -2335,7 +2341,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) + CS%optics, CS%tracer_flow_CSp, CS%debug, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar) elseif (CS%double_diffuse) then ! extra diffusivity for passive tracers @@ -2356,11 +2364,15 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo ; enddo ; enddo call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) + CS%optics, CS%tracer_flow_CSp, CS%debug, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar) else call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, US, tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug) + CS%optics, CS%tracer_flow_CSp, CS%debug, & + KPP_CSp=CS%KPP_CSp, & + nonLocalTrans=CS%KPP_NLTscalar) endif ! (CS%mix_boundary_tracers) @@ -2569,7 +2581,7 @@ end subroutine layered_diabatic !> Returns pointers or values of members within the diabatic_CS type. For extensibility, !! each returned argument is an optional argument subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, minimum_forcing_depth, & - KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo) + KPP_CSp, energetic_PBL_CSp, diabatic_aux_CSp, diabatic_halo, use_KPP) type(diabatic_CS), target, intent(in) :: CS !< module control structure ! All output arguments are optional type(opacity_CS), optional, pointer :: opacity_CSp !< A pointer to be set to the opacity control structure @@ -2584,6 +2596,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, !! control structure integer, optional, intent( out) :: diabatic_halo !< The halo size where the diabatic algorithms !! assume thermodynamics properties are valid. + logical, optional, intent( out) :: use_KPP !< If true, diabatic is using KPP vertical mixing ! Pointers to control structures if (present(opacity_CSp)) opacity_CSp => CS%opacity @@ -2596,6 +2609,7 @@ subroutine extract_diabatic_member(CS, opacity_CSp, optics_CSp, evap_CFL_limit, if (present(evap_CFL_limit)) evap_CFL_limit = CS%evap_CFL_limit if (present(minimum_forcing_depth)) minimum_forcing_depth = CS%minimum_forcing_depth if (present(diabatic_halo)) diabatic_halo = CS%halo_TS_diff + if (present(use_KPP)) use_KPP = CS%use_KPP end subroutine extract_diabatic_member !> Routine called for adiabatic physics diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index 7296f1d469..8089334ff1 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -10,13 +10,16 @@ module MOM_CFC_cap use MOM_forcing_type, only : forcing use MOM_hor_index, only : hor_index_type use MOM_grid, only : ocean_grid_type +use MOM_CVMix_KPP, only : KPP_NonLocalTransport, KPP_CS use MOM_io, only : file_exists, MOM_read_data, slasher use MOM_io, only : vardesc, var_desc, query_vardesc, stdout +use MOM_tracer_registry, only : tracer_type use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_time_manager, only : time_type use time_interp_external_mod, only : init_external_field, time_interp_external -use MOM_tracer_registry, only : register_tracer, tracer_registry_type +use MOM_tracer_registry, only : register_tracer +use MOM_tracer_types, only : tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_unit_scaling, only : unit_scale_type @@ -33,6 +36,17 @@ module MOM_CFC_cap integer, parameter :: NTR = 2 !< the number of tracers in this module. +!> Contains the concentration array, a pointer to Tr in Tr_reg, and some metadata for a single CFC tracer +type, private :: CFC_tracer_data + type(vardesc) :: desc !< A set of metadata for the tracer + real :: IC_val = 0.0 !< The initial value assigned to the tracer [mol kg-1]. + real :: land_val = -1.0 !< The value of the tracer used where land is masked out [mol kg-1]. + character(len=32) :: name !< Tracer variable name + integer :: id_cmor !< Diagnostic ID + real, pointer, dimension(:,:,:) :: conc !< The tracer concentration [mol kg-1]. + type(tracer_type), pointer :: tr_ptr !< pointer to tracer inside Tr_reg + end type CFC_tracer_data + !> The control structure for the CFC_cap tracer package type, public :: CFC_cap_CS ; private character(len=200) :: IC_file !< The file in which the CFC initial values can @@ -40,28 +54,13 @@ module MOM_CFC_cap logical :: Z_IC_file !< If true, the IC_file is in Z-space. The default is false. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM6 tracer registry - real, pointer, dimension(:,:,:) :: & - CFC11 => NULL(), & !< The CFC11 concentration [mol kg-1]. - CFC12 => NULL() !< The CFC12 concentration [mol kg-1]. - ! In the following variables a suffix of _11 refers to CFC11 and _12 to CFC12. - real :: CFC11_IC_val = 0.0 !< The initial value assigned to CFC11 [mol kg-1]. - real :: CFC12_IC_val = 0.0 !< The initial value assigned to CFC12 [mol kg-1]. - real :: CFC11_land_val = -1.0 !< The value of CFC11 used where land is masked out [mol kg-1]. - real :: CFC12_land_val = -1.0 !< The value of CFC12 used where land is masked out [mol kg-1]. logical :: tracers_may_reinit !< If true, tracers may be reset via the initialization code !! if they are not found in the restart files. - character(len=16) :: CFC11_name !< CFC11 variable name - character(len=16) :: CFC12_name !< CFC12 variable name type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate !! the timing of diagnostic output. type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< Model restart control structure - ! The following vardesc types contain a package of metadata about each tracer. - type(vardesc) :: CFC11_desc !< A set of metadata for the CFC11 tracer - type(vardesc) :: CFC12_desc !< A set of metadata for the CFC12 tracer - !>@{ Diagnostic IDs - integer :: id_cfc11_cmor = -1, id_cfc12_cmor = -1 - !>@} + type(CFC_tracer_data), dimension(2) :: CFC_data !< per-tracer parameters / metadata end type CFC_cap_CS contains @@ -85,6 +84,7 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) #include "version_variable.h" real, dimension(:,:,:), pointer :: tr_ptr => NULL() character(len=200) :: dummy ! Dummy variable to store params that need to be logged here. + character :: m2char logical :: register_CFC_cap integer :: isd, ied, jsd, jed, nz, m @@ -117,12 +117,12 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) "if they are not found in the restart files. Otherwise "//& "it is a fatal error if tracers are not found in the "//& "restart files of a restarted run.", default=.false.) - call get_param(param_file, mdl, "CFC11_IC_VAL", CS%CFC11_IC_val, & - "Value that CFC_11 is set to when it is not read from a file.", & - units="mol kg-1", default=0.0) - call get_param(param_file, mdl, "CFC12_IC_VAL", CS%CFC12_IC_val, & - "Value that CFC_12 is set to when it is not read from a file.", & - units="mol kg-1", default=0.0) + do m=1,2 + write(m2char, "(I1)") m + call get_param(param_file, mdl, "CFC1"//m2char//"_IC_VAL", CS%CFC_data(m)%IC_val, & + "Value that CFC_1"//m2char//" is set to when it is not read from a file.", & + units="mol kg-1", default=0.0) + enddo ! the following params are not used in this module. Instead, they are used in ! the cap but are logged here to keep all the CFC cap params together. @@ -147,25 +147,25 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) ! The following vardesc types contain a package of metadata about each tracer, ! including, the name; units; longname; and grid information. - CS%CFC11_name = "CFC_11" ; CS%CFC12_name = "CFC_12" - CS%CFC11_desc = var_desc(CS%CFC11_name,"mol kg-1","Moles Per Unit Mass of CFC-11 in sea water", caller=mdl) - CS%CFC12_desc = var_desc(CS%CFC12_name,"mol kg-1","Moles Per Unit Mass of CFC-12 in sea water", caller=mdl) - - allocate(CS%CFC11(isd:ied,jsd:jed,nz), source=0.0) - allocate(CS%CFC12(isd:ied,jsd:jed,nz), source=0.0) - - ! This pointer assignment is needed to force the compiler not to do a copy in - ! the registration calls. Curses on the designers and implementers of F90. - tr_ptr => CS%CFC11 - ! Register CFC11 for horizontal advection, diffusion, and restarts. - call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & - tr_desc=CS%CFC11_desc, registry_diags=.true., & - restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit) - ! Do the same for CFC12 - tr_ptr => CS%CFC12 - call register_tracer(tr_ptr, Tr_Reg, param_file, HI, GV, & - tr_desc=CS%CFC12_desc, registry_diags=.true., & - restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit) + do m=1,2 + write(m2char, "(I1)") m + write(CS%CFC_data(m)%name, "(2A)") "CFC_1", m2char + CS%CFC_data(m)%desc = var_desc(CS%CFC_data(m)%name, & + "mol kg-1", & + "Moles Per Unit Mass of CFC-1"//m2char//" in sea water", & + caller=mdl) + + allocate(CS%CFC_data(m)%conc(isd:ied,jsd:jed,nz), source=0.0) + + ! This pointer assignment is needed to force the compiler not to do a copy in + ! the registration calls. Curses on the designers and implementers of F90. + tr_ptr => CS%CFC_data(m)%conc + ! Register CFC tracer for horizontal advection, diffusion, and restarts. + call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, & + tr_desc=CS%CFC_data(m)%desc, registry_diags=.true., & + restart_CS=restart_CS, mandatory=.not.CS%tracers_may_reinit, & + Tr_out=CS%CFC_data(m)%tr_ptr) + enddo CS%tr_Reg => tr_Reg CS%restart_CSp => restart_CS @@ -193,30 +193,28 @@ subroutine initialize_CFC_cap(restart, day, G, GV, US, h, diag, OBC, CS) ! local variables logical :: from_file = .false. + integer :: m + character :: m2char if (.not.associated(CS)) return CS%Time => day CS%diag => diag - if (.not.restart .or. (CS%tracers_may_reinit .and. & - .not.query_initialized(CS%CFC11, CS%CFC11_name, CS%restart_CSp))) & - call init_tracer_CFC(h, CS%CFC11, CS%CFC11_name, CS%CFC11_land_val, & - CS%CFC11_IC_val, G, GV, US, CS) - - if (.not.restart .or. (CS%tracers_may_reinit .and. & - .not.query_initialized(CS%CFC12, CS%CFC12_name, CS%restart_CSp))) & - call init_tracer_CFC(h, CS%CFC12, CS%CFC12_name, CS%CFC12_land_val, & - CS%CFC12_IC_val, G, GV, US, CS) + do m=1,2 + if (.not.restart .or. (CS%tracers_may_reinit .and. & + .not.query_initialized(CS%CFC_data(m)%conc, CS%CFC_data(m)%name, CS%restart_CSp))) & + call init_tracer_CFC(h, CS%CFC_data(m)%conc, CS%CFC_data(m)%name, CS%CFC_data(m)%land_val, & + CS%CFC_data(m)%IC_val, G, GV, US, CS) + ! cmor diagnostics + ! CFC11 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/42625c97b8fe75124a345962c4430982.html + ! CFC12 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/3ab8e10027d7014f18f9391890369235.html + write(m2char, "(I1)") m + CS%CFC_data(m)%id_cmor = register_diag_field('ocean_model', 'cfc1'//m2char, diag%axesTL, day, & + 'Mole Concentration of CFC1'//m2char//' in Sea Water', 'mol m-3') + enddo - ! cmor diagnostics - ! CFC11 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/42625c97b8fe75124a345962c4430982.html - CS%id_cfc11_cmor = register_diag_field('ocean_model', 'cfc11', diag%axesTL, day, & - 'Mole Concentration of CFC11 in Sea Water', 'mol m-3') - ! CFC12 cmor conventions: http://clipc-services.ceda.ac.uk/dreq/u/3ab8e10027d7014f18f9391890369235.html - CS%id_cfc12_cmor = register_diag_field('ocean_model', 'cfc12', diag%axesTL, day, & - 'Mole Concentration of CFC12 in Sea Water', 'mol m-3') if (associated(OBC)) then ! Steal from updated DOME in the fullness of time. @@ -273,8 +271,8 @@ end subroutine init_tracer_CFC !> Applies diapycnal diffusion, souces and sinks and any other column !! tracer physics to the CFC cap tracers. CFCs are relatively simple, !! as they are passive tracers with only a surface flux as a source. -subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, & - evap_CFL_limit, minimum_forcing_depth) +subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, KPP_CSp, & + nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -295,6 +293,8 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CFC_cap_CS), pointer :: CS !< The control structure returned by a !! previous call to register_CFC_cap. + type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure + real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim] real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which @@ -305,39 +305,59 @@ subroutine CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, C ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + real :: flux_scale integer :: i, j, k, m, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke if (.not.associated(CS)) return + ! Compute KPP nonlocal term if necessary + if (present(KPP_CSp)) then + if (associated(KPP_CSp) .and. present(nonLocalTrans)) then + flux_scale = GV%Z_to_H / GV%rho0 + + call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%cfc11_flux(:,:), dt, CS%diag, & + CS%CFC_data(1)%tr_ptr, CS%CFC_data(1)%conc(:,:,:), & + flux_scale=flux_scale) + call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%cfc12_flux(:,:), dt, CS%diag, & + CS%CFC_data(2)%tr_ptr, CS%CFC_data(2)%conc(:,:,:), & + flux_scale=flux_scale) + endif + endif + ! Use a tridiagonal solver to determine the concentrations after the ! surface source is applied and diapycnal advection and diffusion occurs. if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC11, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC_data(1)%conc, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC_data(1)%conc, G, GV, sfc_flux=fluxes%cfc11_flux) do k=1,nz ;do j=js,je ; do i=is,ie h_work(i,j,k) = h_old(i,j,k) enddo ; enddo ; enddo - call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC12, dt, fluxes, h_work, & + call applyTracerBoundaryFluxesInOut(G, GV, CS%CFC_data(2)%conc, dt, fluxes, h_work, & evap_CFL_limit, minimum_forcing_depth) - call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux) + call tracer_vertdiff(h_work, ea, eb, dt, CS%CFC_data(2)%conc, G, GV, sfc_flux=fluxes%cfc12_flux) else - call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC11, G, GV, sfc_flux=fluxes%cfc11_flux) - call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC12, G, GV, sfc_flux=fluxes%cfc12_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC_data(1)%conc, G, GV, sfc_flux=fluxes%cfc11_flux) + call tracer_vertdiff(h_old, ea, eb, dt, CS%CFC_data(2)%conc, G, GV, sfc_flux=fluxes%cfc12_flux) endif ! If needed, write out any desired diagnostics from tracer sources & sinks here. - if (CS%id_cfc11_cmor > 0) call post_data(CS%id_cfc11_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC11, CS%diag) - if (CS%id_cfc12_cmor > 0) call post_data(CS%id_cfc12_cmor, (GV%Rho0*US%R_to_kg_m3)*CS%CFC12, CS%diag) + if (CS%CFC_data(1)%id_cmor > 0) call post_data(CS%CFC_data(1)%id_cmor, & + (GV%Rho0*US%R_to_kg_m3)*CS%CFC_data(1)%conc, & + CS%diag) + if (CS%CFC_data(2)%id_cmor > 0) call post_data(CS%CFC_data(2)%id_cmor, & + (GV%Rho0*US%R_to_kg_m3)*CS%CFC_data(2)%conc, & + CS%diag) end subroutine CFC_cap_column_physics + !> Calculates the mass-weighted integral of all tracer stocks, !! returning the number of stocks it has calculated. If the stock_index !! is present, only the stock corresponding to that coded index is returned. @@ -360,7 +380,7 @@ function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) ! Local variables real :: stock_scale ! The dimensional scaling factor to convert stocks to kg [kg H-1 L-2 ~> kg m-3 or 1] real :: mass ! The cell volume or mass [H L2 ~> m3 or kg] - integer :: i, j, k, is, ie, js, je, nz + integer :: i, j, k, is, ie, js, je, nz, m is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke CFC_cap_stock = 0 @@ -373,19 +393,18 @@ function CFC_cap_stock(h, stocks, G, GV, US, CS, names, units, stock_index) return endif ; endif - call query_vardesc(CS%CFC11_desc, name=names(1), units=units(1), caller="CFC_cap_stock") - call query_vardesc(CS%CFC12_desc, name=names(2), units=units(2), caller="CFC_cap_stock") - units(1) = trim(units(1))//" kg" ; units(2) = trim(units(2))//" kg" - stock_scale = US%L_to_m**2 * GV%H_to_kg_m2 - stocks(1) = 0.0 ; stocks(2) = 0.0 - do k=1,nz ; do j=js,je ; do i=is,ie - mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) - stocks(1) = stocks(1) + CS%CFC11(i,j,k) * mass - stocks(2) = stocks(2) + CS%CFC12(i,j,k) * mass - enddo ; enddo ; enddo - stocks(1) = stock_scale * stocks(1) - stocks(2) = stock_scale * stocks(2) + do m=1,2 + call query_vardesc(CS%CFC_data(m)%desc, name=names(m), units=units(m), caller="CFC_cap_stock") + units(m) = trim(units(m))//" kg" + + stocks(m) = 0.0 + do k=1,nz ; do j=js,je ; do i=is,ie + mass = G%mask2dT(i,j) * G%areaT(i,j) * h(i,j,k) + stocks(m) = stocks(m) + CS%CFC_data(m)%conc(i,j,k) * mass + enddo ; enddo ; enddo + stocks(m) = stock_scale * stocks(m) + enddo CFC_cap_stock = 2 @@ -407,8 +426,8 @@ subroutine CFC_cap_surface_state(sfc_state, G, CS) if (.not.associated(CS)) return do j=js,je ; do i=is,ie - sfc_state%sfc_cfc11(i,j) = CS%CFC11(i,j,1) - sfc_state%sfc_cfc12(i,j) = CS%CFC12(i,j,1) + sfc_state%sfc_cfc11(i,j) = CS%CFC_data(1)%conc(i,j,1) + sfc_state%sfc_cfc12(i,j) = CS%CFC_data(2)%conc(i,j,1) enddo ; enddo end subroutine CFC_cap_surface_state @@ -592,8 +611,9 @@ subroutine CFC_cap_end(CS) integer :: m if (associated(CS)) then - if (associated(CS%CFC11)) deallocate(CS%CFC11) - if (associated(CS%CFC12)) deallocate(CS%CFC12) + do m=1,2 + if (associated(CS%CFC_data(m)%conc)) deallocate(CS%CFC_data(m)%conc) + enddo deallocate(CS) endif diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 2ae72a3270..4940d8fa89 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -10,6 +10,7 @@ module MOM_tracer_flow_control use MOM_get_input, only : Get_MOM_input use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type +use MOM_CVMix_KPP, only : KPP_CS use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS use MOM_sponge, only : sponge_CS @@ -402,7 +403,7 @@ end subroutine call_tracer_set_forcing !> This subroutine calls all registered tracer column physics subroutines. subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, tv, optics, CS, & - debug, evap_CFL_limit, minimum_forcing_depth) + debug, KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Layer thickness before entrainment @@ -430,6 +431,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, !! a previous call to !! call_tracer_register. logical, intent(in) :: debug !< If true calculate checksums + type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure + real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim] real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of !! the water that can be fluxed out !! of the top layer in a timestep [nondim] @@ -489,6 +492,8 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (CS%use_CFC_cap) & call CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%CFC_cap_CSp, & + KPP_CSp=KPP_CSp, & + nonLocalTrans=nonLocalTrans, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) if (CS%use_MOM_generic_tracer) then @@ -502,7 +507,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%pseudo_salt_tracer_CSp, tv, debug, & + G, GV, US, CS%pseudo_salt_tracer_CSp, tv, & + debug, & + KPP_CSp=KPP_CSp, & + nonLocalTrans=nonLocalTrans, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) if (CS%use_boundary_impulse_tracer) & @@ -550,7 +558,9 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, G, GV, US, CS%OCMIP2_CFC_CSp) if (CS%use_CFC_cap) & call CFC_cap_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%CFC_cap_CSp) + G, GV, US, CS%CFC_cap_CSp, & + KPP_CSp=KPP_CSp, & + nonLocalTrans=nonLocalTrans) if (CS%use_MOM_generic_tracer) then if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& @@ -560,7 +570,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, endif if (CS%use_pseudo_salt_tracer) & call pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%pseudo_salt_tracer_CSp, tv, debug) + G, GV, US, CS%pseudo_salt_tracer_CSp, & + tv, debug, & + KPP_CSp=KPP_CSp, & + nonLocalTrans=nonLocalTrans) if (CS%use_boundary_impulse_tracer) & call boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%boundary_impulse_tracer_CSp, tv, debug) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 2c77df3e74..cbb73e3fd2 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -1,7 +1,7 @@ -!> This module contains the tracer_registry_type and the subroutines -!! that handle registration of tracers and related subroutines. -!! The primary subroutine, register_tracer, is called to indicate the -!! tracers advected and diffused. +!> This module contains subroutines that handle registration of tracers +!! and related subroutines. The primary subroutine, register_tracer, is +!! called to indicate the tracers advected and diffused. +!! It also makes public the types defined in MOM_tracer_types. module MOM_tracer_registry ! This file is part of MOM6. See LICENSE.md for the license. @@ -22,7 +22,7 @@ module MOM_tracer_registry use MOM_time_manager, only : time_type use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type - +use MOM_tracer_types, only : tracer_type, tracer_registry_type implicit none ; private #include @@ -34,132 +34,19 @@ module MOM_tracer_registry public tracer_registry_init, lock_tracer_registry, tracer_registry_end public tracer_name_lookup -!> The tracer type -type, public :: tracer_type - - real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [conc] -! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [conc] -! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain -! !! specified in OBCs through u-face of cell -! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain -! !! specified in OBCs through v-face of cell - - real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - - real, dimension(:,:,:), pointer :: df_x => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:,:), pointer :: lbd_dfx => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:,:), pointer :: lbd_dfy => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: lbd_dfx_2d => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: lbd_dfy_2d => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - !### These two arrays may be allocated but are never used. - real, dimension(:,:), pointer :: lbd_bulk_df_x => NULL() !< diagnostic array for x-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: lbd_bulk_df_y => NULL() !< diagnostic array for y-diffusive tracer flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux - !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] -! real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux -! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] -! real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux -! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] - - real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes - !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] -! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] -! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes -! !! expressed as a change in concentration -! !! [conc T-1 ~> conc s-1] - real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous - !! timestep used for diagnostics [conc] - real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array - !! at a previous timestep used for diagnostics - !! [conc H ~> conc m or conc kg m-2] - - character(len=32) :: name !< tracer name used for diagnostics and error messages - character(len=64) :: units !< Physical dimensions of the tracer concentration - character(len=240) :: longname !< Long name of the variable -! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer - logical :: registry_diags = .false. !< If true, use the registry to set up the - !! diagnostics associated with this tracer. - character(len=64) :: cmor_name !< CMOR name of this tracer - character(len=64) :: cmor_units !< CMOR physical dimensions of the tracer - character(len=240) :: cmor_longname !< CMOR long name of the tracer - character(len=32) :: flux_nameroot = "" !< Short tracer name snippet used construct the - !! names of flux diagnostics. - character(len=64) :: flux_longname = "" !< A word or phrase used construct the long - !! names of flux diagnostics. - real :: flux_scale = 1.0 !< A scaling factor used to convert the fluxes - !! of this tracer to its desired units, - !! including a factor compensating for H scaling. - character(len=48) :: flux_units = "" !< The units for fluxes of this variable. - character(len=48) :: conv_units = "" !< The units for the flux convergence of this tracer. - real :: conv_scale = 1.0 !< A scaling factor used to convert the flux - !! convergence of this tracer to its desired units, - !! including a factor compensating for H scaling. - character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this - !! tracer, required because CMOR does not follow any - !! discernable pattern for these names. - integer :: ind_tr_squared = -1 !< The tracer registry index for the square of this tracer - - !### THESE CAPABILITIES HAVE NOT YET BEEN IMPLEMENTED. - ! logical :: advect_tr = .true. !< If true, this tracer should be advected - ! logical :: hordiff_tr = .true. !< If true, this tracer should experience epineutral diffusion - logical :: remap_tr = .true. !< If true, this tracer should be vertically remapped - - integer :: diag_form = 1 !< An integer indicating which template is to be used to label diagnostics. - !>@{ Diagnostic IDs - integer :: id_tr = -1, id_tr_post_horzn = -1 - integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1 - integer :: id_lbd_bulk_dfx = -1, id_lbd_bulk_dfy = -1, id_lbd_dfx = -1, id_lbd_dfy = -1 - integer :: id_lbd_dfx_2d = -1 , id_lbd_dfy_2d = -1 - integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1 - integer :: id_adv_xy = -1, id_adv_xy_2d = -1 - integer :: id_dfxy_cont = -1, id_dfxy_cont_2d = -1, id_dfxy_conc = -1 - integer :: id_lbdxy_cont = -1, id_lbdxy_cont_2d = -1, id_lbdxy_conc = -1 - integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1 - integer :: id_tendency = -1, id_trxh_tendency = -1, id_trxh_tendency_2d = -1 - integer :: id_tr_vardec = -1 - !>@} -end type tracer_type - -!> Type to carry basic tracer information -type, public :: tracer_registry_type - integer :: ntr = 0 !< number of registered tracers - type(tracer_type) :: Tr(MAX_FIELDS_) !< array of registered tracers -! type(diag_ctrl), pointer :: diag !< structure to regulate timing of diagnostics - logical :: locked = .false. !< New tracers may be registered if locked=.false. - !! When locked=.true., no more tracers can be registered, - !! at which point common diagnostics can be set up - !! for the registered tracers -end type tracer_registry_type +! These types come from MOM_tracer_types +public tracer_type, tracer_registry_type contains !> This subroutine registers a tracer to be advected and laterally diffused. subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, units, & - cmor_name, cmor_units, cmor_longname, tr_desc, & - OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, df_x, df_y, & - ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, & + cmor_name, cmor_units, cmor_longname, net_surfflux_name, NLT_budget_name, & + net_surfflux_longname, tr_desc, OBC_inflow, OBC_in_u, OBC_in_v, ad_x, ad_y, & + df_x, df_y, ad_2d_x, ad_2d_y, df_2d_x, df_2d_y, advection_xy, registry_diags, & flux_nameroot, flux_longname, flux_units, flux_scale, & convergence_units, convergence_scale, cmor_tendprefix, diag_form, & - restart_CS, mandatory) + restart_CS, mandatory, Tr_out) type(hor_index_type), intent(in) :: HI !< horizontal index type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry @@ -172,6 +59,9 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit character(len=*), optional, intent(in) :: cmor_name !< CMOR name character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name + character(len=*), optional, intent(in) :: net_surfflux_name !< Name for net_surfflux diag + character(len=*), optional, intent(in) :: NLT_budget_name !< Name for NLT_budget diag + character(len=*), optional, intent(in) :: net_surfflux_longname !< Long name for net_surfflux diag type(vardesc), optional, intent(in) :: tr_desc !< A structure with metadata about the tracer real, optional, intent(in) :: OBC_inflow !< the tracer for all inflows via OBC for which OBC_in_u @@ -221,6 +111,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit type(MOM_restart_CS), optional, intent(inout) :: restart_CS !< MOM restart control struct logical, optional, intent(in) :: mandatory !< If true, this tracer must be read !! from a restart file. + type(tracer_type), optional, pointer :: Tr_out !< If present, returns pointer into registry logical :: mand type(tracer_type), pointer :: Tr=>NULL() @@ -236,6 +127,7 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit Reg%ntr = Reg%ntr + 1 Tr => Reg%Tr(Reg%ntr) + if (present(Tr_out)) Tr_out => Reg%Tr(Reg%ntr) if (present(name)) then Tr%name = name @@ -277,6 +169,22 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit if (len_trim(flux_longname) > 0) Tr%flux_longname = flux_longname endif + Tr%net_surfflux_name = "KPP_net"//trim(Tr%name) + if (present(net_surfflux_name)) then + Tr%net_surfflux_name = net_surfflux_name + endif + + Tr%NLT_budget_name = 'KPP_NLT_'//trim(Tr%flux_nameroot)//'_budget' + if (present(NLT_budget_name)) then + Tr%NLT_budget_name = NLT_budget_name + endif + + Tr%net_surfflux_longname = 'Effective net surface '//trim(lowercase(Tr%flux_longname))//& + ' flux, as used by [CVMix] KPP' + if (present(net_surfflux_longname)) then + Tr%net_surfflux_longname = net_surfflux_longname + endif + Tr%flux_units = "" if (present(flux_units)) Tr%flux_units = flux_units @@ -340,7 +248,7 @@ end subroutine lock_tracer_registry !> register_tracer_diagnostics does a set of register_diag_field calls for any previously !! registered in a tracer registry with a value of registry_diags set to .true. -subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) +subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE, use_KPP) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -351,23 +259,26 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) type(diag_ctrl), intent(in) :: diag !< structure to regulate diagnostic output logical, intent(in) :: use_ALE !< If true active diagnostics that only !! apply to ALE configurations - - character(len=24) :: name ! A variable's name in a NetCDF file. - character(len=24) :: shortnm ! A shortened version of a variable's name for - ! creating additional diagnostics. - character(len=72) :: longname ! The long name of that tracer variable. - character(len=72) :: flux_longname ! The tracer name in the long names of fluxes. - character(len=48) :: units ! The dimensions of the tracer. - character(len=48) :: flux_units ! The units for fluxes, either - ! [units] m3 s-1 or [units] kg s-1. - character(len=48) :: conv_units ! The units for flux convergences, either - ! [units] m2 s-1 or [units] kg s-1. - character(len=48) :: unit2 ! The dimensions of the tracer squared + logical, intent(in) :: use_KPP !< If true active diagnostics that only + !! apply to CVMix KPP mixings + + character(len=24) :: name ! A variable's name in a NetCDF file. + character(len=24) :: shortnm ! A shortened version of a variable's name for + ! creating additional diagnostics. + character(len=72) :: longname ! The long name of that tracer variable. + character(len=72) :: flux_longname ! The tracer name in the long names of fluxes. + character(len=48) :: units ! The dimensions of the tracer. + character(len=48) :: flux_units ! The units for fluxes, either + ! [units] m3 s-1 or [units] kg s-1. + character(len=48) :: conv_units ! The units for flux convergences, either + ! [units] m2 s-1 or [units] kg s-1. + character(len=48) :: unit2 ! The dimensions of the tracer squared character(len=72) :: cmorname ! The CMOR name of this tracer. character(len=120) :: cmor_longname ! The CMOR long name of that variable. character(len=120) :: var_lname ! A temporary longname for a diagnostic. character(len=120) :: cmor_var_lname ! The temporary CMOR long name for a diagnostic character(len=72) :: cmor_varname ! The temporary CMOR name for a diagnostic + real :: conversion ! Temporary term while we address a bug type(tracer_type), pointer :: Tr=>NULL() integer :: i, j, k, is, ie, js, je, nz, m, m2, nTr_in integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -661,6 +572,30 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE) endif endif + ! KPP nonlocal term diagnostics + if (use_KPP) then + Tr%id_net_surfflux = register_diag_field('ocean_model', Tr%net_surfflux_name, diag%axesT1, Time, & + Tr%net_surfflux_longname, trim(units)//' m s-1', conversion=GV%H_to_m*US%s_to_T) + Tr%id_NLT_tendency = register_diag_field('ocean_model', "KPP_NLT_d"//trim(shortnm)//"dt", & + diag%axesTL, Time, & + trim(longname)//' tendency due to non-local transport of '//trim(lowercase(flux_longname))//& + ', as calculated by [CVMix] KPP', trim(units)//' s-1', conversion=US%s_to_T) + if (Tr%conv_scale == 0.001*GV%H_to_kg_m2) then + conversion = GV%H_to_kg_m2 + else + conversion = Tr%conv_scale + end if + ! We actually want conversion=Tr%conv_scale for all tracers, but introducing the local variable + ! 'conversion' and setting it to GV%H_to_kg_m2 instead of 0.001*GV%H_to_kg_m2 for salt tracers + ! keeps changes introduced by this refactoring limited to round-off level; as it turns out, + ! there is a bug in the code and the NLT budget term for salinity is off by a factor of 10^3 + ! so introducing the 0.001 here will fix that bug. + Tr%id_NLT_budget = register_diag_field('ocean_model', Tr%NLT_budget_name, & + diag%axesTL, Time, & + trim(flux_longname)//' content change due to non-local transport, as calculated by [CVMix] KPP', & + conv_units, conversion=conversion*US%s_to_T, v_extensive=.true.) + endif + endif ; enddo end subroutine register_tracer_diagnostics diff --git a/src/tracer/MOM_tracer_types.F90 b/src/tracer/MOM_tracer_types.F90 new file mode 100644 index 0000000000..4a474e9301 --- /dev/null +++ b/src/tracer/MOM_tracer_types.F90 @@ -0,0 +1,130 @@ +!> This module contains the tracer_type and tracer_registry_type +module MOM_tracer_types + +implicit none ; private + +#include + +!> The tracer type +type, public :: tracer_type + + real, dimension(:,:,:), pointer :: t => NULL() !< tracer concentration array [conc] +! real :: OBC_inflow_conc= 0.0 !< tracer concentration for generic inflows [conc] +! real, dimension(:,:,:), pointer :: OBC_in_u => NULL() !< structured values for flow into the domain +! !! specified in OBCs through u-face of cell +! real, dimension(:,:,:), pointer :: OBC_in_v => NULL() !< structured values for flow into the domain +! !! specified in OBCs through v-face of cell + + real, dimension(:,:,:), pointer :: ad_x => NULL() !< diagnostic array for x-advective tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + + real, dimension(:,:,:), pointer :: df_x => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: df_y => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: lbd_dfx => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: lbd_dfy => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: lbd_dfx_2d => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: lbd_dfy_2d => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + !### These two arrays may be allocated but are never used. + real, dimension(:,:), pointer :: lbd_bulk_df_x => NULL() !< diagnostic array for x-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: lbd_bulk_df_y => NULL() !< diagnostic array for y-diffusive tracer flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: df2d_x => NULL() !< diagnostic vertical sum x-diffusive flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:), pointer :: df2d_y => NULL() !< diagnostic vertical sum y-diffusive flux + !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] +! real, dimension(:,:), pointer :: df2d_conc_x => NULL() !< diagnostic vertical sum x-diffusive content flux +! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] +! real, dimension(:,:), pointer :: df2d_conc_y => NULL() !< diagnostic vertical sum y-diffusive content flux +! !! [conc H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + + real, dimension(:,:,:), pointer :: advection_xy => NULL() !< convergence of lateral advective tracer fluxes + !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] +! real, dimension(:,:,:), pointer :: diff_cont_xy => NULL() !< convergence of lateral diffusive tracer fluxes +! !! [conc H T-1 ~> conc m s-1 or conc kg m-2 s-1] +! real, dimension(:,:,:), pointer :: diff_conc_xy => NULL() !< convergence of lateral diffusive tracer fluxes +! !! expressed as a change in concentration + !! [conc T-1 ~> conc s-1] + real, dimension(:,:,:), pointer :: t_prev => NULL() !< tracer concentration array at a previous + !! timestep used for diagnostics [conc] + real, dimension(:,:,:), pointer :: Trxh_prev => NULL() !< layer integrated tracer concentration array + !! at a previous timestep used for diagnostics + !! [conc H ~> conc m or conc kg m-2] + + character(len=32) :: name !< tracer name used for diagnostics and error messages + character(len=64) :: units !< Physical dimensions of the tracer concentration + character(len=240) :: longname !< Long name of the variable +! type(vardesc), pointer :: vd => NULL() !< metadata describing the tracer + logical :: registry_diags = .false. !< If true, use the registry to set up the + !! diagnostics associated with this tracer. + character(len=64) :: cmor_name !< CMOR name of this tracer + character(len=64) :: cmor_units !< CMOR physical dimensions of the tracer + character(len=240) :: cmor_longname !< CMOR long name of the tracer + character(len=32) :: flux_nameroot = "" !< Short tracer name snippet used construct the + !! names of flux diagnostics. + character(len=64) :: flux_longname = "" !< A word or phrase used construct the long + !! names of flux diagnostics. + real :: flux_scale = 1.0 !< A scaling factor used to convert the fluxes + !! of this tracer to its desired units, + !! including a factor compensating for H scaling. + character(len=48) :: flux_units = "" !< The units for fluxes of this variable. + character(len=48) :: conv_units = "" !< The units for the flux convergence of this tracer. + real :: conv_scale = 1.0 !< A scaling factor used to convert the flux + !! convergence of this tracer to its desired units, + !! including a factor compensating for H scaling. + character(len=48) :: cmor_tendprefix = "" !< The CMOR variable prefix for tendencies of this + !! tracer, required because CMOR does not follow any + !! discernable pattern for these names. + character(len=48) :: net_surfflux_name = "" !< Name to use for net_surfflux KPP diagnostic + character(len=48) :: NLT_budget_name = "" !< Name to use for NLT_budget KPP diagnostic + character(len=128) :: net_surfflux_longname = "" !< Long name to use for net_surfflux KPP diagnostic + integer :: ind_tr_squared = -1 !< The tracer registry index for the square of this tracer + + !### THESE CAPABILITIES HAVE NOT YET BEEN IMPLEMENTED. + ! logical :: advect_tr = .true. !< If true, this tracer should be advected + ! logical :: hordiff_tr = .true. !< If true, this tracer should experience epineutral diffusion + ! logical :: kpp_nonlocal_tr = .true. !< if true, apply KPP nonlocal transport to this tracer before diffusion + logical :: remap_tr = .true. !< If true, this tracer should be vertically remapped + + integer :: diag_form = 1 !< An integer indicating which template is to be used to label diagnostics. + !>@{ Diagnostic IDs + integer :: id_tr = -1, id_tr_post_horzn = -1 + integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1 + integer :: id_lbd_bulk_dfx = -1, id_lbd_bulk_dfy = -1, id_lbd_dfx = -1, id_lbd_dfy = -1 + integer :: id_lbd_dfx_2d = -1 , id_lbd_dfy_2d = -1 + integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1 + integer :: id_adv_xy = -1, id_adv_xy_2d = -1 + integer :: id_dfxy_cont = -1, id_dfxy_cont_2d = -1, id_dfxy_conc = -1 + integer :: id_lbdxy_cont = -1, id_lbdxy_cont_2d = -1, id_lbdxy_conc = -1 + integer :: id_remap_conc = -1, id_remap_cont = -1, id_remap_cont_2d = -1 + integer :: id_tendency = -1, id_trxh_tendency = -1, id_trxh_tendency_2d = -1 + integer :: id_tr_vardec = -1 + integer :: id_net_surfflux = -1, id_NLT_tendency = -1, id_NLT_budget = -1 + !>@} +end type tracer_type + +!> Type to carry basic tracer information +type, public :: tracer_registry_type + integer :: ntr = 0 !< number of registered tracers + type(tracer_type) :: Tr(MAX_FIELDS_) !< array of registered tracers +! type(diag_ctrl), pointer :: diag !< structure to regulate timing of diagnostics + logical :: locked = .false. !< New tracers may be registered if locked=.false. + !! When locked=.true., no more tracers can be registered, + !! at which point common diagnostics can be set up + !! for the registered tracers +end type tracer_registry_type + + +end module MOM_tracer_types diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index c441e519be..579751952c 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -10,13 +10,14 @@ module pseudo_salt_tracer use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type +use MOM_CVMix_KPP, only : KPP_NonLocalTransport, KPP_CS use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type -use MOM_tracer_registry, only : register_tracer, tracer_registry_type +use MOM_tracer_registry, only : register_tracer, tracer_registry_type, tracer_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_unit_scaling, only : unit_scale_type @@ -33,6 +34,7 @@ module pseudo_salt_tracer !> The control structure for the pseudo-salt tracer type, public :: pseudo_salt_tracer_CS ; private + type(tracer_type), pointer :: tr_ptr !< pointer to tracer inside Tr_reg type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(tracer_registry_type), pointer :: tr_Reg => NULL() !< A pointer to the MOM tracer registry real, pointer :: ps(:,:,:) => NULL() !< The array of pseudo-salt tracer used in this @@ -96,7 +98,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) call register_tracer(tr_ptr, tr_Reg, param_file, HI, GV, name="pseudo_salt", & longname="Pseudo salt passive tracer", units="psu", & registry_diags=.true., restart_CS=restart_CS, & - mandatory=.not.CS%pseudo_salt_may_reinit) + mandatory=.not.CS%pseudo_salt_may_reinit, Tr_out=CS%tr_ptr) CS%tr_Reg => tr_Reg CS%restart_CSp => restart_CS @@ -157,7 +159,7 @@ end subroutine initialize_pseudo_salt_tracer !> Apply sources, sinks and diapycnal diffusion to the tracers in this package. subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, debug, & - evap_CFL_limit, minimum_forcing_depth) + KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -178,6 +180,8 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G !! call to register_pseudo_salt_tracer type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables logical, intent(in) :: debug !< If true calculate checksums + type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure + real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [nondim] real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which @@ -210,6 +214,14 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G call hchksum(CS%ps,"pseudo_salt pre pseudo-salt vertdiff", G%HI) endif + ! Compute KPP nonlocal term if necessary + if (present(KPP_CSp)) then + if (associated(KPP_CSp) .and. present(nonLocalTrans)) & + call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%KPP_salt_flux(:,:), & + dt, CS%diag, CS%tr_ptr, CS%ps(:,:,:)) + endif + + ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then ! This option uses applyTracerBoundaryFluxesInOut, usually in ALE mode