diff --git a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 index 251f37290d..a8398c3cc8 100644 --- a/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 +++ b/config_src/drivers/FMS_cap/MOM_surface_forcing_gfdl.F90 @@ -62,7 +62,7 @@ module MOM_surface_forcing_gfdl !! from MOM_domains) to indicate the staggering of !! the winds that are being provided in calls to !! update_ocean_model. - logical :: use_temperature !< If true, temp and saln used as state variables + logical :: use_temperature !< If true, temp and saln used as state variables. real :: wind_stress_multiplier !< A multiplier applied to incoming wind stress [nondim]. real :: Rho0 !< Boussinesq reference density [R ~> kg m-3] @@ -175,6 +175,7 @@ module MOM_surface_forcing_gfdl real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux [W m-2] real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg m-2 s-1] real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg m-2 s-1] + real, pointer, dimension(:,:) :: excess_salt =>NULL() !< salt left behind by brine rejection [kg m-2 s-1] real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W m-2] real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W m-2] real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W m-2] @@ -304,6 +305,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_added,isd,ied,jsd,jed) + if (associated(IOB%excess_salt)) call safe_alloc_ptr(fluxes%salt_left_behind,isd,ied,jsd,jed) + do j=js-2,je+2 ; do i=is-2,ie+2 fluxes%TKE_tidal(i,j) = CS%TKE_tidal(i,j) fluxes%ustar_tidal(i,j) = CS%ustar_tidal(i,j) @@ -576,6 +579,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, call check_mask_val_consistency(IOB%salt_flux(i-i0,j-j0), G%mask2dT(i,j), i, j, 'salt_flux', G) enddo ; enddo endif + if (associated(IOB%excess_salt)) then + do j=js,je ; do i=is,ie + fluxes%salt_left_behind(i,j) = G%mask2dT(i,j)*(kg_m2_s_conversion*IOB%excess_salt(i-i0,j-j0)) + enddo ; enddo + endif !#CTRL# if (associated(CS%ctrl_forcing_CSp)) then !#CTRL# do j=js,je ; do i=is,ie @@ -1729,6 +1737,9 @@ subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) if (associated(iobt%mass_berg)) then chks = field_chksum( iobt%mass_berg ) ; if (root) write(outunit,100) 'iobt%mass_berg ', chks endif + if (associated(iobt%excess_salt)) then + chks = field_chksum( iobt%excess_salt ) ; if (root) write(outunit,100) 'iobt%excess_salt ', chks + endif 100 FORMAT(" CHECKSUM::",A20," = ",Z20) call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index bd86a633c6..5fde791724 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -14,7 +14,8 @@ module ocean_model_mod use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized -use MOM, only : get_ocean_stocks, step_offline, save_MOM6_internal_state +use MOM, only : get_ocean_stocks, step_offline +use MOM, only : save_MOM_restart use MOM_coms, only : field_chksum use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf use MOM_coupler_types, only : coupler_1d_bc_type, coupler_2d_bc_type @@ -37,7 +38,6 @@ module ocean_model_mod use MOM_grid, only : ocean_grid_type use MOM_io, only : write_version_number, stdout_if_root use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS -use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase use MOM_surface_forcing_gfdl, only : surface_forcing_init, convert_IOB_to_fluxes use MOM_surface_forcing_gfdl, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum @@ -209,9 +209,6 @@ module ocean_model_mod Waves => NULL() !< A pointer to the surface wave control structure type(surface_forcing_CS), pointer :: & forcing_CSp => NULL() !< A pointer to the MOM forcing control structure - type(MOM_restart_CS), pointer :: & - restart_CSp => NULL() !< A pointer set to the restart control structure - !! that will be used for MOM restart files. type(diag_ctrl), pointer :: & diag => NULL() !< A pointer to the diagnostic regulatory structure end type ocean_state_type @@ -279,7 +276,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas ! initialization of ice shelf parameters and arrays. call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & - OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & + Time_in, offline_tracer_mode=OS%offline_tracer_mode, & diag_ptr=OS%diag, count_calls=.true., ice_shelf_CSp=OS%ice_shelf_CSp, & waves_CSp=OS%Waves) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & @@ -572,7 +569,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda endif if ((OS%nstep==0) .and. (OS%nstep_thermo==0)) then ! This is the first call to update_ocean_model. - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp) endif Time_thermo_start = OS%Time @@ -693,24 +690,22 @@ subroutine ocean_model_restart(OS, timestamp) "restart files can only be created after the buoyancy forcing is applied.") if (BTEST(OS%Restart_control,1)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, .true., GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, & + OS%grid, time_stamped=.true., GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & OS%dirs%restart_output_dir, .true.) if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) endif - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, .true.) endif if (BTEST(OS%Restart_control,0)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, & + OS%grid, GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & OS%dirs%restart_output_dir) if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) endif - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time) endif end subroutine ocean_model_restart @@ -758,16 +753,13 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) if (present(directory)) then ; restart_dir = directory else ; restart_dir = OS%dirs%restart_output_dir ; endif - call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, restart_dir, Time, OS%grid, GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir) if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) endif - - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time) - end subroutine ocean_model_save_restart !> Initialize the public ocean type diff --git a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 index cdf93b1bef..82d8881c03 100644 --- a/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 +++ b/config_src/drivers/mct_cap/mom_ocean_model_mct.F90 @@ -14,7 +14,8 @@ module MOM_ocean_model_mct use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized -use MOM, only : get_ocean_stocks, step_offline, save_MOM6_internal_state +use MOM, only : get_ocean_stocks, step_offline +use MOM, only : save_MOM_restart use MOM_coms, only : field_chksum use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging @@ -34,7 +35,6 @@ module MOM_ocean_model_mct use MOM_grid, only : ocean_grid_type use MOM_io, only : close_file, file_exists, read_data, write_version_number use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS -use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase use MOM_surface_forcing_mct, only : surface_forcing_init, convert_IOB_to_fluxes use MOM_surface_forcing_mct, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum @@ -207,9 +207,6 @@ module MOM_ocean_model_mct Waves => NULL() !< A pointer to the surface wave control structure type(surface_forcing_CS), pointer :: & forcing_CSp => NULL() !< A pointer to the MOM forcing control structure - type(MOM_restart_CS), pointer :: & - restart_CSp => NULL() !< A pointer set to the restart control structure - !! that will be used for MOM restart files. type(diag_ctrl), pointer :: & diag => NULL() !< A pointer to the diagnostic regulatory structure end type ocean_state_type @@ -271,7 +268,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%Time = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & - OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & + Time_in, offline_tracer_mode=OS%offline_tracer_mode, & input_restart_file=input_restart_file, & diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & @@ -575,7 +572,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp) endif call disable_averaging(OS%diag) @@ -689,35 +686,32 @@ subroutine ocean_model_restart(OS, timestamp, restartname) "restart files can only be created after the buoyancy forcing is applied.") if (present(restartname)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV, filename=restartname) + call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, & + OS%grid, GV=OS%GV, filename=restartname) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & OS%dirs%restart_output_dir) ! Is this needed? if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, & OS%dirs%restart_output_dir) endif - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time) else if (BTEST(OS%Restart_control,1)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, .true., GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, & + OS%grid, time_stamped=.true., GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & OS%dirs%restart_output_dir, .true.) if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) endif - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, .true.) endif if (BTEST(OS%Restart_control,0)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, & + OS%grid, GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & OS%dirs%restart_output_dir) if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) endif - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time) endif endif @@ -768,7 +762,7 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) if (present(directory)) then ; restart_dir = directory else ; restart_dir = OS%dirs%restart_output_dir ; endif - call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, restart_dir, Time, OS%grid, GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir) diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 205dbdadcc..9ee7ef921f 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -14,7 +14,8 @@ module MOM_ocean_model_nuopc use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized -use MOM, only : get_ocean_stocks, step_offline, save_MOM6_internal_state +use MOM, only : get_ocean_stocks, step_offline +use MOM, only : save_MOM_restart use MOM_coms, only : field_chksum use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf use MOM_diag_mediator, only : diag_ctrl, enable_averages, disable_averaging @@ -34,7 +35,6 @@ module MOM_ocean_model_nuopc use MOM_grid, only : ocean_grid_type use MOM_io, only : close_file, file_exists, read_data, write_version_number use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS -use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase use MOM_time_manager, only : time_type, get_time, set_time, operator(>) use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) @@ -214,9 +214,6 @@ module MOM_ocean_model_nuopc Waves => NULL() !< A pointer to the surface wave control structure type(surface_forcing_CS), pointer :: & forcing_CSp => NULL() !< A pointer to the MOM forcing control structure - type(MOM_restart_CS), pointer :: & - restart_CSp => NULL() !< A pointer set to the restart control structure - !! that will be used for MOM restart files. type(diag_ctrl), pointer :: & diag => NULL() !< A pointer to the diagnostic regulatory structure end type ocean_state_type @@ -281,7 +278,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%Time = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & - OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & + Time_in, offline_tracer_mode=OS%offline_tracer_mode, & input_restart_file=input_restart_file, & diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & @@ -407,7 +404,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! MOM_wave_interface_init is called regardless of the value of USE_WAVES because ! it also initializes statistical waves. - call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag, OS%restart_CSp) + call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag) if (associated(OS%grid%Domain%maskmap)) then call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & @@ -608,7 +605,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & endif if (OS%nstep==0) then - call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) + call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp) endif call disable_averaging(OS%diag) @@ -730,36 +727,32 @@ subroutine ocean_model_restart(OS, timestamp, restartname, stoch_restartname, nu "restart files can only be created after the buoyancy forcing is applied.") if (present(restartname)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV, filename=restartname, num_rest_files=num_rest_files) + call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, & + OS%grid, GV=OS%GV, filename=restartname, num_rest_files=num_rest_files) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & OS%dirs%restart_output_dir) ! Is this needed? if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, & OS%dirs%restart_output_dir) endif - - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time) else if (BTEST(OS%Restart_control,1)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, .true., GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, & + OS%grid, time_stamped=.true., GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir, .true.) + OS%dirs%restart_output_dir, time_stamped=.true.) if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) endif - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, .true.) endif if (BTEST(OS%Restart_control,0)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time, & + OS%grid, GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & OS%dirs%restart_output_dir) if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) endif - call save_MOM6_internal_state(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time) endif endif if (present(stoch_restartname)) then @@ -814,16 +807,13 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) if (present(directory)) then ; restart_dir = directory else ; restart_dir = OS%dirs%restart_output_dir ; endif - call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) + call save_MOM_restart(OS%MOM_CSp, restart_dir, Time, OS%grid, GV=OS%GV) call forcing_save_restart(OS%forcing_CSp, OS%grid, Time, restart_dir) if (OS%use_ice_shelf) then call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) endif - - call save_MOM6_internal_start(OS%MOM_CSp, OS%dirs%restart_output_dir, OS%Time) - end subroutine ocean_model_save_restart !> Initialize the public ocean type diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 72981122f2..84c2eec5b5 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -31,7 +31,8 @@ program MOM6 use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, finish_MOM_initialization use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized - use MOM, only : step_offline, save_MOM6_internal_state + use MOM, only : step_offline + use MOM, only : save_MOM_restart use MOM_coms, only : Set_PElist use MOM_domains, only : MOM_infra_init, MOM_infra_end, set_MOM_thread_affinity use MOM_ensemble_manager, only : ensemble_manager_init, get_ensemble_size @@ -52,7 +53,6 @@ program MOM6 use MOM_io, only : file_exists, open_ASCII_file, close_file use MOM_io, only : check_nml_error, io_infra_init, io_infra_end use MOM_io, only : APPEND_FILE, READONLY_FILE - use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions,only : uppercase use MOM_surface_forcing, only : set_forcing, forcing_save_restart use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS @@ -177,9 +177,6 @@ program MOM6 logical :: override_shelf_fluxes !< If true, and shelf dynamics are active, !! the data_override feature is enabled (only for MOSAIC grid types) type(wave_parameters_cs), pointer :: waves_CSp => NULL() - type(MOM_restart_CS), pointer :: & - restart_CSp => NULL() !< A pointer to the restart control structure - !! that will be used for MOM restart files. type(diag_ctrl), pointer :: & diag => NULL() !< A pointer to the diagnostic regulatory structure !----------------------------------------------------------------------- @@ -281,7 +278,7 @@ program MOM6 if (segment_start_time_set) then ! In this case, the segment starts at a time fixed by ocean_solo.res Time = segment_start_time - call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & + call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, & segment_start_time, offline_tracer_mode=offline_tracer_mode, & diag_ptr=diag, tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp, & waves_CSp=Waves_CSp) @@ -289,7 +286,7 @@ program MOM6 ! In this case, the segment starts at a time read from the MOM restart file ! or is left at Start_time by MOM_initialize. Time = Start_time - call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, restart_CSp, & + call initialize_MOM(Time, Start_time, param_file, dirs, MOM_CSp, & offline_tracer_mode=offline_tracer_mode, diag_ptr=diag, & tracer_flow_CSp=tracer_flow_CSp, ice_shelf_CSp=ice_shelf_CSp, waves_CSp=Waves_CSp) endif @@ -473,7 +470,7 @@ program MOM6 endif if (ns==1) then - call finish_MOM_initialization(Time, dirs, MOM_CSp, restart_CSp) + call finish_MOM_initialization(Time, dirs, MOM_CSp) endif ! This call steps the model over a time dt_forcing. @@ -564,22 +561,19 @@ program MOM6 if ((permit_incr_restart) .and. (fluxes%fluxes_used) .and. & (Time + (Time_step_ocean/2) > restart_time)) then if (BTEST(Restart_control,1)) then - call save_restart(dirs%restart_output_dir, Time, grid, & - restart_CSp, .true., GV=GV) + call save_MOM_restart(MOM_CSp, dirs%restart_output_dir, Time, grid, & + time_stamped=.true., GV=GV) call forcing_save_restart(surface_forcing_CSp, grid, Time, & dirs%restart_output_dir, .true.) if (use_ice_shelf) call ice_shelf_save_restart(ice_shelf_CSp, Time, & dirs%restart_output_dir, .true.) - call save_MOM6_internal_state(MOM_CSp, dirs%restart_output_dir, Time, .true.) endif if (BTEST(Restart_control,0)) then - call save_restart(dirs%restart_output_dir, Time, grid, & - restart_CSp, GV=GV) + call save_MOM_restart(MOM_CSp, dirs%restart_output_dir, Time, grid, GV=GV) call forcing_save_restart(surface_forcing_CSp, grid, Time, & dirs%restart_output_dir) if (use_ice_shelf) call ice_shelf_save_restart(ice_shelf_CSp, Time, & dirs%restart_output_dir) - call save_MOM6_internal_state(MOM_CSp, dirs%restart_output_dir, Time) endif restart_time = restart_time + restint endif @@ -600,10 +594,9 @@ program MOM6 "For conservation, the ocean restart files can only be "//& "created after the buoyancy forcing is applied.") - call save_restart(dirs%restart_output_dir, Time, grid, restart_CSp, GV=GV) + call save_MOM_restart(MOM_CSp, dirs%restart_output_dir, Time, grid, GV=GV) if (use_ice_shelf) call ice_shelf_save_restart(ice_shelf_CSp, Time, & dirs%restart_output_dir) - call save_MOM6_internal_state(MOM_CSp, dirs%restart_output_dir, Time) ! Write the ocean solo restart file. call write_ocean_solo_res(Time, Start_time, calendar_type, & diff --git a/config_src/external/drifters/MOM_particles.F90 b/config_src/external/drifters/MOM_particles.F90 index aad918e5a4..fa3840c6c2 100644 --- a/config_src/external/drifters/MOM_particles.F90 +++ b/config_src/external/drifters/MOM_particles.F90 @@ -11,19 +11,20 @@ module MOM_particles_mod implicit none ; private public particles, particles_run, particles_init, particles_save_restart, particles_end +public particles_to_k_space, particles_to_z_space contains !> Initializes particles container "parts" -subroutine particles_init(parts, Grid, Time, dt, u, v) +subroutine particles_init(parts, Grid, Time, dt, u, v, h) ! Arguments type(particles), pointer, intent(out) :: parts !< Container for all types and memory type(ocean_grid_type), target, intent(in) :: Grid !< Grid type from parent model type(time_type), intent(in) :: Time !< Time type from parent model - real, intent(in) :: dt !< particle timestep [s] - real, dimension(:,:,:), intent(in) :: u !< Zonal velocity field [m s-1] - real, dimension(:,:,:), intent(in) :: v !< Meridional velocity field [m s-1] - + real, intent(in) :: dt !< particle timestep in seconds [T ~> s] + real, dimension(:,:,:),intent(in) :: u !< Zonal velocity field [L T-1 ~> m s-1] + real, dimension(:,:,:),intent(in) :: v !< Meridional velocity field [L T-1 ~> m s-1] + real, dimension(:,:,:),intent(in) :: h !< Thickness of each layer [H ~> m or kg m-2] end subroutine particles_init !> The main driver the steps updates particles @@ -31,8 +32,8 @@ subroutine particles_run(parts, time, uo, vo, ho, tv, stagger) ! Arguments type(particles), pointer :: parts !< Container for all types and memory type(time_type), intent(in) :: time !< Model time - real, dimension(:,:,:), intent(in) :: uo !< Ocean zonal velocity [m s-1] - real, dimension(:,:,:), intent(in) :: vo !< Ocean meridional velocity [m s-1] + real, dimension(:,:,:), intent(in) :: uo !< Ocean zonal velocity [L T-1 ~>m s-1] + real, dimension(:,:,:), intent(in) :: vo !< Ocean meridional velocity [L T-1~> m s-1] real, dimension(:,:,:), intent(in) :: ho !< Ocean layer thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< structure containing pointers to available thermodynamic fields integer, optional, intent(in) :: stagger !< Flag for whether velocities are staggered @@ -41,21 +42,38 @@ end subroutine particles_run !>Save particle locations (and sometimes other vars) to restart file -subroutine particles_save_restart(parts, temp, salt) +subroutine particles_save_restart(parts, h, temp, salt) ! Arguments type(particles), pointer :: parts !< Container for all types and memory - real, dimension(:,:,:), optional, intent(in) :: temp !< Optional container for temperature - real, dimension(:,:,:), optional, intent(in) :: salt !< Optional container for salinity + real, dimension(:,:,:),intent(in) :: h !< Thickness of each layer [H ~> m or kg m-2] + real, dimension(:,:,:), optional, intent(in) :: temp !< Optional container for temperature [C ~> degC] + real, dimension(:,:,:), optional, intent(in) :: salt !< Optional container for salinity [S ~> ppt] end subroutine particles_save_restart !> Deallocate all memory and disassociated pointer -subroutine particles_end(parts, temp, salt) +subroutine particles_end(parts, h, temp, salt) ! Arguments type(particles), pointer :: parts !< Container for all types and memory - real, dimension(:,:,:), optional, intent(in) :: temp !< Optional container for temperature - real, dimension(:,:,:), optional, intent(in) :: salt !< Optional container for salinity + real, dimension(:,:,:),intent(in) :: h !< Thickness of each layer [H ~> m or kg m-2] + real, dimension(:,:,:), optional, intent(in) :: temp !< Optional container for temperature [C ~> degC] + real, dimension(:,:,:), optional, intent(in) :: salt !< Optional container for salinity [S ~> ppt] end subroutine particles_end +subroutine particles_to_k_space(parts, h) + ! Arguments + type(particles), pointer :: parts !< Container for all types and memory + real, dimension(:,:,:),intent(in) :: h !< Thickness of layers [H ~> m or kg m-2] + +end subroutine particles_to_k_space + + +subroutine particles_to_z_space(parts, h) + ! Arguments + type(particles), pointer :: parts !< Container for all types and memory + real, dimension(:,:,:),intent(in) :: h !< Thickness of layers [H ~> m or kg m-2] + +end subroutine particles_to_z_space + end module MOM_particles_mod diff --git a/docs/zotero.bib b/docs/zotero.bib index c0c7ee3bd9..5acaee968a 100644 --- a/docs/zotero.bib +++ b/docs/zotero.bib @@ -2738,3 +2738,12 @@ @article{kraus1967 journal = {Tellus} } +@article{Nguyen2009, + doi = {10.1029/2008JC005121}, + year = {2009}, + journal = {JGR Oceans}, + volume = {114}, + author = {A. T. Nguyen and D. Menemenlis and R. Kwok}, + title = {Improved modeling of the Arctic halocline with a subgrid-scale brine rejection parameterization}, + pages = {C11014} +} diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 4641747115..b8f60b2830 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -20,7 +20,7 @@ module MOM_ALE use MOM_hybgen_unmix, only : hybgen_unmix, init_hybgen_unmix, end_hybgen_unmix, hybgen_unmix_CS use MOM_hybgen_regrid, only : hybgen_regrid_CS use MOM_file_parser, only : get_param, param_file_type, log_param -use MOM_interface_heights,only : find_eta +use MOM_interface_heights,only : find_eta, calc_derived_thermo use MOM_open_boundary, only : ocean_OBC_type, OBC_DIRECTION_E, OBC_DIRECTION_W use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_regridding, only : initialize_regridding, regridding_main, end_regridding @@ -233,21 +233,24 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) call initialize_remapping( CS%remapCS, string, & boundary_extrapolation=remap_boundary_extrap, & @@ -656,6 +659,9 @@ subroutine ALE_regrid_accelerated(CS, G, GV, US, h, tv, n_itt, u, v, OBC, Reg, d ! generate new grid if (CS%do_conv_adj) call convective_adjustment(G, GV, h_loc, tv_local) + ! Update the layer specific volumes if necessary + if (allocated(tv_local%SpV_avg)) call calc_derived_thermo(tv_local, h, G, GV, US, halo=1) + call regridding_main(CS%remapCS, CS%regridCS, G, GV, US, h_loc, tv_local, h, dzInterface) dzIntTotal(:,:,:) = dzIntTotal(:,:,:) + dzInterface(:,:,:) diff --git a/src/ALE/MOM_hybgen_unmix.F90 b/src/ALE/MOM_hybgen_unmix.F90 index 024a9baffa..6ddb828abe 100644 --- a/src/ALE/MOM_hybgen_unmix.F90 +++ b/src/ALE/MOM_hybgen_unmix.F90 @@ -9,6 +9,7 @@ module MOM_hybgen_unmix use MOM_file_parser, only : get_param, param_file_type, log_param use MOM_hybgen_regrid, only : hybgen_column_init use MOM_hybgen_regrid, only : hybgen_regrid_CS, get_hybgen_regrid_params +use MOM_interface_heights, only : calc_derived_thermo use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chkinv use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : ocean_grid_type, thermo_var_ptrs @@ -146,7 +147,8 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h) real :: p_col(GV%ke) ! A column of reference pressures [R L2 T-2 ~> Pa] real :: tracer(GV%ke,max(ntr,1)) ! Columns of each tracer [Conc] real :: h_tot ! Total thickness of the water column [H ~> m or kg m-2] - real :: nominalDepth ! Depth of ocean bottom (positive downward) [H ~> m or kg m-2] + real :: dz_tot ! Vertical distance between the top and bottom of the water column [Z ~> m] + real :: nominalDepth ! Depth of ocean bottom in thickness units (positive downward) [H ~> m or kg m-2] real :: h_thin ! A negligibly small thickness to identify essentially ! vanished layers [H ~> m or kg m-2] real :: dilate ! A factor by which to dilate the target positions from z to z* [nondim] @@ -169,6 +171,15 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h) h_thin = 1e-6*GV%m_to_H debug_conservation = .false. ! Set this to true for debugging + if ((allocated(tv%SpV_avg)) .and. (tv%valid_SpV_halo < 1)) then + if (tv%valid_SpV_halo < 0) then + mesg = "invalid values of SpV_avg." + else + mesg = "insufficiently large SpV_avg halos of width 0 but 1 is needed." + endif + call MOM_error(FATAL, "hybgen_unmix called in fully non-Boussinesq mode with "//trim(mesg)) + endif + p_col(:) = CS%ref_pressure do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 ; if (G%mask2dT(i,j)>0.) then @@ -203,13 +214,27 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h) endif ! The following block of code is used to trigger z* stretching of the targets heights. - nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H - if (h_tot <= CS%min_dilate*nominalDepth) then - dilate = CS%min_dilate - elseif (h_tot >= CS%max_dilate*nominalDepth) then - dilate = CS%max_dilate + if (allocated(tv%SpV_avg)) then ! This is the fully non-Boussiesq version + dz_tot = 0.0 + do k=1,nk + dz_tot = dz_tot + GV%H_to_RZ * tv%SpV_avg(i,j,k) * h_col(k) + enddo + if (dz_tot <= CS%min_dilate*(G%bathyT(i,j)+G%Z_ref)) then + dilate = CS%min_dilate + elseif (dz_tot >= CS%max_dilate*(G%bathyT(i,j)+G%Z_ref)) then + dilate = CS%max_dilate + else + dilate = dz_tot / (G%bathyT(i,j)+G%Z_ref) + endif else - dilate = h_tot / nominalDepth + nominalDepth = (G%bathyT(i,j)+G%Z_ref)*GV%Z_to_H + if (h_tot <= CS%min_dilate*nominalDepth) then + dilate = CS%min_dilate + elseif (h_tot >= CS%max_dilate*nominalDepth) then + dilate = CS%max_dilate + else + dilate = h_tot / nominalDepth + endif endif terrain_following = (h_tot < dilate*CS%dpns) .and. (CS%dpns >= CS%dsns) @@ -268,6 +293,9 @@ subroutine hybgen_unmix(G, GV, US, CS, tv, Reg, ntr, h) endif endif ; enddo ; enddo !i & j. + ! Update the layer properties + if (allocated(tv%SpV_avg)) call calc_derived_thermo(tv, h, G, GV, US, halo=1) + end subroutine hybgen_unmix diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index c5f5807f66..c238c2aa61 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -263,7 +263,7 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m param_name = create_coord_param(param_prefix, "INTERP_SCHEME", param_suffix) string2 = 'PPM_H4' ! Default for diagnostics endif - call get_param(param_file, mdl, "INTERPOLATION_SCHEME", string, & + call get_param(param_file, mdl, param_name, string, & "This sets the interpolation scheme to use to "//& "determine the new grid. These parameters are "//& "only relevant when REGRIDDING_COORDINATE_MODE is "//& @@ -277,28 +277,32 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. - if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701) call set_regrid_params(CS, remap_answer_date=remap_answer_date) call get_param(param_file, mdl, "REGRIDDING_ANSWER_DATE", regrid_answer_date, & "The vintage of the expressions and order of arithmetic to use for regridding. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions.", & - default=20181231) ! ### change to default=default_answer_date) + default=20181231, do_not_log=.not.GV%Boussinesq) ! ### change to default=default_answer_date) + if (.not.GV%Boussinesq) regrid_answer_date = max(regrid_answer_date, 20230701) call set_regrid_params(CS, regrid_answer_date=regrid_answer_date) endif @@ -810,20 +814,47 @@ subroutine regridding_main( remapCS, CS, G, GV, US, h, tv, h_new, dzInterface, & ! Local variables real :: nom_depth_H(SZI_(G),SZJ_(G)) !< The nominal ocean depth at each point in thickness units [H ~> m or kg m-2] + real :: tot_h(SZI_(G),SZJ_(G)) !< The total thickness of the water column [H ~> m or kg m-2] + real :: tot_dz(SZI_(G),SZJ_(G)) !< The total distance between the top and bottom of the water column [Z ~> m] real :: Z_to_H ! A conversion factor used by some routines to convert coordinate ! parameters to depth units [H Z-1 ~> nondim or kg m-3] real :: trickGnuCompiler - integer :: i, j + character(len=128) :: mesg ! A string for error messages + integer :: i, j, k if (present(PCM_cell)) PCM_cell(:,:,:) = .false. Z_to_H = US%Z_to_m * GV%m_to_H ! Often this is equivalent to GV%Z_to_H. - do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 - nom_depth_H(i,j) = (G%bathyT(i,j)+G%Z_ref) * Z_to_H - ! Consider using the following instead: - ! nom_depth_H(i,j) = max( (G%bathyT(i,j)+G%Z_ref) * Z_to_H , CS%min_nom_depth ) - ! if (G%mask2dT(i,j)==0.) nom_depth_H(i,j) = 0.0 - enddo ; enddo + + if ((allocated(tv%SpV_avg)) .and. (tv%valid_SpV_halo < 1)) then + if (tv%valid_SpV_halo < 0) then + mesg = "invalid values of SpV_avg." + else + mesg = "insufficiently large SpV_avg halos of width 0 but 1 is needed." + endif + call MOM_error(FATAL, "Regridding_main called in fully non-Boussinesq mode with "//trim(mesg)) + endif + + if (allocated(tv%SpV_avg)) then ! This is the fully non-Boussinesq case + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + tot_h(i,j) = 0.0 ; tot_dz(i,j) = 0.0 + enddo ; enddo + do k=1,GV%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + tot_h(i,j) = tot_h(i,j) + h(i,j,k) + tot_dz(i,j) = tot_dz(i,j) + GV%H_to_RZ * tv%SpV_avg(i,j,k) * h(i,j,k) + enddo ; enddo ; enddo + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + if ((tot_dz(i,j) > 0.0) .and. (G%bathyT(i,j)+G%Z_ref > 0.0)) then + nom_depth_H(i,j) = (G%bathyT(i,j)+G%Z_ref) * (tot_h(i,j) / tot_dz(i,j)) + else + nom_depth_H(i,j) = 0.0 + endif + enddo ; enddo + else + do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 + nom_depth_H(i,j) = max((G%bathyT(i,j)+G%Z_ref) * Z_to_H, 0.0) + enddo ; enddo + endif select case ( CS%regridding_scheme ) @@ -1304,12 +1335,12 @@ subroutine build_sigma_grid( CS, G, GV, h, nom_depth_H, dzInterface ) ! In sigma coordinates, the bathymetric depth is only used as an arbitrary offset that ! cancels out when determining coordinate motion, so referencing the column postions to ! the surface is perfectly acceptable, but for preservation of previous answers the - ! referencing is done relative to the bottom when in Boussinesq mode. - ! if (GV%Boussinesq) then + ! referencing is done relative to the bottom when in Boussinesq or semi-Boussinesq mode. + if (GV%Boussinesq .or. GV%semi_Boussinesq) then nominalDepth = nom_depth_H(i,j) - ! else - ! nominalDepth = totalThickness - ! endif + else + nominalDepth = totalThickness + endif call build_sigma_column(CS%sigma_CS, nominalDepth, totalThickness, zNew) @@ -1432,12 +1463,12 @@ subroutine build_rho_grid( G, GV, US, h, nom_depth_H, tv, dzInterface, remapCS, ! In rho coordinates, the bathymetric depth is only used as an arbitrary offset that ! cancels out when determining coordinate motion, so referencing the column postions to ! the surface is perfectly acceptable, but for preservation of previous answers the - ! referencing is done relative to the bottom when in Boussinesq mode. - ! if (GV%Boussinesq) then + ! referencing is done relative to the bottom when in Boussinesq or semi-Boussinesq mode. + if (GV%Boussinesq .or. GV%semi_Boussinesq) then nominalDepth = nom_depth_H(i,j) - ! else - ! nominalDepth = totalThickness - ! endif + else + nominalDepth = totalThickness + endif ! Determine absolute interface positions zOld(nz+1) = - nominalDepth diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index df3a308e85..c9b8ea42c0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -34,7 +34,7 @@ module MOM use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : read_param, get_param, log_version, param_file_type -use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : forcing, mech_forcing, find_ustar use MOM_forcing_type, only : MOM_forcing_chksum, MOM_mech_forcing_chksum use MOM_get_input, only : Get_MOM_Input, directories use MOM_io, only : MOM_io_init, vardesc, var_desc @@ -91,7 +91,7 @@ module MOM use MOM_grid, only : set_first_direction, rescale_grid_bathymetry use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_hor_index, only : rotate_hor_index -use MOM_interface_heights, only : find_eta, calc_derived_thermo +use MOM_interface_heights, only : find_eta, calc_derived_thermo, thickness_to_dz use MOM_interface_filter, only : interface_filter, interface_filter_init, interface_filter_end use MOM_interface_filter, only : interface_filter_CS use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init, VarMix_end @@ -162,7 +162,7 @@ module MOM use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end - +use MOM_particles_mod, only : particles_to_k_space, particles_to_z_space implicit none ; private #include @@ -435,13 +435,16 @@ module MOM type(porous_barrier_type) :: pbv !< porous barrier fractional cell metrics type(particles), pointer :: particles => NULL() ! NULL() !< a pointer to the stochastics control structure + type(MOM_restart_CS), pointer :: restart_CS => NULL() + !< Pointer to MOM's restart control structure end type MOM_control_struct public initialize_MOM, finish_MOM_initialization, MOM_end -public step_MOM, step_offline, save_MOM6_internal_state +public step_MOM, step_offline public extract_surface_state, get_ocean_stocks public get_MOM_state_elements, MOM_state_is_synchronized public allocate_surface_state, deallocate_surface_state +public save_MOM_restart !>@{ CPU time clock IDs integer :: id_clock_ocean @@ -541,8 +544,13 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS ! the end of a stepping cycle (whatever that may mean). logical :: therm_reset ! If true, reset running sums of thermodynamic quantities. real :: cycle_time ! The length of the coupled time-stepping cycle [T ~> s]. + real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & + U_star ! The wind friction velocity, calculated using the Boussinesq reference density or + ! the time-evolving surface density in non-Boussinesq mode [Z T-1 ~> m s-1] real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & ssh ! sea surface height, which may be based on eta_av [Z ~> m] + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%GV)) :: & + dz ! Vertical distance across layers [Z ~> m] real, dimension(:,:,:), pointer :: & u => NULL(), & ! u : zonal velocity component [L T-1 ~> m s-1] @@ -669,13 +677,18 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS dt = time_interval / real(n_max) dt_therm = dt ; ntstep = 1 + + if (CS%UseWaves .and. associated(fluxes%ustar)) & + call pass_var(fluxes%ustar, G%Domain, clock=id_clock_pass, halo=1) + if (CS%UseWaves .and. associated(fluxes%tau_mag)) & + call pass_var(fluxes%tau_mag, G%Domain, clock=id_clock_pass, halo=1) + if (associated(fluxes%p_surf)) p_surf => fluxes%p_surf CS%tv%p_surf => NULL() if (CS%use_p_surf_in_EOS .and. associated(fluxes%p_surf)) then CS%tv%p_surf => fluxes%p_surf if (allocated(CS%tv%SpV_avg)) call pass_var(fluxes%p_surf, G%Domain, clock=id_clock_pass) endif - if (CS%UseWaves) call pass_var(fluxes%ustar, G%Domain, clock=id_clock_pass) endif if (therm_reset) then @@ -719,12 +732,16 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS if (CS%UseWaves) then ! Update wave information, which is presently kept static over each call to step_mom call enable_averages(time_interval, Time_start + real_to_time(US%T_to_s*time_interval), CS%diag) - call Update_Stokes_Drift(G, GV, US, Waves, h, forces%ustar, time_interval, do_dyn) + call find_ustar(forces, CS%tv, U_star, G, GV, US, halo=1) + call thickness_to_dz(h, CS%tv, dz, G, GV, US, halo_size=1) + call Update_Stokes_Drift(G, GV, US, Waves, dz, U_star, time_interval, do_dyn) call disable_averaging(CS%diag) endif else ! not do_dyn. if (CS%UseWaves) then ! Diagnostics are not enabled in this call. - call Update_Stokes_Drift(G, GV, US, Waves, h, fluxes%ustar, time_interval, do_dyn) + call find_ustar(fluxes, CS%tv, U_star, G, GV, US, halo=1) + call thickness_to_dz(h, CS%tv, dz, G, GV, US, halo_size=1) + call Update_Stokes_Drift(G, GV, US, Waves, dz, U_star, time_interval, do_dyn) endif endif @@ -1090,7 +1107,7 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & call cpu_clock_end(id_clock_stoch) call cpu_clock_begin(id_clock_varT) if (CS%use_stochastic_EOS) then - call MOM_calc_varT(G, GV, h, CS%tv, CS%stoch_eos_CS, dt) + call MOM_calc_varT(G, GV, US, h, CS%tv, CS%stoch_eos_CS, dt) if (associated(CS%tv%varT)) call pass_var(CS%tv%varT, G%Domain, clock=id_clock_pass, halo=1) endif call cpu_clock_end(id_clock_varT) @@ -1541,6 +1558,10 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call preAle_tracer_diagnostics(CS%tracer_Reg, G, GV) + if (CS%use_particles) then + call particles_to_z_space(CS%particles, h) + endif + if (CS%debug) then call MOM_state_chksum("Pre-ALE ", u, v, h, CS%uh, CS%vh, G, GV, US, omit_corners=.true.) call hchksum(tv%T,"Pre-ALE T", G%HI, haloshift=1, omit_corners=.true., scale=US%C_to_degC) @@ -1588,6 +1609,11 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call cpu_clock_end(id_clock_ALE) endif ! endif for the block "if ( CS%use_ALE_algorithm )" + + if (CS%use_particles) then + call particles_to_k_space(CS%particles, h) + endif + dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo) call create_group_pass(pass_uv_T_S_h, u, v, G%Domain, halo=dynamics_stencil) if (associated(tv%T)) & @@ -1894,7 +1920,7 @@ end subroutine step_offline !> Initialize MOM, including memory allocation, setting up parameters and diagnostics, !! initializing the ocean state variables, and initializing subsidiary modules -subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & +subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & Time_in, offline_tracer_mode, input_restart_file, diag_ptr, & count_calls, tracer_flow_CSp, ice_shelf_CSp, waves_CSp) type(time_type), target, intent(inout) :: Time !< model time, set in this routine @@ -1902,9 +1928,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(param_file_type), intent(out) :: param_file !< structure indicating parameter file to parse type(directories), intent(out) :: dirs !< structure with directory paths type(MOM_control_struct), intent(inout), target :: CS !< pointer set in this routine to MOM control structure - type(MOM_restart_CS), pointer :: restart_CSp !< pointer set in this routine to the - !! restart control structure that will - !! be used for MOM. type(time_type), optional, intent(in) :: Time_in !< time passed to MOM_initialize_state when !! model is not being started from a restart file logical, optional, intent(out) :: offline_tracer_mode !< True is returned if tracers are being run offline @@ -1930,6 +1953,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(dyn_horgrid_type), pointer :: dG_in => NULL() type(diag_ctrl), pointer :: diag => NULL() type(unit_scale_type), pointer :: US => NULL() + type(MOM_restart_CS), pointer :: restart_CSp => NULL() character(len=4), parameter :: vers_num = 'v2.0' integer :: turns ! Number of grid quarter-turns @@ -1948,7 +1972,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & type(sponge_CS), pointer :: sponge_in_CSp => NULL() type(ALE_sponge_CS), pointer :: ALE_sponge_in_CSp => NULL() type(oda_incupd_CS),pointer :: oda_incupd_in_CSp => NULL() - ! This include declares and sets the variable "version". # include "version_variable.h" @@ -2003,6 +2026,9 @@ 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 :: non_Bous ! If true, this run is fully non-Boussinesq + logical :: Boussinesq ! If true, this run is fully Boussinesq + logical :: semi_Boussinesq ! If true, this run is partially non-Boussinesq 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 @@ -2066,10 +2092,18 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & default=.false.) endif + call get_param(param_file, "MOM", "BOUSSINESQ", Boussinesq, & + "If true, make the Boussinesq approximation.", default=.true., do_not_log=.true.) + call get_param(param_file, "MOM", "SEMI_BOUSSINESQ", semi_Boussinesq, & + "If true, do non-Boussinesq pressure force calculations and use mass-based "//& + "thicknesses, but use RHO_0 to convert layer thicknesses into certain "//& + "height changes. This only applies if BOUSSINESQ is false.", & + default=.true., do_not_log=.true.) + non_Bous = .not.(Boussinesq .or. semi_Boussinesq) call get_param(param_file, "MOM", "CALC_RHO_FOR_SEA_LEVEL", CS%calc_rho_for_sea_lev, & "If true, the in-situ density is used to calculate the "//& "effective sea level that is returned to the coupler. If false, "//& - "the Boussinesq parameter RHO_0 is used.", default=.false.) + "the Boussinesq parameter RHO_0 is used.", default=non_Bous) call get_param(param_file, "MOM", "ENABLE_THERMODYNAMICS", use_temperature, & "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) @@ -2327,20 +2361,23 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & default=99991231) call get_param(param_file, "MOM", "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=non_Bous) call get_param(param_file, "MOM", "SURFACE_2018_ANSWERS", answers_2018, & "If true, use expressions for the surface properties that recover the answers "//& "from the end of 2018. Otherwise, use more appropriate expressions that differ "//& - "at roundoff for non-Boussinesq cases.", default=default_2018_answers) + "at roundoff for non-Boussinesq cases.", default=default_2018_answers, do_not_log=non_Bous) ! Revise inconsistent default answer dates. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (.not.non_Bous) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, "MOM", "SURFACE_ANSWER_DATE", CS%answer_date, & "The vintage of the expressions for the surface properties. Values below "//& "20190101 recover the answers from the end of 2018, while higher values "//& "use updated and more robust forms of the same expressions. "//& "If both SURFACE_2018_ANSWERS and SURFACE_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=non_Bous) + if (non_Bous) CS%answer_date = 99991231 call get_param(param_file, "MOM", "USE_DIABATIC_TIME_BUG", CS%use_diabatic_time_bug, & "If true, uses the wrong calendar time for diabatic processes, as was "//& @@ -2656,7 +2693,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! Set the fields that are needed for bitwise identical restarting ! the time stepping scheme. - call restart_init(param_file, restart_CSp) + call restart_init(param_file, CS%restart_CS) + restart_CSp => CS%restart_CS + call set_restart_fields(GV, US, param_file, CS, restart_CSp) if (CS%split) then call register_restarts_dyn_split_RK2(HI, GV, US, param_file, & @@ -2853,8 +2892,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif - ! Allocate any derived equation of state fields. - if (use_temperature .and. .not.(GV%Boussinesq .or. GV%semi_Boussinesq)) then + ! Allocate any derived densities or other equation of state derived fields. + if (.not.(GV%Boussinesq .or. GV%semi_Boussinesq)) then allocate(CS%tv%SpV_avg(isd:ied,jsd:jed,nz), source=0.0) CS%tv%valid_SpV_halo = -1 ! This array does not yet have any valid data. endif @@ -3013,13 +3052,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & new_sim = is_new_run(restart_CSp) if (use_temperature) then - CS%use_stochastic_EOS = MOM_stoch_eos_init(Time, G, US, param_file, diag, CS%stoch_eos_CS, restart_CSp) + CS%use_stochastic_EOS = MOM_stoch_eos_init(Time, G, GV, US, param_file, diag, CS%stoch_eos_CS, restart_CSp) else CS%use_stochastic_EOS = .false. endif if (CS%use_porbar) & - call porous_barriers_init(Time, US, param_file, diag, CS%por_bar_CS) + call porous_barriers_init(Time, GV, US, param_file, diag, CS%por_bar_CS) if (CS%split) then allocate(eta(SZI_(G),SZJ_(G)), source=0.0) @@ -3115,26 +3154,6 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp) endif - ! This subroutine initializes any tracer packages. - call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, & - CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & - CS%ALE_sponge_CSp, CS%tv) - if (present(tracer_flow_CSp)) tracer_flow_CSp => CS%tracer_flow_CSp - - ! If running in offline tracer mode, initialize the necessary control structure and - ! parameters - if (present(offline_tracer_mode)) offline_tracer_mode=CS%offline_tracer_mode - - if (CS%offline_tracer_mode) then - ! Setup some initial parameterizations and also assign some of the subtypes - call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US) - call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & - diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & - tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & - tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug ) - call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp, GV, US) - endif - !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM call cpu_clock_begin(id_clock_pass_init) dynamics_stencil = min(3, G%Domain%nihalo, G%Domain%njhalo) @@ -3160,6 +3179,26 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call cpu_clock_end(id_clock_pass_init) + ! This subroutine initializes any tracer packages. + call tracer_flow_control_init(.not.new_sim, Time, G, GV, US, CS%h, param_file, & + CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & + CS%ALE_sponge_CSp, CS%tv) + if (present(tracer_flow_CSp)) tracer_flow_CSp => CS%tracer_flow_CSp + + ! If running in offline tracer mode, initialize the necessary control structure and + ! parameters + if (present(offline_tracer_mode)) offline_tracer_mode=CS%offline_tracer_mode + + if (CS%offline_tracer_mode) then + ! Setup some initial parameterizations and also assign some of the subtypes + call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV, US) + call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & + diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & + tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & + tv=CS%tv, x_before_y=(MODULO(first_direction,2)==0), debug=CS%debug ) + call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp, GV, US) + endif + call register_obsolete_diagnostics(param_file, CS%diag) if (use_frazil) then @@ -3210,13 +3249,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & end subroutine initialize_MOM !> Finishes initializing MOM and writes out the initial conditions. -subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) +subroutine finish_MOM_initialization(Time, dirs, CS) type(time_type), intent(in) :: Time !< model time, used in this routine type(directories), intent(in) :: dirs !< structure with directory paths type(MOM_control_struct), intent(inout) :: CS !< MOM control structure - type(MOM_restart_CS), pointer :: restart_CSp !< pointer to the restart control - !! structure that will be used for MOM. - ! Local variables + type(ocean_grid_type), pointer :: G => NULL() ! pointer to a structure containing ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to the vertical grid structure @@ -3232,13 +3269,13 @@ subroutine finish_MOM_initialization(Time, dirs, CS, restart_CSp) G => CS%G ; GV => CS%GV ; US => CS%US if (CS%use_particles) then - call particles_init(CS%particles, G, CS%Time, CS%dt_therm, CS%u, CS%v) + call particles_init(CS%particles, G, CS%Time, CS%dt_therm, CS%u, CS%v, CS%h) endif ! Write initial conditions if (CS%write_IC) then allocate(restart_CSp_tmp) - restart_CSp_tmp = restart_CSp + restart_CSp_tmp = CS%restart_CS call restart_registry_lock(restart_CSp_tmp, unlocked=.true.) allocate(z_interface(SZI_(G),SZJ_(G),SZK_(GV)+1)) call find_eta(CS%h, CS%tv, G, GV, US, z_interface, dZref=G%Z_ref) @@ -3917,27 +3954,35 @@ subroutine get_ocean_stocks(CS, mass, heat, salt, on_PE_only) end subroutine get_ocean_stocks -!> Trigger a writing of restarts for the MOM6 internal state -!! -!! Currently this applies to the state that does not take the form -!! of simple arrays for which the generic save_restart() function -!! can be used. -!! -!! Todo: -!! [ ] update particles to use Time and directories -!! [ ] move the call to generic save_restart() in here. -subroutine save_MOM6_internal_state(CS, dirs, time, stamp_time) - type(MOM_control_struct), intent(inout) :: CS !< MOM control structure - character(len=*), intent(in) :: dirs !< The directory where the restart - !! files are to be written - type(time_type), intent(in) :: time !< The current model time - logical, optional, intent(in) :: stamp_time !< If present and true, add time-stamp - - ! Could call save_restart(CS%restart_CSp) here - - if (CS%use_particles) call particles_save_restart(CS%particles) - -end subroutine save_MOM6_internal_state +!> Save restart/pickup files required to initialize the MOM6 internal state. +subroutine save_MOM_restart(CS, directory, time, G, time_stamped, filename, & + GV, num_rest_files, write_IC) + type(MOM_control_struct), intent(inout) :: CS + !< MOM control structure + character(len=*), intent(in) :: directory + !< The directory where the restart files are to be written + type(time_type), intent(in) :: time + !< The current model time + type(ocean_grid_type), intent(inout) :: G + !< The ocean's grid structure + logical, optional, intent(in) :: time_stamped + !< If present and true, add time-stamp to the restart file names + character(len=*), optional, intent(in) :: filename + !< A filename that overrides the name in CS%restartfile + type(verticalGrid_type), optional, intent(in) :: GV + !< The ocean's vertical grid structure + integer, optional, intent(out) :: num_rest_files + !< number of restart files written + logical, optional, intent(in) :: write_IC + !< If present and true, initial conditions are being written + + call save_restart(directory, time, G, CS%restart_CS, & + time_stamped=time_stamped, filename=filename, GV=GV, & + num_rest_files=num_rest_files, write_IC=write_IC) + + ! TODO: Update particles to use Time and directories + if (CS%use_particles) call particles_save_restart(CS%particles, CS%h) +end subroutine save_MOM_restart !> End of ocean model, including memory deallocation @@ -3978,7 +4023,7 @@ subroutine MOM_end(CS) endif if (CS%use_particles) then - call particles_end(CS%particles) + call particles_end(CS%particles, CS%h) deallocate(CS%particles) endif diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 40f759f4b8..adbbd3b4dd 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3,8 +3,9 @@ module MOM_barotropic ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : hchksum, uvchksum +use MOM_checksums, only : chksum0 use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE +use MOM_debugging, only : hchksum, uvchksum use MOM_diag_mediator, only : post_data, query_averaging_enabled, register_diag_field use MOM_diag_mediator, only : diag_ctrl, enable_averaging, enable_averages use MOM_domains, only : min_across_PEs, clone_MOM_domain, deallocate_MOM_domain @@ -105,7 +106,7 @@ module MOM_barotropic real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: frhatv !< The fraction of the total column thickness interpolated to v grid points in each layer [nondim]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: IDatu - !< Inverse of the basin depth at u grid points [Z-1 ~> m-1]. + !< Inverse of the total thickness at u grid points [H-1 ~> m-1 or m2 kg-1]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: lin_drag_u !< A spatially varying linear drag coefficient acting on the zonal barotropic flow !! [H T-1 ~> m s-1 or kg m-2 s-1]. @@ -139,11 +140,11 @@ module MOM_barotropic !< This is a copy of G%IareaT with wide halos, but will !! still utilize the macro IareaT when referenced, [L-2 ~> m-2]. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMW_) :: & - D_u_Cor, & !< A simply averaged depth at u points [Z ~> m]. + D_u_Cor, & !< A simply averaged depth at u points recast as a thickness [H ~> m or kg m-2] dy_Cu, & !< A copy of G%dy_Cu with wide halos [L ~> m]. IdxCu !< A copy of G%IdxCu with wide halos [L-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEMW_,NJMEMBW_) :: & - D_v_Cor, & !< A simply averaged depth at v points [Z ~> m]. + D_v_Cor, & !< A simply averaged depth at v points recast as a thickness [H ~> m or kg m-2] dx_Cv, & !< A copy of G%dx_Cv with wide halos [L ~> m]. IdyCv !< A copy of G%IdyCv with wide halos [L-1 ~> m-1]. real ALLOCABLE_, dimension(NIMEMBW_,NJMEMBW_) :: & @@ -170,6 +171,10 @@ module MOM_barotropic !! 0.0 gives a forward-backward scheme, while 1.0 !! give backward Euler. In practice, bebt should be !! of order 0.2 or greater. + real :: Rho_BT_lin !< A density that is used to convert total water column thicknesses + !! into mass in non-Boussinesq mode with linearized options in the + !! barotropic solver or when estimating the stable barotropic timestep + !! without access to the full baroclinic model state [R ~> kg m-3] logical :: split !< If true, use the split time stepping scheme. logical :: bound_BT_corr !< If true, the magnitude of the fake mass source !! in the barotropic equation that drives the two @@ -216,8 +221,8 @@ module MOM_barotropic logical :: dynamic_psurf !< If true, add a dynamic pressure due to a viscous !! ice shelf, for instance. - real :: Dmin_dyn_psurf !< The minimum depth to use in limiting the size - !! of the dynamic surface pressure for stability [Z ~> m]. + real :: Dmin_dyn_psurf !< The minimum total thickness to use in limiting the size + !! of the dynamic surface pressure for stability [H ~> m or kg m-2]. real :: ice_strength_length !< The length scale at which the damping rate !! due to the ice strength should be the same as if !! a Laplacian were applied [L ~> m]. @@ -511,8 +516,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! relative to eta_PF, with SAL effects included [H ~> m or kg m-2]. ! These are always allocated with symmetric memory and wide halos. - real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 Z-1 ~> s-1 m-1] - ! or [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1] + real :: q(SZIBW_(CS),SZJBW_(CS)) ! A pseudo potential vorticity [T-1 H-1 ~> s-1 m-1 or m2 s-1 kg-1] real, dimension(SZIBW_(CS),SZJW_(CS)) :: & ubt, & ! The zonal barotropic velocity [L T-1 ~> m s-1]. bt_rem_u, & ! The fraction of the barotropic zonal velocity that remains @@ -545,7 +549,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Rayleigh_u, & ! A Rayleigh drag timescale operating at u-points [T-1 ~> s-1]. PFu_bt_sum, & ! The summed zonal barotropic pressure gradient force [L T-2 ~> m s-2]. Coru_bt_sum, & ! The summed zonal barotropic Coriolis acceleration [L T-2 ~> m s-2]. - DCor_u, & ! An averaged depth or total thickness at u points [Z ~> m] or [H ~> m or kg m-2]. + DCor_u, & ! An averaged total thickness at u points [H ~> m or kg m-2]. Datu ! Basin depth at u-velocity grid points times the y-grid ! spacing [H L ~> m2 or kg m-1]. real, dimension(SZIW_(CS),SZJBW_(CS)) :: & @@ -578,7 +582,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, ! [L T-2 ~> m s-2]. Corv_bt_sum, & ! The summed meridional barotropic Coriolis acceleration, ! [L T-2 ~> m s-2]. - DCor_v, & ! An averaged depth or total thickness at v points [Z ~> m] or [H ~> m or kg m-2]. + DCor_v, & ! An averaged total thickness at v points [H ~> m or kg m-2]. Datv ! Basin depth at v-velocity grid points times the x-grid ! spacing [H L ~> m2 or kg m-1]. real, target, dimension(SZIW_(CS),SZJW_(CS)) :: & @@ -626,7 +630,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, vhbt_prev, vhbt_sum_prev, & ! Previous transports stored for OBCs [L2 H T-1 ~> m3 s-1] vbt_int_prev, & ! Previous value of time-integrated velocity stored for OBCs [L ~> m] vhbt_int_prev ! Previous value of time-integrated transport stored for OBCs [L2 H ~> m3] - real :: mass_to_Z ! The inverse of the the mean density (Rho0) [R-1 ~> m3 kg-1] real :: visc_rem ! A work variable that may equal visc_rem_[uv] [nondim] real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. real :: dtbt ! The barotropic time step [T ~> s]. @@ -664,6 +667,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: dyn_coef_max ! The maximum stable value of dyn_coef_eta ! [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1]. real :: ice_strength = 0.0 ! The effective strength of the ice [L2 Z-1 T-2 ~> m s-2]. + real :: H_to_Z ! A local unit conversion factor used with rigid ice [Z H-1 ~> nondim or m3 kg-1] real :: Idt_max2 ! The squared inverse of the local maximum stable ! barotropic time step [T-2 ~> s-2]. real :: H_min_dyn ! The minimum depth to use in limiting the size of the @@ -778,7 +782,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, jsvf = js - (num_cycles-1)*stencil ; jevf = je + (num_cycles-1)*stencil nstep = CEILING(dt/CS%dtbt - 0.0001) - if (is_root_PE() .and. (nstep /= CS%nstep_last)) then + if (is_root_PE() .and. ((nstep /= CS%nstep_last) .or. CS%debug)) then write(mesg,'("btstep is using a dynamic barotropic timestep of ", ES12.6, & & " seconds, max ", ES12.6, ".")') (US%T_to_s*dt/nstep), US%T_to_s*CS%dtbt_max call MOM_mesg(mesg, 3) @@ -791,7 +795,6 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, Idtbt = 1.0 / dtbt bebt = CS%bebt be_proj = CS%bebt - mass_to_Z = 1.0 / GV%Rho0 !--- setup the weight when computing vbt_trans and ubt_trans if (project_velocity) then @@ -1275,17 +1278,17 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (Htot_avg*CS%dy_Cu(I,j) <= 0.0) then CS%IDatu(I,j) = 0.0 elseif (integral_BT_cont) then - CS%IDatu(I,j) = GV%Z_to_H * CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j)*dt, BTCL_u(I,j)), & + CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j)*dt, BTCL_u(I,j)), & CS%dy_Cu(I,j)*Htot_avg) ) elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling. - CS%IDatu(I,j) = GV%Z_to_H * CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j), BTCL_u(I,j)), & + CS%IDatu(I,j) = CS%dy_Cu(I,j) / (max(find_duhbt_du(ubt(I,j), BTCL_u(I,j)), & CS%dy_Cu(I,j)*Htot_avg) ) else - CS%IDatu(I,j) = GV%Z_to_H / Htot_avg + CS%IDatu(I,j) = 1.0 / Htot_avg endif endif - BT_force_u(I,j) = forces%taux(I,j) * mass_to_Z * CS%IDatu(I,j)*visc_rem_u(I,j,1) + BT_force_u(I,j) = forces%taux(I,j) * GV%RZ_to_H * CS%IDatu(I,j)*visc_rem_u(I,j,1) else BT_force_u(I,j) = 0.0 endif ; enddo ; enddo @@ -1301,28 +1304,28 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (Htot_avg*CS%dx_Cv(i,J) <= 0.0) then CS%IDatv(i,J) = 0.0 elseif (integral_BT_cont) then - CS%IDatv(i,J) = GV%Z_to_H * CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J)*dt, BTCL_v(i,J)), & + CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J)*dt, BTCL_v(i,J)), & CS%dx_Cv(i,J)*Htot_avg) ) elseif (use_BT_cont) then ! Reconsider the max and whether there should be some scaling. - CS%IDatv(i,J) = GV%Z_to_H * CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J), BTCL_v(i,J)), & + CS%IDatv(i,J) = CS%dx_Cv(i,J) / (max(find_dvhbt_dv(vbt(i,J), BTCL_v(i,J)), & CS%dx_Cv(i,J)*Htot_avg) ) else - CS%IDatv(i,J) = GV%Z_to_H / Htot_avg + CS%IDatv(i,J) = 1.0 / Htot_avg endif endif - BT_force_v(i,J) = forces%tauy(i,J) * mass_to_Z * CS%IDatv(i,J)*visc_rem_v(i,J,1) + BT_force_v(i,J) = forces%tauy(i,J) * GV%RZ_to_H * CS%IDatv(i,J)*visc_rem_v(i,J,1) else BT_force_v(i,J) = 0.0 endif ; enddo ; enddo if (associated(taux_bot) .and. associated(tauy_bot)) then !$OMP parallel do default(shared) do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0.0) then - BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * mass_to_Z * CS%IDatu(I,j) + BT_force_u(I,j) = BT_force_u(I,j) - taux_bot(I,j) * GV%RZ_to_H * CS%IDatu(I,j) endif ; enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then - BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * mass_to_Z * CS%IDatv(i,J) + BT_force_v(i,J) = BT_force_v(i,J) - tauy_bot(i,J) * GV%RZ_to_H * CS%IDatv(i,J) endif ; enddo ; enddo endif @@ -1595,10 +1598,15 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (CS%dynamic_psurf) then ice_is_rigid = (associated(forces%rigidity_ice_u) .and. & associated(forces%rigidity_ice_v)) - H_min_dyn = GV%Z_to_H * CS%Dmin_dyn_psurf + H_min_dyn = CS%Dmin_dyn_psurf if (ice_is_rigid .and. use_BT_cont) & call BT_cont_to_face_areas(BT_cont, Datu, Datv, G, US, MS, halo=0) if (ice_is_rigid) then + if (GV%Boussinesq) then + H_to_Z = GV%H_to_Z + else + H_to_Z = GV%H_to_RZ / CS%Rho_BT_lin + endif !$OMP parallel do default(shared) private(Idt_max2,H_eff_dx2,dyn_coef_max,ice_strength) do j=js,je ; do i=is,ie ! First determine the maximum stable value for dyn_coef_eta. @@ -1626,7 +1634,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, (CS%ice_strength_length**2 * dtbt) ! Units of dyn_coef: [L2 T-2 H-1 ~> m s-2 or m4 s-2 kg-1] - dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * GV%H_to_Z) + dyn_coef_eta(i,j) = min(dyn_coef_max, ice_strength * H_to_Z) enddo ; enddo ; endif endif @@ -1681,9 +1689,11 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, symmetric=.true., omit_corners=.true., scalar_pair=.true.) call uvchksum("BT frhat[uv]", CS%frhatu, CS%frhatv, G%HI, haloshift=0, & symmetric=.true., omit_corners=.true., scalar_pair=.true.) + call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, haloshift=0, & + symmetric=.true., omit_corners=.true., scalar_pair=.true.) call uvchksum("BT bc_accel_[uv]", bc_accel_u, bc_accel_v, G%HI, haloshift=0, scale=US%L_T2_to_m_s2) call uvchksum("BT IDat[uv]", CS%IDatu, CS%IDatv, G%HI, haloshift=0, & - scale=US%m_to_Z, scalar_pair=.true.) + scale=GV%m_to_H, scalar_pair=.true.) call uvchksum("BT visc_rem_[uv]", visc_rem_u, visc_rem_v, G%HI, & haloshift=1, scalar_pair=.true.) endif @@ -2772,7 +2782,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) !! the effective open face areas as a !! function of barotropic flow. real, optional, intent(in) :: gtot_est !< An estimate of the total gravitational - !! acceleration [L2 Z-1 T-2 ~> m s-2]. + !! acceleration [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. real, optional, intent(in) :: SSH_add !< An additional contribution to SSH to !! provide a margin of error when !! calculating the external wave speed [Z ~> m]. @@ -2817,6 +2827,7 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke MS%isdw = G%isd ; MS%iedw = G%ied ; MS%jsdw = G%jsd ; MS%jedw = G%jed + if (.not.(present(pbce) .or. present(gtot_est))) call MOM_error(FATAL, & "set_dtbt: Either pbce or gtot_est must be present.") @@ -2853,8 +2864,8 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) enddo ; enddo ; enddo else do j=js,je ; do i=is,ie - gtot_E(i,j) = gtot_est * GV%H_to_Z ; gtot_W(i,j) = gtot_est * GV%H_to_Z - gtot_N(i,j) = gtot_est * GV%H_to_Z ; gtot_S(i,j) = gtot_est * GV%H_to_Z + gtot_E(i,j) = gtot_est ; gtot_W(i,j) = gtot_est + gtot_N(i,j) = gtot_est ; gtot_S(i,j) = gtot_est enddo ; enddo endif @@ -2876,6 +2887,12 @@ subroutine set_dtbt(G, GV, US, CS, eta, pbce, BT_cont, gtot_est, SSH_add) CS%dtbt = CS%dtbt_fraction * dtbt_max CS%dtbt_max = dtbt_max + + if (CS%debug) then + call chksum0(CS%dtbt, "End set_dtbt dtbt", scale=US%T_to_s) + call chksum0(CS%dtbt_max, "End set_dtbt dtbt_max", scale=US%T_to_s) + endif + end subroutine set_dtbt !> The following 4 subroutines apply the open boundary conditions. @@ -3342,6 +3359,7 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) ! around a u-point (positive upward) [H ~> m or kg m-2] real :: D_shallow_v(SZIB_(G))! The height of the shallower of the adjacent bathymetric depths ! around a v-point (positive upward) [H ~> m or kg m-2] + real :: Z_to_H ! A local conversion factor [H Z-1 ~> nondim or kg m-3] real :: htot ! The sum of the layer thicknesses [H ~> m or kg m-2]. real :: Ihtot ! The inverse of htot [H-1 ~> m-1 or m2 kg-1]. @@ -3383,9 +3401,9 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) ! This estimates the fractional thickness of each layer at the velocity ! points, using a harmonic mean estimate. -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h_u,CS,h_neglect,h,use_default,G,GV) & -!$OMP private(hatutot,Ihatutot,e_u,D_shallow_u,h_arith,h_harm,wt_arith) + !$OMP parallel do default(none) shared(is,ie,js,je,nz,h_u,CS,h_neglect,h,use_default,G,GV) & + !$OMP private(hatutot,Ihatutot,e_u,D_shallow_u,h_arith,h_harm,wt_arith,Z_to_H) do j=js,je if (present(h_u)) then do I=is-1,ie ; hatutot(I) = h_u(I,j,1) ; enddo @@ -3407,9 +3425,10 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) hatutot(I) = hatutot(I) + CS%frhatu(I,j,k) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then + Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin do I=is-1,ie - e_u(I,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) - D_shallow_u(I) = -GV%Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) + e_u(I,nz+1) = -0.5 * Z_to_H * (G%bathyT(i+1,j) + G%bathyT(i,j)) + D_shallow_u(I) = -Z_to_H * min(G%bathyT(i+1,j), G%bathyT(i,j)) hatutot(I) = 0.0 enddo do k=nz,1,-1 ; do I=is-1,ie @@ -3447,8 +3466,8 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) endif enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,G,GV,h_v,h_neglect,h,use_default) & -!$OMP private(hatvtot,Ihatvtot,e_v,D_shallow_v,h_arith,h_harm,wt_arith) + !$OMP parallel do default(none) shared(is,ie,js,je,nz,CS,G,GV,h_v,h_neglect,h,use_default) & + !$OMP private(hatvtot,Ihatvtot,e_v,D_shallow_v,h_arith,h_harm,wt_arith,Z_to_H) do J=js-1,je if (present(h_v)) then do i=is,ie ; hatvtot(i) = h_v(i,J,1) ; enddo @@ -3470,9 +3489,10 @@ subroutine btcalc(h, G, GV, CS, h_u, h_v, may_use_default, OBC) hatvtot(i) = hatvtot(i) + CS%frhatv(i,J,k) enddo ; enddo elseif (CS%hvel_scheme == HYBRID .or. use_default) then + Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin do i=is,ie - e_v(i,nz+1) = -0.5 * GV%Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) - D_shallow_v(I) = -GV%Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) + e_v(i,nz+1) = -0.5 * Z_to_H * (G%bathyT(i,j+1) + G%bathyT(i,j)) + D_shallow_v(I) = -Z_to_H * min(G%bathyT(i,j+1), G%bathyT(i,j)) hatvtot(I) = 0.0 enddo do k=nz,1,-1 ; do i=is,ie @@ -4140,23 +4160,23 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) ! Local variables real :: H1, H2 ! Temporary total thicknesses [H ~> m or kg m-2]. + real :: Z_to_H ! A local conversion factor [H Z-1 ~> nondim or kg m-3] integer :: i, j, is, ie, js, je, hs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec hs = max(halo,0) -!$OMP parallel default(none) shared(is,ie,js,je,hs,eta,GV,G,CS,Datu,Datv,add_max) & -!$OMP private(H1,H2) + !$OMP parallel default(shared) private(H1,H2,Z_to_H) if (present(eta)) then ! The use of harmonic mean thicknesses ensure positive definiteness. if (GV%Boussinesq) then -!$OMP do + !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i+1,j)*GV%Z_to_H + eta(i+1,j) Datu(I,j) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (H1 + H2) enddo ; enddo -!$OMP do + !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs H1 = CS%bathyT(i,j)*GV%Z_to_H + eta(i,j) ; H2 = CS%bathyT(i,j+1)*GV%Z_to_H + eta(i,j+1) Datv(i,J) = 0.0 ; if ((H1 > 0.0) .and. (H2 > 0.0)) & @@ -4164,14 +4184,14 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) ! Datv(i,J) = CS%dy_v(i,J) * 0.5 * (H1 + H2) enddo ; enddo else -!$OMP do + !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs Datu(I,j) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i+1,j) > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * eta(i,j) * eta(i+1,j)) / & (eta(i,j) + eta(i+1,j)) ! Datu(I,j) = CS%dy_Cu(I,j) * 0.5 * (eta(i,j) + eta(i+1,j)) enddo ; enddo -!$OMP do + !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs Datv(i,J) = 0.0 ; if ((eta(i,j) > 0.0) .and. (eta(i,j+1) > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * eta(i,j) * eta(i,j+1)) / & @@ -4180,33 +4200,37 @@ subroutine find_face_areas(Datu, Datv, G, GV, US, CS, MS, halo, eta, add_max) enddo ; enddo endif elseif (present(add_max)) then -!$OMP do + Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin + + !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - Datu(I,j) = CS%dy_Cu(I,j) * GV%Z_to_H * & + Datu(I,j) = CS%dy_Cu(I,j) * Z_to_H * & max(max(CS%bathyT(i+1,j), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0) enddo ; enddo -!$OMP do + !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - Datv(i,J) = CS%dx_Cv(i,J) * GV%Z_to_H * & + Datv(i,J) = CS%dx_Cv(i,J) * Z_to_H * & max(max(CS%bathyT(i,j+1), CS%bathyT(i,j)) + (G%Z_ref + add_max), 0.0) enddo ; enddo else -!$OMP do + Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin + + !$OMP do do j=js-hs,je+hs ; do I=is-1-hs,ie+hs - H1 = (CS%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ; H2 = (CS%bathyT(i+1,j) + G%Z_ref) * GV%Z_to_H + H1 = (CS%bathyT(i,j) + G%Z_ref) * Z_to_H ; H2 = (CS%bathyT(i+1,j) + G%Z_ref) * Z_to_H Datu(I,j) = 0.0 if ((H1 > 0.0) .and. (H2 > 0.0)) & Datu(I,j) = CS%dy_Cu(I,j) * (2.0 * H1 * H2) / (H1 + H2) enddo ; enddo -!$OMP do + !$OMP do do J=js-1-hs,je+hs ; do i=is-hs,ie+hs - H1 = (CS%bathyT(i,j) + G%Z_ref) * GV%Z_to_H ; H2 = (CS%bathyT(i,j+1) + G%Z_ref) * GV%Z_to_H + H1 = (CS%bathyT(i,j) + G%Z_ref) * Z_to_H ; H2 = (CS%bathyT(i,j+1) + G%Z_ref) * Z_to_H Datv(i,J) = 0.0 if ((H1 > 0.0) .and. (H2 > 0.0)) & Datv(i,J) = CS%dx_Cv(i,J) * (2.0 * H1 * H2) / (H1 + H2) enddo ; enddo endif -!$OMP end parallel + !$OMP end parallel end subroutine find_face_areas @@ -4306,13 +4330,14 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, character(len=40) :: mdl = "MOM_barotropic" ! This module's name. real :: Datu(SZIBS_(G),SZJ_(G)) ! Zonal open face area [H L ~> m2 or kg m-1]. real :: Datv(SZI_(G),SZJBS_(G)) ! Meridional open face area [H L ~> m2 or kg m-1]. - real :: gtot_estimate ! Summed GV%g_prime [L2 Z-1 T-2 ~> m s-2], to give an upper-bound estimate for pbce. + real :: gtot_estimate ! Summed GV%g_prime [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2], to give an + ! upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use ! in calculating the safe external wave speed [Z ~> m]. real :: dtbt_input ! The input value of DTBT, [nondim] if negative or [s] if positive. real :: dtbt_tmp ! A temporary copy of CS%dtbt read from a restart file [T ~> s] real :: wave_drag_scale ! A scaling factor for the barotropic linear wave drag - ! piston velocities. + ! piston velocities [nondim]. character(len=200) :: inputdir ! The directory in which to find input files. character(len=200) :: wave_drag_file ! The file from which to read the wave ! drag piston velocity. @@ -4320,11 +4345,13 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! name in wave_drag_file. real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. + real :: Z_to_H ! A local unit conversion factor [H Z-1 ~> nondim or kg m-3] + real :: H_to_Z ! A local unit conversion factor [Z H-1 ~> nondim or m3 kg-1] real :: det_de ! The partial derivative due to self-attraction and loading of the reference ! geopotential with the sea surface height when tides are enabled [nondim]. ! This is typically ~0.09 or less. real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points - ! that acts on the barotropic flow [Z T-1 ~> m s-1]. + ! that acts on the barotropic flow [H T-1 ~> m s-1 or kg m-2 s-1]. type(memory_size_type) :: MS type(group_pass_type) :: pass_static_data, pass_q_D_Cor @@ -4444,6 +4471,13 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "If true, use the full depth of the ocean at the start of the barotropic "//& "step when calculating the surface stress contribution to the barotropic "//& "acclerations. Otherwise use the depth based on bathyT.", default=.false.) + call get_param(param_file, mdl, "BT_RHO_LINEARIZED", CS%Rho_BT_lin, & + "A density that is used to convert total water column thicknesses into mass "//& + "in non-Boussinesq mode with linearized options in the barotropic solver or "//& + "when estimating the stable barotropic timestep without access to the full "//& + "baroclinic model state.", & + units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R, & + do_not_log=GV%Boussinesq) call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, & "If true, add a dynamic pressure due to a viscous ice "//& @@ -4457,7 +4491,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "The minimum depth to use in limiting the size of the "//& "dynamic surface pressure for stability, if "//& "DYNAMIC_SURFACE_PRESSURE is true..", & - units="m", default=1.0e-6, scale=US%m_to_Z, do_not_log=.not.CS%dynamic_psurf) + units="m", default=1.0e-6, scale=GV%m_to_H, do_not_log=.not.CS%dynamic_psurf) call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, & "The constant that scales the dynamic surface pressure, "//& "if DYNAMIC_SURFACE_PRESSURE is true. Stable values "//& @@ -4471,20 +4505,23 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "BAROTROPIC_2018_ANSWERS", answers_2018, & "If true, use expressions for the barotropic solver that recover the answers "//& "from the end of 2018. Otherwise, use more efficient or general expressions.", & - default=default_2018_answers) + default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "BAROTROPIC_ANSWER_DATE", CS%answer_date, & "The vintage of the expressions in the barotropic solver. "//& "Values below 20190101 recover the answers from the end of 2018, "//& "while higher values uuse more efficient or general expressions. "//& "If both BAROTROPIC_2018_ANSWERS and BAROTROPIC_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) @@ -4729,21 +4766,23 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ALLOC_(CS%D_v_Cor(CS%isdw:CS%iedw,CS%jsdw-1:CS%jedw)) CS%q_D(:,:) = 0.0 ; CS%D_u_Cor(:,:) = 0.0 ; CS%D_v_Cor(:,:) = 0.0 + Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin + Mean_SL = G%Z_ref do j=js,je ; do I=is-1,ie - CS%D_u_Cor(I,j) = 0.5 * (max(Mean_SL+G%bathyT(i+1,j),0.0) + max(Mean_SL+G%bathyT(i,j),0.0)) + CS%D_u_Cor(I,j) = 0.5 * (max(Mean_SL+G%bathyT(i+1,j),0.0) + max(Mean_SL+G%bathyT(i,j),0.0)) * Z_to_H enddo ; enddo do J=js-1,je ; do i=is,ie - CS%D_v_Cor(i,J) = 0.5 * (max(Mean_SL+G%bathyT(i,j+1),0.0) + max(Mean_SL+G%bathyT(i,j),0.0)) + CS%D_v_Cor(i,J) = 0.5 * (max(Mean_SL+G%bathyT(i,j+1),0.0) + max(Mean_SL+G%bathyT(i,j),0.0)) * Z_to_H enddo ; enddo do J=js-1,je ; do I=is-1,ie if (G%mask2dT(i,j)+G%mask2dT(i,j+1)+G%mask2dT(i+1,j)+G%mask2dT(i+1,j+1)>0.) then CS%q_D(I,J) = 0.25 * (CS%BT_Coriolis_scale * G%CoriolisBu(I,J)) * & ((G%areaT(i,j) + G%areaT(i+1,j+1)) + (G%areaT(i+1,j) + G%areaT(i,j+1))) / & - (max(((G%areaT(i,j) * max(Mean_SL+G%bathyT(i,j),0.0) + & - G%areaT(i+1,j+1) * max(Mean_SL+G%bathyT(i+1,j+1),0.0)) + & - (G%areaT(i+1,j) * max(Mean_SL+G%bathyT(i+1,j),0.0) + & - G%areaT(i,j+1) * max(Mean_SL+G%bathyT(i,j+1),0.0))), GV%H_to_Z*GV%H_subroundoff) ) + (Z_to_H * max(((G%areaT(i,j) * max(Mean_SL+G%bathyT(i,j),0.0) + & + G%areaT(i+1,j+1) * max(Mean_SL+G%bathyT(i+1,j+1),0.0)) + & + (G%areaT(i+1,j) * max(Mean_SL+G%bathyT(i+1,j),0.0) + & + G%areaT(i,j+1) * max(Mean_SL+G%bathyT(i,j+1),0.0))), GV%H_subroundoff) ) else ! All four h points are masked out so q_D(I,J) will is meaningless CS%q_D(I,J) = 0. endif @@ -4767,15 +4806,13 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, allocate(lin_drag_h(isd:ied,jsd:jed), source=0.0) - call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=US%m_to_Z*US%T_to_s) + call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=GV%m_to_H*US%T_to_s) call pass_var(lin_drag_h, G%Domain) do j=js,je ; do I=is-1,ie - CS%lin_drag_u(I,j) = (GV%Z_to_H * wave_drag_scale) * & - 0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j)) + CS%lin_drag_u(I,j) = wave_drag_scale * 0.5 * (lin_drag_h(i,j) + lin_drag_h(i+1,j)) enddo ; enddo do J=js-1,je ; do i=is,ie - CS%lin_drag_v(i,J) = (GV%Z_to_H * wave_drag_scale) * & - 0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1)) + CS%lin_drag_v(i,J) = wave_drag_scale * 0.5 * (lin_drag_h(i,j) + lin_drag_h(i,j+1)) enddo ; enddo deallocate(lin_drag_h) endif @@ -4790,7 +4827,12 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, ! Estimate the maximum stable barotropic time step. gtot_estimate = 0.0 - do k=1,GV%ke ; gtot_estimate = gtot_estimate + GV%g_prime(K) ; enddo + if (GV%Boussinesq) then + do k=1,GV%ke ; gtot_estimate = gtot_estimate + GV%H_to_Z*GV%g_prime(K) ; enddo + else + H_to_Z = GV%H_to_RZ / CS%Rho_BT_lin + do k=1,GV%ke ; gtot_estimate = gtot_estimate + H_to_Z*GV%g_prime(K) ; enddo + endif call set_dtbt(G, GV, US, CS, gtot_est=gtot_estimate, SSH_add=SSH_extra) if (dtbt_input > 0.0) then @@ -4957,16 +4999,17 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, if (.not.CS%nonlin_stress) then Mean_SL = G%Z_ref + Z_to_H = GV%Z_to_H ; if (.not.GV%Boussinesq) Z_to_H = GV%RZ_to_H * CS%Rho_BT_lin do j=js,je ; do I=is-1,ie if (G%mask2dCu(I,j)>0.) then - CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / ((G%bathyT(i+1,j) + G%bathyT(i,j)) + 2.0*Mean_SL) + CS%IDatu(I,j) = G%mask2dCu(I,j) * 2.0 / (Z_to_H * ((G%bathyT(i+1,j) + G%bathyT(i,j)) + 2.0*Mean_SL)) else ! Both neighboring H points are masked out so IDatu(I,j) is meaningless CS%IDatu(I,j) = 0. endif enddo ; enddo do J=js-1,je ; do i=is,ie if (G%mask2dCv(i,J)>0.) then - CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / ((G%bathyT(i,j+1) + G%bathyT(i,j)) + 2.0*Mean_SL) + CS%IDatv(i,J) = G%mask2dCv(i,J) * 2.0 / (Z_to_H * ((G%bathyT(i,j+1) + G%bathyT(i,j)) + 2.0*Mean_SL)) else ! Both neighboring H points are masked out so IDatv(i,J) is meaningless CS%IDatv(i,J) = 0. endif diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 090d1ee0fb..73c6503242 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -378,9 +378,9 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are dx_E = ratio_max(G%areaT(i+1,j), G%dy_Cu(I,j), 1000.0*G%dxT(i+1,j)) else ; dx_W = G%dxT(i,j) ; dx_E = G%dxT(i+1,j) ; endif - if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)) & + if (du_max_CFL(I) * visc_rem(I,k) > dx_W*CFL_dt - u(I,j,k)*G%mask2dCu(I,j)) & du_max_CFL(I) = (dx_W*CFL_dt - u(I,j,k)) / visc_rem(I,k) - if (du_min_CFL(I) * visc_rem(I,k) < -dx_E*CFL_dt - u(I,j,k)) & + if (du_min_CFL(I) * visc_rem(I,k) < -dx_E*CFL_dt - u(I,j,k)*G%mask2dCu(I,j)) & du_min_CFL(I) = -(dx_E*CFL_dt + u(I,j,k)) / visc_rem(I,k) enddo ; enddo endif @@ -1201,9 +1201,9 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac dy_S = ratio_max(G%areaT(i,j), G%dx_Cv(I,j), 1000.0*G%dyT(i,j)) dy_N = ratio_max(G%areaT(i,j+1), G%dx_Cv(I,j), 1000.0*G%dyT(i,j+1)) else ; dy_S = G%dyT(i,j) ; dy_N = G%dyT(i,j+1) ; endif - if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)) & + if (dv_max_CFL(i) * visc_rem(i,k) > dy_S*CFL_dt - v(i,J,k)*G%mask2dCv(i,J)) & dv_max_CFL(i) = (dy_S*CFL_dt - v(i,J,k)) / visc_rem(i,k) - if (dv_min_CFL(i) * visc_rem(i,k) < -dy_N*CFL_dt - v(i,J,k)) & + if (dv_min_CFL(i) * visc_rem(i,k) < -dy_N*CFL_dt - v(i,J,k)*G%mask2dCv(i,J)) & dv_min_CFL(i) = -(dy_N*CFL_dt + v(i,J,k)) / visc_rem(i,k) enddo ; enddo endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 5ce9ec8962..eebb7d6b8a 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -481,7 +481,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s Use_Stokes_PGF = associated(Waves) if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF if (Use_Stokes_PGF) then - call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1) + call Stokes_PGF(G, GV, US, dz, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) ! We are adding Stokes_PGF to hydrostatic PGF here. The diag PFu/PFv ! will therefore report the sum total PGF and we avoid other @@ -748,7 +749,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s Use_Stokes_PGF = associated(Waves) if (Use_Stokes_PGF) Use_Stokes_PGF = Waves%Stokes_PGF if (Use_Stokes_PGF) then - call Stokes_PGF(G, GV, h, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) + call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1) + call Stokes_PGF(G, GV, US, dz, u, v, CS%PFu_Stokes, CS%PFv_Stokes, Waves) if (.not.Waves%Passive_Stokes_PGF) then do k=1,nz do j=js,je ; do I=Isq,Ieq diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 4897771100..f4e9960cd8 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -11,7 +11,7 @@ module MOM_forcing_type use MOM_diag_mediator, only : post_data, register_diag_field, register_scalar_field use MOM_diag_mediator, only : time_type, diag_ctrl, safe_alloc_alloc, query_averaging_enabled use MOM_diag_mediator, only : enable_averages, disable_averaging -use MOM_EOS, only : calculate_density_derivs, EOS_domain +use MOM_EOS, only : calculate_density_derivs, calculate_specific_vol_derivs, EOS_domain use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type @@ -29,7 +29,7 @@ module MOM_forcing_type public extractFluxes1d, extractFluxes2d, optics_type public MOM_forcing_chksum, MOM_mech_forcing_chksum -public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d +public calculateBuoyancyFlux1d, calculateBuoyancyFlux2d, find_ustar public forcing_accumulate, fluxes_accumulate public forcing_SinglePointPrint, mech_forcing_diags, forcing_diagnostics public register_forcing_type_diags, allocate_forcing_type, deallocate_forcing_type @@ -53,6 +53,12 @@ module MOM_forcing_type module procedure allocate_mech_forcing_from_ref end interface allocate_mech_forcing +!> Determine the friction velocity from a forcing type or a mechanical forcing type. +interface find_ustar + module procedure find_ustar_fluxes + module procedure find_ustar_mech_forcing +end interface find_ustar + ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional ! consistency testing. These are noted in comments with units like Z, H, L, and T, along with ! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units @@ -72,8 +78,11 @@ module MOM_forcing_type tau_mag => NULL(), & !< Magnitude of the wind stress averaged over tracer cells, !! including any contributions from sub-gridscale variability !! or gustiness [R L Z T-2 ~> Pa] - ustar_gustless => NULL() !< surface friction velocity scale without any + ustar_gustless => NULL(), & !< surface friction velocity scale without any !! any augmentation for gustiness [Z T-1 ~> m s-1]. + tau_mag_gustless => NULL() !< Magnitude of the wind stress averaged over tracer cells, + !! without any augmentation for sub-gridscale variability + !! or gustiness [R L Z T-2 ~> Pa] ! surface buoyancy force, used when temperature is not a state variable real, pointer, dimension(:,:) :: & @@ -135,8 +144,10 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & salt_flux => NULL(), & !< net salt flux into the ocean [R Z T-1 ~> kgSalt m-2 s-1] salt_flux_in => NULL(), & !< salt flux provided to the ocean from coupler [R Z T-1 ~> kgSalt m-2 s-1] - salt_flux_added => NULL() !< additional salt flux from restoring or flux adjustment before adjustment + salt_flux_added => NULL(), & !< additional salt flux from restoring or flux adjustment before adjustment !! to net zero [R Z T-1 ~> kgSalt m-2 s-1] + salt_left_behind => NULL() !< salt left in ocean at the surface from brine rejection + !! [R Z T-1 ~> kgSalt m-2 s-1] ! applied surface pressure from other component models (e.g., atmos, sea ice, land ice) real, pointer, dimension(:,:) :: p_surf_full => NULL() @@ -746,15 +757,15 @@ subroutine extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, dt, & endif ! Salt fluxes - Net_salt(i) = 0.0 - if (do_NSR) Net_salt_rate(i) = 0.0 + net_salt(i) = 0.0 + if (do_NSR) net_salt_rate(i) = 0.0 ! Convert salt_flux from kg (salt)/(m^2 * s) to ! Boussinesq: (ppt * m) ! non-Bouss: (g/m^2) if (associated(fluxes%salt_flux)) then - Net_salt(i) = (scale * dt * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H + net_salt(i) = (scale * dt * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H !Repeat above code for 'rate' term - if (do_NSR) Net_salt_rate(i) = (scale * 1. * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H + if (do_NSR) net_salt_rate(i) = (scale * 1. * (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j))) * GV%RZ_to_H endif ! Diagnostics follow... @@ -981,13 +992,19 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt real, dimension(SZI_(G)) :: pressure ! pressure at the surface [R L2 T-2 ~> Pa] real, dimension(SZI_(G)) :: dRhodT ! density partial derivative wrt temp [R C-1 ~> kg m-3 degC-1] real, dimension(SZI_(G)) :: dRhodS ! density partial derivative wrt saln [R S-1 ~> kg m-3 ppt-1] + real, dimension(SZI_(G)) :: dSpV_dT ! Partial derivative of specific volume with respect + ! to temperature [R-1 C-1 ~> m3 kg-1 degC-1] + real, dimension(SZI_(G)) :: dSpV_dS ! Partial derivative of specific volume with respect + ! to salinity [R-1 S-1 ~> m3 kg-1 ppt-1] real, dimension(SZI_(G),SZK_(GV)+1) :: netPen ! The net penetrating shortwave radiation at each level ! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] logical :: useRiverHeatContent logical :: useCalvingHeatContent - real :: GoRho ! The gravitational acceleration divided by mean density times a - ! unit conversion factor [L2 H-1 R-1 T-2 ~> m4 kg-1 s-2 or m7 kg-2 s-2] + real :: GoRho ! The gravitational acceleration divided by mean density times a + ! unit conversion factor [L2 H-1 R-1 T-2 ~> m4 kg-1 s-2 or m7 kg-2 s-2] + real :: g_conv ! The gravitational acceleration times the conversion factors from non-Boussinesq + ! thickness units to mass per units area [R L2 H-1 T-2 ~> kg m-2 s-2 or m s-2] real :: H_limit_fluxes ! A depth scale that specifies when the ocean is shallow that ! it is necessary to eliminate fluxes [H ~> m or kg m-2] integer :: i, k @@ -997,9 +1014,6 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt useCalvingHeatContent = .False. H_limit_fluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) - pressure(:) = 0. - if (associated(tv%p_surf)) then ; do i=G%isc,G%iec ; pressure(i) = tv%p_surf(i,j) ; enddo ; endif - GoRho = (GV%g_Earth * GV%H_to_Z) / GV%Rho0 ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: @@ -1019,10 +1033,6 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt call sumSWoverBands(G, GV, US, h(:,j,:), dz, optics_nbands(optics), optics, j, 1.0, & H_limit_fluxes, .true., penSWbnd, netPen) - ! Density derivatives - call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dRhodT, dRhodS, & - tv%eqn_of_state, EOS_domain(G%HI)) - ! Adjust netSalt to reflect dilution effect of FW flux ! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] netSalt(G%isc:G%iec) = netSalt(G%isc:G%iec) - Salt(G%isc:G%iec,j,1) * netH(G%isc:G%iec) @@ -1033,13 +1043,41 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt !netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd, dim=1 ) netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1) - ! Convert to a buoyancy flux, excluding penetrating SW heating - buoyancyFlux(G%isc:G%iec,1) = - GoRho * ( dRhodS(G%isc:G%iec) * netSalt(G%isc:G%iec) + & - dRhodT(G%isc:G%iec) * netHeat(G%isc:G%iec) ) ! [L2 T-3 ~> m2 s-3] - ! We also have a penetrative buoyancy flux associated with penetrative SW - do k=2, GV%ke+1 - buoyancyFlux(G%isc:G%iec,k) = - GoRho * ( dRhodT(G%isc:G%iec) * netPen(G%isc:G%iec,k) ) ! [L2 T-3 ~> m2 s-3] - enddo + ! Determine the buoyancy flux + pressure(:) = 0. + if (associated(tv%p_surf)) then ; do i=G%isc,G%iec ; pressure(i) = tv%p_surf(i,j) ; enddo ; endif + + if ((.not.GV%Boussinesq) .and. (.not.GV%semi_Boussinesq)) then + g_conv = GV%g_Earth * GV%H_to_RZ + + ! Specific volume derivatives + call calculate_specific_vol_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dSpV_dT, dSpV_dS, & + tv%eqn_of_state, EOS_domain(G%HI)) + + ! Convert to a buoyancy flux [L2 T-3 ~> m2 s-3], first excluding penetrating SW heating + do i=G%isc,G%iec + buoyancyFlux(i,1) = g_conv * (dSpV_dS(i) * netSalt(i) + dSpV_dT(i) * netHeat(i)) + enddo + ! We also have a penetrative buoyancy flux associated with penetrative SW + do k=2,GV%ke+1 ; do i=G%isc,G%iec + buoyancyFlux(i,k) = g_conv * ( dSpV_dT(i) * netPen(i,k) ) ! [L2 T-3 ~> m2 s-3] + enddo ; enddo + else + GoRho = (GV%g_Earth * GV%H_to_Z) / GV%Rho0 + + ! Density derivatives + call calculate_density_derivs(Temp(:,j,1), Salt(:,j,1), pressure, dRhodT, dRhodS, & + tv%eqn_of_state, EOS_domain(G%HI)) + + ! Convert to a buoyancy flux [L2 T-3 ~> m2 s-3], excluding penetrating SW heating + do i=G%isc,G%iec + buoyancyFlux(i,1) = - GoRho * ( dRhodS(i) * netSalt(i) + dRhodT(i) * netHeat(i) ) + enddo + ! We also have a penetrative buoyancy flux associated with penetrative SW + do k=2,GV%ke+1 ; do i=G%isc,G%iec + buoyancyFlux(i,k) = - GoRho * ( dRhodT(i) * netPen(i,k) ) ! [L2 T-3 ~> m2 s-3] + enddo ; enddo + endif end subroutine calculateBuoyancyFlux1d @@ -1075,6 +1113,139 @@ subroutine calculateBuoyancyFlux2d(G, GV, US, fluxes, optics, h, Temp, Salt, tv, end subroutine calculateBuoyancyFlux2d +!> Determine the friction velocity from the contenxts of a forcing type, perhaps +!! using the evolving surface density. +subroutine find_ustar_fluxes(fluxes, tv, U_star, G, GV, US, halo, H_T_units) + 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 + type(forcing), intent(in) :: fluxes !< Surface fluxes container + type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any + !! available thermodynamic fields. + real, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: U_star !< The surface friction velocity [Z T-1 ~> m s-1] or + !! [H T-1 ~> m s-1 or kg m-2 s-1], depending on H_T_units. + integer, optional, intent(in) :: halo !< The extra halo size to fill in, 0 by default + logical, optional, intent(in) :: H_T_units !< If present and true, return U_star in units + !! of [H T-1 ~> m s-1 or kg m-2 s-1] + + ! Local variables + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] or in some semi-Boussinesq cases + ! the rescaled reference density [H2 Z-1 L-1 R-1 ~> m3 kg-1 or kg m-3] + logical :: Z_T_units ! If true, U_star is returned in units of [Z T-1 ~> m s-1], otherwise it is + ! returned in [H T-1 ~> m s-1 or kg m-2 s-1] + integer :: i, j, k, is, ie, js, je, hs + + hs = 0 ; if (present(halo)) hs = max(halo, 0) + is = G%isc - hs ; ie = G%iec + hs ; js = G%jsc - hs ; je = G%jec + hs + + Z_T_units = .true. ; if (present(H_T_units)) Z_T_units = .not.H_T_units + + if (.not.(associated(fluxes%ustar) .or. associated(fluxes%tau_mag))) & + call MOM_error(FATAL, "find_ustar_fluxes requires that either ustar or tau_mag be associated.") + + if (associated(fluxes%ustar) .and. (GV%Boussinesq .or. .not.associated(fluxes%tau_mag))) then + if (Z_T_units) then + do j=js,je ; do i=is,ie + U_star(i,j) = fluxes%ustar(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + U_star(i,j) = GV%Z_to_H * fluxes%ustar(i,j) + enddo ; enddo + endif + elseif (allocated(tv%SpV_avg)) then + if (tv%valid_SpV_halo < 0) call MOM_error(FATAL, & + "find_ustar_fluxes called in non-Boussinesq mode with invalid values of SpV_avg.") + if (tv%valid_SpV_halo < hs) call MOM_error(FATAL, & + "find_ustar_fluxes called in non-Boussinesq mode with insufficient valid values of SpV_avg.") + if (Z_T_units) then + do j=js,je ; do i=is,ie + U_star(i,j) = sqrt(US%L_to_Z*fluxes%tau_mag(i,j) * tv%SpV_avg(i,j,1)) + enddo ; enddo + else + do j=js,je ; do i=is,ie + U_star(i,j) = GV%RZ_to_H * sqrt(US%L_to_Z*fluxes%tau_mag(i,j) / tv%SpV_avg(i,j,1)) + enddo ; enddo + endif + else + I_rho = US%L_to_Z * GV%Z_to_H * GV%RZ_to_H + if (Z_T_units) I_rho = US%L_to_Z * GV%H_to_Z * GV%RZ_to_H ! == US%L_to_Z / GV%Rho0 + do j=js,je ; do i=is,ie + U_star(i,j) = sqrt(fluxes%tau_mag(i,j) * I_rho) + enddo ; enddo + endif + +end subroutine find_ustar_fluxes + + +!> Determine the friction velocity from the contenxts of a forcing type, perhaps +!! using the evolving surface density. +subroutine find_ustar_mech_forcing(forces, tv, U_star, G, GV, US, halo, H_T_units) + 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 + type(mech_forcing), intent(in) :: forces !< Surface forces container + type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any + !! available thermodynamic fields. + real, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: U_star !< The surface friction velocity [Z T-1 ~> m s-1] + integer, optional, intent(in) :: halo !< The extra halo size to fill in, 0 by default + logical, optional, intent(in) :: H_T_units !< If present and true, return U_star in units + !! of [H T-1 ~> m s-1 or kg m-2 s-1] + + ! Local variables + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] or in some semi-Boussinesq cases + ! the rescaled reference density [H2 Z-1 L-1 R-1 ~> m3 kg-1 or kg m-3] + logical :: Z_T_units ! If true, U_star is returned in units of [Z T-1 ~> m s-1], otherwise it is + ! returned in [H T-1 ~> m s-1 or kg m-2 s-1] + integer :: i, j, k, is, ie, js, je, hs + + hs = 0 ; if (present(halo)) hs = max(halo, 0) + is = G%isc - hs ; ie = G%iec + hs ; js = G%jsc - hs ; je = G%jec + hs + + Z_T_units = .true. ; if (present(H_T_units)) Z_T_units = .not.H_T_units + + if (.not.(associated(forces%ustar) .or. associated(forces%tau_mag))) & + call MOM_error(FATAL, "find_ustar_mech requires that either ustar or tau_mag be associated.") + + if (associated(forces%ustar) .and. (GV%Boussinesq .or. .not.associated(forces%tau_mag))) then + if (Z_T_units) then + do j=js,je ; do i=is,ie + U_star(i,j) = forces%ustar(i,j) + enddo ; enddo + else + do j=js,je ; do i=is,ie + U_star(i,j) = GV%Z_to_H * forces%ustar(i,j) + enddo ; enddo + endif + elseif (allocated(tv%SpV_avg)) then + if (tv%valid_SpV_halo < 0) call MOM_error(FATAL, & + "find_ustar_mech called in non-Boussinesq mode with invalid values of SpV_avg.") + if (tv%valid_SpV_halo < hs) call MOM_error(FATAL, & + "find_ustar_mech called in non-Boussinesq mode with insufficient valid values of SpV_avg.") + if (Z_T_units) then + do j=js,je ; do i=is,ie + U_star(i,j) = sqrt(US%L_to_Z*forces%tau_mag(i,j) * tv%SpV_avg(i,j,1)) + enddo ; enddo + else + do j=js,je ; do i=is,ie + U_star(i,j) = GV%RZ_to_H * sqrt(US%L_to_Z*forces%tau_mag(i,j) / tv%SpV_avg(i,j,1)) + enddo ; enddo + endif + else + I_rho = US%L_to_Z * GV%Z_to_H * GV%RZ_to_H + if (Z_T_units) I_rho = US%L_to_Z * GV%H_to_Z * GV%RZ_to_H ! == US%L_to_Z / GV%Rho0 + do j=js,je ; do i=is,ie + U_star(i,j) = sqrt(forces%tau_mag(i,j) * I_rho) + enddo ; enddo + endif + +end subroutine find_ustar_mech_forcing + + !> Write out chksums for thermodynamic fluxes. subroutine MOM_forcing_chksum(mesg, fluxes, G, US, haloshift) character(len=*), intent(in) :: mesg !< message @@ -1947,6 +2118,10 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, diag%axesT1,Time,'Salt flux into ocean at surface due to restoring or flux adjustment', & units='kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) + handles%id_saltFluxAdded = register_diag_field('ocean_model', 'salt_left_behind', & + diag%axesT1,Time,'Salt left in ocean at surface due to ice formation', & + units='kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) + handles%id_saltFluxGlobalAdj = register_scalar_field('ocean_model', & 'salt_flux_global_restoring_adjustment', Time, diag, & 'Adjustment needed to balance net global salt flux into ocean at surface', & @@ -2056,34 +2231,55 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) wt2 = 1.0 - wt1 ! = flux_tmp%dt_buoy_accum / (fluxes%dt_buoy_accum + flux_tmp%dt_buoy_accum) fluxes%dt_buoy_accum = fluxes%dt_buoy_accum + flux_tmp%dt_buoy_accum - ! Copy over the pressure fields and accumulate averages of ustar, either from the forcing + ! Copy over the pressure fields and accumulate averages of ustar or tau_mag, either from the forcing ! type or from the temporary fluxes type. if (present(forces)) then do j=js,je ; do i=is,ie fluxes%p_surf(i,j) = forces%p_surf(i,j) fluxes%p_surf_full(i,j) = forces%p_surf_full(i,j) + enddo ; enddo + if (associated(fluxes%ustar)) then ; do j=js,je ; do i=is,ie fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*forces%ustar(i,j) + enddo ; enddo ; endif + if (associated(fluxes%tau_mag)) then ; do j=js,je ; do i=is,ie fluxes%tau_mag(i,j) = wt1*fluxes%tau_mag(i,j) + wt2*forces%tau_mag(i,j) - enddo ; enddo + enddo ; enddo ; endif else do j=js,je ; do i=is,ie fluxes%p_surf(i,j) = flux_tmp%p_surf(i,j) fluxes%p_surf_full(i,j) = flux_tmp%p_surf_full(i,j) + enddo ; enddo + if (associated(fluxes%ustar)) then ; do j=js,je ; do i=is,ie fluxes%ustar(i,j) = wt1*fluxes%ustar(i,j) + wt2*flux_tmp%ustar(i,j) + enddo ; enddo ; endif + if (associated(fluxes%tau_mag)) then ; do j=js,je ; do i=is,ie fluxes%tau_mag(i,j) = wt1*fluxes%tau_mag(i,j) + wt2*flux_tmp%tau_mag(i,j) - enddo ; enddo + enddo ; enddo ; endif endif - ! Average the water, heat, and salt fluxes, and ustar. - do j=js,je ; do i=is,ie + ! Average ustar_gustless. + if (associated(fluxes%ustar_gustless)) then if (fluxes%gustless_accum_bug) then - fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j) + do j=js,je ; do i=is,ie + fluxes%ustar_gustless(i,j) = flux_tmp%ustar_gustless(i,j) + enddo ; enddo else - fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j) + do j=js,je ; do i=is,ie + fluxes%ustar_gustless(i,j) = wt1*fluxes%ustar_gustless(i,j) + wt2*flux_tmp%ustar_gustless(i,j) + enddo ; enddo endif + endif + if (associated(fluxes%tau_mag_gustless)) then + do j=js,je ; do i=is,ie + fluxes%tau_mag_gustless(i,j) = wt1*fluxes%tau_mag_gustless(i,j) + wt2*flux_tmp%tau_mag_gustless(i,j) + enddo ; enddo + endif + + ! Average the water, heat, and salt fluxes. + do j=js,je ; do i=is,ie fluxes%evap(i,j) = wt1*fluxes%evap(i,j) + wt2*flux_tmp%evap(i,j) fluxes%lprec(i,j) = wt1*fluxes%lprec(i,j) + wt2*flux_tmp%lprec(i,j) fluxes%fprec(i,j) = wt1*fluxes%fprec(i,j) + wt2*flux_tmp%fprec(i,j) @@ -2238,8 +2434,8 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) Irho0 = US%L_to_Z / Rho0 - if (associated(forces%taux) .and. associated(forces%tauy) .and. & - associated(fluxes%ustar_gustless)) then + if ( associated(forces%taux) .and. associated(forces%tauy) .and. & + (associated(fluxes%ustar_gustless) .or. associated(fluxes%tau_mag_gustless)) ) then do j=js,je ; do i=is,ie taux2 = 0.0 if ((G%mask2dCu(I-1,j) + G%mask2dCu(I,j)) > 0.0) & @@ -2252,11 +2448,16 @@ subroutine set_derived_forcing_fields(forces, fluxes, G, US, Rho0) G%mask2dCv(i,J) * forces%tauy(i,J)**2) / & (G%mask2dCv(i,J-1) + G%mask2dCv(i,J)) - if (fluxes%gustless_accum_bug) then - ! This change is just for computational efficiency, but it is wrapped with another change. - fluxes%ustar_gustless(i,j) = sqrt(US%L_to_Z * sqrt(taux2 + tauy2) / Rho0) - else - fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) + if (associated(fluxes%ustar_gustless)) then + if (fluxes%gustless_accum_bug) then + ! This change is just for computational efficiency, but it is wrapped with another change. + fluxes%ustar_gustless(i,j) = sqrt(US%L_to_Z * sqrt(taux2 + tauy2) / Rho0) + else + fluxes%ustar_gustless(i,j) = sqrt(sqrt(taux2 + tauy2) * Irho0) + endif + endif + if (associated(fluxes%tau_mag_gustless)) then + fluxes%tau_mag_gustless(i,j) = sqrt(taux2 + tauy2) endif enddo ; enddo endif @@ -3012,7 +3213,7 @@ end subroutine forcing_diagnostics !> Conditionally allocate fields within the forcing type subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & shelf, iceberg, salt, fix_accum_bug, cfc, waves, & - shelf_sfc_accumulation, lamult, hevap) + shelf_sfc_accumulation, lamult, hevap, tau_mag) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(forcing), intent(inout) :: fluxes !< A structure containing thermodynamic forcing fields logical, optional, intent(in) :: water !< If present and true, allocate water fluxes @@ -3033,6 +3234,7 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & logical, optional, intent(in) :: hevap !< If present and true, allocate heat content evap. !! This field must be allocated when enthalpy is provided !! via coupler. + logical, optional, intent(in) :: tau_mag !< If present and true, allocate tau_mag and related fields ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -3052,6 +3254,10 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & call myAlloc(fluxes%ustar_gustless,isd,ied,jsd,jed, ustar) call myAlloc(fluxes%tau_mag,isd,ied,jsd,jed, ustar) + ! Note that myAlloc can be called safely multiple times for the same pointer. + call myAlloc(fluxes%tau_mag,isd,ied,jsd,jed, tau_mag) + call myAlloc(fluxes%tau_mag_gustless,isd,ied,jsd,jed, tau_mag) + call myAlloc(fluxes%evap,isd,ied,jsd,jed, water) call myAlloc(fluxes%lprec,isd,ied,jsd,jed, water) call myAlloc(fluxes%fprec,isd,ied,jsd,jed, water) @@ -3112,20 +3318,20 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & if (present(fix_accum_bug)) fluxes%gustless_accum_bug = .not.fix_accum_bug end subroutine allocate_forcing_by_group - +!> Allocate elements of a new forcing type based on their status in an existing type. subroutine allocate_forcing_by_ref(fluxes_ref, G, fluxes) - type(forcing), intent(in) :: fluxes_ref !< Reference fluxes - type(ocean_grid_type), intent(in) :: G !< Grid metric of target fluxes - type(forcing), intent(out) :: fluxes !< Target fluxes + type(forcing), intent(in) :: fluxes_ref !< Reference fluxes + type(ocean_grid_type), intent(in) :: G !< Grid metric of target fluxes + type(forcing), intent(out) :: fluxes !< Target fluxes - logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & - do_iceberg, do_heat_added, do_buoy + logical :: do_ustar, do_taumag, do_water, do_heat, do_salt, do_press, do_shelf + logical :: do_iceberg, do_heat_added, do_buoy - call get_forcing_groups(fluxes_ref, do_water, do_heat, do_ustar, do_press, & + call get_forcing_groups(fluxes_ref, do_water, do_heat, do_ustar, do_taumag, do_press, & do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy) call allocate_forcing_type(G, fluxes, do_water, do_heat, do_ustar, & - do_press, do_shelf, do_iceberg, do_salt) + do_press, do_shelf, do_iceberg, do_salt, tau_mag=do_taumag) ! The following fluxes would typically be allocated by the driver call myAlloc(fluxes%sw_vis_dir, G%isd, G%ied, G%jsd, G%jed, & @@ -3164,7 +3370,7 @@ end subroutine allocate_forcing_by_ref !> Conditionally allocate fields within the mechanical forcing type using !! control flags. subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & - press, iceberg, waves, num_stk_bands) + press, iceberg, waves, num_stk_bands, tau_mag) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(mech_forcing), intent(inout) :: forces !< Forcing fields structure @@ -3175,6 +3381,7 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & logical, optional, intent(in) :: iceberg !< If present and true, allocate forces for icebergs logical, optional, intent(in) :: waves !< If present and true, allocate wave fields integer, optional, intent(in) :: num_stk_bands !< Number of Stokes bands to allocate + logical, optional, intent(in) :: tau_mag !< If present and true, allocate tau_mag ! Local variables integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -3187,6 +3394,8 @@ subroutine allocate_mech_forcing_by_group(G, forces, stress, ustar, shelf, & call myAlloc(forces%ustar,isd,ied,jsd,jed, ustar) call myAlloc(forces%tau_mag,isd,ied,jsd,jed, ustar) + ! Note that myAlloc can be called safely multiple times for the same pointer. + call myAlloc(forces%tau_mag,isd,ied,jsd,jed, tau_mag) call myAlloc(forces%p_surf,isd,ied,jsd,jed, press) call myAlloc(forces%p_surf_full,isd,ied,jsd,jed, press) @@ -3226,24 +3435,25 @@ subroutine allocate_mech_forcing_from_ref(forces_ref, G, forces) type(ocean_grid_type), intent(in) :: G !< Grid metric of target forcing type(mech_forcing), intent(out) :: forces !< Mechanical forcing fields - logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg + logical :: do_stress, do_ustar, do_tau_mag, do_shelf, do_press, do_iceberg ! Identify the active fields in the reference forcing - call get_mech_forcing_groups(forces_ref, do_stress, do_ustar, do_shelf, & - do_press, do_iceberg) + call get_mech_forcing_groups(forces_ref, do_stress, do_ustar, do_tau_mag, do_shelf, & + do_press, do_iceberg) call allocate_mech_forcing(G, forces, do_stress, do_ustar, do_shelf, & - do_press, do_iceberg) + do_press, do_iceberg, tau_mag=do_tau_mag) end subroutine allocate_mech_forcing_from_ref !> Return flags indicating which groups of forcings are allocated -subroutine get_forcing_groups(fluxes, water, heat, ustar, press, shelf, & +subroutine get_forcing_groups(fluxes, water, heat, ustar, tau_mag, press, shelf, & iceberg, salt, heat_added, buoy) type(forcing), intent(in) :: fluxes !< Reference flux fields logical, intent(out) :: water !< True if fluxes contains water-based fluxes logical, intent(out) :: heat !< True if fluxes contains heat-based fluxes - logical, intent(out) :: ustar !< True if fluxes contains ustar fluxes + logical, intent(out) :: ustar !< True if fluxes contains ustar + logical, intent(out) :: tau_mag !< True if fluxes contains tau_mag logical, intent(out) :: press !< True if fluxes contains surface pressure logical, intent(out) :: shelf !< True if fluxes contains ice shelf fields logical, intent(out) :: iceberg !< True if fluxes contains iceberg fluxes @@ -3256,6 +3466,7 @@ subroutine get_forcing_groups(fluxes, water, heat, ustar, press, shelf, & ! we handle them here as independent flags. ustar = associated(fluxes%ustar) .and. associated(fluxes%ustar_gustless) + tau_mag = associated(fluxes%tau_mag) .and. associated(fluxes%tau_mag_gustless) ! TODO: Check for all associated fields, but for now just check one as a marker water = associated(fluxes%evap) heat = associated(fluxes%seaice_melt_heat) @@ -3269,10 +3480,11 @@ end subroutine get_forcing_groups !> Return flags indicating which groups of mechanical forcings are allocated -subroutine get_mech_forcing_groups(forces, stress, ustar, shelf, press, iceberg) +subroutine get_mech_forcing_groups(forces, stress, ustar, tau_mag, shelf, press, iceberg) type(mech_forcing), intent(in) :: forces !< Reference forcing fields logical, intent(out) :: stress !< True if forces contains wind stress fields logical, intent(out) :: ustar !< True if forces contains ustar field + logical, intent(out) :: tau_mag !< True if forces contains tau_mag field logical, intent(out) :: shelf !< True if forces contains ice shelf fields logical, intent(out) :: press !< True if forces contains pressure fields logical, intent(out) :: iceberg !< True if forces contains iceberg fields @@ -3280,6 +3492,7 @@ subroutine get_mech_forcing_groups(forces, stress, ustar, shelf, press, iceberg) stress = associated(forces%taux) & .and. associated(forces%tauy) ustar = associated(forces%ustar) + tau_mag = associated(forces%tau_mag) shelf = associated(forces%rigidity_ice_u) & .and. associated(forces%rigidity_ice_v) & .and. associated(forces%frac_shelf_u) & @@ -3394,17 +3607,21 @@ subroutine rotate_forcing(fluxes_in, fluxes, turns) type(forcing), intent(inout) :: fluxes !< Rotated forcing structure integer, intent(in) :: turns !< Number of quarter turns - logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & + logical :: do_ustar, do_taumag, do_water, do_heat, do_salt, do_press, do_shelf, & do_iceberg, do_heat_added, do_buoy - call get_forcing_groups(fluxes_in, do_water, do_heat, do_ustar, do_press, & + call get_forcing_groups(fluxes_in, do_water, do_heat, do_ustar, do_taumag, do_press, & do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy) - if (do_ustar) then + if (associated(fluxes_in%ustar)) & call rotate_array(fluxes_in%ustar, turns, fluxes%ustar) + if (associated(fluxes_in%ustar_gustless)) & call rotate_array(fluxes_in%ustar_gustless, turns, fluxes%ustar_gustless) + + if (associated(fluxes_in%tau_mag)) & call rotate_array(fluxes_in%tau_mag, turns, fluxes%tau_mag) - endif + if (associated(fluxes_in%tau_mag_gustless)) & + call rotate_array(fluxes_in%tau_mag_gustless, turns, fluxes%tau_mag_gustless) if (do_water) then call rotate_array(fluxes_in%evap, turns, fluxes%evap) @@ -3525,19 +3742,19 @@ subroutine rotate_mech_forcing(forces_in, turns, forces) integer, intent(in) :: turns !< Number of quarter-turns type(mech_forcing), intent(inout) :: forces !< Forcing on the rotated domain - logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg + logical :: do_stress, do_ustar, do_tau_mag, do_shelf, do_press, do_iceberg - call get_mech_forcing_groups(forces_in, do_stress, do_ustar, do_shelf, & + call get_mech_forcing_groups(forces_in, do_stress, do_ustar, do_tau_mag, do_shelf, & do_press, do_iceberg) if (do_stress) & call rotate_vector(forces_in%taux, forces_in%tauy, turns, & forces%taux, forces%tauy) - if (do_ustar) then + if (associated(forces_in%ustar)) & call rotate_array(forces_in%ustar, turns, forces%ustar) + if (associated(forces_in%tau_mag)) & call rotate_array(forces_in%tau_mag, turns, forces%tau_mag) - endif if (do_shelf) then call rotate_array_pair( & @@ -3581,8 +3798,9 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) !! or updated from mean tau. real :: tx_mean, ty_mean ! Mean wind stresses [R L Z T-2 ~> Pa] + real :: tau_mag ! The magnitude of the wind stresses [R L Z T-2 ~> Pa] real :: Irho0 ! Inverse of the mean density rescaled to [Z L-1 R-1 ~> m3 kg-1] - logical :: do_stress, do_ustar, do_shelf, do_press, do_iceberg, tau2ustar + logical :: do_stress, do_ustar, do_taumag, do_shelf, do_press, do_iceberg, tau2ustar integer :: i, j, is, ie, js, je, isB, ieB, jsB, jeB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isB = G%iscB ; ieB = G%iecB ; jsB = G%jscB ; jeB = G%jecB @@ -3592,7 +3810,7 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) tau2ustar = .false. if (present(UpdateUstar)) tau2ustar = UpdateUstar - call get_mech_forcing_groups(forces, do_stress, do_ustar, do_shelf, & + call get_mech_forcing_groups(forces, do_stress, do_ustar, do_taumag, do_shelf, & do_press, do_iceberg) if (do_stress) then @@ -3605,19 +3823,24 @@ subroutine homogenize_mech_forcing(forces, G, US, Rho0, UpdateUstar) if (G%mask2dCv(i,J) > 0.0) forces%tauy(i,J) = ty_mean enddo ; enddo if (tau2ustar) then - do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then - forces%tau_mag(i,j) = sqrt(tx_mean**2 + ty_mean**2) - forces%ustar(i,j) = sqrt(forces%tau_mag(i,j) * Irho0) - endif ; enddo ; enddo + tau_mag = sqrt(tx_mean**2 + ty_mean**2) + if (associated(forces%tau_mag)) then ; do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + forces%tau_mag(i,j) = tau_mag + endif ; enddo ; enddo ; endif + if (associated(forces%ustar)) then ; do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + forces%ustar(i,j) = sqrt(tau_mag * Irho0) + endif ; enddo ; enddo ; endif else - call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) - call homogenize_field_t(forces%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa) + if (associated(forces%ustar)) & + call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) + if (associated(forces%tau_mag)) & + call homogenize_field_t(forces%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa) endif else - if (do_ustar) then + if (associated(forces%ustar)) & call homogenize_field_t(forces%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) + if (associated(forces%tau_mag)) & call homogenize_field_t(forces%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa) - endif endif if (do_shelf) then @@ -3648,17 +3871,21 @@ subroutine homogenize_forcing(fluxes, G, GV, US) type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - logical :: do_ustar, do_water, do_heat, do_salt, do_press, do_shelf, & - do_iceberg, do_heat_added, do_buoy + logical :: do_ustar, do_taumag, do_water, do_heat, do_salt, do_press, do_shelf + logical :: do_iceberg, do_heat_added, do_buoy - call get_forcing_groups(fluxes, do_water, do_heat, do_ustar, do_press, & + call get_forcing_groups(fluxes, do_water, do_heat, do_ustar, do_taumag, do_press, & do_shelf, do_iceberg, do_salt, do_heat_added, do_buoy) - if (do_ustar) then + if (associated(fluxes%ustar)) & call homogenize_field_t(fluxes%ustar, G, tmp_scale=US%Z_to_m*US%s_to_T) + if (associated(fluxes%ustar_gustless)) & call homogenize_field_t(fluxes%ustar_gustless, G, tmp_scale=US%Z_to_m*US%s_to_T) + + if (associated(fluxes%tau_mag)) & call homogenize_field_t(fluxes%tau_mag, G, tmp_scale=US%RLZ_T2_to_Pa) - endif + if (associated(fluxes%tau_mag_gustless)) & + call homogenize_field_t(fluxes%tau_mag_gustless, G, tmp_scale=US%RLZ_T2_to_Pa) if (do_water) then call homogenize_field_t(fluxes%evap, G, tmp_scale=US%RZ_T_to_kg_m2s) diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index dfd1048b82..0a579db299 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -19,6 +19,7 @@ module MOM_interface_heights public find_eta, dz_to_thickness, thickness_to_dz, dz_to_thickness_simple public calc_derived_thermo +public find_rho_bottom !> Calculates the heights of the free surface or all interfaces from layer thicknesses. interface find_eta @@ -278,6 +279,8 @@ subroutine calc_derived_thermo(tv, h, G, GV, US, halo, debug) ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: p_t ! Hydrostatic pressure atop a layer [R L2 T-2 ~> Pa] real, dimension(SZI_(G),SZJ_(G)) :: dp ! Pressure change across a layer [R L2 T-2 ~> Pa] + real, dimension(SZK_(GV)) :: SpV_lay ! The specific volume of each layer when no equation of + ! state is used [R-1 ~> m3 kg-1] logical :: do_debug ! If true, write checksums for debugging. integer :: i, j, k, is, ie, js, je, halos, nz @@ -309,10 +312,147 @@ subroutine calc_derived_thermo(tv, h, G, GV, US, halo, debug) call hchksum(tv%T, "derived_thermo T", G%HI, haloshift=halos, scale=US%C_to_degC) call hchksum(tv%S, "derived_thermo S", G%HI, haloshift=halos, scale=US%S_to_ppt) endif + elseif (allocated(tv%Spv_avg)) then + do k=1,nz ; SpV_lay(k) = 1.0 / GV%Rlay(k) ; enddo + do k=1,nz ; do j=js,je ; do i=is,ie + tv%SpV_avg(i,j,k) = SpV_lay(k) + enddo ; enddo ; enddo + tv%valid_SpV_halo = halos endif end subroutine calc_derived_thermo + +!> Determine the in situ density averaged over a specified distance from the bottom, +!! calculating it as the inverse of the mass-weighted average specific volume. +subroutine find_rho_bottom(h, dz, pres_int, dz_avg, tv, j, G, GV, US, Rho_bot) + 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 + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZK_(GV)), & + intent(in) :: dz !< Height change across layers [Z ~> m] + real, dimension(SZI_(G),SZK_(GV)+1), & + intent(in) :: pres_int !< Pressure at each interface [R L2 T-2 ~> Pa] + real, dimension(SZI_(G)), intent(in) :: dz_avg !< The vertical distance over which to average [Z ~> m] + type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available + !! thermodynamic fields. + integer, intent(in) :: j !< j-index of row to work on + real, dimension(SZI_(G)), intent(out) :: Rho_bot !< Near-bottom density [R ~> kg m-3]. + + ! Local variables + real :: hb(SZI_(G)) ! Running sum of the thickness in the bottom boundary layer [H ~> m or kg m-2] + real :: SpV_h_bot(SZI_(G)) ! Running sum of the specific volume times thickness in the bottom + ! boundary layer [R-1 H ~> m4 kg-1 or m] + real :: dz_bbl_rem(SZI_(G)) ! Vertical extent of the boundary layer that has yet to be accounted + ! for [Z ~> m] + real :: h_bbl_frac(SZI_(G)) ! Thickness of the fractional layer that makes up the top of the + ! boundary layer [H ~> m or kg m-2] + real :: T_bbl(SZI_(G)) ! Temperature of the fractional layer that makes up the top of the + ! boundary layer [C ~> degC] + real :: S_bbl(SZI_(G)) ! Salinity of the fractional layer that makes up the top of the + ! boundary layer [S ~> ppt] + real :: P_bbl(SZI_(G)) ! Pressure the top of the boundary layer [R L2 T-2 ~> Pa] + real :: dp(SZI_(G)) ! Pressure change across the fractional layer that makes up the top + ! of the boundary layer [R L2 T-2 ~> Pa] + real :: SpV_bbl(SZI_(G)) ! In situ specific volume of the fractional layer that makes up the + ! top of the boundary layer [R-1 ~> m3 kg-1] + real :: frac_in ! The fraction of a layer that is within the bottom boundary layer [nondim] + logical :: do_i(SZI_(G)), do_any + logical :: use_EOS + integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state + integer :: i, k, is, ie, nz + + is = G%isc ; ie = G%iec ; nz = GV%ke + + use_EOS = associated(tv%T) .and. associated(tv%S) .and. associated(tv%eqn_of_state) + + if (GV%Boussinesq .or. GV%semi_Boussinesq .or. .not.allocated(tv%SpV_avg)) then + do i=is,ie + rho_bot(i) = GV%Rho0 + enddo + else + ! Check that SpV_avg has been set. + if (tv%valid_SpV_halo < 0) call MOM_error(FATAL, & + "find_rho_bottom called in fully non-Boussinesq mode with invalid values of SpV_avg.") + + ! Set the bottom density to the inverse of the in situ specific volume averaged over the + ! specified distance, with care taken to avoid having compressibility lead to an imprint + ! of the layer thicknesses on this density. + do i=is,ie + hb(i) = 0.0 ; SpV_h_bot(i) = 0.0 + dz_bbl_rem(i) = G%mask2dT(i,j) * max(0.0, dz_avg(i)) + do_i(i) = .true. + if (G%mask2dT(i,j) <= 0.0) then + ! Set acceptable values for calling the equation of state over land. + T_bbl(i) = 0.0 ; S_bbl(i) = 0.0 ; dp(i) = 0.0 ; P_bbl(i) = 0.0 + SpV_bbl(i) = 1.0 ! This value is arbitrary, provided it is non-zero. + h_bbl_frac(i) = 0.0 + do_i(i) = .false. + endif + enddo + + do k=nz,1,-1 + do_any = .false. + do i=is,ie ; if (do_i(i)) then + if (dz(i,k) < dz_bbl_rem(i)) then + ! This layer is fully within the averaging depth. + SpV_h_bot(i) = SpV_h_bot(i) + h(i,j,k) * tv%SpV_avg(i,j,k) + dz_bbl_rem(i) = dz_bbl_rem(i) - dz(i,k) + hb(i) = hb(i) + h(i,j,k) + do_any = .true. + else + if (dz(i,k) > 0.0) then + frac_in = dz_bbl_rem(i) / dz(i,k) + else + frac_in = 0.0 + endif + if (use_EOS) then + ! Store the properties of this layer to determine the average + ! specific volume of the portion that is within the BBL. + T_bbl(i) = tv%T(i,j,k) ; S_bbl(i) = tv%S(i,j,k) + dp(i) = frac_in * (GV%g_Earth*GV%H_to_RZ * h(i,j,k)) + P_bbl(i) = pres_int(i,K) + (1.0-frac_in) * (GV%g_Earth*GV%H_to_RZ * h(i,j,k)) + else + SpV_bbl(i) = tv%SpV_avg(i,j,k) + endif + h_bbl_frac(i) = frac_in * h(i,j,k) + dz_bbl_rem(i) = 0.0 + do_i(i) = .false. + endif + endif ; enddo + if (.not.do_any) exit + enddo + do i=is,ie ; if (do_i(i)) then + ! The nominal bottom boundary layer is thicker than the water column, but layer 1 is + ! already included in the averages. These values are set so that the call to find + ! the layer-average specific volume will behave sensibly. + if (use_EOS) then + T_bbl(i) = tv%T(i,j,1) ; S_bbl(i) = tv%S(i,j,1) + dp(i) = 0.0 + P_bbl(i) = pres_int(i,1) + else + SpV_bbl(i) = tv%SpV_avg(i,j,1) + endif + h_bbl_frac(i) = 0.0 + endif ; enddo + + if (use_EOS) then + ! Find the average specific volume of the fractional layer atop the BBL. + EOSdom(:) = EOS_domain(G%HI) + call average_specific_vol(T_bbl, S_bbl, P_bbl, dp, SpV_bbl, tv%eqn_of_state, EOSdom) + endif + + do i=is,ie + if (hb(i) + h_bbl_frac(i) < GV%H_subroundoff) h_bbl_frac(i) = GV%H_subroundoff + rho_bot(i) = G%mask2dT(i,j) * (hb(i) + h_bbl_frac(i)) / (SpV_h_bot(i) + h_bbl_frac(i)*SpV_bbl(i)) + enddo + endif + +end subroutine find_rho_bottom + + !> Converts thickness from geometric height units to thickness units, perhaps via an !! inversion of the integral of the density in pressure using variables stored in !! the thermo_var_ptrs type when in non-Boussinesq mode. @@ -349,9 +489,7 @@ subroutine dz_to_thickness_tv(dz, tv, h, G, GV, US, halo_size) endif else do k=1,nz ; do j=js,je ; do i=is,ie - h(i,j,k) = (GV%Z_to_H*dz(i,j,k)) * (GV%Rlay(k) / GV%Rho0) - ! Consider revising this to the mathematically equivalent expression: - ! h(i,j,k) = (GV%RZ_to_H * GV%Rlay(k)) * dz(i,j,k) + h(i,j,k) = (GV%RZ_to_H * GV%Rlay(k)) * dz(i,j,k) enddo ; enddo ; enddo endif endif @@ -419,10 +557,16 @@ subroutine dz_to_thickness_EOS(dz, Temp, Saln, EoS, h, G, GV, US, halo_size, p_s do i=is,ie ; p_top(i,j) = p_bot(i,j) ; enddo call calculate_density(Temp(:,j,k), Saln(:,j,k), p_top(:,j), rho, & EoS, EOSdom) - do i=is,ie - ! This could be simplified, but it would change answers at roundoff. - p_bot(i,j) = p_top(i,j) + (GV%g_Earth*GV%H_to_Z) * ((GV%Z_to_H*dz(i,j,k)) * rho(i)) - enddo + ! The following two expressions are mathematically equivalent. + if (GV%semi_Boussinesq) then + do i=is,ie + p_bot(i,j) = p_top(i,j) + (GV%g_Earth*GV%H_to_Z) * ((GV%Z_to_H*dz(i,j,k)) * rho(i)) + enddo + else + do i=is,ie + p_bot(i,j) = p_top(i,j) + rho(i) * (GV%g_Earth * dz(i,j,k)) + enddo + endif enddo do itt=1,max_itt @@ -433,9 +577,15 @@ subroutine dz_to_thickness_EOS(dz, Temp, Saln, EoS, h, G, GV, US, halo_size, p_s EoS, EOSdom) ! Use Newton's method to correct the bottom value. ! The hydrostatic equation is sufficiently linear that no bounds-checking is needed. - do i=is,ie - p_bot(i,j) = p_bot(i,j) + rho(i) * ((GV%g_Earth*GV%H_to_Z)*(GV%Z_to_H*dz(i,j,k)) - dz_geo(i,j)) - enddo + if (GV%semi_Boussinesq) then + do i=is,ie + p_bot(i,j) = p_bot(i,j) + rho(i) * ((GV%g_Earth*GV%H_to_Z)*(GV%Z_to_H*dz(i,j,k)) - dz_geo(i,j)) + enddo + else + do i=is,ie + p_bot(i,j) = p_bot(i,j) + rho(i) * (GV%g_Earth*dz(i,j,k) - dz_geo(i,j)) + enddo + endif enddo ; endif enddo @@ -476,7 +626,7 @@ subroutine dz_to_thickness_simple(dz, h, G, GV, US, halo_size, layer_mode) layered = .false. ; if (present(layer_mode)) layered = layer_mode is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke - if (GV%Boussinesq .or. (.not.layered)) then + if (GV%Boussinesq) then do k=1,nz ; do j=js,je ; do i=is,ie h(i,j,k) = GV%Z_to_H * dz(i,j,k) enddo ; enddo ; enddo @@ -484,6 +634,10 @@ subroutine dz_to_thickness_simple(dz, h, G, GV, US, halo_size, layer_mode) do k=1,nz ; do j=js,je ; do i=is,ie h(i,j,k) = (GV%RZ_to_H * GV%Rlay(k)) * dz(i,j,k) enddo ; enddo ; enddo + else + do k=1,nz ; do j=js,je ; do i=is,ie + h(i,j,k) = (US%Z_to_m * GV%m_to_H) * dz(i,j,k) + enddo ; enddo ; enddo endif end subroutine dz_to_thickness_simple diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index 07dd19b0a6..29c547148d 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -36,8 +36,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface heights [Z ~> m] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, intent(in) :: dt_kappa_smooth !< A smoothing vertical diffusivity - !! times a smoothing timescale [Z2 ~> m2]. + real, intent(in) :: dt_kappa_smooth !< A smoothing vertical + !! diffusivity times a smoothing + !! timescale [H Z ~> m2 or kg m-1] logical, intent(in) :: use_stanley !< turn on stanley param in slope real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: slope_x !< Isopycnal slope in i-dir [Z L-1 ~> nondim] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(inout) :: slope_y !< Isopycnal slope in j-dir [Z L-1 ~> nondim] @@ -142,7 +143,7 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - dz_neglect = GV%H_subroundoff * GV%H_to_Z + dz_neglect = GV%dZ_subroundoff local_open_u_BC = .false. local_open_v_BC = .false. @@ -195,9 +196,9 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan if (use_EOS) then if (present(halo)) then - call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, halo+1) + call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, US, halo+1) else - call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, 1) + call vert_fill_TS(h, tv%T, tv%S, dt_kappa_smooth, T, S, G, GV, US, 1) endif endif @@ -341,9 +342,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan slope = slope * max(g%mask2dT(i,j),g%mask2dT(i+1,j)) endif slope_x(I,j,K) = slope - if (present(dzSxN)) dzSxN(I,j,K) = sqrt( G_Rho0 * max(0., wtL * ( dzaL * drdkL ) & - + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N - * abs(slope) * G%mask2dCu(I,j) ! x-direction contribution to S^2 + if (present(dzSxN)) & + dzSxN(I,j,K) = sqrt( G_Rho0 * max(0., wtL * ( dzaL * drdkL ) & + + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N + * abs(slope) * G%mask2dCu(I,j) ! x-direction contribution to S^2 enddo ! I enddo ; enddo ! end of j-loop @@ -477,9 +479,10 @@ subroutine calc_isoneutral_slopes(G, GV, US, h, e, tv, dt_kappa_smooth, use_stan slope = slope * max(g%mask2dT(i,j),g%mask2dT(i,j+1)) endif slope_y(i,J,K) = slope - if (present(dzSyN)) dzSyN(i,J,K) = sqrt( G_Rho0 * max(0., wtL * ( dzaL * drdkL ) & - + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N - * abs(slope) * G%mask2dCv(i,J) ! x-direction contribution to S^2 + if (present(dzSyN)) & + dzSyN(i,J,K) = sqrt( G_Rho0 * max(0., wtL * ( dzaL * drdkL ) & + + wtR * ( dzaR * drdkR )) / (wtL + wtR) ) & ! dz * N + * abs(slope) * G%mask2dCv(i,J) ! x-direction contribution to S^2 enddo ! i enddo ; enddo ! end of j-loop @@ -488,14 +491,15 @@ end subroutine calc_isoneutral_slopes !> Returns tracer arrays (nominally T and S) with massless layers filled with !! sensible values, by diffusing vertically with a small but constant diffusivity. -subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, larger_h_denom) +subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, US, halo_here, larger_h_denom) 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 real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T_in !< Input temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S_in !< Input salinity [S ~> ppt] real, intent(in) :: kappa_dt !< A vertical diffusivity to use for smoothing - !! times a smoothing timescale [Z2 ~> m2]. + !! times a smoothing timescale [H Z ~> m2 or kg m-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T_f !< Filled temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S_f !< Filled salinity [S ~> ppt] integer, optional, intent(in) :: halo_here !< Number of halo points to work on, @@ -525,10 +529,15 @@ subroutine vert_fill_TS(h, T_in, S_in, kappa_dt, T_f, S_f, G, GV, halo_here, lar is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo ; nz = GV%ke h_neglect = GV%H_subroundoff - kap_dt_x2 = (2.0*kappa_dt)*GV%Z_to_H**2 + ! The use of the fixed rescaling factor in the next line avoids an extra call to thickness_to_dz() + ! and the use of an extra 3-d array of vertical distnaces across layers (dz). This would be more + ! physically consistent, but it would also be more expensive, and given that this routine applies + ! a small (but arbitrary) amount of mixing to clean up the properties of nearly massless layers, + ! the added expense is hard to justify. + kap_dt_x2 = (2.0*kappa_dt) * (US%Z_to_m*GV%m_to_H) ! Usually the latter term is GV%Z_to_H. h0 = h_neglect if (present(larger_h_denom)) then - if (larger_h_denom) h0 = 1.0e-16*sqrt(kappa_dt)*GV%Z_to_H + if (larger_h_denom) h0 = 1.0e-16*sqrt(0.5*kap_dt_x2) endif if (kap_dt_x2 <= 0.0) then diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index ebe3907469..d73d96b242 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -414,12 +414,13 @@ subroutine calc_por_interface(D_min, D_max, D_avg, eta_layer, w_layer, do_next) endif end subroutine calc_por_interface -subroutine porous_barriers_init(Time, US, param_file, diag, CS) - type(porous_barrier_CS), intent(inout) :: CS !< Module control structure - type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse +subroutine porous_barriers_init(Time, GV, US, param_file, diag, CS) type(time_type), intent(in) :: Time !< Current model time - type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control 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 + type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure + type(porous_barrier_CS), intent(inout) :: CS !< Module control structure ! local variables character(len=40) :: mdl = "MOM_porous_barriers" ! This module's name. @@ -439,7 +440,9 @@ subroutine porous_barriers_init(Time, US, param_file, diag, CS) call get_param(param_file, mdl, "PORBAR_ANSWER_DATE", CS%answer_date, & "The vintage of the porous barrier weight function calculations. Values below "//& "20220806 recover the old answers in which the layer averaged weights are not "//& - "strictly limited by an upper-bound of 1.0 .", default=default_answer_date) + "strictly limited by an upper-bound of 1.0 .", & + default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) call get_param(param_file, mdl, "PORBAR_MASKING_DEPTH", CS%mask_depth, & "If the effective average depth at the velocity cell is shallower than this "//& diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90 index deb878e99c..2bd742be6d 100644 --- a/src/core/MOM_stoch_eos.F90 +++ b/src/core/MOM_stoch_eos.F90 @@ -40,7 +40,7 @@ module MOM_stoch_eos real :: stanley_coeff !< Coefficient correlating the temperature gradient !! and SGS T variance [nondim]; if <0, turn off scheme in all codes real :: stanley_a !< a in exp(aX) in stochastic coefficient [nondim] - real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] + real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] !>@{ Diagnostic IDs integer :: id_stoch_eos = -1, id_stoch_phi = -1, id_tvar_sgs = -1 @@ -51,9 +51,10 @@ module MOM_stoch_eos contains !> Initializes MOM_stoch_eos module, returning a logical indicating whether this module will be used. -logical function MOM_stoch_eos_init(Time, G, US, param_file, diag, CS, restart_CS) +logical function MOM_stoch_eos_init(Time, G, GV, US, param_file, diag, CS, restart_CS) type(time_type), intent(in) :: Time !< Time for stochastic process type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse type(diag_ctrl), target, intent(inout) :: diag !< Structure used to control diagnostics @@ -80,7 +81,7 @@ logical function MOM_stoch_eos_init(Time, G, US, param_file, diag, CS, restart_C call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s, & + units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T, & do_not_log=(CS%stanley_coeff<0.0)) ! Don't run anything if STANLEY_COEFF < 0 @@ -193,9 +194,10 @@ subroutine post_stoch_EOS_diags(CS, tv, diag) end subroutine post_stoch_EOS_diags !> Computes a parameterization of the SGS temperature variance -subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) +subroutine MOM_calc_varT(G, GV, US, h, tv, CS, dt) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h !< Layer thickness [H ~> m] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure @@ -219,7 +221,7 @@ subroutine MOM_calc_varT(G, GV, h, tv, CS, dt) ! extreme gradients along layers which are vanished against topography. It is ! still a poor approximation in the interior when coordinates are strongly tilted. if (.not. associated(tv%varT)) allocate(tv%varT(G%isd:G%ied, G%jsd:G%jed, GV%ke), source=0.0) - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo_here=1, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, US, halo_here=1, larger_h_denom=.true.) do k=1,G%ke do j=G%jsc,G%jec diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 0c4a42e8c6..199524fa33 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -234,12 +234,12 @@ module MOM_variables real, allocatable, dimension(:,:) :: & bbl_thick_u, & !< The bottom boundary layer thickness at the u-points [Z ~> m]. bbl_thick_v, & !< The bottom boundary layer thickness at the v-points [Z ~> m]. - kv_bbl_u, & !< The bottom boundary layer viscosity at the u-points [Z2 T-1 ~> m2 s-1]. - kv_bbl_v, & !< The bottom boundary layer viscosity at the v-points [Z2 T-1 ~> m2 s-1]. - ustar_BBL, & !< The turbulence velocity in the bottom boundary layer at h points [Z T-1 ~> m s-1]. + kv_bbl_u, & !< The bottom boundary layer viscosity at the u-points [H Z T-1 ~> m2 s-1 or Pa s] + kv_bbl_v, & !< The bottom boundary layer viscosity at the v-points [H Z T-1 ~> m2 s-1 or Pa s] + ustar_BBL, & !< The turbulence velocity in the bottom boundary layer at + !! h points [H T-1 ~> m s-1 or kg m-2 s-1]. TKE_BBL, & !< A term related to the bottom boundary layer source of turbulent kinetic - !! energy, currently in [Z3 T-3 ~> m3 s-3], but may at some time be changed - !! to [R Z3 T-3 ~> W m-2]. + !! energy, currently in [H Z2 T-3 ~> m3 s-3 or W m-2]. taux_shelf, & !< The zonal stresses on the ocean under shelves [R Z L T-2 ~> Pa]. tauy_shelf !< The meridional stresses on the ocean under shelves [R Z L T-2 ~> Pa]. real, allocatable, dimension(:,:) :: tbl_thick_shelf_u @@ -247,9 +247,11 @@ module MOM_variables real, allocatable, dimension(:,:) :: tbl_thick_shelf_v !< Thickness of the viscous top boundary layer under ice shelves at v-points [Z ~> m]. real, allocatable, dimension(:,:) :: kv_tbl_shelf_u - !< Viscosity in the viscous top boundary layer under ice shelves at u-points [Z2 T-1 ~> m2 s-1]. + !< Viscosity in the viscous top boundary layer under ice shelves at + !! u-points [H Z T-1 ~> m2 s-1 or Pa s] real, allocatable, dimension(:,:) :: kv_tbl_shelf_v - !< Viscosity in the viscous top boundary layer under ice shelves at v-points [Z2 T-1 ~> m2 s-1]. + !< Viscosity in the viscous top boundary layer under ice shelves at + !! v-points [H Z T-1 ~> m2 s-1 or Pa s] real, allocatable, dimension(:,:) :: nkml_visc_u !< The number of layers in the viscous surface mixed layer at u-points [nondim]. !! This is not an integer because there may be fractional layers, and it is stored in @@ -258,24 +260,24 @@ module MOM_variables real, allocatable, dimension(:,:) :: nkml_visc_v !< The number of layers in the viscous surface mixed layer at v-points [nondim]. real, allocatable, dimension(:,:,:) :: & - Ray_u, & !< The Rayleigh drag velocity to be applied to each layer at u-points [Z T-1 ~> m s-1]. - Ray_v !< The Rayleigh drag velocity to be applied to each layer at v-points [Z T-1 ~> m s-1]. + Ray_u, & !< The Rayleigh drag velocity to be applied to each layer at u-points [H T-1 ~> m s-1 or Pa s m-1]. + Ray_v !< The Rayleigh drag velocity to be applied to each layer at v-points [H T-1 ~> m s-1 or Pa s m-1]. ! The following elements are pointers so they can be used as targets for pointers in the restart registry. real, pointer, dimension(:,:) :: MLD => NULL() !< Instantaneous active mixing layer depth [Z ~> m]. real, pointer, dimension(:,:) :: sfc_buoy_flx !< Surface buoyancy flux (derived) [Z2 T-3 ~> m2 s-3]. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers - !! in tracer columns [Z2 T-1 ~> m2 s-1]. + !! in tracer columns [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, pointer, dimension(:,:,:) :: Kv_shear => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers - !! in tracer columns [Z2 T-1 ~> m2 s-1]. + !! in tracer columns [H Z T-1 ~> m2 s-1 or Pa s] real, pointer, dimension(:,:,:) :: Kv_shear_Bu => NULL() !< The shear-driven turbulent vertical viscosity at the interfaces between layers in - !! corner columns [Z2 T-1 ~> m2 s-1]. + !! corner columns [H Z T-1 ~> m2 s-1 or Pa s] real, pointer, dimension(:,:,:) :: Kv_slow => NULL() !< The turbulent vertical viscosity component due to "slow" processes (e.g., tidal, - !! background, convection etc) [Z2 T-1 ~> m2 s-1]. + !! background, convection etc) [H Z T-1 ~> m2 s-1 or Pa s] real, pointer, dimension(:,:,:) :: TKE_turb => NULL() !< The turbulent kinetic energy per unit mass at the interfaces [Z2 T-2 ~> m2 s-2]. !! This may be at the tracer or corner points diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index d53b2e6636..e9c1092ed7 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -83,7 +83,8 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1] real, optional, intent(in) :: str !< The surface wind stress [R L Z T-2 ~> Pa] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc + !! [H T-1 ~> m s-1 or Pa s m-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. @@ -223,8 +224,8 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st (vel_scale*ADp%du_other(I,j,k)) ; enddo endif if (present(a)) then - write(file,'(/,"a: ",ES10.3," ")', advance='no') US%Z_to_m*a(I,j,ks)*dt - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(I,j,K)*dt) ; enddo + write(file,'(/,"a: ",ES10.3," ")', advance='no') h_scale*a(I,j,ks)*dt + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (h_scale*a(I,j,K)*dt) ; enddo endif if (present(hv)) then write(file,'(/,"hvel: ")', advance='no') @@ -422,7 +423,8 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st real, intent(in) :: vel_rpt !< The velocity magnitude that triggers a report [L T-1 ~> m s-1] real, optional, intent(in) :: str !< The surface wind stress [R L Z T-2 ~> Pa] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), & - optional, intent(in) :: a !< The layer coupling coefficients from vertvisc [Z T-1 ~> m s-1]. + optional, intent(in) :: a !< The layer coupling coefficients from vertvisc + !! [H T-1 ~> m s-1 or Pa s m-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, !! from vertvisc [H ~> m or kg m-2]. @@ -566,8 +568,8 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, US, CS, vel_rpt, st (vel_scale*ADp%dv_other(i,J,k)) ; enddo endif if (present(a)) then - write(file,'(/,"a: ",ES10.3," ")', advance='no') US%Z_to_m*a(i,J,ks)*dt - do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (US%Z_to_m*a(i,J,K)*dt) ; enddo + write(file,'(/,"a: ",ES10.3," ")', advance='no') h_scale*a(i,J,ks)*dt + do K=ks+1,ke+1 ; if (do_k(k-1)) write(file,'(ES10.3," ")', advance='no') (h_scale*a(i,J,K)*dt) ; enddo endif if (present(hv)) then write(file,'(/,"hvel: ")', advance='no') diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index cf8b042c14..c23712d8e7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -56,7 +56,7 @@ module MOM_diagnostics !! monotonic for the purposes of calculating the equivalent !! barotropic wave speed [nondim]. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of - !! calculating the equivalent barotropic wave speed [Z ~> m]. + !! calculating the equivalent barotropic wave speed [H ~> m or kg m-2]. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. @@ -984,7 +984,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_dKEdt > 0) then - ! Calculate the time derivative of the layer KE [H L2 T-3 ~> m3 s-3]. + ! Calculate the time derivative of the layer KE [H L2 T-3 ~> m3 s-3 or W m-2]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * CS%du_dt(I,j,k) @@ -1006,7 +1006,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_PE_to_KE > 0) then - ! Calculate the potential energy to KE term [H L2 T-3 ~> m3 s-3]. + ! Calculate the potential energy to KE term [H L2 T-3 ~> m3 s-3 or W m-2]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%PFu(I,j,k) @@ -1025,7 +1025,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_KE_BT > 0) then - ! Calculate the barotropic contribution to KE term [H L2 T-3 ~> m3 s-3]. + ! Calculate the barotropic contribution to KE term [H L2 T-3 ~> m3 s-3 or W m-2]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%u_accel_bt(I,j,k) @@ -1044,7 +1044,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_KE_Coradv > 0) then - ! Calculate the KE source from the combined Coriolis and advection terms [H L2 T-3 ~> m3 s-3]. + ! Calculate the KE source from the combined Coriolis and advection terms [H L2 T-3 ~> m3 s-3 or W m-2]. ! The Coriolis source should be zero, but is not due to truncation errors. There should be ! near-cancellation of the global integral of this spurious Coriolis source. do k=1,nz @@ -1069,7 +1069,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_KE_adv > 0) then - ! Calculate the KE source from along-layer advection [H L2 T-3 ~> m3 s-3]. + ! Calculate the KE source from along-layer advection [H L2 T-3 ~> m3 s-3 or W m-2]. ! NOTE: All terms in KE_adv are multiplied by -1, which can easily produce ! negative zeros and may signal a reproducibility issue over land. ! We resolve this by re-initializing and only evaluating over water points. @@ -1098,7 +1098,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_KE_visc > 0) then - ! Calculate the KE source from vertical viscosity [H L2 T-3 ~> m3 s-3]. + ! Calculate the KE source from vertical viscosity [H L2 T-3 ~> m3 s-3 or W m-2]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc(I,j,k) @@ -1117,7 +1117,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_KE_visc_gl90 > 0) then - ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3]. + ! Calculate the KE source from GL90 vertical viscosity [H L2 T-3 ~> m3 s-3 or W m-2]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_visc_gl90(I,j,k) @@ -1136,7 +1136,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_KE_stress > 0) then - ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3]. + ! Calculate the KE source from surface stress (included in KE_visc) [H L2 T-3 ~> m3 s-3 or W m-2]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_str(I,j,k) @@ -1155,7 +1155,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_KE_horvisc > 0) then - ! Calculate the KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3]. + ! Calculate the KE source from horizontal viscosity [H L2 T-3 ~> m3 s-3 or W m-2]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%diffu(I,j,k) @@ -1174,7 +1174,7 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, GV, US, CS endif if (CS%id_KE_dia > 0) then - ! Calculate the KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3]. + ! Calculate the KE source from diapycnal diffusion [H L2 T-3 ~> m3 s-3 or W m-2]. do k=1,nz do j=js,je ; do I=Isq,Ieq KE_u(I,j) = uh(I,j,k) * G%dxCu(I,j) * ADp%du_dt_dia(I,j,k) @@ -1594,7 +1594,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag call get_param(param_file, mdl, "DIAG_EBT_MONO_N2_DEPTH", CS%mono_N2_depth, & "The depth below which N2 is limited as monotonic for the "// & "purposes of calculating the equivalent barotropic wave speed.", & - units='m', scale=US%m_to_Z, default=-1.) + units='m', scale=GV%m_to_H, default=-1.) call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_TOL", wave_speed_tol, & "The fractional tolerance for finding the wave speeds.", & units="nondim", default=0.001) @@ -1610,21 +1610,24 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, US, param_file, diag default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. - if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701) call get_param(param_file, mdl, "SPLIT", split, default=.true., do_not_log=.true.) diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index fd957d0a44..fb95b79a91 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -8,7 +8,7 @@ module MOM_sum_output use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs, field_chksum use MOM_coms, only : reproducing_sum, reproducing_sum_EFP, EFP_to_real, real_to_EFP use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_sum_across_PEs -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg +use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe 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 @@ -510,24 +510,18 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci do k=1,nz ; vol_lay(k) = (US%m_to_L**2*GV%H_to_Z/GV%H_to_kg_m2)*mass_lay(k) ; enddo else tmp1(:,:,:) = 0.0 - if (CS%do_APE_calc) then - do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = HL2_to_kg * h(i,j,k) * areaTm(i,j) - enddo ; enddo ; enddo - mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP) + do k=1,nz ; do j=js,je ; do i=is,ie + tmp1(i,j,k) = HL2_to_kg * h(i,j,k) * areaTm(i,j) + enddo ; enddo ; enddo + mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP) + if (CS%do_APE_calc) then call find_eta(h, tv, G, GV, US, eta, dZref=G%Z_ref) do k=1,nz ; do j=js,je ; do i=is,ie tmp1(i,j,k) = US%Z_to_m*US%L_to_m**2*(eta(i,j,K)-eta(i,j,K+1)) * areaTm(i,j) enddo ; enddo ; enddo vol_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=vol_lay) do k=1,nz ; vol_lay(k) = US%m_to_Z*US%m_to_L**2 * vol_lay(k) ; enddo - else - do k=1,nz ; do j=js,je ; do i=is,ie - tmp1(i,j,k) = HL2_to_kg * h(i,j,k) * areaTm(i,j) - enddo ; enddo ; enddo - mass_tot = reproducing_sum(tmp1, isr, ier, jsr, jer, sums=mass_lay, EFP_sum=mass_EFP) - do k=1,nz ; vol_lay(k) = US%m_to_Z*US%m_to_L**2*US%kg_m3_to_R * (mass_lay(k) / GV%Rho0) ; enddo endif endif ! Boussinesq @@ -643,7 +637,7 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci if (GV%Boussinesq) then do j=js,je ; do i=is,ie hbelow = 0.0 - do k=nz,1,-1 + do K=nz,1,-1 hbelow = hbelow + h(i,j,k) * GV%H_to_Z hint = Z_0APE(K) + (hbelow - (G%bathyT(i,j) + G%Z_ref)) hbot = Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref) @@ -652,14 +646,28 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, US, CS, tracer_CSp, dt_forci (hint * hint - hbot * hbot) enddo enddo ; enddo - else + elseif (GV%semi_Boussinesq) then do j=js,je ; do i=is,ie - do k=nz,1,-1 + do K=nz,1,-1 hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. hbot = max(Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref), 0.0) PE_pt(i,j,K) = (0.5 * PE_scale_factor * areaTm(i,j) * (GV%Rho0*GV%g_prime(K))) * & - (hint * hint - hbot * hbot) + (hint * hint - hbot * hbot) + enddo + enddo ; enddo + else + do j=js,je ; do i=is,ie + do K=nz,2,-1 + hint = Z_0APE(K) + eta(i,j,K) ! eta and H_0 have opposite signs. + hbot = max(Z_0APE(K) - (G%bathyT(i,j) + G%Z_ref), 0.0) + PE_pt(i,j,K) = (0.25 * PE_scale_factor * areaTm(i,j) * & + ((GV%Rlay(k)+GV%Rlay(k-1))*GV%g_prime(K))) * & + (hint * hint - hbot * hbot) enddo + hint = Z_0APE(1) + eta(i,j,1) ! eta and H_0 have opposite signs. + hbot = max(Z_0APE(1) - (G%bathyT(i,j) + G%Z_ref), 0.0) + PE_pt(i,j,1) = (0.5 * PE_scale_factor * areaTm(i,j) * (GV%Rlay(1)*GV%g_prime(1))) * & + (hint * hint - hbot * hbot) enddo ; enddo endif @@ -1077,7 +1085,7 @@ subroutine depth_list_setup(G, GV, US, DL, CS) valid_DL_read = .true. ! Otherwise there would have been a fatal error. endif else - if (is_root_pe()) call MOM_error(WARNING, "depth_list_setup: "// & + if (is_root_pe()) call MOM_error(NOTE, "depth_list_setup: "// & trim(CS%depth_list_file)//" does not exist. Creating a new file.") valid_DL_read = .false. endif diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index bb1b381c15..c2b671f1c6 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -38,7 +38,8 @@ module MOM_wave_speed !! wave speed [nondim]. This parameter controls the default behavior of !! wave_speed() which can be overridden by optional arguments. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of - !! calculating the equivalent barotropic wave speed [Z ~> m]. + !! calculating the equivalent barotropic wave speed [H ~> m or kg m-2]. + !! If this parameter is negative, this limiting does not occur. !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. real :: min_speed2 = 0. !< The minimum mode 1 internal wave speed squared [L2 T-2 ~> m2 s-2] @@ -80,7 +81,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ !! for the purposes of calculating vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as !! monotonic for the purposes of calculating vertical - !! modal structure [Z ~> m]. + !! modal structure [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: modal_structure !< Normalized model structure [nondim] @@ -156,9 +157,11 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ real :: sum_hc ! The sum of the layer thicknesses [Z ~> m] real :: gp ! A limited local copy of gprime [L2 Z-1 T-2 ~> m s-2] real :: N2min ! A minimum buoyancy frequency, including a slope rescaling factor [L2 Z-2 T-2 ~> s-2] + logical :: below_mono_N2_frac ! True if an interface is below the fractional depth where N2 should not increase. + logical :: below_mono_N2_depth ! True if an interface is below the absolute depth where N2 should not increase. logical :: l_use_ebt_mode, calc_modal_structure real :: l_mono_N2_column_fraction ! A local value of mono_N2_column_fraction [nondim] - real :: l_mono_N2_depth ! A local value of mono_N2_column_depth [Z ~> m] + real :: l_mono_N2_depth ! A local value of mono_N2_column_depth [H ~> m or kg m-2] real :: mode_struct(SZK_(GV)) ! The mode structure [nondim], but it is also temporarily ! in units of [L2 T-2 ~> m2 s-2] after it is modified inside of tdma6. real :: ms_min, ms_max ! The minimum and maximum mode structure values returned from tdma6 [L2 T-2 ~> m2 s-2] @@ -213,18 +216,11 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ c2_scale = US%m_s_to_L_T**2 / 4096.0**2 ! Other powers of 2 give identical results. min_h_frac = tol_Hfrac / real(nz) -!$OMP parallel do default(none) shared(is,ie,js,je,nz,h,G,GV,US,min_h_frac,use_EOS,tv,& -!$OMP calc_modal_structure,l_use_ebt_mode,modal_structure, & -!$OMP l_mono_N2_column_fraction,l_mono_N2_depth,CS, & -!$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale, & -!$OMP better_est,cg1_min2,tol_merge,tol_solve,c2_scale) & -!$OMP private(htot,hmin,kf,H_here,HxT_here,HxS_here,HxR_here, & -!$OMP Hf,Tf,Sf,Rf,pres,T_int,S_int,drho_dT,drho_dS, & -!$OMP drxh_sum,kc,Hc,Hc_H,Tc,Sc,I_Hnew,gprime,& -!$OMP Rc,speed2_tot,Igl,Igu,lam0,lam,lam_it,dlam, & -!$OMP mode_struct,sum_hc,N2min,gp,hw, & -!$OMP ms_min,ms_max,ms_sq,H_top,H_bot,I_Htot,merge, & -!$OMP det,ddet,det_it,ddet_it) + !$OMP parallel do default(private) shared(is,ie,js,je,nz,h,G,GV,US,tv,use_EOS, & + !$OMP CS,min_h_frac,calc_modal_structure,l_use_ebt_mode, & + !$OMP modal_structure,l_mono_N2_column_fraction,l_mono_N2_depth, & + !$OMP Z_to_pres,cg1,g_Rho0,rescale,I_rescale,cg1_min2, & + !$OMP better_est,tol_solve,tol_merge,c2_scale) do j=js,je ! First merge very thin layers with the one above (or below if they are ! at the top). This also transposes the row order so that columns can @@ -334,7 +330,7 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ drxh_sum = drxh_sum + 0.5*(Hf(k-1,i)+Hf(k,i)) * max(0.0,Rf(k,i)-Rf(k-1,i)) enddo endif - endif + endif ! use_EOS ! Find gprime across each internal interface, taking care of convective instabilities by ! merging layers. If the estimated wave speed is too small, simply return zero. @@ -451,24 +447,34 @@ subroutine wave_speed(h, tv, G, GV, US, cg1, CS, full_halos, use_ebt_mode, mono_ Igu(1) = 0. ! Neumann condition for pressure modes sum_hc = Hc(1) N2min = gprime(2)/Hc(1) + + below_mono_N2_frac = .false. + below_mono_N2_depth = .false. do k=2,kc hw = 0.5*(Hc(k-1)+Hc(k)) gp = gprime(K) if (l_mono_N2_column_fraction>0. .or. l_mono_N2_depth>=0.) then - !### Change to: if ( ((htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i)) .or. & ) ) - if ( (((G%bathyT(i,j)+G%Z_ref) - sum_hc < l_mono_N2_column_fraction*(G%bathyT(i,j)+G%Z_ref)) .or. & - ((l_mono_N2_depth >= 0.) .and. (sum_hc > l_mono_N2_depth))) .and. & - (gp > N2min*hw) ) then - ! Filters out regions where N2 increases with depth but only in a lower fraction + ! Determine whether N2 estimates should not be allowed to increase with depth. + if (l_mono_N2_column_fraction>0.) then + !### Change to: (htot(i) - sum_hc < l_mono_N2_column_fraction*htot(i)) + below_mono_N2_frac = ((G%bathyT(i,j)+G%Z_ref) - GV%H_to_Z*sum_hc < & + l_mono_N2_column_fraction*(G%bathyT(i,j)+G%Z_ref)) + endif + if (l_mono_N2_depth >= 0.) below_mono_N2_depth = (sum_hc > GV%H_to_Z*l_mono_N2_depth) + + if ( (gp > N2min*hw) .and. (below_mono_N2_frac .or. below_mono_N2_depth) ) then + ! Filters out regions where N2 increases with depth, but only in a lower fraction ! of the water column or below a certain depth. gp = N2min * hw else N2min = gp / hw endif endif + Igu(k) = 1.0/(gp*Hc(k)) Igl(k-1) = 1.0/(gp*Hc(k-1)) sum_hc = sum_hc + Hc(k) + if (better_est) then ! Estimate that the ebt_mode is sqrt(2) times the speed of the flat bottom modes. speed2_tot = speed2_tot + 2.0 * gprime(K)*((H_top(K) * H_bot(K)) * I_Htot) @@ -689,7 +695,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s H_top, & ! The distance of each filtered interface from the ocean surface [Z ~> m] H_bot, & ! The distance of each filtered interface from the bottom [Z ~> m] gprime, & ! The reduced gravity across each interface [L2 Z-1 T-2 ~> m s-2]. - N2 ! The Brunt Vaissalla freqency squared [T-2 ~> s-2] + N2 ! The buoyancy freqency squared [T-2 ~> s-2] real, dimension(SZK_(GV),SZI_(G)) :: & Hf, & ! Layer thicknesses after very thin layers are combined [Z ~> m] Tf, & ! Layer temperatures after very thin layers are combined [C ~> degC] @@ -703,7 +709,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s Sc, & ! A column of layer salinities after convective instabilities are removed [S ~> ppt] Rc, & ! A column of layer densities after convective instabilities are removed [R ~> kg m-3] Hc_H ! Hc(:) rescaled from Z to thickness units [H ~> m or kg m-2] - real :: I_Htot ! The inverse of the total filtered thicknesses [Z ~> m] + real :: I_Htot ! The inverse of the total filtered thicknesses [Z-1 ~> m-1] real :: c2_scale ! A scaling factor for wave speeds to help control the growth of the determinant and its ! derivative with lam between rows of the Thomas algorithm solver [L2 s2 T-2 m-2 ~> nondim]. ! The exact value should not matter for the final result if it is an even power of 2. @@ -796,6 +802,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s ! Simplifying the following could change answers at roundoff. Z_to_pres = GV%Z_to_H * (GV%H_to_RZ * GV%g_Earth) use_EOS = associated(tv%eqn_of_state) + if (CS%c1_thresh < 0.0) & call MOM_error(FATAL, "INTERNAL_WAVE_CG1_THRESH must be set to a non-negative "//& "value via wave_speed_init for wave_speeds to be used.") @@ -977,7 +984,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s I_Hnew = 1.0 / (Hc(kc) + Hc(kc-1)) Tc(kc-1) = (Hc(kc)*Tc(kc) + Hc(kc-1)*Tc(kc-1)) * I_Hnew Sc(kc-1) = (Hc(kc)*Sc(kc) + Hc(kc-1)*Sc(kc-1)) * I_Hnew - Hc(kc-1) = (Hc(kc) + Hc(kc-1)) + Hc(kc-1) = Hc(kc) + Hc(kc-1) kc = kc - 1 else ; exit ; endif enddo @@ -1005,7 +1012,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s if (merge) then ! Merge this layer with the one above and backtrack. Rc(kc) = (Hc(kc)*Rc(kc) + Hf(k,i)*Rf(k,i)) / (Hc(kc) + Hf(k,i)) - Hc(kc) = (Hc(kc) + Hf(k,i)) + Hc(kc) = Hc(kc) + Hf(k,i) ! Backtrack to remove any convective instabilities above... Note ! that the tolerance is a factor of two larger, to avoid limit how ! far back we go. @@ -1018,7 +1025,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s if (merge) then ! Merge the two bottommost layers. At this point kc = k2. Rc(kc-1) = (Hc(kc)*Rc(kc) + Hc(kc-1)*Rc(kc-1)) / (Hc(kc) + Hc(kc-1)) - Hc(kc-1) = (Hc(kc) + Hc(kc-1)) + Hc(kc-1) = Hc(kc) + Hc(kc-1) kc = kc - 1 else ; exit ; endif enddo @@ -1108,7 +1115,7 @@ subroutine wave_speeds(h, tv, G, GV, US, nmodes, cn, CS, w_struct, u_struct, u_s do k=1,kc w2avg = w2avg + 0.5*(mode_struct(K)**2+mode_struct(K+1)**2)*Hc(k) ![Z L4 T-4] enddo - renorm = sqrt(htot(i)*a_int/w2avg) ![L-2 T-2] + renorm = sqrt(htot(i)*a_int/w2avg) ! [T2 L-2] do K=1,kc+1 ; mode_struct(K) = renorm * mode_struct(K) ; enddo ! after renorm, mode_struct is again [nondim] @@ -1436,7 +1443,7 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de !! calculating the vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited !! as monotonic for the purposes of calculating the - !! vertical modal structure [Z ~> m]. + !! vertical modal structure [H ~> m or kg m-2]. logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions !! that recover the remapping answers from 2018. Otherwise !! use more robust but mathematically equivalent expressions. @@ -1465,7 +1472,8 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de call log_version(mdl, version) call wave_speed_set_param(CS, use_ebt_mode=use_ebt_mode, mono_N2_column_fraction=mono_N2_column_fraction, & - better_speed_est=better_speed_est, min_speed=min_speed, wave_speed_tol=wave_speed_tol, & + mono_N2_depth=mono_N2_depth, better_speed_est=better_speed_est, & + min_speed=min_speed, wave_speed_tol=wave_speed_tol, & remap_answers_2018=remap_answers_2018, remap_answer_date=remap_answer_date, & c1_thresh=c1_thresh) @@ -1487,7 +1495,7 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ !! calculating the vertical modal structure [nondim]. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited !! as monotonic for the purposes of calculating the - !! vertical modal structure [Z ~> m]. + !! vertical modal structure [H ~> m or kg m-2]. logical, optional, intent(in) :: remap_answers_2018 !< If true, use the order of arithmetic and expressions !! that recover the remapping answers from 2018. Otherwise !! use more robust but mathematically equivalent expressions. diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 092b12a2d2..58511c866b 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -3184,21 +3184,24 @@ subroutine diag_mediator_init(G, GV, US, nz, param_file, diag_cs, doc_file_dir) default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. - if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701) call get_param(param_file, mdl, 'USE_GRID_SPACE_DIAGNOSTIC_AXES', diag_cs%grid_space_axes, & 'If true, use a grid index coordinate convention for diagnostic axes. ',& default=.false.) diff --git a/src/framework/MOM_file_parser.F90 b/src/framework/MOM_file_parser.F90 index 35d75cff7f..88fabf0c74 100644 --- a/src/framework/MOM_file_parser.F90 +++ b/src/framework/MOM_file_parser.F90 @@ -152,28 +152,34 @@ subroutine open_param_file(filename, CS, checkable, component, doc_file_dir) ! Check that this file has not already been opened if (CS%nfiles > 0) then reopened_file = .false. - inquire(file=trim(filename), number=iounit) - if (iounit /= -1) then - do i = 1, CS%nfiles - if (CS%iounit(i) == iounit) then - call assert(trim(CS%filename(1)) == trim(filename), & - "open_param_file: internal inconsistency! "//trim(filename)// & - " is registered as open but has the wrong unit number!") - call MOM_error(WARNING, & - "open_param_file: file "//trim(filename)// & - " has already been opened. This should NOT happen!"// & - " Did you specify the same file twice in a namelist?") - reopened_file = .true. - endif ! unit numbers - enddo ! i + + if (is_root_pe()) then + inquire(file=trim(filename), number=iounit) + if (iounit /= -1) then + do i = 1, CS%nfiles + if (CS%iounit(i) == iounit) then + call assert(trim(CS%filename(1)) == trim(filename), & + "open_param_file: internal inconsistency! "//trim(filename)// & + " is registered as open but has the wrong unit number!") + call MOM_error(WARNING, & + "open_param_file: file "//trim(filename)// & + " has already been opened. This should NOT happen!"// & + " Did you specify the same file twice in a namelist?") + reopened_file = .true. + endif ! unit numbers + enddo ! i + endif endif + if (any_across_PEs(reopened_file)) return endif ! Check that the file exists to readstdlog - inquire(file=trim(filename), exist=file_exists) - if (.not.file_exists) call MOM_error(FATAL, & - "open_param_file: Input file '"// trim(filename)//"' does not exist.") + if (is_root_pe()) then + inquire(file=trim(filename), exist=file_exists) + if (.not.file_exists) call MOM_error(FATAL, & + "open_param_file: Input file '"// trim(filename)//"' does not exist.") + endif Netcdf_file = .false. if (strlen > 3) then diff --git a/src/framework/MOM_get_input.F90 b/src/framework/MOM_get_input.F90 index b6b5b89be9..b6773ccb21 100644 --- a/src/framework/MOM_get_input.F90 +++ b/src/framework/MOM_get_input.F90 @@ -11,6 +11,7 @@ module MOM_get_input use MOM_file_parser, only : open_param_file, param_file_type use MOM_io, only : file_exists, close_file, slasher, ensembler use MOM_io, only : open_namelist_file, check_nml_error +use posix, only : mkdir, stat, stat_buf implicit none ; private @@ -54,6 +55,8 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename, character(len=240) :: output_dir integer :: unit, io, ierr, valid_param_files + type(stat_buf) :: buf + namelist /MOM_input_nml/ output_directory, input_filename, parameter_filename, & restart_input_dir, restart_output_dir @@ -73,6 +76,7 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename, endif ! Read namelist parameters + ! NOTE: Every rank is reading MOM_input_nml ierr=1 ; do while (ierr /= 0) read(unit, nml=MOM_input_nml, iostat=io, end=10) ierr = check_nml_error(io, 'MOM_input_nml') @@ -92,6 +96,15 @@ subroutine get_MOM_input(param_file, dirs, check_params, default_input_filename, dirs%restart_input_dir = slasher(ensembler(restart_input_dir)) dirs%input_filename = ensembler(input_filename) endif + + ! Create the RESTART directory if absent + if (is_root_PE()) then + if (stat(trim(dirs%restart_output_dir), buf) == -1) then + ierr = mkdir(trim(dirs%restart_output_dir), int(o'700')) + if (ierr == -1) & + call MOM_error(FATAL, 'Restart directory could not be created.') + endif + endif endif ! Open run-time parameter file(s) diff --git a/src/framework/posix.F90 b/src/framework/posix.F90 index 213ff4656d..fffb619cba 100644 --- a/src/framework/posix.F90 +++ b/src/framework/posix.F90 @@ -13,6 +13,16 @@ module posix implicit none +!> Container for file metadata from stat +!! +!! NOTE: This is currently just a placeholder containing fields, such as size, +!! uid, mode, etc. A readable Fortran type may be used in the future. +type, bind(c) :: stat_buf + private + character(kind=c_char) :: state(SIZEOF_STAT_BUF) + !< Byte array containing file metadata +end type stat_buf + !> Container for the jump point buffer created by setjmp(). !! !! The buffer typically contains the current register values, stack pointers, @@ -52,6 +62,34 @@ function chmod_posix(path, mode) result(rc) bind(c, name="chmod") !< Function return code end function chmod_posix + !> C interface to POSIX mkdir() + !! Users should use the Fortran-defined mkdir() function. + function mkdir_posix(path, mode) result(rc) bind(c, name="mkdir") + ! #include + ! int mkdir(const char *path, mode_t mode); + import :: c_char, c_int + + character(kind=c_char), dimension(*), intent(in) :: path + !< Zero-delimited file path + integer(kind=c_int), value, intent(in) :: mode + !< File permission to be assigned to file. + integer(kind=c_int) :: rc + !< Function return code + end function mkdir_posix + + !> C interface to POSIX stat() + !! Users should use the Fortran-defined stat() function. + function stat_posix(path, buf) result(rc) bind(c, name="stat") + import :: c_char, stat_buf, c_int + + character(kind=c_char), dimension(*), intent(in) :: path + !< Pathname of a POSIX file + type(stat_buf), intent(in) :: buf + !< Information describing the file if it exists + integer(kind=c_int) :: rc + !< Function return code + end function + !> C interface to POSIX signal() !! Users should use the Fortran-defined signal() function. function signal_posix(sig, func) result(handle) bind(c, name="signal") @@ -240,6 +278,44 @@ function chmod(path, mode) result(rc) rc = int(rc_c) end function chmod +!> Create a file directory +!! +!! This creates a new directory named `path` with permissons set by `mode`. +!! If successful, it returns zero. Otherwise, it returns -1. +function mkdir(path, mode) result(rc) + character(len=*), intent(in) :: path + integer, intent(in) :: mode + integer :: rc + + integer(kind=c_int) :: mode_c + integer(kind=c_int) :: rc_c + + mode_c = int(mode, kind=c_int) + rc_c = mkdir_posix(path//c_null_char, mode_c) + rc = int(rc_c) +end function mkdir + +!> Get file status +!! +!! This obtains information about the named file and writes it to buf. +!! If found, it returns zero. Otherwise, it returns -1. +function stat(path, buf) result(rc) + character(len=*), intent(in) :: path + !< Pathname of file to be inspected + type(stat_buf), intent(out) :: buf + !< Buffer containing information about the file if it exists + ! NOTE: Currently the contents of buf are not readable, but we could move + ! the contents into a readable Fortran type. + integer :: rc + !< Function return code + + integer(kind=c_int) :: rc_c + + rc_c = stat_posix(path//c_null_char, buf) + + rc = int(rc_c) +end function stat + !> Create a signal handler `handle` to be called when `sig` is detected. !! !! If successful, the previous handler for `sig` is returned. Otherwise, @@ -359,6 +435,9 @@ function setjmp_missing(env) result(rc) bind(c) print '(a)', 'ERROR: setjmp() is not implemented in this build.' print '(a)', 'Recompile with autoconf or -DSETJMP_NAME=\"\".' error stop + + ! NOTE: compilers may expect a return value, even if it is unreachable + rc = -1 end function setjmp_missing !> Placeholder function for a missing or unconfigured longjmp @@ -386,7 +465,7 @@ function sigsetjmp_missing(env, savesigs) result(rc) bind(c) print '(a)', 'Recompile with autoconf or -DSIGSETJMP_NAME=\"\".' error stop - ! NOTE: Compilers may expect a return value, even if it is unreachable + ! NOTE: compilers may expect a return value, even if it is unreachable rc = -1 end function sigsetjmp_missing diff --git a/src/framework/posix.h b/src/framework/posix.h index f7cea0fec9..c4b09e1285 100644 --- a/src/framework/posix.h +++ b/src/framework/posix.h @@ -1,6 +1,12 @@ #ifndef MOM6_POSIX_H_ #define MOM6_POSIX_H_ +! STAT_BUF_SIZE should be set to sizeof(stat). +! The default value is based on glibc 2.28. +#ifndef SIZEOF_STAT_BUF +#define SIZEOF_STAT_BUF 144 +#endif + ! JMP_BUF_SIZE should be set to sizeof(jmp_buf). ! If unset, then use a typical glibc value (25 long ints) #ifndef SIZEOF_JMP_BUF diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 8e0e58c1b6..d0faeb3aae 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -185,6 +185,14 @@ module MOM_ice_shelf !! salinity [C S-1 ~> degC ppt-1] real :: dTFr_dp !< Partial derivative of freezing temperature with !! pressure [C T2 R-1 L-2 ~> degC Pa-1] + real :: Zeta_N !< The stability constant xi_N = 0.052 from Holland & Jenkins '99 + !! divided by the von Karman constant VK. Was 1/8. + real :: Vk !< Von Karman's constant - dimensionless + real :: Rc !< critical flux Richardson number. + logical :: buoy_flux_itt_bug !< If true, fixes buoyancy iteration bug + logical :: salt_flux_itt_bug !< If true, fixes salt iteration bug + real :: buoy_flux_itt_threshold !< Buoyancy iteration threshold for convergence + !>@{ Diagnostic handles integer :: id_melt = -1, id_exch_vel_s = -1, id_exch_vel_t = -1, & id_tfreeze = -1, id_tfl_shelf = -1, & @@ -261,10 +269,10 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) !! interface, positive for melting and negative for freezing [S ~> ppt]. !! This is computed as part of the ISOMIP diagnostics. real :: time_step !< Length of time over which these fluxes will be applied [T ~> s]. - real, parameter :: VK = 0.40 !< Von Karman's constant - dimensionless - real :: ZETA_N = 0.052 !> The fraction of the boundary layer over which the - !! viscosity is linearly increasing [nondim]. (Was 1/8. Why?) - real, parameter :: RC = 0.20 ! critical flux Richardson number. + real :: VK !< Von Karman's constant - dimensionless + real :: ZETA_N !< This is the stability constant xi_N = 0.052 from Holland & Jenkins '99 + !! divided by the von Karman constant VK. Was 1/8. [nondim] + real :: RC !< critical flux Richardson number. real :: I_ZETA_N !< The inverse of ZETA_N [nondim]. real :: I_LF !< The inverse of the latent heat of fusion [Q-1 ~> kg J-1]. real :: I_VK !< The inverse of the Von Karman constant [nondim]. @@ -346,6 +354,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) endif ! useful parameters is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ied = G%ied ; jed = G%jed + ZETA_N = CS%Zeta_N + VK = CS%Vk + RC = CS%Rc I_ZETA_N = 1.0 / ZETA_N I_LF = 1.0 / CS%Lat_fusion SC = CS%kv_molec/CS%kd_molec_salt @@ -527,7 +538,7 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) if (wB_flux < 0.0) then ! The buoyancy flux is stabilizing and will reduce the turbulent ! fluxes, and iteration is required. - n_star_term = (ZETA_N/RC) * (hBL_neut * VK) / (ustar_h)**3 + n_star_term = (ZETA_N * hBL_neut * VK) / (RC * ustar_h**3) do it3 = 1,30 ! n_star <= 1.0 is the ratio of working boundary layer thickness ! to the neutral thickness. @@ -558,13 +569,15 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) wT_flux = dT_ustar * I_Gam_T wB_flux_new = dB_dS * (dS_ustar * I_Gam_S) + dB_dT * wT_flux - ! Find the root where wB_flux_new = wB_flux. Make the 1.0e-4 below into a parameter? - if (abs(wB_flux_new - wB_flux) < 1.0e-4*(abs(wB_flux_new) + abs(wB_flux))) exit + ! Find the root where wB_flux_new = wB_flux. + if (abs(wB_flux_new - wB_flux) < CS%buoy_flux_itt_threshold*(abs(wB_flux_new) + abs(wB_flux))) exit dDwB_dwB_in = dG_dwB * (dB_dS * (dS_ustar * I_Gam_S**2) + & dB_dT * (dT_ustar * I_Gam_T**2)) - 1.0 ! This is Newton's method without any bounds. Should bounds be needed? wB_flux_new = wB_flux - (wB_flux_new - wB_flux) / dDwB_dwB_in + ! Update wB_flux + if (CS%buoy_flux_itt_bug) wB_flux = wB_flux_new enddo !it3 endif @@ -637,7 +650,8 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) Sbdry(i,j) = Sbdry_it endif ! Sb_min_set - Sbdry(i,j) = Sbdry_it + if (.not.CS%salt_flux_itt_bug) Sbdry(i,j) = Sbdry_it + endif ! CS%find_salt_root enddo !it1 @@ -1514,7 +1528,24 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, call get_param(param_file, mdl, "READ_TIDEAMP", read_TIDEAMP, & "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) - + call get_param(param_file, mdl, "ICE_SHELF_LINEAR_SHELF_FRAC", CS%Zeta_N, & + "Ratio of HJ99 stability constant xi_N (ratio of maximum "//& + "mixing length to planetary boundary layer depth in "//& + "neutrally stable conditions) to the von Karman constant", & + units="nondim", default=0.13) + call get_param(param_file, mdl, "ICE_SHELF_VK_CNST", CS%Vk, & + "Von Karman constant.", & + units="nondim", default=0.40) + call get_param(param_file, mdl, "ICE_SHELF_RC", CS%Rc, & + "Critical flux Richardson number for ice melt ", & + units="nondim", default=0.20) + call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_BUG", CS%buoy_flux_itt_bug, & + "Bug fix of buoyancy iteration", default=.true.) + call get_param(param_file, mdl, "ICE_SHELF_SALT_FLUX_ITT_BUG", CS%salt_flux_itt_bug, & + "Bug fix of salt iteration", default=.true.) + call get_param(param_file, mdl, "ICE_SHELF_BUOYANCY_FLUX_ITT_THRESHOLD", CS%buoy_flux_itt_threshold, & + "Convergence criterion of Newton's method for ice shelf "//& + "buoyancy iteration.", units="nondim", default=1.0e-4) if (PRESENT(sfc_state_in)) then allocate(sfc_state) diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 8af8cd3bc6..37c719209b 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -126,6 +126,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) ! Local variables real :: g_int ! Reduced gravities across the internal interfaces [L2 Z-1 T-2 ~> m s-2]. real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2]. + real :: Rlay_Ref ! The target density of the surface layer [R ~> kg m-3]. character(len=40) :: mdl = "set_coord_from_gprime" ! This subroutine's name. integer :: k, nz nz = GV%ke @@ -138,11 +139,20 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true., scale=US%m_s_to_L_T**2*US%Z_to_m) + call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & + "The reference potential density used for layer 1.", & + units="kg m-3", default=US%R_to_kg_m3*GV%Rho0, scale=US%kg_m3_to_R) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = g_int ; enddo - Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + Rlay(1) = Rlay_Ref + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + else + do k=2,nz + Rlay(k) = Rlay(k-1) * ((GV%g_Earth + 0.5*g_prime(k)) / (GV%g_Earth - 0.5*g_prime(k))) + enddo + endif call callTree_leave(trim(mdl)//'()') @@ -184,9 +194,15 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, US, param_file) enddo ! These statements set the interface reduced gravities. ! g_prime(1) = g_fs - do k=2,nz - g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) - enddo + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do k=2,nz + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + enddo + else + do k=2,nz + g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1)) + enddo + endif call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_layer_density @@ -237,7 +253,13 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, US, param_file, eqn_of_state call calculate_density(T_ref, S_ref, P_ref, Rlay(1), eqn_of_state) ! These statements set the layer densities. ! - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + else + do k=2,nz + Rlay(k) = Rlay(k-1) * ((GV%g_Earth + 0.5*g_prime(k)) / (GV%g_Earth - 0.5*g_prime(k))) + enddo + endif call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref @@ -294,7 +316,15 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, US, param_file, eqn_of_s g_prime(1) = g_fs do k=1,nz ; Pref(k) = P_Ref ; enddo call calculate_density(T0, S0, Pref, Rlay, eqn_of_state, (/1,nz/) ) - do k=2,nz; g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) ; enddo + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do k=2,nz + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + enddo + else + do k=2,nz + g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1)) + enddo + endif call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile @@ -387,7 +417,15 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, US, param_file, eqn_of_sta do k=k_light-1,1,-1 Rlay(k) = 2.0*Rlay(k+1) - Rlay(k+2) enddo - do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do k=2,nz + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + enddo + else + do k=2,nz + g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1)) + enddo + endif call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range @@ -429,7 +467,15 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, US, param_file) call MOM_read_data(filename, coord_var, Rlay, scale=US%kg_m3_to_R) g_prime(1) = g_fs - do k=2,nz ; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) ; enddo + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do k=2,nz + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + enddo + else + do k=2,nz + g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1)) + enddo + endif do k=1,nz ; if (g_prime(k) <= 0.0) then call MOM_error(FATAL, "MOM_initialization set_coord_from_file: "//& "Zero or negative g_primes read from variable "//"Layer"//" in file "//& @@ -479,9 +525,15 @@ subroutine set_coord_linear(Rlay, g_prime, GV, US, param_file) enddo ! These statements set the interface reduced gravities. g_prime(1) = g_fs - do k=2,nz - g_prime(k) = (GV%g_Earth/(GV%Rho0)) * (Rlay(k) - Rlay(k-1)) - enddo + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do k=2,nz + g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) + enddo + else + do k=2,nz + g_prime(k) = 2.0*GV%g_Earth * (Rlay(k) - Rlay(k-1)) / (Rlay(k) + Rlay(k-1)) + enddo + endif call callTree_leave(trim(mdl)//'()') end subroutine set_coord_linear @@ -498,6 +550,7 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! Local variables real :: g_fs ! Reduced gravity across the free surface [L2 Z-1 T-2 ~> m s-2]. + real :: Rlay_Ref ! The target density of the surface layer [R ~> kg m-3]. character(len=40) :: mdl = "set_coord_to_none" ! This subroutine's name. integer :: k, nz nz = GV%ke @@ -507,11 +560,20 @@ subroutine set_coord_to_none(Rlay, g_prime, GV, US, param_file) call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth*US%L_T_to_m_s**2*US%m_to_Z, scale=US%m_s_to_L_T**2*US%Z_to_m) + call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & + "The reference potential density used for layer 1.", & + units="kg m-3", default=US%R_to_kg_m3*GV%Rho0, scale=US%kg_m3_to_R) g_prime(1) = g_fs do k=2,nz ; g_prime(k) = 0. ; enddo - Rlay(1) = GV%Rho0 - do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + Rlay(1) = Rlay_Ref + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo + else + do k=2,nz + Rlay(k) = Rlay(k-1) * ((GV%g_Earth + 0.5*g_prime(k)) / (GV%g_Earth - 0.5*g_prime(k))) + enddo + endif call callTree_leave(trim(mdl)//'()') @@ -522,8 +584,8 @@ end subroutine set_coord_to_none subroutine write_vertgrid_file(GV, US, param_file, directory) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - character(len=*), intent(in) :: directory !< The directory into which to place the file. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + character(len=*), intent(in) :: directory !< The directory into which to place the file. ! Local variables character(len=240) :: filepath type(vardesc) :: vars(2) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 802fd33d0f..ddccf4a754 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -153,7 +153,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & real :: depth_tot(SZI_(G),SZJ_(G)) ! The nominal total depth of the ocean [Z ~> m] real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) ! The layer thicknesses in geopotential (z) units [Z ~> m] character(len=200) :: inputdir ! The directory where NetCDF input files are. - character(len=200) :: config + character(len=200) :: config, h_config real :: H_rescale ! A rescaling factor for thicknesses from the representation in ! a restart file to the internal representation in this run [various units ~> 1] real :: dt ! The baroclinic dynamics timestep for this run [T ~> s]. @@ -263,7 +263,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & convert = .false. else ! Initialize thickness, h. - call get_param(PF, mdl, "THICKNESS_CONFIG", config, & + call get_param(PF, mdl, "THICKNESS_CONFIG", h_config, & "A string that determines how the initial layer "//& "thicknesses are specified for a new run: \n"//& " \t file - read interface heights from the file specified \n"//& @@ -294,7 +294,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& " \t USER - call a user modified routine.", & default="uniform", do_not_log=just_read) - select case (trim(config)) + select case (trim(h_config)) case ("file") call initialize_thickness_from_file(dz, depth_tot, G, GV, US, PF, file_has_thickness=.false., & mass_file=.false., just_read=just_read) @@ -344,12 +344,13 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("soliton"); call soliton_initialize_thickness(dz, depth_tot, G, GV, US) case ("phillips"); call Phillips_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("rossby_front"); call Rossby_front_initialize_thickness(dz, G, GV, US, & - PF, just_read=just_read) + case ("rossby_front") + call Rossby_front_initialize_thickness(h, G, GV, US, PF, just_read=just_read) + convert = .false. ! Rossby_front initialization works directly in thickness units. case ("USER"); call user_initialize_thickness(dz, G, GV, PF, & just_read=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& - "Unrecognized layer thickness configuration "//trim(config)) + "Unrecognized layer thickness configuration "//trim(h_config)) end select ! Initialize temperature and salinity (T and S). @@ -376,6 +377,16 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & " \t USER - call a user modified routine.", & fail_if_missing=new_sim, do_not_log=just_read) ! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& + + ! Check for incompatible THICKNESS_CONFIG and TS_CONFIG settings + if (new_sim .and. (.not.convert)) then ; select case (trim(config)) + case ("DOME2D", "ISOMIP", "adjustment2d", "baroclinic_zone", "sloshing", & + "seamount", "dumbbell", "SCM_CVMix_tests", "dense") + call MOM_error(FATAL, "TS_CONFIG = "//trim(config)//" does not work with thicknesses "//& + "that have already been converted to thickness units, as is the case with "//& + "THICKNESS_CONFIG = "//trim(h_config)//".") + end select ; endif + select case (trim(config)) case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, US, PF, & eos, tv%P_Ref, just_read=just_read) @@ -401,8 +412,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & tv%S, dz, G, GV, US, PF, just_read=just_read) case ("dumbbell"); call dumbbell_initialize_temperature_salinity(tv%T, & tv%S, dz, G, GV, US, PF, just_read=just_read) - case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & - tv%S, dz, G, GV, US, PF, just_read=just_read) + case ("rossby_front") + if (convert .and. .not.just_read) call dz_to_thickness(dz, tv, h, G, GV, US) + call Rossby_front_initialize_temperature_salinity ( tv%T, tv%S, h, & + G, GV, US, PF, just_read=just_read) case ("SCM_CVMix_tests"); call SCM_CVMix_tests_TS_init(tv%T, tv%S, dz, & G, GV, US, PF, just_read=just_read) case ("dense"); call dense_water_initialize_TS(G, GV, US, PF, tv%T, tv%S, & @@ -1158,23 +1171,29 @@ subroutine trim_for_ice(PF, G, GV, US, ALE_CSp, tv, h, just_read) default=99991231, do_not_log=just_read) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101), do_not_log=just_read) + default=(default_answer_date<20190101), do_not_log=just_read.or.(.not.GV%Boussinesq)) call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read) + "forms of the same expressions.", & + default=default_2018_answers, do_not_log=just_read.or.(.not.GV%Boussinesq)) ! Revise inconsistent default answer dates for remapping. - if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date, do_not_log=just_read) + "latter takes precedence.", & + default=default_answer_date, do_not_log=just_read.or.(.not.GV%Boussinesq)) + if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701) else remap_answer_date = 20181231 + if (.not.GV%Boussinesq) remap_answer_date = 20230701 endif if (just_read) return ! All run-time parameters have been read, so return. @@ -2579,7 +2598,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just default=99991231, do_not_log=just_read) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101), do_not_log=just_read) + default=(default_answer_date<20190101), do_not_log=just_read.or.(.not.GV%Boussinesq)) call get_param(PF, mdl, "TEMP_SALT_INIT_VERTICAL_REMAP_ONLY", pre_gridded, & "If true, initial conditions are on the model horizontal grid. " //& "Extrapolation over missing ocean values is done using an ICE-9 "//& @@ -2589,34 +2608,44 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read) + "forms of the same expressions.", & + default=default_2018_answers, do_not_log=just_read.or.(.not.GV%Boussinesq)) ! Revise inconsistent default answer dates for remapping. default_remap_ans_date = default_answer_date - if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 - if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + endif call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_remap_ans_date, do_not_log=just_read) + "latter takes precedence.", & + default=default_remap_ans_date, do_not_log=just_read.or.(.not.GV%Boussinesq)) + if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701) endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& - "forms of the same expressions.", default=default_2018_answers, do_not_log=just_read) + "forms of the same expressions.", & + default=default_2018_answers, do_not_log=just_read.or.(.not.GV%Boussinesq)) ! Revise inconsistent default answer dates for horizontal regridding. default_hor_reg_ans_date = default_answer_date - if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 - if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + if (GV%Boussinesq) then + if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 + if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + endif call get_param(PF, mdl, "HOR_REGRID_ANSWER_DATE", hor_regrid_answer_date, & "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_hor_reg_ans_date, do_not_log=just_read) + "latter takes precedence.", & + default=default_hor_reg_ans_date, do_not_log=just_read.or.(.not.GV%Boussinesq)) + if (.not.GV%Boussinesq) hor_regrid_answer_date = max(hor_regrid_answer_date, 20230701) if (.not.useALEremapping) then call get_param(PF, mdl, "ADJUST_THICKNESS", correct_thickness, & diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index 64f6673371..decd197b2b 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -127,39 +127,45 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ default=99991231) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) if (useALE) then call get_param(PF, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. default_remap_ans_date = default_answer_date - if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 - if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + endif call get_param(PF, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_remap_ans_date) + "latter takes precedence.", default=default_remap_ans_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701) endif call get_param(PF, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizonal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for horizontal regridding. default_hor_reg_ans_date = default_answer_date - if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 - if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + if (GV%Boussinesq) then + if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 + if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + endif call get_param(PF, mdl, "HOR_REGRID_ANSWER_DATE", hor_regrid_answer_date, & "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_hor_reg_ans_date) + "latter takes precedence.", default=default_hor_reg_ans_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) hor_regrid_answer_date = max(hor_regrid_answer_date, 20230701) if (PRESENT(homogenize)) homog=homogenize if (PRESENT(useALEremapping)) useALE=useALEremapping diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index 53615b0063..fc67b20e87 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -255,20 +255,24 @@ subroutine init_oda(Time, G, GV, US, diag_CS, CS) default=99991231) call get_param(PF, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(PF, mdl, "ODA_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from original version of the ODA driver. Otherwise, use updated and "//& - "more robust forms of the same expressions.", default=default_2018_answers) + "more robust forms of the same expressions.", & + default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(PF, mdl, "ODA_ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic and expressions used by the ODA driver "//& "Values below 20190101 recover the answers from the end of 2018, while higher "//& "values use updated and more robust forms of the same expressions. "//& "If both ODA_2018_ANSWERS and ODA_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) inputdir = slasher(inputdir) select case(lowercase(trim(assim_method))) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 02338fab96..3059ca1637 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -311,13 +311,13 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h do j=js,je ; do I=is-1,ie drag_vel_u(I,j) = 0.0 if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & - drag_vel_u(I,j) = visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + drag_vel_u(I,j) = GV%H_to_Z*visc%Kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) enddo ; enddo !$OMP parallel do default(shared) do J=js-1,je ; do i=is,ie drag_vel_v(i,J) = 0.0 if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & - drag_vel_v(i,J) = visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + drag_vel_v(i,J) = GV%H_to_Z*visc%Kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) enddo ; enddo !$OMP parallel do default(shared) @@ -1578,7 +1578,8 @@ subroutine ML_MEKE_calculate_features(G, GV, US, CS, Rd_dx_h, u, v, tv, h, dt, f h_v(i,J,k) = 0.5*(h(i,j,k)*G%mask2dT(i,j) + h(i,j+1,k)*G%mask2dT(i,j+1)) + GV%Angstrom_H enddo; enddo; enddo; call find_eta(h, tv, G, GV, US, e, halo_size=2) - call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*1.e-7, .false., slope_x, slope_y) + ! Note the hard-coded dimenisional constant in the following line. + call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*1.e-7*GV%m2_s_to_HZ_T, .false., slope_x, slope_y) call pass_vector(slope_x, slope_y, G%Domain) do j=js-1,je+1; do i=is-1,ie+1 slope_x_vert_avg(I,j) = vertical_average_interface(slope_x(i,j,:), h_u(i,j,:), GV%H_subroundoff) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 9037c71c5a..f9a35c1e3d 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -98,7 +98,7 @@ module MOM_hor_visc !! the answers from the end of 2018, while higher values use updated !! and more robust forms of the same expressions. real :: GME_h0 !< The strength of GME tapers quadratically to zero when the bathymetric - !! depth is shallower than GME_H0 [Z ~> m] + !! total water column thickness is less than GME_H0 [H ~> m or kg m-2] real :: GME_efficiency !< The nondimensional prefactor multiplying the GME coefficient [nondim] real :: GME_limiter !< The absolute maximum value the GME coefficient is allowed to take [L2 T-1 ~> m2 s-1]. real :: min_grid_Kh !< Minimum horizontal Laplacian viscosity used to @@ -284,7 +284,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, grad_div_mag_h, & ! Magnitude of divergence gradient at h-points [L-1 T-1 ~> m-1 s-1] dudx, dvdy, & ! components in the horizontal tension [T-1 ~> s-1] GME_effic_h, & ! The filtered efficiency of the GME terms at h points [nondim] - htot ! The total thickness of all layers [Z ~> m] + htot ! The total thickness of all layers [H ~> m or kg m-2] real :: Del2vort_h ! Laplacian of vorticity at h-points [L-2 T-1 ~> m-2 s-1] real :: grad_vel_mag_bt_h ! Magnitude of the barotropic velocity gradient tensor squared at h-points [T-2 ~> s-2] real :: boundary_mask_h ! A mask that zeroes out cells with at least one land edge [nondim] @@ -353,8 +353,8 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, real :: hu, hv ! Thicknesses interpolated by arithmetic means to corner ! points; these are first interpolated to u or v velocity ! points where masks are applied [H ~> m or kg m-2]. - real :: h_arith_q ! The arithmetic mean total thickness at q points [Z ~> m] - real :: I_GME_h0 ! The inverse of GME tapering scale [Z-1 ~> m-1] + real :: h_arith_q ! The arithmetic mean total thickness at q points [H ~> m or kg m-2] + real :: I_GME_h0 ! The inverse of GME tapering scale [H-1 ~> m-1 or m2 kg-1] real :: h_neglect ! thickness so small it can be lost in roundoff and so neglected [H ~> m or kg m-2] real :: h_neglect3 ! h_neglect^3 [H3 ~> m3 or kg3 m-6] real :: h_min ! Minimum h at the 4 neighboring velocity points [H ~> m] @@ -494,7 +494,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, htot(i,j) = 0.0 enddo ; enddo do k=1,nz ; do j=js-2,je+2 ; do i=is-2,ie+2 - htot(i,j) = htot(i,j) + GV%H_to_Z*h(i,j,k) + htot(i,j) = htot(i,j) + h(i,j,k) enddo ; enddo ; enddo I_GME_h0 = 1.0 / CS%GME_h0 @@ -1795,20 +1795,24 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "HOR_VISC_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for horizontal viscosity. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "HOR_VISC_ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic and expressions in the horizontal "//& "viscosity calculations. Values below 20190101 recover the answers from the "//& "end of 2018, while higher values use updated and more robust forms of the "//& "same expressions. If both HOR_VISC_2018_ANSWERS and HOR_VISC_ANSWER_DATE are "//& - "specified, the latter takes precedence.", default=default_answer_date) + "specified, the latter takes precedence.", & + default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & @@ -2042,7 +2046,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) call get_param(param_file, mdl, "GME_H0", CS%GME_h0, & "The strength of GME tapers quadratically to zero when the bathymetric "//& "depth is shallower than GME_H0.", & - units="m", scale=US%m_to_Z, default=1000.0) + units="m", scale=GV%m_to_H, default=1000.0) call get_param(param_file, mdl, "GME_EFFICIENCY", CS%GME_efficiency, & "The nondimensional prefactor multiplying the GME coefficient.", & units="nondim", default=1.0) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 8c56107a4f..788e922ff2 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -78,9 +78,10 @@ module MOM_internal_tides real, allocatable, dimension(:,:,:,:,:) :: TKE_Froude_loss !< energy lost due to wave breaking [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:) :: TKE_itidal_loss_fixed - !< Fixed part of the energy lost due to small-scale drag [R L-2 Z3 ~> kg m-2] here; - !! This will be multiplied by N and the squared near-bottom velocity to get - !! the energy losses in [R Z3 T-3 ~> W m-2] + !< Fixed part of the energy lost due to small-scale drag [R Z3 L-2 ~> kg m-2] here; + !! This will be multiplied by N and the squared near-bottom velocity (and by + !! the near-bottom density in non-Boussinesq mode) to get the energy losses + !! in [R Z4 H-1 L-2 ~> kg m-2 or m] real, allocatable, dimension(:,:,:,:,:) :: TKE_itidal_loss !< energy lost due to small-scale wave drag [R Z3 T-3 ~> W m-2] real, allocatable, dimension(:,:,:,:,:) :: TKE_residual_loss @@ -120,7 +121,7 @@ module MOM_internal_tides real :: cdrag !< The bottom drag coefficient [nondim]. real :: drag_min_depth !< The minimum total ocean thickness that will be used in the denominator !! of the quadratic drag terms for internal tides when - !! INTERNAL_TIDE_QUAD_DRAG is true [Z ~> m] + !! INTERNAL_TIDE_QUAD_DRAG is true [H ~> m or kg m-2] logical :: apply_background_drag !< If true, apply a drag due to background processes as a sink. logical :: apply_bottom_drag @@ -187,7 +188,7 @@ module MOM_internal_tides !> Calls subroutines in this file that are needed to refract, propagate, !! and dissipate energy density of the internal tide. -subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, & +subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, Rho_bot, dt, & G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -203,6 +204,8 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, & real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: Nb !< Near-bottom buoyancy frequency [T-1 ~> s-1]. !! In some cases the input values are used, but in !! others this is set along with the wave speeds. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Rho_bot !< Near-bottom density or the Boussinesq + !! reference density [R ~> kg m-3]. real, intent(in) :: dt !< Length of time over which to advance !! the internal tides [T ~> s]. type(int_tide_CS), intent(inout) :: CS !< Internal tide control structure @@ -228,8 +231,8 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, & real :: frac_per_sector ! The inverse of the number of angular, modal and frequency bins [nondim] real :: f2 ! The squared Coriolis parameter interpolated to a tracer point [T-2 ~> s-2] real :: Kmag2 ! A squared horizontal wavenumber [L-2 ~> m-2] - real :: I_D_here ! The inverse of the local depth [Z-1 ~> m-1] - real :: I_rho0 ! The inverse fo the Boussinesq density [R-1 ~> m3 kg-1] + real :: I_D_here ! The inverse of the local water column thickness [H-1 ~> m-1 or m2 kg-1] + real :: I_mass ! The inverse of the local water mass [R-1 Z-1 ~> m2 kg-1] real :: freq2 ! The frequency squared [T-2 ~> s-2] real :: PE_term ! total potential energy of profile [R Z ~> kg m-2] real :: KE_term ! total kinetic energy of profile [R Z ~> kg m-2] @@ -244,7 +247,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, & real :: En_initial, Delta_E_check ! Energies for debugging [R Z3 T-2 ~> J m-2] real :: TKE_Froude_loss_check, TKE_Froude_loss_tot ! Energy losses for debugging [R Z3 T-3 ~> W m-2] character(len=160) :: mesg ! The text of an error message - integer :: a, m, fr, i, j, k, is, ie, js, je, isd, ied, jsd, jed, nAngle, nzm + integer :: a, m, fr, i, j, k, is, ie, js, je, isd, ied, jsd, jed, nAngle integer :: id_g, jd_g ! global (decomp-invar) indices (for debugging) type(group_pass_type), save :: pass_test, pass_En type(time_type) :: time_end @@ -252,8 +255,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, & is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nAngle = CS%NAngle - nzm = GV%ke - I_rho0 = 1.0 / GV%Rho0 + cn_subRO = 1e-30*US%m_s_to_L_T en_subRO = 1e-30*US%W_m2_to_RZ3_T3*US%s_to_T @@ -429,11 +431,20 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, & do k=1,GV%ke ; do j=jsd,jed ; do i=isd,ied htot(i,j) = htot(i,j) + h(i,j,k) enddo ; enddo ; enddo - do j=jsd,jed ; do i=isd,ied - I_D_here = 1.0 / (max(GV%H_to_Z*htot(i,j), CS%drag_min_depth)) - drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, US%L_to_Z**2*vel_btTide(i,j)**2 + & - tot_En(i,j) * I_rho0 * I_D_here)) * I_D_here - enddo ; enddo + if (GV%Boussinesq) then + ! This is mathematically equivalent to the form in the option below, but they differ at roundoff. + do j=jsd,jed ; do i=isd,ied + I_D_here = 1.0 / (max(htot(i,j), CS%drag_min_depth)) + drag_scale(i,j) = CS%cdrag * sqrt(max(0.0, US%L_to_Z**2*vel_btTide(i,j)**2 + & + tot_En(i,j) * GV%RZ_to_H * I_D_here)) * GV%Z_to_H*I_D_here + enddo ; enddo + else + do j=jsd,jed ; do i=isd,ied + I_mass = GV%RZ_to_H / (max(htot(i,j), CS%drag_min_depth)) + drag_scale(i,j) = (CS%cdrag * (Rho_bot(i,j)*I_mass)) * & + sqrt(max(0.0, US%L_to_Z**2*vel_btTide(i,j)**2 + tot_En(i,j) * I_mass)) + enddo ; enddo + endif do m=1,CS%nMode ; do fr=1,CS%nFreq ; do a=1,CS%nAngle ; do j=jsd,jed ; do i=isd,ied ! Calculate loss rate and apply loss over the time step ; apply the same drag timescale ! to each En component (technically not correct; fix later) @@ -504,7 +515,7 @@ subroutine propagate_int_tide(h, tv, TKE_itidal_input, vel_btTide, Nb, dt, & ! Finally, apply loss if (CS%apply_wave_drag) then ! Calculate loss rate and apply loss over the time step - call itidal_lowmode_loss(G, US, CS, Nb, Ub, CS%En, CS%TKE_itidal_loss_fixed, & + call itidal_lowmode_loss(G, GV, US, CS, Nb, Rho_bot, Ub, CS%En, CS%TKE_itidal_loss_fixed, & CS%TKE_itidal_loss, dt, full_halos=.false.) endif ! Check for En<0 - for debugging, delete later @@ -782,18 +793,21 @@ end subroutine sum_En !> Calculates the energy lost from the propagating internal tide due to !! scattering over small-scale roughness along the lines of Jayne & St. Laurent (2001). -subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) +subroutine itidal_lowmode_loss(G, GV, US, CS, Nb, Rho_bot, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) 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 type(int_tide_CS), intent(in) :: CS !< Internal tide control structure real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(in) :: Nb !< Near-bottom stratification [T-1 ~> s-1]. + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(in) :: Rho_bot !< Near-bottom density [R ~> kg m-3]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & intent(inout) :: Ub !< RMS (over one period) near-bottom horizontal !! mode velocity [L T-1 ~> m s-1]. real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [R L-2 Z3 ~> kg m-2] - !! (rho*kappa*h^2). + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss [R Z4 H-1 L-2 ~> kg m-2 or m] + !! (rho*kappa*h^2) or (kappa*h^2). real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & intent(inout) :: En !< Energy density of the internal waves [R Z3 T-2 ~> J m-2]. real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & @@ -830,14 +844,18 @@ subroutine itidal_lowmode_loss(G, US, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, enddo ! Calculate TKE loss rate; units of [R Z3 T-3 ~> W m-2] here. - TKE_loss_tot = q_itides * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + TKE_loss_tot = q_itides * GV%Z_to_H * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 + else + TKE_loss_tot = q_itides * (GV%RZ_to_H * Rho_bot(i,j)) * TKE_loss_fixed(i,j) * Nb(i,j) * Ub(i,j,fr,m)**2 + endif ! Update energy remaining (this is a pseudo implicit calc) ! (E(t+1)-E(t))/dt = -TKE_loss(E(t+1)/E(t)), which goes to zero as E(t+1) goes to zero if (En_tot > 0.0) then do a=1,CS%nAngle frac_per_sector = En(i,j,a,fr,m)/En_tot - TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot ! Wm-2 + TKE_loss(i,j,a,fr,m) = frac_per_sector*TKE_loss_tot ! [R Z3 T-3 ~> W m-2] loss_rate = TKE_loss(i,j,a,fr,m) / (En(i,j,a,fr,m) + En_negl) ! [T-1 ~> s-1] En(i,j,a,fr,m) = En(i,j,a,fr,m) / (1.0 + dt*loss_rate) enddo @@ -2458,8 +2476,8 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "INTERNAL_TIDE_DRAG_MIN_DEPTH", CS%drag_min_depth, & "The minimum total ocean thickness that will be used in the denominator "//& "of the quadratic drag terms for internal tides.", & - units="m", default=1.0, scale=US%m_to_Z, do_not_log=.not.CS%apply_bottom_drag) - CS%drag_min_depth = MAX(CS%drag_min_depth, GV%H_subroundoff * GV%H_to_Z) + units="m", default=1.0, scale=GV%m_to_H, do_not_log=.not.CS%apply_bottom_drag) + CS%drag_min_depth = MAX(CS%drag_min_depth, GV%H_subroundoff) call get_param(param_file, mdl, "INTERNAL_TIDE_FROUDE_DRAG", CS%apply_Froude_drag, & "If true, apply wave breaking as a sink.", & default=.false.) @@ -2543,9 +2561,10 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) else h2(i,j) = max(h2(i,j), 0.0) endif - ! Compute the fixed part; units are [R L-2 Z3 ~> kg m-2] here - ! will be multiplied by N and the squared near-bottom velocity to get into [R Z3 T-3 ~> W m-2] - CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor*GV%Rho0 * US%L_to_Z*kappa_itides * h2(i,j) + ! Compute the fixed part; units are [R Z4 H-1 L-2 ~> kg m-2 or m] here + ! will be multiplied by N and the squared near-bottom velocity (and by the + ! near-bottom density in non-Boussinesq mode) to get into [R Z3 T-3 ~> W m-2] + CS%TKE_itidal_loss_fixed(i,j) = 0.5*kappa_h2_factor* GV%H_to_RZ * US%L_to_Z*kappa_itides * h2(i,j) enddo ; enddo deallocate(h2) @@ -2644,16 +2663,16 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) enddo call pass_var(CS%residual,G%domain) - CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & - Time, 'First baroclinic mode (eigen) speed', 'm s-1', conversion=US%L_T_to_m_s) - allocate(CS%id_cn(CS%nMode), source=-1) - do m=1,CS%nMode - write(var_name, '("cn_mode",i1)') m - write(var_descript, '("Baroclinic (eigen) speed of mode ",i1)') m - CS%id_cn(m) = register_diag_field('ocean_model',var_name, diag%axesT1, & - Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) - call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) - enddo + CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & + Time, 'First baroclinic mode (eigen) speed', 'm s-1', conversion=US%L_T_to_m_s) + allocate(CS%id_cn(CS%nMode), source=-1) + do m=1,CS%nMode + write(var_name, '("cn_mode",i1)') m + write(var_descript, '("Baroclinic (eigen) speed of mode ",i1)') m + CS%id_cn(m) = register_diag_field('ocean_model',var_name, diag%axesT1, & + Time, var_descript, 'm s-1', conversion=US%L_T_to_m_s) + call MOM_mesg("Registering "//trim(var_name)//", Described as: "//var_descript, 5) + enddo ! Register maps of reflection parameters diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 7d71a62e25..d3ee675269 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -135,7 +135,7 @@ module MOM_lateral_mixing_coeffs !! F = 1 / (1 + (Res_coef_visc*Ld/dx)^Res_fn_power) real :: depth_scaled_khth_h0 !< The depth above which KHTH is linearly scaled away [Z ~> m] real :: depth_scaled_khth_exp !< The exponent used in the depth dependent scaling function for KHTH [nondim] - real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [Z2 T-1 ~> m2 s-1] + real :: kappa_smooth !< A diffusivity for smoothing T/S in vanished layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] integer :: Res_fn_power_khth !< The power of dx/Ld in the KhTh resolution function. Any !! positive integer power may be used, but even powers !! and especially 2 are coded to be more efficient. @@ -1103,7 +1103,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) real :: oneOrTwo ! A variable that may be 1 or 2, depending on which form ! of the equatorial deformation radius us used [nondim] real :: N2_filter_depth ! A depth below which stratification is treated as monotonic when - ! calculating the first-mode wave speed [Z ~> m] + ! calculating the first-mode wave speed [H ~> m or kg m-2] real :: KhTr_passivity_coeff ! Coefficient setting the ratio between along-isopycnal tracer ! mixing and interface height mixing [nondim] real :: absurdly_small_freq ! A miniscule frequency that is used to avoid division by 0 [T-1 ~> s-1]. The @@ -1239,8 +1239,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) in_use = .true. call get_param(param_file, mdl, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, & "The depth below which N2 is monotonized to avoid stratification "//& - "artifacts from altering the equivalent barotropic mode structure.",& - units="m", default=2000., scale=US%m_to_Z) + "artifacts from altering the equivalent barotropic mode structure. "//& + "This monotonzization is disabled if this parameter is negative.", & + units="m", default=-1.0, scale=GV%m_to_H) allocate(CS%ebt_struct(isd:ied,jsd:jed,GV%ke), source=0.0) endif @@ -1264,7 +1265,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) + units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T) endif if (CS%calculate_Eady_growth_rate) then @@ -1506,21 +1507,24 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. - if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) remap_answer_date = max(remap_answer_date, 20230701) call get_param(param_file, mdl, "INTERNAL_WAVE_SPEED_TOL", wave_speed_tol, & "The fractional tolerance for finding the wave speeds.", & diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 206773ecb0..5b7ec60dee 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -11,7 +11,7 @@ module MOM_mixed_layer_restrat use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_file_parser, only : openParameterBlock, closeParameterBlock -use MOM_forcing_type, only : mech_forcing +use MOM_forcing_type, only : mech_forcing, find_ustar use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_lateral_mixing_coeffs, only : VarMix_CS @@ -184,6 +184,9 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & + U_star_2d, & ! The wind friction velocity, calculated using + ! the Boussinesq reference density or the time-evolving surface density + ! in non-Boussinesq mode [Z T-1 ~> m s-1] MLD_fast, & ! Mixed layer depth actually used in MLE restratification parameterization [H ~> m or kg m-2] htot_fast, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av_fast, & ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] @@ -254,6 +257,9 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, call MOM_error(FATAL, "mixedlayer_restrat_OM4: "// & "The resolution argument, Rd/dx, was not associated.") + ! Extract the friction velocity from the forcing type. + call find_ustar(forces, tv, U_star_2d, G, GV, US, halo=1) + if (CS%MLE_density_diff > 0.) then ! We need to calculate a mixed layer depth, MLD. !! TODO: use derivatives and mid-MLD pressure. Currently this is sigma-0. -AJA pRef_MLD(:) = 0. @@ -408,7 +414,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, if (CS%debug) then call hchksum(h,'mixed_layer_restrat: h', G%HI, haloshift=1, scale=GV%H_to_m) - call hchksum(forces%ustar,'mixed_layer_restrat: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) + call hchksum(U_star_2d, 'mixed_layer_restrat: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) call hchksum(MLD_fast,'mixed_layer_restrat: MLD', G%HI, haloshift=1, scale=GV%H_to_m) call hchksum(Rml_av_fast,'mixed_layer_restrat: rml', G%HI, haloshift=1, & scale=US%m_to_Z*US%L_T_to_m_s**2) @@ -421,7 +427,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, ! U - Component !$OMP do do j=js,je ; do I=is-1,ie - u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) + u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i+1,j))) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f @@ -508,7 +514,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, ! V- component !$OMP do do J=js-1,je ; do i=is,ie - u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) + u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i,j+1))) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) ! If needed, res_scaling_fac = min( ds, L_d ) / l_f @@ -711,6 +717,9 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d wpup ! Turbulent vertical momentum [ ????? ~> m2 s-2] real :: uDml_diag(SZIB_(G),SZJ_(G)) ! A 2D copy of uDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vDml_diag(SZI_(G),SZJB_(G)) ! A 2D copy of vDml for diagnostics [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: U_star_2d(SZI_(G),SZJ_(G)) ! The wind friction velocity, calculated using the Boussinesq + ! reference density or the time-evolving surface density in non-Boussinesq + ! mode [Z T-1 ~> m s-1] real :: covTS(SZI_(G)) ! SGS TS covariance in Stanley param; currently 0 [degC ppt] real :: varS(SZI_(G)) ! SGS S variance in Stanley param; currently 0 [ppt2] real :: dmu(SZK_(GV)) ! Change in mu(z) across layer k [nondim] @@ -762,12 +771,15 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d call pass_var(bflux, G%domain, halo=1) + ! Extract the friction velocity from the forcing type. + call find_ustar(forces, tv, U_star_2d, G, GV, US, halo=1) + if (CS%debug) then call hchksum(h,'mixed_Bodner: h', G%HI, haloshift=1, scale=GV%H_to_m) call hchksum(BLD, 'mle_Bodner: BLD in', G%HI, haloshift=1, scale=US%Z_to_m) if (associated(bflux)) & call hchksum(bflux, 'mle_Bodner: bflux', G%HI, haloshift=1, scale=US%Z_to_m**2*US%s_to_T**3) - call hchksum(forces%ustar,'mle_Bodner: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) + call hchksum(U_star_2d, 'mle_Bodner: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) call hchksum(CS%MLD_filtered, 'mle_Bodner: MLD_filtered 1', & G%HI, haloshift=1, scale=US%Z_to_m) call hchksum(CS%MLD_filtered_slow,'mle_Bodner: MLD_filtered_slow 1', & @@ -793,7 +805,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d do j = js-1, je+1 ; do i = is-1, ie+1 w_star3 = max(0., -bflux(i,j)) * BLD(i,j) & ! (this line in Z3 T-3 ~> m3 s-3) * ( ( US%Z_to_m * US%s_to_T )**3 ) ! m3 s-3 - u_star3 = ( US%Z_to_m * US%s_to_T * forces%ustar(i,j) )**3 ! m3 s-3 + u_star3 = ( US%Z_to_m * US%s_to_T * U_star_2d(i,j) )**3 ! m3 s-3 wpup(i,j) = max( CS%min_wstar2, & ! The max() avoids division by zero later ( CS%mstar * u_star3 + CS%nstar * w_star3 )**two_thirds ) & ! (this line m2 s-2) * ( ( US%m_to_Z * US%T_to_s )**2 ) ! Z2 T-2 ~> m2 s-2 @@ -965,7 +977,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d ! Offer diagnostic fields for averaging. if (query_averaging_enabled(CS%diag)) then - if (CS%id_ustar > 0) call post_data(CS%id_ustar, forces%ustar, CS%diag) + if (CS%id_ustar > 0) call post_data(CS%id_ustar, U_star_2d, CS%diag) if (CS%id_bflux > 0) call post_data(CS%id_bflux, bflux, CS%diag) if (CS%id_wpup > 0) call post_data(CS%id_wpup, wpup, CS%diag) if (CS%id_Rml > 0) call post_data(CS%id_Rml, buoy_av, CS%diag) @@ -1053,6 +1065,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) h_avail ! The volume available for diffusion out of each face of each ! sublayer of the mixed layer, divided by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZI_(G),SZJ_(G)) :: & + U_star_2d, & ! The wind friction velocity, calculated using + ! the Boussinesq reference density or the time-evolving surface density + ! in non-Boussinesq mode [Z T-1 ~> m s-1] htot, & ! The sum of the thicknesses of layers in the mixed layer [H ~> m or kg m-2] Rml_av ! g_Rho0 times the average mixed layer density [L2 Z-1 T-2 ~> m s-2] real :: g_Rho0 ! G_Earth/Rho0 [L2 Z-1 T-2 R-1 ~> m4 s-2 kg-1] @@ -1110,6 +1125,9 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) if (CS%use_Stanley_ML) call MOM_error(FATAL, "mixedlayer_restrat_BML: "// & "The Stanley parameterization is not available with the BML.") + ! Extract the friction velocity from the forcing type. + call find_ustar(forces, tv, U_star_2d, G, GV, US, halo=1) + ! Fix this later for nkml >= 3. p0(:) = 0.0 @@ -1145,7 +1163,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do j=js,je ; do I=is-1,ie h_vel = 0.5*(htot(i,j) + htot(i+1,j)) * GV%H_to_Z - u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j))) + u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i+1,j))) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) @@ -1196,7 +1214,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) do J=js-1,je ; do i=is,ie h_vel = 0.5*(htot(i,j) + htot(i,j+1)) * GV%H_to_Z - u_star = max(CS%ustar_min, 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1))) + u_star = max(CS%ustar_min, 0.5*(U_star_2d(i,j) + U_star_2d(i,j+1))) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index a7ff2f1c0a..1de4c9ba6b 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -14,7 +14,7 @@ module MOM_thickness_diffuse use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : MOM_read_data, slasher -use MOM_interface_heights, only : find_eta +use MOM_interface_heights, only : find_eta, thickness_to_dz use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_MEKE_types, only : MEKE_type @@ -44,9 +44,9 @@ module MOM_thickness_diffuse real :: Kh_eta_bg !< Background isopycnal height diffusivity [L2 T-1 ~> m2 s-1] real :: Kh_eta_vel !< Velocity scale that is multiplied by the grid spacing to give !! the isopycnal height diffusivity [L T-1 ~> m s-1] - real :: slope_max !< Slopes steeper than slope_max are limited in some way [Z L-1 ~> nondim]. - real :: kappa_smooth !< Vertical diffusivity used to interpolate more - !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. + real :: slope_max !< Slopes steeper than slope_max are limited in some way [Z L-1 ~> nondim] + real :: kappa_smooth !< Vertical diffusivity used to interpolate more sensible values + !! of T & S into thin layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] logical :: thickness_diffuse !< If true, interfaces heights are diffused. logical :: use_FGNV_streamfn !< If true, use the streamfunction formulation of !! Ferrari et al., 2010, which effectively emphasizes @@ -439,7 +439,6 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp endif endif - !$OMP do do K=1,nz+1 ; do j=js,je ; do I=is-1,ie ; int_slope_u(I,j,K) = 0.0 ; enddo ; enddo ; enddo !$OMP do @@ -458,6 +457,12 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%debug) then call uvchksum("Kh_[uv]", Kh_u, Kh_v, G%HI, haloshift=0, & scale=(US%L_to_m**2)*US%s_to_T, scalar_pair=.true.) + call uvchksum("Kh_[uv]_CFL", Kh_u_CFL, Kh_v_CFL, G%HI, haloshift=0, & + scale=(US%L_to_m**2)*US%s_to_T, scalar_pair=.true.) + if (Resoln_scaled) then + call uvchksum("Res_fn_[uv]", VarMix%Res_fn_u, VarMix%Res_fn_v, G%HI, haloshift=0, & + scale=1.0, scalar_pair=.true.) + endif call uvchksum("int_slope_[uv]", int_slope_u, int_slope_v, G%HI, haloshift=0) call hchksum(h, "thickness_diffuse_1 h", G%HI, haloshift=1, scale=GV%H_to_m) call hchksum(e, "thickness_diffuse_1 e", G%HI, haloshift=1, scale=US%Z_to_m) @@ -628,14 +633,17 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! by dt [H L2 T-1 ~> m3 s-1 or kg s-1]. h_frac ! The fraction of the mass in the column above the bottom ! interface of a layer that is within a layer [nondim]. 0 m] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: & Slope_y_PE, & ! 3D array of neutral slopes at v-points, set equal to Slope (below) [nondim] hN2_y_PE ! Harmonic mean of thicknesses around the interfaces times the buoyancy frequency - ! at v-points [L2 Z-1 T-2 ~> m s-2], used for calculating PE release + ! at v-points with unit conversion factors [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2], + ! used for calculating the potential energy release real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: & Slope_x_PE, & ! 3D array of neutral slopes at u-points, set equal to Slope (below) [nondim] hN2_x_PE ! Harmonic mean of thicknesses around the interfaces times the buoyancy frequency - ! at u-points [L2 Z-1 T-2 ~> m s-2], used for calculating PE release + ! at u-points with unit conversion factors [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2], + ! used for calculating the potential energy release real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & pres, & ! The pressure at an interface [R L2 T-2 ~> Pa]. h_avail_rsum ! The running sum of h_avail above an interface [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -670,8 +678,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV real :: Work_v(SZI_(G),SZJB_(G)) ! The work done by the isopycnal height diffusion ! integrated over v-point water columns [R Z L4 T-3 ~> W] real :: Work_h ! The work averaged over an h-cell [R Z L2 T-3 ~> W m-2]. - real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell [L4 Z-1 T-3 ~> m3 s-3] - ! The calculation is equal to h * S^2 * N^2 * kappa_GM. + real :: PE_release_h ! The amount of potential energy released by GM averaged over an h-cell + ! [R Z L2 T-3 ~> W m-2]. The calculation equals rho0 * h * S^2 * N^2 * kappa_GM. real :: I4dt ! 1 / 4 dt [T-1 ~> s-1]. real :: drdiA, drdiB ! Along layer zonal potential density gradients in the layers above (A) ! and below (B) the interface times the grid spacing [R ~> kg m-3]. @@ -686,57 +694,71 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! [Z R ~> kg m-2]. real :: hg2A, hg2B, hg2L, hg2R ! Squares of geometric mean thicknesses [H2 ~> m2 or kg2 m-4]. real :: haA, haB, haL, haR ! Arithmetic mean thicknesses [H ~> m or kg m-2]. - real :: dzaL, dzaR ! Temporary thicknesses [Z ~> m] + real :: dzg2A, dzg2B ! Squares of geometric mean vertical layer extents [Z2 ~> m2]. + real :: dzaA, dzaB ! Arithmetic mean vertical layer extents [Z ~> m]. + real :: dzaL, dzaR ! Temporary vertical layer extents [Z ~> m] real :: wtA, wtB ! Unnormalized weights of the slopes above and below [H3 ~> m3 or kg3 m-6] real :: wtL, wtR ! Unnormalized weights of the slopes to the left and right [H3 Z ~> m4 or kg3 m-5] real :: drdx, drdy ! Zonal and meridional density gradients [R L-1 ~> kg m-4]. real :: drdz ! Vertical density gradient [R Z-1 ~> kg m-4]. - real :: h_harm ! Harmonic mean layer thickness [H ~> m or kg m-2]. - real :: c2_h_u(SZIB_(G),SZK_(GV)+1) ! Wave speed squared divided by h at u-points [L2 Z-1 T-2 ~> m s-2]. - real :: c2_h_v(SZI_(G),SZK_(GV)+1) ! Wave speed squared divided by h at v-points [L2 Z-1 T-2 ~> m s-2]. - real :: hN2_u(SZIB_(G),SZK_(GV)+1) ! Thickness in m times N2 at interfaces above u-points [L2 Z-1 T-2 ~> m s-2]. - real :: hN2_v(SZI_(G),SZK_(GV)+1) ! Thickness in m times N2 at interfaces above v-points [L2 Z-1 T-2 ~> m s-2]. + real :: dz_harm ! Harmonic mean layer vertical extent [Z ~> m]. + real :: c2_dz_u(SZIB_(G),SZK_(GV)+1) ! Wave speed squared divided by dz at u-points times rescaling + ! factors from depths to thicknesses [H2 L2 Z-3 T-2 ~> m s-2 or kg m-2 s-2] + real :: c2_dz_v(SZI_(G),SZK_(GV)+1) ! Wave speed squared divided by dz at v-points times rescaling + ! factors from depths to thicknesses [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2] + real :: dzN2_u(SZIB_(G),SZK_(GV)+1) ! Vertical extent times N2 at interfaces above u-points times + ! rescaling factors from vertical to horizontal distances [L2 Z-1 T-2 ~> m s-2] + real :: dzN2_v(SZI_(G),SZK_(GV)+1) ! Vertical extent times N2 at interfaces above v-points times + ! rescaling factors from vertical to horizontal distances [L2 Z-1 T-2 ~> m s-2] real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning - ! streamfunction [Z L2 T-1 ~> m3 s-1]. - real :: Sfn_unlim_u(SZIB_(G),SZK_(GV)+1) ! Streamfunction for u-points [Z L2 T-1 ~> m3 s-1]. - real :: Sfn_unlim_v(SZI_(G),SZK_(GV)+1) ! Streamfunction for v-points [Z L2 T-1 ~> m3 s-1]. + ! streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1]. + real :: Sfn_unlim_u(SZIB_(G),SZK_(GV)+1) ! Volume streamfunction for u-points [Z L2 T-1 ~> m3 s-1] + real :: Sfn_unlim_v(SZI_(G),SZK_(GV)+1) ! Volume streamfunction for v-points [Z L2 T-1 ~> m3 s-1] real :: slope2_Ratio_u(SZIB_(G),SZK_(GV)+1) ! The ratio of the slope squared to slope_max squared [nondim] real :: slope2_Ratio_v(SZI_(G),SZK_(GV)+1) ! The ratio of the slope squared to slope_max squared [nondim] real :: Sfn_in_h ! The overturning streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1] (note that ! the units are different from other Sfn vars). - real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface. This is a - ! good thing to use when the slope is so large as to be meaningless [Z L2 T-1 ~> m3 s-1]. + real :: Sfn_safe ! The streamfunction that goes linearly back to 0 at the surface + ! [H L2 T-1 ~> m3 s-1 or kg s-1]. This is a good value to use when the + ! slope is so large as to be meaningless, usually due to weak stratification. real :: Slope ! The slope of density surfaces, calculated in a way that is always ! between -1 and 1 after undoing dimensional scaling, [Z L-1 ~> nondim] real :: mag_grad2 ! The squared magnitude of the 3-d density gradient [R2 L-2 ~> kg2 m-8]. real :: I_slope_max2 ! The inverse of slope_max squared [L2 Z-2 ~> nondim]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: hn_2 ! Half of h_neglect [H ~> m or kg m-2]. real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4]. real :: dz_neglect ! A thickness [Z ~> m], that is so small it is usually lost ! in roundoff and can be neglected [Z ~> m]. + real :: dz_neglect2 ! dz_neglect^2 [Z2 ~> m2] real :: G_scale ! The gravitational acceleration times a unit conversion ! factor [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. logical :: find_work ! If true, find the change in energy due to the fluxes. integer :: nk_linear ! The number of layers over which the streamfunction goes to 0. real :: G_rho0 ! g/Rho0 [L2 R-1 Z-1 T-2 ~> m4 kg-1 s-2]. + real :: Rho_avg ! The in situ density averaged to an interface [R ~> kg m-3] real :: N2_floor ! A floor for N2 to avoid degeneracy in the elliptic solver ! times unit conversion factors [L2 Z-2 T-2 ~> s-2] + real :: N2_unlim ! An unlimited estimate of the buoyancy frequency + ! times unit conversion factors [L2 Z-2 T-2 ~> s-2] real :: Tl(5) ! copy of T in local stencil [C ~> degC] real :: mn_T ! mean of T in local stencil [C ~> degC] real :: mn_T2 ! mean of T**2 in local stencil [C2 ~> degC2] real :: hl(5) ! Copy of local stencil of H [H ~> m] real :: r_sm_H ! Reciprocal of sum of H in local stencil [H-1 ~> m-1] + real :: Z_to_H ! A conversion factor from heights to thicknesses, perhaps based on + ! a spatially variable local density [H Z-1 ~> nondim or kg m-3] real :: Tsgs2(SZI_(G),SZJ_(G),SZK_(GV)) ! Sub-grid temperature variance [C2 ~> degC2] real :: diag_sfn_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction ! [H L2 T-1 ~> m3 s-1 or kg s-1] real :: diag_sfn_unlim_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction before - ! applying limiters [H L2 T-1 ~> m3 s-1 or kg s-1] + ! applying limiters [Z L2 T-1 ~> m3 s-1] real :: diag_sfn_y(SZI_(G),SZJB_(G),SZK_(GV)+1) ! Diagnostic of the y-face streamfunction ! [H L2 T-1 ~> m3 s-1 or kg s-1] real :: diag_sfn_unlim_y(SZI_(G),SZJB_(G),SZK_(GV)+1) ! Diagnostic of the y-face streamfunction before - ! applying limiters [H L2 T-1 ~> m3 s-1 or kg s-1] + ! applying limiters [Z L2 T-1 ~> m3 s-1] logical :: present_slope_x, present_slope_y, calc_derivatives integer, dimension(2) :: EOSdom_u ! The shifted I-computational domain to use for equation of ! state calculations at u-points. @@ -753,10 +775,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV I_slope_max2 = 1.0 / (CS%slope_max**2) G_scale = GV%g_Earth * GV%H_to_Z - h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 - dz_neglect = GV%H_subroundoff*GV%H_to_Z + h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect**2 ; hn_2 = 0.5*h_neglect + dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect**2 G_rho0 = GV%g_Earth / GV%Rho0 - N2_floor = CS%N2_floor*US%Z_to_L**2 + N2_floor = CS%N2_floor * US%Z_to_L**2 use_EOS = associated(tv%eqn_of_state) present_slope_x = PRESENT(slope_x) @@ -776,9 +798,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (use_EOS) then halo = 1 ! Default halo to fill is 1 - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, halo, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_smooth*dt, T, S, G, GV, US, halo, larger_h_denom=.true.) endif + ! Rescale the thicknesses, perhaps using the specific volume. + call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1) + if (CS%use_FGNV_streamfn .and. .not. associated(cg1)) call MOM_error(FATAL, & "cg1 must be associated when using FGNV streamfunction.") @@ -824,20 +849,21 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV EOSdom_h1(:) = EOS_domain(G%HI, halo=1) !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & - !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & - !$OMP h_neglect2,int_slope_u,KH_u,uhtot,h_frac,h_avail_rsum, & - !$OMP uhD,h_avail,G_scale,Work_u,CS,slope_x,cg1,diag_sfn_x, & - !$OMP diag_sfn_unlim_x,N2_floor,EOSdom_u,EOSdom_h1,use_stanley,Tsgs2, & - !$OMP present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & - !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u, & + !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz,dz_neglect,dz_neglect2, & + !$OMP h_neglect2,hn_2,I_slope_max2,int_slope_u,KH_u,uhtot, & + !$OMP h_frac,h_avail_rsum,uhD,h_avail,Work_u,CS,slope_x,cg1, & + !$OMP diag_sfn_x,diag_sfn_unlim_x,N2_floor,EOSdom_u,EOSdom_h1, & + !$OMP use_stanley,Tsgs2,present_slope_x,G_rho0,Slope_x_PE,hN2_x_PE) & + !$OMP private(drdiA,drdiB,drdkL,drdkR,pres_u,T_u,S_u,G_scale, & !$OMP drho_dT_u,drho_dS_u,hg2A,hg2B,hg2L,hg2R,haA, & - !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h, & + !$OMP drho_dT_dT_h,scrap,pres_h,T_h,S_h,N2_unlim, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz, & - !$OMP drdx,mag_grad2,Slope,slope2_Ratio_u,hN2_u, & - !$OMP Sfn_unlim_u,drdi_u,drdkDe_u,h_harm,c2_h_u, & + !$OMP dzg2A,dzg2B,dzaA,dzaB,dz_harm,Z_to_H, & + !$OMP drdx,mag_grad2,Slope,slope2_Ratio_u,dzN2_u, & + !$OMP Sfn_unlim_u,Rho_avg,drdi_u,drdkDe_u,c2_dz_u, & !$OMP Sfn_safe,Sfn_est,Sfn_in_h,calc_derivatives) do j=js,je - do I=is-1,ie ; hN2_u(I,1) = 0. ; hN2_u(I,nz+1) = 0. ; enddo + do I=is-1,ie ; dzN2_u(I,1) = 0. ; dzN2_u(I,nz+1) = 0. ; enddo do K=nz,2,-1 if (find_work .and. .not.(use_EOS)) then drdiA = 0.0 ; drdiB = 0.0 @@ -907,9 +933,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haR = 0.5*(h(i+1,j,k-1) + h(i+1,j,k)) + h_neglect if (GV%Boussinesq) then dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z - else + elseif (GV%semi_Boussinesq) then dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i+1,j,K-1) - e(i+1,j,K+1)) + dz_neglect + else + dzaL = 0.5*(dz(i,j,k-1) + dz(i,j,k)) + dz_neglect + dzaR = 0.5*(dz(i+1,j,k-1) + dz(i+1,j,k)) + dz_neglect endif ! Use the harmonic mean thicknesses to weight the horizontal gradients. ! These unnormalized weights have been rearranged to minimize divisions. @@ -924,10 +953,23 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haA = 0.5*(h(i,j,k-1) + h(i+1,j,k-1)) + h_neglect haB = 0.5*(h(i,j,k) + h(i+1,j,k)) + h_neglect - ! hN2_u is used with the FGNV streamfunction formulation - hN2_u(I,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * & - max(drdz*G_rho0, N2_floor) + if (GV%Boussinesq) then + N2_unlim = drdz*G_rho0 + else + N2_unlim = (GV%g_Earth*GV%RZ_to_H) * & + ((wtL * drdkL + wtR * drdkR) / (haL*wtL + haR*wtR)) + endif + + dzg2A = dz(i,j,k-1)*dz(i+1,j,k-1) + dz_neglect2 + dzg2B = dz(i,j,k)*dz(i+1,j,k) + dz_neglect2 + dzaA = 0.5*(dz(i,j,k-1) + dz(i+1,j,k-1)) + dz_neglect + dzaB = 0.5*(dz(i,j,k) + dz(i+1,j,k)) + dz_neglect + ! dzN2_u is used with the FGNV streamfunction formulation + dzN2_u(I,K) = (0.5 * ( dzg2A / dzaA + dzg2B / dzaB )) * max(N2_unlim, N2_floor) + if (find_work .and. CS%GM_src_alt) & + hN2_x_PE(I,j,k) = (0.5 * ( hg2A / haA + hg2B / haB )) * max(N2_unlim, N2_floor) endif + if (present_slope_x) then Slope = slope_x(I,j,k) slope2_Ratio_u(I,K) = Slope**2 * I_slope_max2 @@ -958,11 +1000,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV slope2_Ratio_u(I,K) = (1.0 - int_slope_u(I,j,K)) * slope2_Ratio_u(I,K) Slope_x_PE(I,j,k) = MIN(Slope,CS%slope_max) - hN2_x_PE(I,j,k) = hN2_u(I,K) if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope - ! Estimate the streamfunction at each interface [Z L2 T-1 ~> m3 s-1]. - Sfn_unlim_u(I,K) = -((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) + ! Estimate the streamfunction at each interface [H L2 T-1 ~> m3 s-1 or kg s-1]. + Sfn_unlim_u(I,K) = -(KH_u(I,j,K)*G%dy_Cu(I,j))*Slope ! Avoid moving dense water upslope from below the level of ! the bottom on the receiving side. @@ -992,10 +1033,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) - hN2_u(I,K) = GV%g_prime(K) + dzN2_u(I,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) - hN2_u(I,K) = N2_floor * dz_neglect + dzN2_u(I,K) = N2_floor * dz_neglect Sfn_unlim_u(I,K) = 0. endif ! if (k > nk_linear) if (CS%id_sfn_unlim_x>0) diag_sfn_unlim_x(I,j,K) = Sfn_unlim_u(I,K) @@ -1004,10 +1045,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn) then do k=1,nz ; do I=is-1,ie ; if (G%OBCmaskCu(I,j)>0.) then - h_harm = max( h_neglect, & - 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) - c2_h_u(I,k) = CS%FGNV_scale * & - ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / (GV%H_to_Z*h_harm) + dz_harm = max( dz_neglect, & + 2. * dz(i,j,k) * dz(i+1,j,k) / ( ( dz(i,j,k) + dz(i+1,j,k) ) + dz_neglect ) ) + c2_dz_u(I,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i+1,j) ) )**2 / dz_harm endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1016,7 +1056,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do K=2,nz Sfn_unlim_u(I,K) = (1. + CS%FGNV_scale) * Sfn_unlim_u(I,K) enddo - call streamfn_solver(nz, c2_h_u(I,:), hN2_u(I,:), Sfn_unlim_u(I,:)) + call streamfn_solver(nz, c2_dz_u(I,:), dzN2_u(I,:), Sfn_unlim_u(I,:)) else do K=2,nz Sfn_unlim_u(I,K) = 0. @@ -1027,25 +1067,36 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do K=nz,2,-1 do I=is-1,ie + + if (allocated(tv%SpV_avg) .and. (find_work .or. (k > nk_linear)) ) then + Rho_avg = ( ((h(i,j,k) + h(i,j,k-1)) + (h(i+1,j,k) + h(i+1,j,k-1))) + 4.0*hn_2 ) / & + ( ((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k) + (h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1)) + & + ((h(i+1,j,k)+hn_2)*tv%SpV_avg(i+1,j,k) + (h(i+1,j,k-1)+hn_2)*tv%SpV_avg(i+1,j,k-1)) ) + ! Use an average density to convert the volume streamfunction estimate into a mass streamfunction. + Z_to_H = (GV%RZ_to_H*Rho_avg) + else + Z_to_H = GV%Z_to_H + endif + if (k > nk_linear) then if (use_EOS) then if (uhtot(I,j) <= 0.0) then ! The transport that must balance the transport below is positive. - Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z + Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i,j,k)) else ! (uhtot(I,j) > 0.0) - Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) * GV%H_to_Z + Sfn_safe = uhtot(I,j) * (1.0 - h_frac(i+1,j,k)) endif - ! The actual streamfunction at each interface. - Sfn_est = (Sfn_unlim_u(I,K) + slope2_Ratio_u(I,K)*Sfn_safe) / (1.0 + slope2_Ratio_u(I,K)) - else ! With .not.use_EOS, the layers are constant density. - Sfn_est = Sfn_unlim_u(I,K) + ! Determine the actual streamfunction at each interface. + Sfn_est = (Z_to_H*Sfn_unlim_u(I,K) + slope2_Ratio_u(I,K)*Sfn_safe) / (1.0 + slope2_Ratio_u(I,K)) + else ! When use_EOS is false, the layers are constant density. + Sfn_est = Z_to_H*Sfn_unlim_u(I,K) endif ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) + Sfn_in_H = min(max(Sfn_est, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. @@ -1076,6 +1127,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! else ! sfn_slope_x(I,j,K) = sfn_slope_x(I,j,K+1) * (1.0 - h_frac(i+1,j,k)) ! endif + endif uhtot(I,j) = uhtot(I,j) + uhD(I,j,k) @@ -1087,6 +1139,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! A second order centered estimate is used for the density transferred ! between water columns. + if (allocated(tv%SpV_avg)) then + G_scale = GV%H_to_RZ * GV%g_Earth / Rho_avg + else + G_scale = GV%g_Earth * GV%H_to_Z + endif + Work_u(I,j) = Work_u(I,j) + G_scale * & ( uhtot(I,j) * drdkDe_u(I,K) - & (uhD(I,j,k) * drdi_u(I,k)) * 0.25 * & @@ -1099,18 +1157,19 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Calculate the meridional fluxes and gradients. - !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S, & - !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,I_slope_max2, & + !$OMP parallel do default(none) shared(nz,is,ie,js,je,find_work,use_EOS,G,GV,US,pres,T,S,dz, & + !$OMP nk_linear,IsdB,tv,h,h_neglect,e,dz_neglect,dz_neglect2, & !$OMP h_neglect2,int_slope_v,KH_v,vhtot,h_frac,h_avail_rsum, & - !$OMP vhD,h_avail,G_scale,Work_v,CS,slope_y,cg1,diag_sfn_y, & - !$OMP diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,Tsgs2, & - !$OMP present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & + !$OMP I_slope_max2,vhD,h_avail,Work_v,CS,slope_y,cg1,hn_2,& + !$OMP diag_sfn_y,diag_sfn_unlim_y,N2_floor,EOSdom_v,use_stanley,& + !$OMP Tsgs2, present_slope_y,G_rho0,Slope_y_PE,hN2_y_PE) & !$OMP private(drdjA,drdjB,drdkL,drdkR,pres_v,T_v,S_v,S_h,S_hr, & - !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA, & - !$OMP drho_dT_dT_h,drho_dT_dT_hr, scrap,pres_h,T_h,T_hr, & + !$OMP drho_dT_v,drho_dS_v,hg2A,hg2B,hg2L,hg2R,haA,G_scale, & + !$OMP drho_dT_dT_h,drho_dT_dT_hr,scrap,pres_h,T_h,T_hr, & !$OMP haB,haL,haR,dzaL,dzaR,wtA,wtB,wtL,wtR,drdz,pres_hr, & - !$OMP drdy,mag_grad2,Slope,slope2_Ratio_v,hN2_v, & - !$OMP Sfn_unlim_v,drdj_v,drdkDe_v,h_harm,c2_h_v, & + !$OMP dzg2A,dzg2B,dzaA,dzaB,dz_harm,Z_to_H, & + !$OMP drdy,mag_grad2,Slope,slope2_Ratio_v,dzN2_v,N2_unlim, & + !$OMP Sfn_unlim_v,Rho_avg,drdj_v,drdkDe_v,c2_dz_v, & !$OMP Sfn_safe,Sfn_est,Sfn_in_h,calc_derivatives) do J=js-1,je do K=nz,2,-1 @@ -1186,11 +1245,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV hg2R = h(i,j+1,k-1)*h(i,j+1,k) + h_neglect2 haL = 0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect haR = 0.5*(h(i,j+1,k-1) + h(i,j+1,k)) + h_neglect + if (GV%Boussinesq) then dzaL = haL * GV%H_to_Z ; dzaR = haR * GV%H_to_Z - else + elseif (GV%semi_Boussinesq) then dzaL = 0.5*(e(i,j,K-1) - e(i,j,K+1)) + dz_neglect dzaR = 0.5*(e(i,j+1,K-1) - e(i,j+1,K+1)) + dz_neglect + else + dzaL = 0.5*(dz(i,j,k-1) + dz(i,j,k)) + dz_neglect + dzaR = 0.5*(dz(i,j+1,k-1) + dz(i,j+1,k)) + dz_neglect endif ! Use the harmonic mean thicknesses to weight the horizontal gradients. ! These unnormalized weights have been rearranged to minimize divisions. @@ -1205,9 +1268,22 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV haA = 0.5*(h(i,j,k-1) + h(i,j+1,k-1)) + h_neglect haB = 0.5*(h(i,j,k) + h(i,j+1,k)) + h_neglect - ! hN2_v is used with the FGNV streamfunction formulation - hN2_v(i,K) = (0.5 * GV%H_to_Z * ( hg2A / haA + hg2B / haB )) * & - max(drdz*G_rho0, N2_floor) + if (GV%Boussinesq) then + N2_unlim = drdz*G_rho0 + else + N2_unlim = (GV%g_Earth*GV%RZ_to_H) * & + ((wtL * drdkL + wtR * drdkR) / (haL*wtL + haR*wtR)) + endif + + dzg2A = dz(i,j,k-1)*dz(i,j+1,k-1) + dz_neglect2 + dzg2B = dz(i,j,k)*dz(i,j+1,k) + dz_neglect2 + dzaA = 0.5*(dz(i,j,k-1) + dz(i,j+1,k-1)) + dz_neglect + dzaB = 0.5*(dz(i,j,k) + dz(i,j+1,k)) + dz_neglect + + ! dzN2_v is used with the FGNV streamfunction formulation + dzN2_v(i,K) = (0.5*( dzg2A / dzaA + dzg2B / dzaB )) * max(N2_unlim, N2_floor) + if (find_work .and. CS%GM_src_alt) & + hN2_y_PE(i,J,k) = (0.5*( hg2A / haA + hg2B / haB )) * max(N2_unlim, N2_floor) endif if (present_slope_y) then Slope = slope_y(i,J,k) @@ -1239,10 +1315,8 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV slope2_Ratio_v(i,K) = (1.0 - int_slope_v(i,J,K)) * slope2_Ratio_v(i,K) Slope_y_PE(i,J,k) = MIN(Slope,CS%slope_max) - hN2_y_PE(i,J,k) = hN2_v(i,K) if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope - ! Estimate the streamfunction at each interface [Z L2 T-1 ~> m3 s-1]. Sfn_unlim_v(i,K) = -((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) ! Avoid moving dense water upslope from below the level of @@ -1273,10 +1347,10 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) - hN2_v(i,K) = GV%g_prime(K) + dzN2_v(i,K) = GV%g_prime(K) endif ! if (use_EOS) else ! if (k > nk_linear) - hN2_v(i,K) = N2_floor * dz_neglect + dzN2_v(i,K) = N2_floor * dz_neglect Sfn_unlim_v(i,K) = 0. endif ! if (k > nk_linear) if (CS%id_sfn_unlim_y>0) diag_sfn_unlim_y(i,J,K) = Sfn_unlim_v(i,K) @@ -1285,10 +1359,9 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (CS%use_FGNV_streamfn) then do k=1,nz ; do i=is,ie ; if (G%OBCmaskCv(i,J)>0.) then - h_harm = max( h_neglect, & - 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) - c2_h_v(i,k) = CS%FGNV_scale * & - ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / (GV%H_to_Z*h_harm) + dz_harm = max( dz_neglect, & + 2. * dz(i,j,k) * dz(i,j+1,k) / ( ( dz(i,j,k) + dz(i,j+1,k) ) + dz_neglect ) ) + c2_dz_v(i,k) = CS%FGNV_scale * ( 0.5*( cg1(i,j) + cg1(i,j+1) ) )**2 / dz_harm endif ; enddo ; enddo ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. @@ -1297,7 +1370,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do K=2,nz Sfn_unlim_v(i,K) = (1. + CS%FGNV_scale) * Sfn_unlim_v(i,K) enddo - call streamfn_solver(nz, c2_h_v(i,:), hN2_v(i,:), Sfn_unlim_v(i,:)) + call streamfn_solver(nz, c2_dz_v(i,:), dzN2_v(i,:), Sfn_unlim_v(i,:)) else do K=2,nz Sfn_unlim_v(i,K) = 0. @@ -1308,25 +1381,35 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do K=nz,2,-1 do i=is,ie + if (allocated(tv%SpV_avg) .and. (find_work .or. (k > nk_linear)) ) then + Rho_avg = ( ((h(i,j,k) + h(i,j,k-1)) + (h(i,j+1,k) + h(i,j+1,k-1))) + 4.0*hn_2 ) / & + ( ((h(i,j,k)+hn_2) * tv%SpV_avg(i,j,k) + (h(i,j,k-1)+hn_2) * tv%SpV_avg(i,j,k-1)) + & + ((h(i,j+1,k)+hn_2)*tv%SpV_avg(i,j+1,k) + (h(i,j+1,k-1)+hn_2)*tv%SpV_avg(i,j+1,k-1)) ) + ! Use an average density to convert the volume streamfunction estimate into a mass streamfunction. + Z_to_H = (GV%RZ_to_H*Rho_avg) + else + Z_to_H = GV%Z_to_H + endif + if (k > nk_linear) then if (use_EOS) then if (vhtot(i,J) <= 0.0) then ! The transport that must balance the transport below is positive. - Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) * GV%H_to_Z + Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j,k)) else ! (vhtot(I,j) > 0.0) - Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) * GV%H_to_Z + Sfn_safe = vhtot(i,J) * (1.0 - h_frac(i,j+1,k)) endif - ! The actual streamfunction at each interface. - Sfn_est = (Sfn_unlim_v(i,K) + slope2_Ratio_v(i,K)*Sfn_safe) / (1.0 + slope2_Ratio_v(i,K)) - else ! With .not.use_EOS, the layers are constant density. - Sfn_est = Sfn_unlim_v(i,K) + ! Find the actual streamfunction at each interface. + Sfn_est = (Z_to_H*Sfn_unlim_v(i,K) + slope2_Ratio_v(i,K)*Sfn_safe) / (1.0 + slope2_Ratio_v(i,K)) + else ! When use_EOS is false, the layers are constant density. + Sfn_est = Z_to_H*Sfn_unlim_v(i,K) endif ! Make sure that there is enough mass above to allow the streamfunction ! to satisfy the boundary condition of 0 at the surface. - Sfn_in_H = min(max(Sfn_est * GV%Z_to_H, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) + Sfn_in_H = min(max(Sfn_est, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) ! The actual transport is limited by the mass available in the two ! neighboring grid cells. @@ -1367,6 +1450,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! A second order centered estimate is used for the density transferred ! between water columns. + if (allocated(tv%SpV_avg)) then + G_scale = GV%H_to_RZ * GV%g_Earth / Rho_avg + else + G_scale = GV%g_Earth * GV%H_to_Z + endif + Work_v(i,J) = Work_v(i,J) + G_scale * & ( vhtot(i,J) * drdkDe_v(i,K) - & (vhD(i,J,k) * drdj_v(i,k)) * 0.25 * & @@ -1383,7 +1472,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do J=js-1,je ; do i=is,ie ; vhD(i,J,1) = -vhtot(i,J) ; enddo ; enddo else EOSdom_u(1) = (is-1) - (G%IsdB-1) ; EOSdom_u(2) = ie - (G%IsdB-1) - !$OMP parallel do default(shared) private(pres_u,T_u,S_u,drho_dT_u,drho_dS_u,drdiB) + !$OMP parallel do default(shared) private(pres_u,T_u,S_u,drho_dT_u,drho_dS_u,drdiB,G_scale) do j=js,je if (use_EOS) then do I=is-1,ie @@ -1397,9 +1486,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do I=is-1,ie uhD(I,j,1) = -uhtot(I,j) + G_scale = GV%g_Earth * GV%H_to_Z if (use_EOS) then drdiB = drho_dT_u(I) * (T(i+1,j,1)-T(i,j,1)) + & drho_dS_u(I) * (S(i+1,j,1)-S(i,j,1)) + if (allocated(tv%SpV_avg)) then + G_scale = GV%H_to_RZ * GV%g_Earth * & + ( ((h(i,j,1)+hn_2) * tv%SpV_avg(i,j,1) + (h(i+1,j,1)+hn_2) * tv%SpV_avg(i+1,j,1)) / & + ( (h(i,j,1) + h(i+1,j,1)) + 2.0*hn_2 ) ) + endif endif if (CS%use_GM_work_bug) then Work_u(I,j) = Work_u(I,j) + G_scale * & @@ -1414,7 +1509,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo EOSdom_v(:) = EOS_domain(G%HI) - !$OMP parallel do default(shared) private(pres_v,T_v,S_v,drho_dT_v,drho_dS_v,drdjB) + !$OMP parallel do default(shared) private(pres_v,T_v,S_v,drho_dT_v,drho_dS_v,drdjB,G_scale) do J=js-1,je if (use_EOS) then do i=is,ie @@ -1428,9 +1523,15 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV do i=is,ie vhD(i,J,1) = -vhtot(i,J) + G_scale = GV%g_Earth * GV%H_to_Z if (use_EOS) then drdjB = drho_dT_v(i) * (T(i,j+1,1)-T(i,j,1)) + & drho_dS_v(i) * (S(i,j+1,1)-S(i,j,1)) + if (allocated(tv%SpV_avg)) then + G_scale = GV%H_to_RZ * GV%g_Earth * & + ( ((h(i,j,1)+hn_2) * tv%SpV_avg(i,j,1) + (h(i,j+1,1)+hn_2) * tv%SpV_avg(i,j+1,1)) / & + ( (h(i,j,1) + h(i,j+1,1)) + 2.0*hn_2 ) ) + endif endif Work_v(i,J) = Work_v(i,J) - G_scale * & ( (vhD(i,J,1) * drdjB) * 0.25 * & @@ -1451,11 +1552,12 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (find_work .and. CS%GM_src_alt) then ; if (allocated(MEKE%GM_src)) then do j=js,je ; do i=is,ie ; do k=nz,1,-1 - PE_release_h = -0.25*(KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & + PE_release_h = -0.25 * (GV%H_to_RZ*US%L_to_Z**2) * & + (KH_u(I,j,k)*(Slope_x_PE(I,j,k)**2) * hN2_x_PE(I,j,k) + & Kh_u(I-1,j,k)*(Slope_x_PE(I-1,j,k)**2) * hN2_x_PE(I-1,j,k) + & Kh_v(i,J,k)*(Slope_y_PE(i,J,k)**2) * hN2_y_PE(i,J,k) + & Kh_v(i,J-1,k)*(Slope_y_PE(i,J-1,k)**2) * hN2_y_PE(i,J-1,k)) - MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + US%L_to_Z**2 * GV%Rho0 * PE_release_h + MEKE%GM_src(i,j) = MEKE%GM_src(i,j) + PE_release_h enddo ; enddo ; enddo endif ; endif @@ -1471,16 +1573,18 @@ end subroutine thickness_diffuse_full !> Tridiagonal solver for streamfunction at interfaces subroutine streamfn_solver(nk, c2_h, hN2, sfn) integer, intent(in) :: nk !< Number of layers - real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers [L2 Z-1 T-2 ~> m s-2] - real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces [L2 Z-1 T-2 ~> m s-2] - real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [Z L2 T-1 ~> m3 s-1] or arbitrary units + real, dimension(nk), intent(in) :: c2_h !< Wave speed squared over thickness in layers, rescaled to + !! [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2] + real, dimension(nk+1), intent(in) :: hN2 !< Thickness times N2 at interfaces times rescaling factors + !! [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2] + real, dimension(nk+1), intent(inout) :: sfn !< Streamfunction [H L2 T-1 ~> m3 s-1 or kg s-1] or arbitrary units !! On entry, equals diffusivity times slope. !! On exit, equals the streamfunction. ! Local variables real :: c1(nk) ! The dependence of the final streamfunction on the values below [nondim] real :: d1 ! The complement of c1(k) (i.e., 1 - c1(k)) [nondim] - real :: b_denom ! A term in the denominator of beta [L2 Z-1 T-2 ~> m s-2] - real :: beta ! The normalization for the pivot [Z T2 L-2 ~> s2 m-1] + real :: b_denom ! A term in the denominator of beta [H L2 Z-2 T-2 ~> m s-2 or kg m-2 s-2] + real :: beta ! The normalization for the pivot [Z2 T2 H-1 L-2 ~> s2 m-1 or m2 s2 kg-1] integer :: k sfn(1) = 0. @@ -2087,7 +2191,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m_to_Z**2*US%T_to_s) + units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of "//& "Ferrari et al., 2010, which effectively emphasizes "//& @@ -2144,20 +2248,24 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "MEKE_GEOMETRIC_2018_ANSWERS", MEKE_GEOM_answers_2018, & "If true, use expressions in the MEKE_GEOMETRIC calculation that recover the "//& "answers from the original implementation. Otherwise, use expressions that "//& - "satisfy rotational symmetry.", default=default_2018_answers) + "satisfy rotational symmetry.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for MEKE_geometric. - if (MEKE_GEOM_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.MEKE_GEOM_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (MEKE_GEOM_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.MEKE_GEOM_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "MEKE_GEOMETRIC_ANSWER_DATE", CS%MEKE_GEOM_answer_date, & "The vintage of the expressions in the MEKE_GEOMETRIC calculation. "//& "Values below 20190101 recover the answers from the original implementation, "//& "while higher values use expressions that satisfy rotational symmetry. "//& "If both MEKE_GEOMETRIC_2018_ANSWERS and MEKE_GEOMETRIC_ANSWER_DATE are "//& - "specified, the latter takes precedence.", default=default_answer_date) + "specified, the latter takes precedence.", & + default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%MEKE_GEOM_answer_date = max(CS%MEKE_GEOM_answer_date, 20230701) endif call get_param(param_file, mdl, "USE_KH_IN_MEKE", CS%Use_KH_in_MEKE, & diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 2a30f68b42..1faeed00ba 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -228,14 +228,16 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. default_remap_ans_date = default_answer_date - if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + endif if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& @@ -243,22 +245,27 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_remap_ans_date) + "latter takes precedence.", default=default_remap_ans_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%remap_answer_date = max(CS%remap_answer_date, 20230701) + call get_param(param_file, mdl, "HOR_REGRID_2018_ANSWERS", hor_regrid_answers_2018, & "If true, use the order of arithmetic for horizontal regridding that recovers "//& "the answers from the end of 2018. Otherwise, use rotationally symmetric "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for horizontal regridding. default_hor_reg_ans_date = default_answer_date - if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 - if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + if (GV%Boussinesq) then + if (hor_regrid_answers_2018 .and. (default_hor_reg_ans_date >= 20190101)) default_hor_reg_ans_date = 20181231 + if (.not.hor_regrid_answers_2018 .and. (default_hor_reg_ans_date < 20190101)) default_hor_reg_ans_date = 20190101 + endif call get_param(param_file, mdl, "HOR_REGRID_ANSWER_DATE", CS%hor_regrid_answer_date, & "The vintage of the order of arithmetic for horizontal regridding. "//& "Dates before 20190101 give the same answers as the code did in late 2018, "//& "while later versions add parentheses for rotational symmetry. "//& "Dates after 20230101 use reproducing sums for global averages. "//& "If both HOR_REGRID_2018_ANSWERS and HOR_REGRID_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_hor_reg_ans_date) + "latter takes precedence.", default=default_hor_reg_ans_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%hor_regrid_answer_date = max(CS%hor_regrid_answer_date, 20230701) CS%time_varying_sponges = .false. CS%nz = GV%ke diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 32946021be..303e41fc3d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -12,6 +12,7 @@ module MOM_CVMix_KPP use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_grid, only : ocean_grid_type, isPointInCell +use MOM_interface_heights, only : thickness_to_dz use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -536,7 +537,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', & 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s', conversion=US%Z2_T_to_m2_s) + 'Diffusivity passed to KPP', 'm2/s', conversion=GV%HZ_T_to_m2_s) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', & 'm2/s', conversion=US%Z2_T_to_m2_s) @@ -604,19 +605,19 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & type(ocean_grid_type), intent(in) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: uStar !< Surface friction velocity [Z T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: buoyFlux !< Surface buoyancy flux [L2 T-3 ~> m2 s-3] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kt !< (in) Vertical diffusivity of heat w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 T-1 ~> m2 s-1] + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Ks !< (in) Vertical diffusivity of salt w/o KPP !! (out) Vertical diffusivity including KPP - !! [Z2 T-1 ~> m2 s-1] + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kv !< (in) Vertical viscosity w/o KPP !! (out) Vertical viscosity including KPP - !! [Z2 T-1 ~> m2 s-1] + !! [H Z T-1 ~> m2 s-1 or Pa s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransHeat !< Temp non-local transport [nondim] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: nonLocalTransScalar !< scalar non-local trans. [nondim] type(wave_parameters_CS), pointer :: Waves !< Wave CS for Langmuir turbulence @@ -624,6 +625,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & ! Local variables integer :: i, j, k ! Loop indices + real, dimension(SZI_(G),SZK_(GV)) :: dz ! Height change across layers [Z ~> m] real, dimension( GV%ke ) :: cellHeight ! Cell center heights referenced to surface [Z ~> m] (negative in ocean) real, dimension( GV%ke+1 ) :: iFaceHeight ! Interface heights referenced to surface [Z ~> m] (negative in ocean) real, dimension( GV%ke ) :: z_cell ! Cell center heights referenced to surface [m] (negative in ocean) @@ -650,8 +652,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & call hchksum(h, "KPP in: h",G%HI,haloshift=0, scale=GV%H_to_m) call hchksum(uStar, "KPP in: uStar",G%HI,haloshift=0, scale=US%Z_to_m*US%s_to_T) call hchksum(buoyFlux, "KPP in: buoyFlux",G%HI,haloshift=0, scale=US%L_to_m**2*US%s_to_T**3) - call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kt, "KPP in: Kt",G%HI,haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Ks, "KPP in: Ks",G%HI,haloshift=0, scale=GV%HZ_T_to_m2_s) endif nonLocalTrans(:,:) = 0.0 @@ -662,13 +664,17 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & buoy_scale = US%L_to_m**2*US%s_to_T**3 !$OMP parallel do default(none) firstprivate(nonLocalTrans) & - !$OMP private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, & + !$OMP private(surfFricVel, iFaceHeight, hcorr, dh, dz, cellHeight, & !$OMP surfBuoyFlux, Kdiffusivity, Kviscosity, LangEnhK, sigma, & !$OMP sigmaRatio, z_inter, z_cell) & - !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, Kt, & + !$OMP shared(G, GV, CS, US, tv, uStar, h, buoy_scale, buoyFlux, Kt, & !$OMP Ks, Kv, nonLocalTransHeat, nonLocalTransScalar, Waves, lamult) ! loop over horizontal points on processor do j = G%jsc, G%jec + + ! Find the vertical distances across layers. + call thickness_to_dz(h, tv, dz, j, G, GV) + do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then ! things independent of position within the column @@ -679,7 +685,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment + dh = dz(i,k) ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -711,9 +717,9 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & Kdiffusivity(:,:) = 0. ! Diffusivities for heat and salt [m2 s-1] Kviscosity(:) = 0. ! Viscosity [m2 s-1] else - Kdiffusivity(:,1) = US%Z2_T_to_m2_s * Kt(i,j,:) - Kdiffusivity(:,2) = US%Z2_T_to_m2_s * Ks(i,j,:) - Kviscosity(:) = US%Z2_T_to_m2_s * Kv(i,j,:) + Kdiffusivity(:,1) = GV%HZ_T_to_m2_s * Kt(i,j,:) + Kdiffusivity(:,2) = GV%HZ_T_to_m2_s * Ks(i,j,:) + Kviscosity(:) = GV%HZ_T_to_m2_s * Kv(i,j,:) endif IF (CS%LT_K_ENHANCEMENT) then @@ -860,16 +866,16 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & if (.not. CS%passiveMode) then if (CS%KPPisAdditive) then do k=1, GV%ke+1 - Kt(i,j,k) = Kt(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,1) - Ks(i,j,k) = Ks(i,j,k) + US%m2_s_to_Z2_T * Kdiffusivity(k,2) - Kv(i,j,k) = Kv(i,j,k) + US%m2_s_to_Z2_T * Kviscosity(k) + Kt(i,j,k) = Kt(i,j,k) + GV%m2_s_to_HZ_T * Kdiffusivity(k,1) + Ks(i,j,k) = Ks(i,j,k) + GV%m2_s_to_HZ_T * Kdiffusivity(k,2) + Kv(i,j,k) = Kv(i,j,k) + GV%m2_s_to_HZ_T * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k) enddo else ! KPP replaces prior diffusivity when former is non-zero do k=1, GV%ke+1 - if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,1) - if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = US%m2_s_to_Z2_T * Kdiffusivity(k,2) - if (Kviscosity(k) /= 0.) Kv(i,j,k) = US%m2_s_to_Z2_T * Kviscosity(k) + if (Kdiffusivity(k,1) /= 0.) Kt(i,j,k) = GV%m2_s_to_HZ_T * Kdiffusivity(k,1) + if (Kdiffusivity(k,2) /= 0.) Ks(i,j,k) = GV%m2_s_to_HZ_T * Kdiffusivity(k,2) + if (Kviscosity(k) /= 0.) Kv(i,j,k) = GV%m2_s_to_HZ_T * Kviscosity(k) if (CS%Stokes_Mixing) Waves%KvS(i,j,k) = Kv(i,j,k) enddo endif @@ -883,8 +889,8 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & call cpu_clock_end(id_clock_KPP_calc) if (CS%debug) then - call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kt, "KPP out: Kt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Ks, "KPP out: Ks", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif ! send diagnostics to post_data @@ -912,7 +918,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Temp !< potential/cons temp [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: Salt !< Salinity [S ~> ppt] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(in) :: u !< Velocity i-component [L T-1 ~> m s-1] @@ -924,9 +930,12 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: lamult !< Langmuir enhancement factor [nondim] ! Local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Height change across layers [Z ~> m] + ! Variables for passing to CVMix routines, often in MKS units real, dimension( GV%ke ) :: Ws_1d ! Profile of vertical velocity scale for scalars in MKS units [m s-1] real, dimension( GV%ke ) :: deltaRho ! delta Rho in numerator of Bulk Ri number [R ~> kg m-3] + real, dimension( GV%ke ) :: deltaBuoy ! Change in Buoyancy based on deltaRho [m s-2] real, dimension( GV%ke ) :: deltaU2 ! square of delta U (shear) in denominator of Bulk Ri [m2 s-2] real, dimension( GV%ke ) :: surfBuoyFlux2 ! Surface buoyancy flux in MKS units [m2 s-3] real, dimension( GV%ke ) :: BulkRi_1d ! Bulk Richardson number for each layer [nondim] @@ -940,7 +949,6 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real :: Coriolis ! Coriolis parameter at tracer points in MKS units [s-1] real :: KPP_OBL_depth ! Boundary layer depth calculated by CVMix_kpp_compute_OBL_depth in MKS units [m] - ! Variables for EOS calculations real, dimension( 3*GV%ke ) :: rho_1D ! A column of densities [R ~> kg m-3] real, dimension( 3*GV%ke ) :: pres_1D ! A column of pressures [R L2 T-2 ~> Pa] @@ -952,8 +960,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real, dimension( GV%ke+1 ) :: N2_1d ! Brunt-Vaisala frequency squared, at interfaces [T-2 ~> s-2] real :: zBottomMinusOffset ! Height of bottom plus a little bit [Z ~> m] real :: GoRho ! Gravitational acceleration in MKS units divided by density [m s-2 R-1 ~> m4 kg-1 s-2] - real :: GoRho_Z_L2 ! Gravitational acceleration divided by density times aspect ratio - ! rescaling [Z T-2 R-1 ~> m4 kg-1 s-2] + real :: GoRho_Z_L2 ! Gravitational acceleration, perhaps divided by density, times aspect ratio + ! rescaling [H T-2 R-1 ~> m4 kg-1 s-2 or m s-2] real :: pRef ! The interface pressure [R L2 T-2 ~> Pa] real :: Uk, Vk ! Layer velocities relative to their averages in the surface layer [L T-1 ~> m s-1] real :: SLdepth_0d ! Surface layer depth = surf_layer_ext*OBLdepth [Z ~> m] @@ -992,10 +1000,17 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl call cpu_clock_begin(id_clock_KPP_compute_BLD) ! some constants - GoRho_Z_L2 = US%L_to_Z**2 * GV%g_Earth / GV%Rho0 - GoRho = US%Z_to_m*US%s_to_T**2 * GoRho_Z_L2 + GoRho = US%Z_to_m*US%s_to_T**2 * (US%L_to_Z**2 * GV%g_Earth / GV%Rho0) + if (GV%Boussinesq) then + GoRho_Z_L2 = US%L_to_Z**2 * GV%Z_to_H * GV%g_Earth / GV%Rho0 + else + GoRho_Z_L2 = US%L_to_Z**2 * GV%g_Earth * GV%RZ_to_H + endif buoy_scale = US%L_to_m**2*US%s_to_T**3 + ! Find the vertical distances across layers. + call thickness_to_dz(h, tv, dz, G, GV, US) + ! loop over horizontal points on processor !$OMP parallel do default(none) private(surfFricVel, iFaceHeight, hcorr, dh, cellHeight, & !$OMP surfBuoyFlux, U_H, V_H, Coriolis, pRef, SLdepth_0d, vt2_1d, & @@ -1003,9 +1018,9 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !$OMP surfHvS, hTot, delH, surftemp, surfsalt, surfu, surfv, & !$OMP surfUs, surfVs, Uk, Vk, deltaU2, km1, kk, pres_1D, N_col, & !$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_guess, LA, rho_1D, & - !$OMP deltarho, N2_1d, ws_1d, LangEnhVT2,KPP_OBL_depth, z_cell, & + !$OMP deltarho, deltaBuoy, N2_1d, ws_1d, LangEnhVT2,KPP_OBL_depth, z_cell, & !$OMP z_inter, OBL_depth, BulkRi_1d, zBottomMinusOffset) & - !$OMP shared(G, GV, CS, US, uStar, h, buoy_scale, buoyFlux, & + !$OMP shared(G, GV, CS, US, uStar, h, dz, buoy_scale, buoyFlux, & !$OMP Temp, Salt, waves, tv, GoRho, GoRho_Z_L2, u, v, lamult) do j = G%jsc, G%jec do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then @@ -1032,7 +1047,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment + dh = dz(i,j,k) ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -1061,7 +1076,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl do ktmp = 1,ksfc ! SLdepth_0d can be between cell interfaces - delH = min( max(0.0, SLdepth_0d - hTot), h(i,j,ktmp)*GV%H_to_Z ) + delH = min( max(0.0, SLdepth_0d - hTot), dz(i,j,ktmp) ) ! surface layer thickness hTot = hTot + delH @@ -1127,7 +1142,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then MLD_guess = max( CS%MLD_guess_min, abs(CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & - H=H(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) + dz=dz(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) CS%La_SL(i,j) = LA endif @@ -1142,8 +1157,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl km1 = max(1, k-1) kk = 3*(k-1) deltaRho(k) = rho_1D(kk+2) - rho_1D(kk+1) + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + deltaBuoy(k) = GoRho*(rho_1D(kk+2) - rho_1D(kk+1)) + else + deltaBuoy(k) = (US%Z_to_m*US%s_to_T**2) * (US%L_to_Z**2 * GV%g_Earth) * & + ( (rho_1D(kk+2) - rho_1D(kk+1)) / (0.5 * (rho_1D(kk+2) + rho_1D(kk+1))) ) + endif N2_1d(k) = (GoRho_Z_L2 * (rho_1D(kk+2) - rho_1D(kk+3)) ) / & - ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z) + ((0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)) CS%N(i,j,k) = sqrt( max( N2_1d(k), 0.) ) enddo N2_1d(GV%ke+1 ) = 0.0 @@ -1197,7 +1218,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! Calculate Bulk Richardson number from eq (21) of LMD94 BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & zt_cntr=z_cell, & ! Depth of cell center [m] - delta_buoy_cntr=GoRho*deltaRho, & ! Bulk buoyancy difference, Br-B(z) [m s-2] + delta_buoy_cntr=deltaBuoy, & ! Bulk buoyancy difference, Br-B(z) [m s-2] delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2] ws_cntr=Ws_1d, & ! Turbulent velocity scale profile [m s-1] N_iface=N_col, & ! Buoyancy frequency [s-1] @@ -1251,7 +1272,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !BGR consider if LTEnhancement is wanted for diagnostics if (CS%id_Ws > 0) then call CVMix_kpp_compute_turbulent_scales( & - -cellHeight(:)/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate + -cellHeight(:)/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate [nondim] US%Z_to_m*CS%OBLdepth(i,j), & ! (in) OBL depth [m] surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] @@ -1291,19 +1312,19 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag) ! BLD smoothing: - if (CS%n_smooth > 0) call KPP_smooth_BLD(CS, G, GV, US, h) + if (CS%n_smooth > 0) call KPP_smooth_BLD(CS, G, GV, US, dz) end subroutine KPP_compute_BLD !> Apply a 1-1-4-1-1 Laplacian filter one time on BLD to reduce any horizontal two-grid-point noise -subroutine KPP_smooth_BLD(CS, G, GV, US, h) +subroutine KPP_smooth_BLD(CS, G, GV, US, dz) ! Arguments type(KPP_CS), pointer :: CS !< Control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer/level thicknesses [H ~> m or kg m-2] + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: dz !< Layer thicknesses [Z ~> m] ! local real, dimension(SZI_(G),SZJ_(G)) :: OBLdepth_prev ! OBLdepth before s.th smoothing iteration [Z ~> m] @@ -1328,7 +1349,7 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, h) OBLdepth_prev = CS%OBLdepth ! apply smoothing on OBL depth - !$OMP parallel do default(none) shared(G, GV, US, CS, h, OBLdepth_prev) & + !$OMP parallel do default(none) shared(G, GV, US, CS, dz, OBLdepth_prev) & !$OMP private(wc, ww, we, wn, ws, dh, hcorr, cellHeight, iFaceHeight) do j = G%jsc, G%jec do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then @@ -1338,7 +1359,7 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, h) do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment + dh = dz(i,j,k) ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index e26c061929..19744cb6c5 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -11,6 +11,7 @@ module MOM_CVMix_conv use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : thickness_to_dz use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -143,15 +144,16 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) type(CVMix_conv_cs), intent(in) :: CS !< CVMix convection control structure real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hbl !< Depth of ocean boundary layer [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(inout) :: Kd !< Diapycnal diffusivity at each interface that - !! will be incremented here [Z2 T-1 ~> m2 s-1]. + intent(inout) :: Kd !< Diapycnal diffusivity at each interface + !! that will be incremented here + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(inout) :: KV !< Viscosity at each interface that will be - !! incremented here [Z2 T-1 ~> m2 s-1]. + intent(inout) :: Kv !< Viscosity at each interface that will be + !! incremented here [H Z T-1 ~> m2 s-1 or Pa s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_aux !< A second diapycnal diffusivity at each !! interface that will also be incremented - !! here [Z2 T-1 ~> m2 s-1]. + !! here [H Z T-1 ~> m2 s-1 or kg m-1 s-1] ! local variables real, dimension(SZK_(GV)) :: rho_lwr !< Adiabatic Water Density [kg m-3], this is a dummy @@ -162,23 +164,27 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) real, dimension(SZK_(GV)+1) :: N2 !< Squared buoyancy frequency [s-2] real, dimension(SZK_(GV)+1) :: kv_col !< Viscosities at interfaces in the column [m2 s-1] real, dimension(SZK_(GV)+1) :: kd_col !< Diffusivities at interfaces in the column [m2 s-1] - real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces [m] - real, dimension(SZK_(GV)) :: cellHeight !< Height of cell centers [m] + real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces [Z ~> m] + real, dimension(SZK_(GV)) :: cellHeight !< Height of cell centers [Z ~> m] + real, dimension(SZI_(G),SZK_(GV)) :: dz ! Height change across layers [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & kd_conv, & !< Diffusivity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] kv_conv, & !< Viscosity added by convection for diagnostics [Z2 T-1 ~> m2 s-1] N2_3d !< Squared buoyancy frequency for diagnostics [T-2 ~> s-2] integer :: kOBL !< level of ocean boundary layer extent - real :: g_o_rho0 ! Gravitational acceleration divided by density times unit conversion factors - ! [Z s-2 R-1 ~> m4 s-2 kg-1] + real :: g_o_rho0 ! Gravitational acceleration, perhaps divided by density, times unit conversion factors + ! [H s-2 R-1 ~> m4 s-2 kg-1 or m s-2] real :: pref ! Interface pressures [R L2 T-2 ~> Pa] real :: rhok, rhokm1 ! In situ densities of the layers above and below at the interface pressure [R ~> kg m-3] - real :: hbl_KPP ! The depth of the ocean boundary as used by KPP [m] - real :: dz ! A thickness [Z ~> m] + real :: dh_int ! The distance between layer centers [H ~> m or kg m-2] real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] integer :: i, j, k - g_o_rho0 = US%L_to_Z**2*US%s_to_T**2 * GV%g_Earth / GV%Rho0 + if (GV%Boussinesq) then + g_o_rho0 = (US%L_to_Z**2*US%s_to_T**2*GV%Z_to_H) * GV%g_Earth / GV%Rho0 + else + g_o_rho0 = (US%L_to_Z**2*US%s_to_T**2*GV%RZ_to_H) * GV%g_Earth + endif ! initialize dummy variables rho_lwr(:) = 0.0 ; rho_1d(:) = 0.0 @@ -191,6 +197,10 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) if (CS%id_kd_conv > 0) Kd_conv(:,:,:) = 0.0 do j = G%jsc, G%jec + + ! Find the vertical distances across layers. + call thickness_to_dz(h, tv, dz, j, G, GV) + do i = G%isc, G%iec ! skip calling at land points @@ -205,8 +215,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) call calculate_density(tv%t(i,j,k), tv%s(i,j,k), pRef, rhok, tv%eqn_of_state) call calculate_density(tv%t(i,j,k-1), tv%s(i,j,k-1), pRef, rhokm1, tv%eqn_of_state) - dz = ((0.5*(h(i,j,k-1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z) - N2(K) = g_o_rho0 * (rhok - rhokm1) / dz ! Can be negative + dh_int = 0.5*(h(i,j,k-1) + h(i,j,k)) + GV%H_subroundoff + N2(K) = g_o_rho0 * (rhok - rhokm1) / dh_int ! Can be negative enddo @@ -214,17 +224,16 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) hcorr = 0.0 ! compute heights at cell center and interfaces do k=1,GV%ke - dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights + dh = dz(i,k) ! Nominal thickness to use for increment, in the units of heights dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh - iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh enddo ! gets index of the level and interface above hbl - hbl_KPP = US%Z_to_m*hbl(i,j) ! Convert to the units used by CVMix. - kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl_KPP) + kOBL = CVMix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl(i,j)) kv_col(:) = 0.0 ; kd_col(:) = 0.0 call CVMix_coeffs_conv(Mdiff_out=kv_col(:), & @@ -238,18 +247,18 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) ! Increment the diffusivity outside of the boundary layer. do K=max(1,kOBL+1),GV%ke+1 - Kd(i,j,K) = Kd(i,j,K) + US%m2_s_to_Z2_T * kd_col(K) + Kd(i,j,K) = Kd(i,j,K) + GV%m2_s_to_HZ_T * kd_col(K) enddo if (present(Kd_aux)) then ! Increment the other diffusivity outside of the boundary layer. do K=max(1,kOBL+1),GV%ke+1 - Kd_aux(i,j,K) = Kd_aux(i,j,K) + US%m2_s_to_Z2_T * kd_col(K) + Kd_aux(i,j,K) = Kd_aux(i,j,K) + GV%m2_s_to_HZ_T * kd_col(K) enddo endif ! Increment the viscosity outside of the boundary layer. do K=max(1,kOBL+1),GV%ke+1 - Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * kv_col(K) + Kv(i,j,K) = Kv(i,j,K) + GV%m2_s_to_HZ_T * kv_col(K) enddo ! Store 3-d arrays for diagnostics. @@ -277,8 +286,8 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) ! call hchksum(Kd_conv, "MOM_CVMix_conv: Kd_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) ! if (CS%id_kv_conv > 0) & ! call hchksum(Kv_conv, "MOM_CVMix_conv: Kv_conv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd, "MOM_CVMix_conv: Kd", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Kv, "MOM_CVMix_conv: Kv", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif ! send diagnostics to post_data diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index 6e2c76ba8d..af17e0287f 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -35,7 +35,7 @@ module MOM_CVMix_ddiff real :: kappa_ddiff_param1 !< exterior coefficient in diffusive convection regime [nondim] real :: kappa_ddiff_param2 !< middle coefficient in diffusive convection regime [nondim] real :: kappa_ddiff_param3 !< interior coefficient in diffusive convection regime [nondim] - real :: min_thickness !< Minimum thickness allowed [Z ~> m] + real :: min_thickness !< Minimum thickness allowed [H ~> m or kg-2] character(len=4) :: diff_conv_type !< type of diffusive convection to use. Options are Marmorino & !! Caldwell 1976 ("MC76"; default) and Kelley 1988, 1990 ("K90") logical :: debug !< If true, turn on debugging @@ -83,7 +83,7 @@ logical function CVMix_ddiff_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) call get_param(param_file, mdl, 'MIN_THICKNESS', CS%min_thickness, & - units="m", scale=US%m_to_Z, default=0.001, do_not_log=.True.) + units="m", scale=GV%m_to_H, default=0.001, do_not_log=.True.) call openParameterBlock(param_file,'CVMIX_DDIFF') @@ -150,9 +150,11 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) integer, intent(in) :: j !< Meridional grid index to work on. ! Kd_T and Kd_S are intent inout because only one j-row is set here, but they are essentially outputs. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd_T !< Interface double diffusion diapycnal - !! diffusivity for temp [Z2 T-1 ~> m2 s-1]. + !! diffusivity for temperature + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd_S !< Interface double diffusion diapycnal - !! diffusivity for salt [Z2 T-1 ~> m2 s-1]. + !! diffusivity for salinity + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] type(CVMix_ddiff_cs), pointer :: CS !< The control structure returned !! by a previous call to CVMix_ddiff_init. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & @@ -160,7 +162,7 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) ! Local variables real, dimension(SZK_(GV)) :: & - cellHeight, & !< Height of cell centers [m] + cellHeight, & !< Height of cell centers relative to the sea surface [H ~> m or kg m-2] dRho_dT, & !< partial derivatives of density with temperature [R C-1 ~> kg m-3 degC-1] dRho_dS, & !< partial derivatives of density with salinity [R S-1 ~> kg m-3 ppt-1] pres_int, & !< pressure at each interface [R L2 T-2 ~> Pa] @@ -174,8 +176,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) Kd1_T, & !< Diapycanal diffusivity of temperature [m2 s-1]. Kd1_S !< Diapycanal diffusivity of salinity [m2 s-1]. - real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces [m] - real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] + real, dimension(SZK_(GV)+1) :: iFaceHeight !< Height of interfaces relative to the sea surface [H ~> m or kg m-2] + real :: dh, hcorr ! Limited thicknesses and a cumulative correction [H ~> m or kg m-2] integer :: i, k ! initialize dummy variables @@ -235,16 +237,16 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) hcorr = 0.0 ! compute heights at cell center and interfaces do k=1,GV%ke - dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in height units + dh = h(i,j,k) ! Nominal thickness to use for increment, in height units dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness - cellHeight(k) = iFaceHeight(k) - 0.5 * US%Z_to_m*dh - iFaceHeight(k+1) = iFaceHeight(k) - US%Z_to_m*dh + cellHeight(k) = iFaceHeight(k) - 0.5 * dh + iFaceHeight(k+1) = iFaceHeight(k) - dh enddo ! gets index of the level and interface above hbl - !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl(i,j)) + !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, GV%Z_to_H*hbl(i,j)) Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0 call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), & @@ -254,8 +256,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) nlev=GV%ke, & max_nlev=GV%ke) do K=1,GV%ke+1 - Kd_T(i,j,K) = US%m2_s_to_Z2_T * Kd1_T(K) - Kd_S(i,j,K) = US%m2_s_to_Z2_T * Kd1_S(K) + Kd_T(i,j,K) = GV%m2_s_to_HZ_T * Kd1_T(K) + Kd_S(i,j,K) = GV%m2_s_to_HZ_T * Kd1_S(K) enddo ! Do not apply mixing due to convection within the boundary layer diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 708bb7c4fd..829318b606 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -10,6 +10,7 @@ module MOM_CVMix_shear use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : thickness_to_dz use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -66,9 +67,9 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2]. type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: kd !< The vertical diffusivity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. + !! (not layer!) [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: kv !< The vertical viscosity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. + !! (not layer!) [H Z T-1 ~> m2 s-1 or Pa s] type(CVMix_shear_cs), pointer :: CS !< The control structure returned by a previous !! call to CVMix_shear_init. ! Local variables @@ -76,11 +77,12 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) real :: GoRho ! Gravitational acceleration divided by density [Z T-2 R-1 ~> m4 s-2 kg-1] real :: pref ! Interface pressures [R L2 T-2 ~> Pa] real :: DU, DV ! Velocity differences [L T-1 ~> m s-1] - real :: DZ ! Grid spacing around an interface [Z ~> m] + real :: dz_int ! Grid spacing around an interface [Z ~> m] real :: N2 ! Buoyancy frequency at an interface [T-2 ~> s-2] real :: S2 ! Shear squared at an interface [T-2 ~> s-2] real :: dummy ! A dummy variable [nondim] real :: dRho ! Buoyancy differences [Z T-2 ~> m s-2] + real, dimension(SZI_(G),SZK_(GV)) :: dz ! Height change across layers [Z ~> m] real, dimension(2*(GV%ke)) :: pres_1d ! A column of interface pressures [R L2 T-2 ~> Pa] real, dimension(2*(GV%ke)) :: temp_1d ! A column of temperatures [C ~> degC] real, dimension(2*(GV%ke)) :: salt_1d ! A column of salinities [S ~> ppt] @@ -96,6 +98,10 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) epsln = 1.e-10 * GV%m_to_H do j = G%jsc, G%jec + + ! Find the vertical distances across layers. + call thickness_to_dz(h, tv, dz, j, G, GV) + do i = G%isc, G%iec ! skip calling for land points @@ -132,10 +138,14 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) kk = 2*(k-1) DU = u_h(i,j,k) - u_h(i,j,km1) DV = v_h(i,j,k) - v_h(i,j,km1) - DRHO = GoRho * (rho_1D(kk+1) - rho_1D(kk+2)) - DZ = (0.5*(h(i,j,km1) + h(i,j,k))+GV%H_subroundoff)*GV%H_to_Z - N2 = DRHO / DZ - S2 = US%L_to_Z**2*(DU*DU+DV*DV)/(DZ*DZ) + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + dRho = GoRho * (rho_1D(kk+1) - rho_1D(kk+2)) + else + dRho = (US%L_to_Z**2 * GV%g_Earth) * (rho_1D(kk+1) - rho_1D(kk+2)) / (0.5*(rho_1D(kk+1) + rho_1D(kk+2))) + endif + dz_int = 0.5*(dz(i,km1) + dz(i,k)) + GV%dZ_subroundoff + N2 = DRHO / dz_int + S2 = US%L_to_Z**2*(DU*DU + DV*DV) / (dz_int*dz_int) Ri_Grad(k) = max(0., N2) / max(S2, 1.e-10*US%T_to_s**2) ! fill 3d arrays, if user asks for diagnostics @@ -176,8 +186,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) if (CS%id_ri_grad > 0) CS%ri_grad(i,j,:) = Ri_Grad(:) do K=1,GV%ke+1 - Kvisc(K) = US%Z2_T_to_m2_s * kv(i,j,K) - Kdiff(K) = US%Z2_T_to_m2_s * kd(i,j,K) + Kvisc(K) = GV%HZ_T_to_m2_s * kv(i,j,K) + Kdiff(K) = GV%HZ_T_to_m2_s * kd(i,j,K) enddo ! Call to CVMix wrapper for computing interior mixing coefficients. @@ -187,8 +197,8 @@ subroutine calculate_CVMix_shear(u_H, v_H, h, tv, kd, kv, G, GV, US, CS ) nlev=GV%ke, & max_nlev=GV%ke) do K=1,GV%ke+1 - kv(i,j,K) = US%m2_s_to_Z2_T * Kvisc(K) - kd(i,j,K) = US%m2_s_to_Z2_T * Kdiff(K) + kv(i,j,K) = GV%m2_s_to_HZ_T * Kvisc(K) + kd(i,j,K) = GV%m2_s_to_HZ_T * Kdiff(K) enddo enddo enddo @@ -324,9 +334,9 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & - 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s) + 'Vertical diffusivity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%HZ_T_to_m2_s) CS%id_kv = register_diag_field('ocean_model', 'kv_shear_CVMix', diag%axesTi, Time, & - 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=US%Z2_T_to_m2_s) + 'Vertical viscosity added by MOM_CVMix_shear module', 'm2/s', conversion=GV%HZ_T_to_m2_s) end function CVMix_shear_init diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 01f8303ae2..693b9395bd 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -45,15 +45,15 @@ module MOM_bkgnd_mixing real :: Bryan_Lewis_c4 !< The depth where diffusivity is Bryan_Lewis_bl1 in the !! Bryan-Lewis profile [Z ~> m] real :: bckgrnd_vdc1 !< Background diffusivity (Ledwell) when - !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] + !! horiz_varying_background=.true. [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: bckgrnd_vdc_eq !< Equatorial diffusivity (Gregg) when - !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] + !! horiz_varying_background=.true. [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: bckgrnd_vdc_psim !< Max. PSI induced diffusivity (MacKinnon) when - !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] + !! horiz_varying_background=.true. [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: bckgrnd_vdc_Banda !< Banda Sea diffusivity (Gordon) when - !! horiz_varying_background=.true. [Z2 T-1 ~> m2 s-1] - real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1] - real :: Kd !< interior diapycnal diffusivity [Z2 T-1 ~> m2 s-1] + !! horiz_varying_background=.true. [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real :: Kd_min !< minimum diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real :: Kd !< interior diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: N0_2Omega !< ratio of the typical Buoyancy frequency to !! twice the Earth's rotation period, used with the @@ -63,10 +63,10 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn [nondim]. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kd_tot_ml !< The mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1] + real :: Kd_tot_ml !< The mixed layer diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] !! when no other physically based mixed layer turbulence !! parameterization is being used. - real :: Hmix !< mixed layer thickness [Z ~> m] when no physically based + real :: Hmix !< mixed layer thickness [H ~> m or kg m-2] when no physically based !! ocean surface boundary layer parameterization is used. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on !! latitude, like GFDL CM2.1/CM2M. There is no @@ -114,8 +114,10 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL !! surface boundary layer. ! Local variables - real :: Kv ! The interior vertical viscosity [Z2 T-1 ~> m2 s-1] - read to set Prandtl + real :: Kv ! The interior vertical viscosity [H Z T-1 ~> m2 s-1 or Pa s] - read to set Prandtl ! number unless it is provided as a parameter + real :: Kd_z ! The background diapycnal diffusivity in [Z2 T-1 ~> m2 s-1] for use + ! in setting the default for other diffusivities. real :: prandtl_bkgnd_comp ! Kv/CS%Kd [nondim]. Gets compared with user-specified prandtl_bkgnd. ! This include declares and sets the variable "version". @@ -132,19 +134,20 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL call log_version(param_file, mdl, version, & "Adding static vertical background mixing coefficients") - call get_param(param_file, mdl, "KD", CS%Kd, & + call get_param(param_file, mdl, "KD", Kd_z, & "The background diapycnal diffusivity of density in the "//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, "//& "may be used.", default=0.0, units="m2 s-1", scale=US%m2_s_to_Z2_T) + CS%Kd = (GV%m2_s_to_HZ_T*US%Z2_T_to_m2_s) * Kd_z call get_param(param_file, mdl, "KV", Kv, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) + units="m2 s-1", scale=GV%m2_s_to_HZ_T, fail_if_missing=.true.) call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=0.01*Kd_z*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T) ! The following is needed to set one of the choices of vertical background mixing @@ -152,11 +155,11 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL if (CS%physical_OBL_scheme) then ! Check that Kdml is not set when using bulk mixed layer call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, & - units="m2 s-1", default=-1., scale=US%m2_s_to_Z2_T, do_not_log=.true.) + units="m2 s-1", default=-1., scale=GV%m2_s_to_HZ_T, do_not_log=.true.) if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & "bkgnd_mixing_init: KDML is a depricated parameter that should not be used.") call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, & - units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + units="m2 s-1", default=-1.0, scale=GV%m2_s_to_HZ_T, do_not_log=.true.) if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & "bkgnd_mixing_init: KD_ML_TOT cannot be set when using a physically based ocean "//& "boundary layer mixing parameterization.") @@ -166,13 +169,13 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL "The total diapcynal diffusivity in the surface mixed layer when there is "//& "not a physically based parameterization of mixing in the mixed layer, such "//& "as bulk mixed layer or KPP or ePBL.", & - units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + units="m2 s-1", default=Kd_z*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T, do_not_log=.true.) if (abs(CS%Kd_tot_ml - CS%Kd) <= 1.0e-15*abs(CS%Kd)) then call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, & "If BULKMIXEDLAYER is false, KDML is the elevated "//& "diapycnal diffusivity in the topmost HMIX of fluid. "//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + units="m2 s-1", default=Kd_z*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T, do_not_log=.true.) if (abs(CS%Kd_tot_ml - CS%Kd) > 1.0e-15*abs(CS%Kd)) & call MOM_error(WARNING, "KDML is a depricated parameter. Use KD_ML_TOT instead.") endif @@ -180,12 +183,12 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL "The total diapcynal diffusivity in the surface mixed layer when there is "//& "not a physically based parameterization of mixing in the mixed layer, such "//& "as bulk mixed layer or KPP or ePBL.", & - units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, unscale=US%Z2_T_to_m2_s) + units="m2 s-1", default=Kd_z*US%Z2_T_to_m2_s, unscale=GV%HZ_T_to_m2_s) call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface "//& "viscosity and diffusivity are elevated when the bulk "//& - "mixed layer is not used.", units="m", scale=US%m_to_Z, fail_if_missing=.true.) + "mixed layer is not used.", units="m", scale=GV%m_to_H, fail_if_missing=.true.) endif call get_param(param_file, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) @@ -228,19 +231,19 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL call get_param(param_file, mdl, "BCKGRND_VDC1", CS%bckgrnd_vdc1, & "Background diffusivity (Ledwell) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.16e-04, scale=US%m2_s_to_Z2_T) + units="m2 s-1",default = 0.16e-04, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "BCKGRND_VDC_EQ", CS%bckgrnd_vdc_eq, & "Equatorial diffusivity (Gregg) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.01e-04, scale=US%m2_s_to_Z2_T) + units="m2 s-1",default = 0.01e-04, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "BCKGRND_VDC_PSIM", CS%bckgrnd_vdc_psim, & "Max. PSI induced diffusivity (MacKinnon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 0.13e-4, scale=US%m2_s_to_Z2_T) + units="m2 s-1",default = 0.13e-4, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "BCKGRND_VDC_BAN", CS%bckgrnd_vdc_Banda, & "Banda Sea diffusivity (Gordon) when HORIZ_VARYING_BACKGROUND=True", & - units="m2 s-1",default = 1.0e-4, scale=US%m2_s_to_Z2_T) + units="m2 s-1",default = 1.0e-4, scale=GV%m2_s_to_HZ_T) endif call get_param(param_file, mdl, "PRANDTL_BKGND", CS%prandtl_bkgnd, & @@ -318,12 +321,12 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< squared buoyancy frequency associated !! with layers [T-2 ~> s-2] - real, dimension(SZI_(G),SZK_(GV)), intent(out) :: Kd_lay !< The background diapycnal diffusivity - !! of each layer [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: Kd_int !< The background diapycnal diffusivity - !! of each interface [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: Kd_lay !< The background diapycnal diffusivity of each + !! layer [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: Kd_int !< The background diapycnal diffusivity of each + !! interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZK_(GV)+1), intent(out) :: Kv_bkgnd !< The background vertical viscosity at - !! each interface [Z2 T-1 ~> m2 s-1] + !! each interface [H Z T-1 ~> m2 s-1 or Pa s] integer, intent(in) :: j !< Meridional grid index type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(bkgnd_mixing_cs), pointer :: CS !< The control structure returned by @@ -333,10 +336,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, real, dimension(SZK_(GV)+1) :: depth_int !< Distance from surface of the interfaces [m] real, dimension(SZK_(GV)+1) :: Kd_col !< Diffusivities at the interfaces [m2 s-1] real, dimension(SZK_(GV)+1) :: Kv_col !< Viscosities at the interfaces [m2 s-1] - real, dimension(SZI_(G)) :: Kd_sfc !< Surface value of the diffusivity [Z2 T-1 ~> m2 s-1] - real, dimension(SZI_(G)) :: depth !< Distance from surface of an interface [Z ~> m] - real :: depth_c !< depth of the center of a layer [Z ~> m] - real :: I_Hmix !< inverse of fixed mixed layer thickness [Z-1 ~> m-1] + real, dimension(SZI_(G)) :: Kd_sfc !< Surface value of the diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real, dimension(SZI_(G)) :: depth !< Distance from surface of an interface [H ~> m or kg m-2] + real :: depth_c !< depth of the center of a layer [H ~> m or kg m-2] + real :: I_Hmix !< inverse of fixed mixed layer thickness [H-1 ~> m-1 or m2 kg-1] real :: I_2Omega !< 1/(2 Omega) [T ~> s] real :: N_2Omega ! The ratio of the stratification to the Earth's rotation rate [nondim] real :: N02_N2 ! The ratio a reference stratification to the actual stratification [nondim] @@ -344,8 +347,8 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, real :: deg_to_rad !< factor converting degrees to radians [radians degree-1], pi/180. real :: abs_sinlat !< absolute value of sine of latitude [nondim] real :: min_sinlat ! The minimum value of the sine of latitude [nondim] - real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [Z2 T-1 ~> m2 s-1] - real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere [Z2 T-1 ~> m2 s-1] + real :: bckgrnd_vdc_psin !< PSI diffusivity in northern hemisphere [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real :: bckgrnd_vdc_psis !< PSI diffusivity in southern hemisphere [H Z T-1 ~> m2 s-1 or kg m-1 s-1] integer :: i, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -380,11 +383,11 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, ! Update Kd and Kv. do K=1,nz+1 - Kv_bkgnd(i,K) = US%m2_s_to_Z2_T*Kv_col(K) - Kd_int(i,K) = US%m2_s_to_Z2_T*Kd_col(K) + Kv_bkgnd(i,K) = GV%m2_s_to_HZ_T * Kv_col(K) + Kd_int(i,K) = GV%m2_s_to_HZ_T*Kd_col(K) enddo do k=1,nz - Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_col(K) + Kd_col(K+1)) + Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * GV%m2_s_to_HZ_T * (Kd_col(K) + Kd_col(K+1)) enddo enddo ! i loop @@ -461,10 +464,10 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, if ((.not.CS%physical_OBL_scheme) .and. (CS%Kd /= CS%Kd_tot_ml)) then ! This is a crude way to put in a diffusive boundary layer without an explicit boundary ! layer turbulence scheme. It should not be used for any realistic ocean models. - I_Hmix = 1.0 / (CS%Hmix + GV%H_subroundoff*GV%H_to_Z) + I_Hmix = 1.0 / (CS%Hmix + GV%H_subroundoff) do i=is,ie ; depth(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - depth_c = depth(i) + 0.5*GV%H_to_Z*h(i,j,k) + depth_c = depth(i) + 0.5*h(i,j,k) if (CS%Kd_via_Kdml_bug) then ! These two lines should update Kd_lay, not Kd_int. They were correctly working on the ! same variables until MOM6 commit 7a818716 (PR#750), which was added on March 26, 2018. @@ -481,7 +484,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, endif endif - depth(i) = depth(i) + GV%H_to_Z*h(i,j,k) + depth(i) = depth(i) + h(i,j,k) enddo ; enddo else ! There is no vertical structure to the background diffusivity. diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index 66e2dfa6b2..ceba8dad1a 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -9,7 +9,7 @@ module MOM_bulk_mixed_layer use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_file_parser, only : get_param, log_param, log_version, param_file_type -use MOM_forcing_type, only : extractFluxes1d, forcing +use MOM_forcing_type, only : extractFluxes1d, forcing, find_ustar use MOM_grid, only : ocean_grid_type use MOM_opacity, only : absorbRemainingSW, optics_type, extract_optics_slice use MOM_unit_scaling, only : unit_scale_type @@ -235,6 +235,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ksort ! The sorted k-index that each original layer goes to. real, dimension(SZI_(G),SZJ_(G)) :: & h_miss ! The summed absolute mismatch [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)) :: & + U_star_2d ! The wind friction velocity, calculated using the Boussinesq reference density or + ! the time-evolving surface density in non-Boussinesq mode [Z T-1 ~> m s-1] real, dimension(SZI_(G)) :: & TKE, & ! The turbulent kinetic energy available for mixing over a ! time step [Z L2 T-2 ~> m3 s-2]. @@ -412,6 +415,9 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C max_BL_det(:) = -1 EOSdom(:) = EOS_domain(G%HI) + ! Extract the friction velocity from the forcing type. + call find_ustar(fluxes, tv, U_star_2d, G, GV, US) + !$OMP parallel default(shared) firstprivate(dKE_CA,cTKE,h_CA,max_BL_det,p_ref,p_ref_cv) & !$OMP private(h,u,v,h_orig,eps,T,S,opacity_band,d_ea,d_eb,R0,Rcv,ksort, & !$OMP dR0_dT,dR0_dS,dRcv_dT,dRcv_dS,htot,Ttot,Stot,TKE,Conv_en, & @@ -513,7 +519,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! First the TKE at the depth of free convection that is available ! to drive mixing is calculated. - call find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & + call find_starting_TKE(htot, h_CA, fluxes, U_star_2d, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & j, ksort, G, GV, US, CS) @@ -1252,7 +1258,7 @@ end subroutine mixedlayer_convection !> This subroutine determines the TKE available at the depth of free !! convection to drive mechanical entrainment. -subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & +subroutine find_starting_TKE(htot, h_CA, fluxes, U_star_2d, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & j, ksort, G, GV, US, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. @@ -1265,6 +1271,10 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, type(forcing), intent(in) :: fluxes !< A structure containing pointers to any !! possible forcing fields. Unused fields !! have NULL pointers. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: U_star_2d !< The wind friction velocity, calculated + !! using the Boussinesq reference density or + !! the time-evolving surface density in + !! non-Boussinesq mode [Z T-1 ~> m s-1] real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy source !! due to free convection [Z L2 T-2 ~> m3 s-2]. real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in @@ -1325,7 +1335,8 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, if (CS%omega_frac >= 1.0) absf = 2.0*CS%omega do i=is,ie - U_star = fluxes%ustar(i,j) + U_star = U_star_2d(i,j) + if (associated(fluxes%ustar_shelf) .and. associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & U_star = (1.0 - fluxes%frac_shelf_h(i,j)) * U_star + & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index ba265af5e2..6a5e454d19 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -67,7 +67,11 @@ module MOM_diabatic_aux !! e-folding depth of incoming shortwave radiation. type(external_field) :: sbc_chl !< A handle used in time interpolation of !! chlorophyll read from a file. - logical :: chl_from_file !< If true, chl_a is read from a file. + logical :: chl_from_file !< If true, chl_a is read from a file. + logical :: do_brine_plume !< If true, insert salt flux below the surface according to + !! a parameterization by \cite Nguyen2009. + integer :: brine_plume_n !< The exponent in the brine plume parameterization. + real :: plume_strength !< Fraction of the available brine to take to the bottom of the mixed layer. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. type(diag_ctrl), pointer :: diag !< Structure used to regulate timing of diagnostic output @@ -236,11 +240,11 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, tv, dt, G, GV) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(in) :: Kd_T !< The extra diffusivity of temperature due to !! double diffusion relative to the diffusivity of - !! diffusivity of density [Z2 T-1 ~> m2 s-1]. + !! density [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(in) :: Kd_S !< The extra diffusivity of salinity due to !! double diffusion relative to the diffusivity of - !! diffusivity of density [Z2 T-1 ~> m2 s-1]. + !! density [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any !! available thermodynamic fields. real, intent(in) :: dt !< Time increment [T ~> s]. @@ -269,8 +273,8 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, tv, dt, G, GV) do j=js,je do i=is,ie I_h_int = 1.0 / (0.5 * (h(i,j,1) + h(i,j,2)) + h_neglect) - mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%Z_to_H**2) * I_h_int - mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%Z_to_H**2) * I_h_int + mix_T(i,2) = ((dt * Kd_T(i,j,2)) * GV%Z_to_H) * I_h_int + mix_S(i,2) = ((dt * Kd_S(i,j,2)) * GV%Z_to_H) * I_h_int h_tr = h(i,j,1) + h_neglect b1_T(i) = 1.0 / (h_tr + mix_T(i,2)) @@ -283,8 +287,8 @@ subroutine differential_diffuse_T_S(h, T, S, Kd_T, Kd_S, tv, dt, G, GV) do k=2,nz-1 ; do i=is,ie ! Calculate the mixing across the interface below this layer. I_h_int = 1.0 / (0.5 * (h(i,j,k) + h(i,j,k+1)) + h_neglect) - mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%Z_to_H**2) * I_h_int - mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%Z_to_H**2) * I_h_int + mix_T(i,K+1) = ((dt * Kd_T(i,j,K+1)) * GV%Z_to_H) * I_h_int + mix_S(i,K+1) = ((dt * Kd_S(i,j,K+1)) * GV%Z_to_H) * I_h_int c1_T(i,k) = mix_T(i,K) * b1_T(i) c1_S(i,k) = mix_S(i,K) * b1_S(i) @@ -1034,7 +1038,7 @@ end subroutine diagnoseMLDbyEnergy subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, tv, & aggregate_FW_forcing, evap_CFL_limit, & minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, & - SkinBuoyFlux ) + SkinBuoyFlux, MLD) type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1064,6 +1068,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !! salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. + real, pointer, dimension(:,:), optional :: MLD!< Mixed layer depth for brine plumes [Z ~> m] ! Local variables integer, parameter :: maxGroundings = 5 @@ -1102,7 +1107,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t netheat_rate, & ! netheat but for dt=1 [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] netsalt_rate, & ! netsalt but for dt=1 (e.g. returns a rate) ! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] - netMassInOut_rate! netmassinout but for dt=1 [H T-1 ~> m s-1 or kg m-2 s-1] + netMassInOut_rate, & ! netmassinout but for dt=1 [H T-1 ~> m s-1 or kg m-2 s-1] + mixing_depth ! Mixed layer depth [Z -> m] real, dimension(SZI_(G), SZK_(GV)) :: & h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2] T2d, & ! A 2-d copy of the layer temperatures [C ~> degC] @@ -1132,6 +1138,11 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! and rejected brine are initially applied in vanishingly thin layers at the ! top of the layer before being mixed throughout the layer. logical :: calculate_buoyancy ! If true, calculate the surface buoyancy flux. + real, dimension(SZI_(G)) :: dK ! Depth [Z ~> m]. + real, dimension(SZI_(G)) :: A_brine ! Constant [Z-(n+1) ~> m-(n+1)]. + real :: fraction_left_brine ! Sum for keeping track of the fraction of brine so far (in depth) + real :: plume_fraction ! Sum for keeping track of the fraction of brine so far (in depth) + real :: plume_flux ! Brine flux to move downwards [S H ~> ppt m or ppt kg m-2] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, k, nz, nb character(len=45) :: mesg @@ -1139,6 +1150,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Idt = 1.0 / dt + plume_flux = 0.0 calculate_energetics = (present(cTKE) .and. present(dSV_dT) .and. present(dSV_dS)) calculate_buoyancy = present(SkinBuoyFlux) @@ -1158,6 +1170,17 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t GoRho = US%L_to_Z**2*GV%g_Earth / GV%Rho0 endif + if (CS%do_brine_plume .and. .not. associated(MLD)) then + call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& + "Brine plume parameterization requires a mixed-layer depth,\n"//& + "currently coming from the energetic PBL scheme.") + endif + if (CS%do_brine_plume .and. .not. associated(fluxes%salt_left_behind)) then + call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& + "Brine plume parameterization requires DO_BRINE_PLUME\n"//& + "to be turned on in SIS2 as well as MOM6.") + endif + ! H_limit_fluxes is used by extractFluxes1d to scale down fluxes if the total ! depth of the ocean is vanishing. It does not (yet) handle a value of zero. ! To accommodate vanishing upper layers, we need to allow for an instantaneous @@ -1173,9 +1196,9 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !$OMP H_limit_fluxes,numberOfGroundings,iGround,jGround,& !$OMP nonPenSW,hGrounding,CS,Idt,aggregate_FW_forcing, & !$OMP minimum_forcing_depth,evap_CFL_limit,dt,EOSdom, & - !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho, & + !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho,& !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2, & - !$OMP EnthalpyConst) & + !$OMP EnthalpyConst,MLD) & !$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, & !$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, & !$OMP IforcingDepthScale, & @@ -1183,8 +1206,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !$OMP netMassIn,pres,d_pres,p_lay,dSV_dT_2d, & !$OMP netmassinout_rate,netheat_rate,netsalt_rate, & !$OMP drhodt,drhods,pen_sw_bnd_rate, & - !$OMP pen_TKE_2d,Temp_in,Salin_in,RivermixConst) & - !$OMP firstprivate(SurfPressure) + !$OMP pen_TKE_2d,Temp_in,Salin_in,RivermixConst, & + !$OMP mixing_depth,A_brine,fraction_left_brine, & + !$OMP plume_fraction,dK) & + !$OMP firstprivate(SurfPressure,plume_flux) do j=js,je ! Work in vertical slices for efficiency @@ -1300,6 +1325,14 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! ocean (and corresponding outward heat content), and ignoring penetrative SW. ! B/ update mass, salt, temp from mass leaving ocean. ! C/ update temp due to penetrative SW + if (CS%do_brine_plume) then + do i=is,ie + mixing_depth(i) = max(MLD(i,j) - minimum_forcing_depth * GV%H_to_Z, minimum_forcing_depth * GV%H_to_Z) + mixing_depth(i) = min(mixing_depth(i), max(sum(h(i,j,:)), GV%angstrom_h) * GV%H_to_Z) + A_brine(i) = (CS%brine_plume_n + 1) / (mixing_depth(i) ** (CS%brine_plume_n + 1)) + enddo + endif + do i=is,ie if (G%mask2dT(i,j) > 0.) then @@ -1372,8 +1405,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t enddo ! k=1,1 ! B/ Update mass, salt, temp from mass leaving ocean and other fluxes of heat and salt. + fraction_left_brine = 1.0 do k=1,nz - ! Place forcing into this layer if this layer has nontrivial thickness. ! For layers thin relative to 1/IforcingDepthScale, then distribute ! forcing into deeper layers. @@ -1388,6 +1421,33 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t fractionOfForcing = -evap_CFL_limit*h2d(i,k)/netMassOut(i) endif + if (CS%do_brine_plume .and. associated(fluxes%salt_left_behind)) then + if (fluxes%salt_left_behind(i,j) > 0 .and. fraction_left_brine > 0.0) then + ! Place forcing into this layer by depth for brine plume parameterization. + if (k == 1) then + dK(i) = 0.5 * h(i,j,k) * GV%H_to_Z ! Depth of center of layer K + plume_flux = - (1000.0*US%ppt_to_S * (CS%plume_strength * fluxes%salt_left_behind(i,j))) * GV%RZ_to_H + plume_fraction = 1.0 + else + dK(i) = dK(i) + 0.5 * ( h(i,j,k) + h(i,j,k-1) ) * GV%H_to_Z ! Depth of center of layer K + plume_flux = 0.0 + endif + if (dK(i) <= mixing_depth(i) .and. fraction_left_brine > 0.0) then + plume_fraction = min(fraction_left_brine, A_brine(i) * dK(i) ** CS%brine_plume_n & + * h(i,j,k) * GV%H_to_Z) + else + IforcingDepthScale = 1. / max(GV%H_subroundoff, minimum_forcing_depth - netMassOut(i) ) + ! plume_fraction = fraction_left_brine, unless h2d is less than IforcingDepthScale. + plume_fraction = min(fraction_left_brine, h2d(i,k)*IforcingDepthScale) + endif + fraction_left_brine = fraction_left_brine - plume_fraction + plume_flux = plume_flux + plume_fraction * (1000.0*US%ppt_to_S * (CS%plume_strength * & + fluxes%salt_left_behind(i,j))) * GV%RZ_to_H + else + plume_flux = 0.0 + endif + endif + ! Change in state due to forcing dThickness = max( fractionOfForcing*netMassOut(i), -h2d(i,k) ) @@ -1432,7 +1492,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t endif Ithickness = 1.0/h2d(i,k) ! Inverse of new thickness T2d(i,k) = (hOld*T2d(i,k) + dTemp)*Ithickness - tv%S(i,j,k) = (hOld*tv%S(i,j,k) + dSalt)*Ithickness + tv%S(i,j,k) = (hOld*tv%S(i,j,k) + dSalt + plume_flux)*Ithickness elseif (h2d(i,k) < 0.0) then ! h2d==0 is a special limit that needs no extra handling call forcing_SinglePointPrint(fluxes,G,i,j,'applyBoundaryFluxesInOut (h<0)') write(0,*) 'applyBoundaryFluxesInOut(): lon,lat=',G%geoLonT(i,j),G%geoLatT(i,j) @@ -1702,6 +1762,16 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori CS%use_calving_heat_content = .false. endif + call get_param(param_file, mdl, "DO_BRINE_PLUME", CS%do_brine_plume, & + "If true, use a brine plume parameterization from "//& + "Nguyen et al., 2009.", default=.false.) + call get_param(param_file, mdl, "BRINE_PLUME_EXPONENT", CS%brine_plume_n, & + "If using the brine plume parameterization, set the integer exponent.", & + default=5, do_not_log=.not.CS%do_brine_plume) + call get_param(param_file, mdl, "BRINE_PLUME_FRACTION", CS%plume_strength, & + "Fraction of the available brine to mix down using the brine plume parameterization.", & + units="nondim", default=1.0, do_not_log=.not.CS%do_brine_plume) + if (useALEalgorithm) then CS%id_createdH = register_diag_field('ocean_model',"created_H",diag%axesT1, & Time, "The volume flux added to stop the ocean from drying out and becoming negative in depth", & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 0c28c063ea..b2b8527819 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -12,8 +12,9 @@ module MOM_diabatic_driver use MOM_CVMix_ddiff, only : CVMix_ddiff_is_used use MOM_diabatic_aux, only : diabatic_aux_init, diabatic_aux_end, diabatic_aux_CS use MOM_diabatic_aux, only : make_frazil, adjust_salt, differential_diffuse_T_S, triDiagTS -use MOM_diabatic_aux, only : triDiagTS_Eulerian, find_uv_at_h, diagnoseMLDbyDensityDifference -use MOM_diabatic_aux, only : applyBoundaryFluxesInOut, diagnoseMLDbyEnergy, set_pen_shortwave +use MOM_diabatic_aux, only : triDiagTS_Eulerian, find_uv_at_h +use MOM_diabatic_aux, only : applyBoundaryFluxesInOut, set_pen_shortwave +use MOM_diabatic_aux, only : diagnoseMLDbyDensityDifference, diagnoseMLDbyEnergy use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : post_product_sum_u, post_product_sum_v use MOM_diag_mediator, only : diag_ctrl, time_type, diag_update_remap_grids @@ -36,14 +37,14 @@ module MOM_diabatic_driver use MOM_error_handler, only : MOM_error, FATAL, WARNING, callTree_showQuery,MOM_mesg use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, log_version, param_file_type, read_param -use MOM_forcing_type, only : forcing, MOM_forcing_chksum +use MOM_forcing_type, only : forcing, MOM_forcing_chksum, find_ustar use MOM_forcing_type, only : calculateBuoyancyFlux2d, forcing_SinglePointPrint use MOM_geothermal, only : geothermal_entraining, geothermal_in_place use MOM_geothermal, only : geothermal_init, geothermal_end, geothermal_CS use MOM_grid, only : ocean_grid_type use MOM_int_tide_input, only : set_int_tide_input, int_tide_input_init use MOM_int_tide_input, only : int_tide_input_end, int_tide_input_CS, int_tide_input_type -use MOM_interface_heights, only : find_eta, calc_derived_thermo +use MOM_interface_heights, only : find_eta, calc_derived_thermo, thickness_to_dz use MOM_internal_tides, only : propagate_int_tide use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS use MOM_kappa_shear, only : kappa_shear_is_used @@ -145,11 +146,11 @@ module MOM_diabatic_driver !! diffusivity of Kd_min_tr (see below) were operating. real :: Kd_BBL_tr !< A bottom boundary layer tracer diffusivity that !! will allow for explicitly specified bottom fluxes - !! [Z2 T-1 ~> m2 s-1]. The entrainment at the bottom is at - !! least sqrt(Kd_BBL_tr*dt) over the same distance. + !! [H2 T-1 ~> m2 s-1 or kg2 m-4 s-2]. The entrainment at the + !! bottom is at least sqrt(Kd_BBL_tr*dt) over the same distance. real :: Kd_min_tr !< A minimal diffusivity that should always be !! applied to tracers, especially in massless layers - !! near the bottom [Z2 T-1 ~> m2 s-1]. + !! near the bottom [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: minimum_forcing_depth !< The smallest depth over which heat and freshwater !! fluxes are applied [H ~> m or kg m-2]. real :: evap_CFL_limit = 0.8 !< The largest fraction of a layer that can be @@ -170,8 +171,6 @@ module MOM_diabatic_driver real :: MLD_En_vals(3) !< Energy values for energy mixed layer diagnostics [R Z3 T-2 ~> J m-2] !>@{ Diagnostic IDs - integer :: id_cg1 = -1 ! diagnostic handle for mode-1 speed - integer, allocatable, dimension(:) :: id_cn ! diagnostic handle for all mode speeds integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1 integer :: id_Kd_heat = -1, id_Kd_salt = -1, id_Kd_int = -1, id_Kd_ePBL = -1 @@ -387,7 +386,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & CS%int_tide_input_CSp) call propagate_int_tide(h, tv, CS%int_tide_input%TKE_itidal_input, CS%int_tide_input%tideamp, & - CS%int_tide_input%Nb, dt, G, GV, US, CS%int_tide) + CS%int_tide_input%Nb, CS%int_tide_input%Rho_bot, dt, G, GV, US, CS%int_tide) if (showCallTree) call callTree_waypoint("done with propagate_int_tide (diabatic)") endif ! end CS%use_int_tides @@ -530,6 +529,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_orig, & ! Initial layer thicknesses [H ~> m or kg m-2] + dz, & ! The vertical distance between interfaces around a layer [Z ~> m] dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1] dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [R Z3 T-2 ~> J m-2]. @@ -543,18 +543,19 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! salinity and passive tracers [H ~> m or kg m-2] ent_t, & ! The diffusive coupling across interfaces within one time step for ! temperature [H ~> m or kg m-2] - Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] + Kd_int, & ! diapycnal diffusivity of interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_extra_T , & ! The extra diffusivity of temperature due to double diffusion relative to - ! Kd_int [Z2 T-1 ~> m2 s-1]. + ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to - ! Kd_int [Z2 T-1 ~> m2 s-1]. - Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] + ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] Sdif_flx ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)) :: & + U_star, & ! The friction velocity [Z T-1 ~> m s-1]. SkinBuoyFlux ! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL logical, dimension(SZI_(G)) :: & @@ -562,14 +563,14 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! sufficiently thick that the no-flux boundary conditions have not restricted ! the entrainment - usually sqrt(Kd*dt). - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2] - real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4] + real :: dz_neglect ! A vertical distance that is so small it is usually lost + ! in roundoff and can be neglected [Z ~> m] + real :: dz_neglect2 ! dz_neglect^2 [Z2 ~> m2] real :: add_ent ! Entrainment that needs to be added when mixing tracers [H ~> m or kg m-2] - real :: I_hval ! The inverse of the thicknesses averaged to interfaces [H-1 ~> m-1 or m2 kg-1] + real :: I_dzval ! The inverse of the thicknesses averaged to interfaces [Z-1 ~> m-1] real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is ! coupled to the bottom within a timestep [H ~> m or kg m-2] - real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2]. real :: Ent_int ! The diffusive entrainment rate at an interface [H ~> m or kg m-2] @@ -580,7 +581,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect + dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect*dz_neglect + Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 showCallTree = callTree_showQuery() @@ -638,7 +640,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif ! Set diffusivities for heat and salt separately @@ -659,8 +661,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%debug) then - call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Kd_salt, "after set_diffusivity Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif call cpu_clock_begin(id_clock_kpp) @@ -673,20 +675,23 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! unlike other instances where the fluxes are integrated in time over a time-step. call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) - ! The KPP scheme calculates boundary layer diffusivities and non-local transport. + ! Determine the friction velocity, perhaps using the evovling surface density. + call find_ustar(fluxes, tv, U_star, G, GV, US) + + ! The KPP scheme calculates boundary layer diffusivities and non-local transport. if ( associated(fluxes%lamult) ) then call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) + U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) else call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) + U_star, CS%KPP_buoy_flux, Waves=Waves) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) endif if (associated(Hml)) then @@ -719,8 +724,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G, US) - call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & scale=US%C_to_degC*GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & @@ -775,15 +780,18 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_shear) endif + ! Find the vertical distances across layers. + call thickness_to_dz(h, tv, dz, G, GV, US) + ! This block sets ent_t and ent_s from h and Kd_int. do j=js,je ; do i=is,ie ent_s(i,j,1) = 0.0 ; ent_s(i,j,nz+1) = 0.0 ent_t(i,j,1) = 0.0 ; ent_t(i,j,nz+1) = 0.0 enddo ; enddo - !$OMP parallel do default(shared) private(I_hval) + !$OMP parallel do default(shared) private(I_dzval) do K=2,nz ; do j=js,je ; do i=is,ie - I_hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ent_s(i,j,K) = (GV%Z_to_H**2) * dt * I_hval * Kd_int(i,j,K) + I_dzval = 1.0 / (dz_neglect + 0.5*(dz(i,j,k-1) + dz(i,j,k))) + ent_s(i,j,K) = dt * I_dzval * Kd_int(i,j,K) ent_t(i,j,K) = ent_s(i,j,K) enddo ; enddo ; enddo if (showCallTree) call callTree_waypoint("done setting ent_s and ent_t from Kd_int (diabatic)") @@ -814,18 +822,23 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & - optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) + optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD=visc%MLD) if (CS%debug) then - call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(ent_s, "after applyBoundaryFluxes ent_s", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_mks) + call hchksum(ent_s, "after applyBoundaryFluxes ent_s", G%HI, haloshift=0, scale=GV%H_to_mks) call hchksum(cTKE, "after applyBoundaryFluxes cTKE", G%HI, haloshift=0, & scale=US%RZ3_T3_to_W_m2*US%T_to_s) call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT", G%HI, haloshift=0, & scale=US%kg_m3_to_R*US%degC_to_C) call hchksum(dSV_dS, "after applyBoundaryFluxes dSV_dS", G%HI, haloshift=0, & scale=US%kg_m3_to_R*US%ppt_to_S) + call hchksum(h, "after applyBoundaryFluxes h", G%HI, haloshift=0, scale=GV%H_to_mks) + call hchksum(tv%T, "after applyBoundaryFluxes tv%T", G%HI, haloshift=0, scale=US%C_to_degC) + call hchksum(tv%S, "after applyBoundaryFluxes tv%S", G%HI, haloshift=0, scale=US%S_to_ppt) + call hchksum(SkinBuoyFlux, "after applyBdryFlux SkinBuoyFlux", G%HI, haloshift=0, & + scale=US%Z_to_m**2*US%s_to_T**3) endif call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) @@ -846,6 +859,9 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) endif + ! Find the vertical distances across layers, which may have been modified by the net surface flux + call thickness_to_dz(h, tv, dz, G, GV, US) + ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie if (CS%ePBL_is_additive) then @@ -856,7 +872,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim visc%Kv_shear(i,j,K) = max(visc%Kv_shear(i,j,K), CS%ePBL_Prandtl*Kd_ePBL(i,j,K)) endif - Ent_int = Kd_add_here * (GV%Z_to_H**2 * dt) / (0.5*(h(i,j,k-1) + h(i,j,k)) + h_neglect) + Ent_int = Kd_add_here * dt / (0.5*(dz(i,j,k-1) + dz(i,j,k)) + dz_neglect) ent_s(i,j,K) = ent_s(i,j,K) + Ent_int Kd_int(i,j,K) = Kd_int(i,j,K) + Kd_add_here @@ -869,13 +885,16 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (CS%debug) then call hchksum(ent_t, "after ePBL ent_t", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(ent_s, "after ePBL ent_s", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth) + CS%evap_CFL_limit, CS%minimum_forcing_depth, MLD=visc%MLD) + + ! Find the vertical distances across layers, which may have been modified by the net surface flux + call thickness_to_dz(h, tv, dz, G, GV, US) endif ! endif for CS%use_energetic_PBL @@ -1002,7 +1021,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracer_ALE) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = sqrt(dt * CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je @@ -1021,8 +1040,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_int, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & - ((h(i,j,k-1)+h(i,j,k)+h_neglect) / (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & + add_ent = ((dt * CS%Kd_min_tr)) * & + ((dz(i,j,k-1)+dz(i,j,k)+dz_neglect) / (dz(i,j,k-1)*dz(i,j,k)+dz_neglect2)) - & 0.5*(ent_s(i,j,K) + ent_s(i,j,K)) if (htot(i) < Tr_ea_BBL) then add_ent = max(0.0, add_ent, (Tr_ea_BBL - htot(i)) - ent_s(i,j,K)) @@ -1034,8 +1053,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif if (CS%double_diffuse) then ; if (Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & - (0.5 * (h(i,j,k-1) + h(i,j,k)) + h_neglect) + add_ent = (dt * Kd_extra_S(i,j,k)) / & + (0.5 * (dz(i,j,k-1) + dz(i,j,k)) + dz_neglect) ent_s(i,j,K) = ent_s(i,j,K) + add_ent endif ; endif enddo ; enddo @@ -1045,8 +1064,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (Kd_extra_S(i,j,k) > 0.0) then - add_ent = ((dt * Kd_extra_S(i,j,k)) * GV%Z_to_H**2) / & - (0.5 * (h(i,j,k-1) + h(i,j,k)) + h_neglect) + add_ent = (dt * Kd_extra_S(i,j,k)) / & + (0.5 * (dz(i,j,k-1) + dz(i,j,k)) + dz_neglect) else add_ent = 0.0 endif @@ -1126,6 +1145,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_orig, & ! Initial layer thicknesses [H ~> m or kg m-2] + dz, & ! The vertical distance between interfaces around a layer [Z ~> m] dSV_dT, & ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1] dSV_dS, & ! The partial derivative of specific volume with salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. cTKE, & ! convective TKE requirements for each layer [R Z3 T-2 ~> J m-2]. @@ -1140,33 +1160,33 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ent_t, & ! The diffusive coupling across interfaces within one time step for ! temperature [H ~> m or kg m-2] Kd_heat, & ! diapycnal diffusivity of heat or the smaller of the diapycnal diffusivities of - ! heat and salt [Z2 T-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] + ! heat and salt [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_extra_T , & ! The extra diffusivity of temperature due to double diffusion relative to - ! Kd_int returned from set_diffusivity [Z2 T-1 ~> m2 s-1]. + ! Kd_int returned from set_diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to - ! Kd_int returned from set_diffusivity [Z2 T-1 ~> m2 s-1]. - Kd_ePBL, & ! boundary layer or convective diapycnal diffusivities at interfaces [Z2 T-1 ~> m2 s-1] + ! Kd_int returned from set_diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kd_ePBL, & ! boundary layer or convective diapycnal diffusivities at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] Sdif_flx ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)) :: & + U_star, & ! The friction velocity [Z T-1 ~> m s-1]. SkinBuoyFlux ! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL logical, dimension(SZI_(G)) :: & in_boundary ! True if there are no massive layers below, where massive is defined as ! sufficiently thick that the no-flux boundary conditions have not restricted ! the entrainment - usually sqrt(Kd*dt). - - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2] - real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4] + real :: dz_neglect ! A vertical distance that is so small it is usually lost + ! in roundoff and can be neglected [Z ~> m] + real :: dz_neglect2 ! dz_neglect^2 [Z2 ~> m2] real :: add_ent ! Entrainment that needs to be added when mixing tracers [H ~> m or kg m-2] - real :: I_hval ! The inverse of the thicknesses averaged to interfaces [H-1 ~> m-1 or m2 kg-1] + real :: I_dzval ! The inverse of the thicknesses averaged to interfaces [Z-1 ~> m-1] real :: Tr_ea_BBL ! The diffusive tracer thickness in the BBL that is ! coupled to the bottom within a timestep [H ~> m or kg m-2] real :: htot(SZIB_(G)) ! The summed thickness from the bottom [H ~> m or kg m-2]. - real :: Kd_add_here ! An added diffusivity [Z2 T-1 ~> m2 s-1]. + real :: Kd_add_here ! An added diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real :: Idt ! The inverse time step [T-1 ~> s-1] logical :: showCallTree ! If true, show the call tree @@ -1174,7 +1194,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect + dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect*dz_neglect + Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 ent_s(:,:,:) = 0.0 ; ent_t(:,:,:) = 0.0 @@ -1235,7 +1256,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) - call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_heat, "after set_diffusivity Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif ! Store the diagnosed typical diffusivity at interfaces. @@ -1257,8 +1278,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif if (CS%debug) then - call hchksum(Kd_heat, "after double diffuse Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd_salt, "after double diffuse Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_heat, "after double diffuse Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Kd_salt, "after double diffuse Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif if (CS%useKPP) then @@ -1276,18 +1297,21 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + ! Determine the friction velocity, perhaps using the evovling surface density. + call find_ustar(fluxes, tv, U_star, G, GV, US) + ! The KPP scheme calculates boundary layer diffusivities and non-local transport. if ( associated(fluxes%lamult) ) then call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) + U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) else call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) + U_star, CS%KPP_buoy_flux, Waves=Waves) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) endif @@ -1307,8 +1331,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G, US) - call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & scale=US%C_to_degC*GV%H_to_m*US%s_to_T) call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & @@ -1360,7 +1384,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux) + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD=visc%MLD) if (CS%debug) then call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_m) @@ -1408,13 +1432,13 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (CS%debug) then call hchksum(ent_t, "after ePBL ent_t", G%HI, haloshift=0, scale=GV%H_to_m) call hchksum(ent_s, "after ePBL ent_s", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth) + CS%evap_CFL_limit, CS%minimum_forcing_depth, MLD=visc%MLD) endif ! endif for CS%use_energetic_PBL @@ -1464,17 +1488,20 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, enddo ; enddo ; enddo endif + ! Find the vertical distances across layers, which may have been modified by the net surface flux + call thickness_to_dz(h, tv, dz, G, GV, US) + ! set ent_t=dt*Kd_heat/h_int and est_s=dt*Kd_salt/h_int on interfaces for use in the tridiagonal solver. do j=js,je ; do i=is,ie ent_t(i,j,1) = 0. ; ent_t(i,j,nz+1) = 0. ent_s(i,j,1) = 0. ; ent_s(i,j,nz+1) = 0. enddo ; enddo - !$OMP parallel do default(shared) private(I_hval) + !$OMP parallel do default(shared) private(I_dzval) do K=2,nz ; do j=js,je ; do i=is,ie - I_hval = 1.0 / (h_neglect + 0.5*(h(i,j,k-1) + h(i,j,k))) - ent_t(i,j,K) = (GV%Z_to_H**2) * dt * I_hval * Kd_heat(i,j,k) - ent_s(i,j,K) = (GV%Z_to_H**2) * dt * I_hval * Kd_salt(i,j,k) + I_dzval = 1.0 / (dz_neglect + 0.5*(dz(i,j,k-1) + dz(i,j,k))) + ent_t(i,j,K) = dt * I_dzval * Kd_heat(i,j,k) + ent_s(i,j,K) = dt * I_dzval * Kd_salt(i,j,k) enddo ; enddo ; enddo if (showCallTree) call callTree_waypoint("done setting ent_t and ent_t from Kd_heat and " //& "Kd_salt (diabatic_ALE)") @@ -1505,14 +1532,14 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call diag_update_remap_grids(CS%diag) ! Diagnose the diapycnal diffusivities and other related quantities. - if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) - if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) - if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) + if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) + if (CS%id_Kd_salt > 0) call post_data(CS%id_Kd_salt, Kd_salt, CS%diag) + if (CS%id_Kd_ePBL > 0) call post_data(CS%id_Kd_ePBL, Kd_ePBL, CS%diag) - if (CS%id_ea_t > 0) call post_data(CS%id_ea_t, ent_t(:,:,1:nz), CS%diag) - if (CS%id_eb_t > 0) call post_data(CS%id_eb_t, ent_t(:,:,2:nz+1), CS%diag) - if (CS%id_ea_s > 0) call post_data(CS%id_ea_s, ent_s(:,:,1:nz), CS%diag) - if (CS%id_eb_s > 0) call post_data(CS%id_eb_s, ent_s(:,:,2:nz+1), CS%diag) + if (CS%id_ea_t > 0) call post_data(CS%id_ea_t, ent_t(:,:,1:nz), CS%diag) + if (CS%id_eb_t > 0) call post_data(CS%id_eb_t, ent_t(:,:,2:nz+1), CS%diag) + if (CS%id_ea_s > 0) call post_data(CS%id_ea_s, ent_s(:,:,1:nz), CS%diag) + if (CS%id_eb_s > 0) call post_data(CS%id_eb_s, ent_s(:,:,2:nz+1), CS%diag) Idt = 1.0 / dt if (CS%id_Tdif > 0) then @@ -1540,7 +1567,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call cpu_clock_begin(id_clock_tracers) if (CS%mix_boundary_tracer_ALE) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = sqrt(dt * CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -1554,8 +1581,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! bottom, add some mixing of tracers between these layers. This flux is based on the ! harmonic mean of the two thicknesses, following what is done in layered mode. Kd_min_tr ! should be much less than the values in Kd_salt, perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & - ((h(i,j,k-1)+h(i,j,k) + h_neglect) / (h(i,j,k-1)*h(i,j,k) + h_neglect2)) - & + add_ent = (dt * CS%Kd_min_tr) * & + ((dz(i,j,k-1)+dz(i,j,k) + dz_neglect) / (dz(i,j,k-1)*dz(i,j,k) + dz_neglect2)) - & ent_s(i,j,K) if (htot(i) < Tr_ea_BBL) then add_ent = max(0.0, add_ent, (Tr_ea_BBL - htot(i)) - ent_s(i,j,K)) @@ -1646,15 +1673,19 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! one time step [H ~> m or kg m-2] eb, & ! amount of fluid entrained from the layer below within ! one time step [H ~> m or kg m-2] - Kd_lay, & ! diapycnal diffusivity of layers [Z2 T-1 ~> m2 s-1] + Kd_lay, & ! diapycnal diffusivity of layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] h_orig, & ! initial layer thicknesses [H ~> m or kg m-2] + dz, & ! The vertical distance between interfaces around a layer [Z ~> m] hold, & ! layer thickness before diapycnal entrainment, and later the initial ! layer thicknesses (if a mixed layer is used) [H ~> m or kg m-2] + dz_old, & ! The initial vertical distance between interfaces around a layer + ! or the distance before entrainment [Z ~> m] u_h, & ! Zonal velocities at thickness points after entrainment [L T-1 ~> m s-1] v_h, & ! Meridional velocities at thickness points after entrainment [L T-1 ~> m s-1] temp_diag, & ! Diagnostic array of previous temperatures [C ~> degC] saln_diag ! Diagnostic array of previous salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G)) :: & + U_star, & ! The friction velocity [Z T-1 ~> m s-1]. Rcv_ml ! Coordinate density of mixed layer [R ~> kg m-3], used for applying sponges real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & @@ -1665,13 +1696,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! homogenize tracers in massless layers near the boundaries [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & - Kd_int, & ! diapycnal diffusivity of interfaces [Z2 T-1 ~> m2 s-1] - Kd_heat, & ! diapycnal diffusivity of heat [Z2 T-1 ~> m2 s-1] - Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [Z2 T-1 ~> m2 s-1] + Kd_int, & ! diapycnal diffusivity of interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kd_heat, & ! diapycnal diffusivity of heat [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kd_salt, & ! diapycnal diffusivity of salt and passive tracers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_extra_T , & ! The extra diffusivity of temperature due to double diffusion relative to - ! Kd_int [Z2 T-1 ~> m2 s-1]. + ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to - ! Kd_int [Z2 T-1 ~> m2 s-1]. + ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] @@ -1697,7 +1728,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2] - real :: h_neglect2 ! h_neglect^2 [H2 ~> m2 or kg2 m-4] + real :: dz_neglect ! A vertical distance that is so small it is usually lost + ! in roundoff and can be neglected [Z ~> m] + real :: dz_neglect2 ! dz_neglect^2 [Z2 ~> m2] real :: net_ent ! The net of ea-eb at an interface [H ~> m or kg m-2] real :: add_ent ! Entrainment that needs to be added when mixing tracers [H ~> m or kg m-2] real :: eaval ! eaval is 2*ea at velocity grid points [H ~> m or kg m-2] @@ -1724,7 +1757,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB nkmb = GV%nk_rho_varies - h_neglect = GV%H_subroundoff ; h_neglect2 = h_neglect*h_neglect + h_neglect = GV%H_subroundoff + dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect*dz_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 @@ -1852,8 +1886,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call MOM_state_chksum("after set_diffusivity ", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after set_diffusivity ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after set_diffusivity ", tv, G, US) - call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_lay, "after set_diffusivity Kd_lay", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Kd_Int, "after set_diffusivity Kd_Int", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif @@ -1885,17 +1919,20 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo ; enddo ; enddo endif + ! Determine the friction velocity, perhaps using the evovling surface density. + call find_ustar(fluxes, tv, U_star, G, GV, US) + if ( associated(fluxes%lamult) ) then call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) + U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) else call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - fluxes%ustar, CS%KPP_buoy_flux, Waves=Waves) + U_star, CS%KPP_buoy_flux, Waves=Waves) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, fluxes%ustar, CS%KPP_buoy_flux, Kd_heat, & + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) endif @@ -1930,8 +1967,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call MOM_state_chksum("after KPP", u, v, h, G, GV, US, haloshift=0) call MOM_forcing_chksum("after KPP", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP", tv, G, US) - 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) + call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP @@ -2300,8 +2337,15 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! mixing of passive tracers from massless boundary layers to interior call cpu_clock_begin(id_clock_tracers) + + ! Find the vertical distances across layers. + if (CS%mix_boundary_tracers .or. CS%double_diffuse) & + call thickness_to_dz(h, tv, dz, G, GV, US) + if (CS%double_diffuse) & + call thickness_to_dz(hold, tv, dz_old, G, GV, US) + if (CS%mix_boundary_tracers) then - Tr_ea_BBL = GV%Z_to_H * sqrt(dt*CS%Kd_BBL_tr) + Tr_ea_BBL = sqrt(dt * CS%Kd_BBL_tr) !$OMP parallel do default(shared) private(htot,in_boundary,add_ent) do j=js,je do i=is,ie @@ -2320,9 +2364,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! in the calculation of the fluxes in the first place. Kd_min_tr ! should be much less than the values that have been set in Kd_lay, ! perhaps a molecular diffusivity. - add_ent = ((dt * CS%Kd_min_tr) * GV%Z_to_H**2) * & - ((h(i,j,k-1)+h(i,j,k)+h_neglect) / & - (h(i,j,k-1)*h(i,j,k)+h_neglect2)) - & + add_ent = (dt * CS%Kd_min_tr) * & + ((dz(i,j,k-1) + dz(i,j,k) + dz_neglect) / & + (dz(i,j,k-1)*dz(i,j,k) + dz_neglect2)) - & 0.5*(ea(i,j,k) + eb(i,j,k-1)) if (htot(i) < Tr_ea_BBL) then add_ent = max(0.0, add_ent, & @@ -2337,9 +2381,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ebtr(i,j,k-1) = eb(i,j,k-1) ; eatr(i,j,k) = ea(i,j,k) endif if (CS%double_diffuse) then ; if (Kd_extra_S(i,j,K) > 0.0) then - add_ent = ((dt * Kd_extra_S(i,j,K)) * GV%Z_to_H**2) / & - (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & - h_neglect) + add_ent = (dt * Kd_extra_S(i,j,K)) / & + (0.25 * ((dz(i,j,k-1) + dz(i,j,k)) + (dz_old(i,j,k-1) + dz_old(i,j,k))) + dz_neglect) ebtr(i,j,k-1) = ebtr(i,j,k-1) + add_ent eatr(i,j,k) = eatr(i,j,k) + add_ent endif ; endif @@ -2361,9 +2404,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e !$OMP parallel do default(shared) private(add_ent) do k=nz,2,-1 ; do j=js,je ; do i=is,ie if (Kd_extra_S(i,j,K) > 0.0) then - add_ent = ((dt * Kd_extra_S(i,j,K)) * GV%Z_to_H**2) / & - (0.25 * ((h(i,j,k-1) + h(i,j,k)) + (hold(i,j,k-1) + hold(i,j,k))) + & - h_neglect) + add_ent = (dt * Kd_extra_S(i,j,K)) / & + (0.25 * ((dz(i,j,k-1) + dz(i,j,k)) + (dz_old(i,j,k-1) + dz_old(i,j,k))) + dz_neglect) else add_ent = 0.0 endif @@ -3090,12 +3132,14 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di "A minimal diffusivity that should always be applied to "//& "tracers, especially in massless layers near the bottom. "//& "The default is 0.1*KD.", & - units="m2 s-1", default=0.1*Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=0.1*Kd*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "KD_BBL_TR", CS%Kd_BBL_tr, & "A bottom boundary layer tracer diffusivity that will "//& "allow for explicitly specified bottom fluxes. The "//& "entrainment at the bottom is at least sqrt(Kd_BBL_tr*dt) "//& - "over the same distance.", units="m2 s-1", default=0., scale=US%m2_s_to_Z2_T) + "over the same distance.", & + units="m2 s-1", default=0., scale=GV%m2_s_to_HZ_T*(US%Z_to_m*GV%m_to_H)) + ! The scaling factor here is usually equivalent to GV%m2_s_to_HZ_T*GV%Z_to_H. endif call get_param(param_file, mdl, "TRACER_TRIDIAG", CS%tracer_tridiag, & @@ -3242,19 +3286,19 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di endif CS%id_Kd_int = register_diag_field('ocean_model', 'Kd_interface', diag%axesTi, Time, & - 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Total diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) if (CS%use_energetic_PBL) then CS%id_Kd_ePBL = register_diag_field('ocean_model', 'Kd_ePBL', diag%axesTi, Time, & - 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'ePBL diapycnal diffusivity at interfaces', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) endif CS%id_Kd_heat = register_diag_field('ocean_model', 'Kd_heat', diag%axesTi, Time, & - 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & + 'Total diapycnal diffusivity for heat at interfaces', 'm2 s-1', conversion=GV%HZ_T_to_m2_s, & cmor_field_name='difvho', & cmor_standard_name='ocean_vertical_heat_diffusivity', & cmor_long_name='Ocean vertical heat diffusivity') CS%id_Kd_salt = register_diag_field('ocean_model', 'Kd_salt', diag%axesTi, Time, & - 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=US%Z2_T_to_m2_s, & + 'Total diapycnal diffusivity for salt at interfaces', 'm2 s-1', conversion=GV%HZ_T_to_m2_s, & cmor_field_name='difvso', & cmor_standard_name='ocean_vertical_salt_diffusivity', & cmor_long_name='Ocean vertical salt diffusivity') diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 641816513c..06c3915d84 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -12,6 +12,7 @@ module MOM_energetic_PBL 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_interface_heights, only : thickness_to_dz use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs @@ -277,7 +278,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: Kd_int !< The diagnosed diffusivities at interfaces - !! [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. type(energetic_PBL_CS), intent(inout) :: CS !< Energetic PBL control structure real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: buoy_flux !< The surface buoyancy flux [Z2 T-3 ~> m2 s-3]. @@ -309,6 +310,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Local variables real, dimension(SZI_(G),SZK_(GV)) :: & h_2d, & ! A 2-d slice of the layer thickness [H ~> m or kg m-2]. + dz_2d, & ! A 2-d slice of the vertical distance across layers [Z ~> m]. T_2d, & ! A 2-d slice of the layer temperatures [C ~> degC]. S_2d, & ! A 2-d slice of the layer salinities [S ~> ppt]. TKE_forced_2d, & ! A 2-d slice of TKE_forced [R Z3 T-2 ~> J m-2]. @@ -320,6 +322,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS Kd_2d ! A 2-d version of the diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. real, dimension(SZK_(GV)) :: & h, & ! The layer thickness [H ~> m or kg m-2]. + dz, & ! The vertical distance across layers [Z ~> m]. T0, & ! The initial layer temperatures [C ~> degC]. S0, & ! The initial layer salinities [S ~> ppt]. dSV_dT_1d, & ! The partial derivatives of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1]. @@ -362,7 +365,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Zero out diagnostics before accumulation. if (CS%TKE_diagnostics) then -!!OMP parallel do default(none) shared(is,ie,js,je,CS) + !!OMP parallel do default(none) shared(is,ie,js,je,CS) do j=js,je ; do i=is,ie CS%diag_TKE_wind(i,j) = 0.0 ; CS%diag_TKE_MKE(i,j) = 0.0 CS%diag_TKE_conv(i,j) = 0.0 ; CS%diag_TKE_forcing(i,j) = 0.0 @@ -373,8 +376,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! if (CS%id_Mixing_Length>0) CS%Mixing_Length(:,:,:) = 0.0 ! if (CS%id_Velocity_Scale>0) CS%Velocity_Scale(:,:,:) = 0.0 -!!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & -!!OMP CS,G,GV,US,fluxes,TKE_forced,dSV_dT,dSV_dS,Kd_int) + !!OMP parallel do default(private) shared(js,je,nz,is,ie,h_3d,u_3d,v_3d,tv,dt, & + !!OMP CS,G,GV,US,fluxes,TKE_forced,dSV_dT,dSV_dS,Kd_int) do j=js,je ! Copy the thicknesses and other fields to 2-d arrays. do k=1,nz ; do i=is,ie @@ -383,6 +386,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS TKE_forced_2d(i,k) = TKE_forced(i,j,k) dSV_dT_2d(i,k) = dSV_dT(i,j,k) ; dSV_dS_2d(i,k) = dSV_dS(i,j,k) enddo ; enddo + call thickness_to_dz(h_3d, tv, dz_2d, j, G, GV) ! Determine the initial mech_TKE and conv_PErel, including the energy required ! to mix surface heating through the topmost cell, the energy released by mixing @@ -394,7 +398,8 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Copy the thicknesses and other fields to 1-d arrays. do k=1,nz - h(k) = h_2d(i,k) + GV%H_subroundoff ; u(k) = u_2d(i,k) ; v(k) = v_2d(i,k) + h(k) = h_2d(i,k) + GV%H_subroundoff ; dz(k) = dz_2d(i,k) + GV%dZ_subroundoff + u(k) = u_2d(i,k) ; v(k) = v_2d(i,k) T0(k) = T_2d(i,k) ; S0(k) = S_2d(i,k) ; TKE_forcing(k) = TKE_forced_2d(i,k) dSV_dT_1d(k) = dSV_dT_2d(i,k) ; dSV_dS_1d(k) = dSV_dS_2d(i,k) enddo @@ -421,15 +426,15 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS ! Perhaps provide a first guess for MLD based on a stored previous value. MLD_io = -1.0 - if (CS%MLD_iteration_guess .and. (CS%ML_Depth(i,j) > 0.0)) MLD_io = CS%ML_Depth(i,j) + if (CS%MLD_iteration_guess .and. (CS%ML_depth(i,j) > 0.0)) MLD_io = CS%ML_depth(i,j) if (stoch_CS%pert_epbl) then ! stochastics are active - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + call ePBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & US, CS, eCD, Waves, G, i, j, & TKE_gen_stoch=stoch_CS%epbl1_wts(i,j), TKE_diss_stoch=stoch_CS%epbl2_wts(i,j)) else - call ePBL_column(h, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & + call ePBL_column(h, dz, u, v, T0, S0, dSV_dT_1d, dSV_dS_1d, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, & US, CS, eCD, Waves, G, i, j) endif @@ -467,7 +472,7 @@ subroutine energetic_PBL(h_3d, u_3d, v_3d, tv, fluxes, dt, Kd_int, G, GV, US, CS CS%ML_depth(i,j) = 0.0 endif ; enddo ! Close of i-loop - Note unusual loop order! - do K=1,nz+1 ; do i=is,ie ; Kd_int(i,j,K) = Kd_2d(i,K) ; enddo ; enddo + do K=1,nz+1 ; do i=is,ie ; Kd_int(i,j,K) = GV%Z_to_H*Kd_2d(i,K) ; enddo ; enddo enddo ! j-loop @@ -499,12 +504,13 @@ end subroutine energetic_PBL !> This subroutine determines the diffusivities from the integrated energetics !! mixed layer model for a single column of water. -subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & +subroutine ePBL_column(h, dz, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, absf, & u_star, u_star_mean, dt, MLD_io, Kd, mixvel, mixlen, GV, US, CS, eCD, & Waves, G, i, j, TKE_gen_stoch, TKE_diss_stoch) type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m]. real, dimension(SZK_(GV)), intent(in) :: u !< Zonal velocities interpolated to h points !! [L T-1 ~> m s-1]. real, dimension(SZK_(GV)), intent(in) :: v !< Zonal velocities interpolated to h points @@ -828,7 +834,7 @@ subroutine ePBL_column(h, u, v, T0, S0, dSV_dT, dSV_dS, TKE_forcing, B_flux, abs !/ Here we get MStar, which is the ratio of convective TKE driven mixing to UStar**3 MLD_guess_z = GV%H_to_Z*MLD_guess ! Convert MLD from thickness to height coordinates for these calls if (CS%Use_LT) then - call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess_z), u_star_mean, i, j, h, Waves, & + call get_Langmuir_Number(LA, G, GV, US, abs(MLD_guess_z), u_star_mean, i, j, dz, Waves, & U_H=u, V_H=v) call find_mstar(CS, US, B_flux, u_star, u_star_Mean, MLD_guess_z, absf, & MStar_total, Langmuir_Number=La, Convect_Langmuir_Number=LAmod,& @@ -1931,7 +1937,7 @@ subroutine energetic_PBL_get_MLD(CS, MLD, G, US, m_to_MLD_units) scale = 1.0 ; if (present(m_to_MLD_units)) scale = US%Z_to_m * m_to_MLD_units do j=G%jsc,G%jec ; do i=G%isc,G%iec - MLD(i,j) = scale*CS%ML_Depth(i,j) + MLD(i,j) = scale*CS%ML_depth(i,j) enddo ; enddo end subroutine energetic_PBL_get_MLD @@ -2002,21 +2008,24 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "EPBL_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for horizontal viscosity. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "EPBL_ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic and expressions in the energetic "//& "PBL calculations. Values below 20190101 recover the answers from the "//& "end of 2018, while higher values use updated and more robust forms of the "//& "same expressions. If both EPBL_2018_ANSWERS and EPBL_ANSWER_DATE are "//& - "specified, the latter takes precedence.", default=default_answer_date) - + "specified, the latter takes precedence.", & + default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & "If true, the ePBL code uses the original form of the "//& diff --git a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 index 51a28db0e9..c30f5c2c3f 100644 --- a/src/parameterizations/vertical/MOM_entrain_diffusive.F90 +++ b/src/parameterizations/vertical/MOM_entrain_diffusive.F90 @@ -78,10 +78,10 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & ! At least one of the two following arguments must be present. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: Kd_Lay !< The diapycnal diffusivity of layers - !! [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(in) :: Kd_int !< The diapycnal diffusivity of interfaces - !! [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. ! This subroutine calculates ea and eb, the rates at which a layer entrains ! from the layers above and below. The entrainment rates are proportional to @@ -274,23 +274,23 @@ subroutine entrainment_diffusive(h, tv, fluxes, dt, G, GV, US, CS, ea, eb, & if (present(Kd_Lay)) then do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (dt * Kd_lay(i,j,k)) + dtKd(i,k) = GV%Z_to_H * (dt * Kd_lay(i,j,k)) enddo ; enddo if (present(Kd_int)) then do K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H * (dt * Kd_int(i,j,K)) enddo ; enddo else do K=2,nz ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (0.5 * dt * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k))) + dtKd_int(i,K) = GV%Z_to_H * (0.5 * dt * (Kd_lay(i,j,k-1) + Kd_lay(i,j,k))) enddo ; enddo endif else ! Kd_int must be present, or there already would have been an error. do k=1,nz ; do i=is,ie - dtKd(i,k) = GV%Z_to_H**2 * (0.5 * dt * (Kd_int(i,j,K)+Kd_int(i,j,K+1))) + dtKd(i,k) = GV%Z_to_H * (0.5 * dt * (Kd_int(i,j,K)+Kd_int(i,j,K+1))) enddo ; enddo dO K=1,nz+1 ; do i=is,ie - dtKd_int(i,K) = GV%Z_to_H**2 * (dt * Kd_int(i,j,K)) + dtKd_int(i,K) = GV%Z_to_H * (dt * Kd_int(i,j,K)) enddo ; enddo endif diff --git a/src/parameterizations/vertical/MOM_full_convection.F90 b/src/parameterizations/vertical/MOM_full_convection.F90 index 344511bf29..a5fba3adc6 100644 --- a/src/parameterizations/vertical/MOM_full_convection.F90 +++ b/src/parameterizations/vertical/MOM_full_convection.F90 @@ -3,11 +3,12 @@ module MOM_full_convection ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density_derivs, EOS_domain +use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : thickness_to_dz +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density_derivs, EOS_domain implicit none ; private @@ -31,15 +32,16 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(out) :: S_adj !< Adjusted salinity [S ~> ppt]. real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] (or NULL). - real, intent(in) :: Kddt_smooth !< A smoothing vertical - !! diffusivity times a timestep [H2 ~> m2 or kg2 m-4]. + real, intent(in) :: Kddt_smooth !< A smoothing vertical diffusivity + !! times a timestep [H Z ~> m2 or kg m-1]. integer, intent(in) :: halo !< Halo width over which to compute ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & dRho_dT, & ! The derivative of density with temperature [R C-1 ~> kg m-3 degC-1] dRho_dS ! The derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. - real :: h_neglect, h0 ! A thickness that is so small it is usually lost + real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m] + real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. ! logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. real, dimension(SZI_(G),SZK0_(G)) :: & @@ -90,15 +92,17 @@ subroutine full_convection(G, GV, US, h, tv, T_adj, S_adj, p_surf, Kddt_smooth, if (.not.associated(tv%eqn_of_state)) return h_neglect = GV%H_subroundoff - mix_len = (1.0e20 * nz) * (G%max_depth * GV%Z_to_H) - h0 = 1.0e-16*sqrt(Kddt_smooth) + h_neglect + mix_len = (1.0e20 * nz) * (G%max_depth * US%Z_to_m * GV%m_to_H) do j=js,je mix(:,:) = 0.0 ; d_b(:,:) = 1.0 ! These would be Te_b(:,:) = tv%T(:,j,:), etc., but the values are not used Te_b(:,:) = 0.0 ; Se_b(:,:) = 0.0 - call smoothed_dRdT_dRdS(h, tv, Kddt_smooth, dRho_dT, dRho_dS, G, GV, US, j, p_surf, halo) + ! Find the vertical distances across layers. + call thickness_to_dz(h, tv, dz, j, G, GV, halo_size=halo) + + call smoothed_dRdT_dRdS(h, dz, tv, Kddt_smooth, dRho_dT, dRho_dS, G, GV, US, j, p_surf, halo) do i=is,ie do_i(i) = (G%mask2dT(i,j) > 0.0) @@ -306,14 +310,16 @@ end function is_unstable !> Returns the partial derivatives of locally referenced potential density with !! temperature and salinity after the properties have been smoothed with a small !! constant diffusivity. -subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, halo) +subroutine smoothed_dRdT_dRdS(h, dz, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, halo) 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 !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZK_(GV)), & + intent(in) :: dz !< Height change across layers [Z ~> m] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables - real, intent(in) :: Kddt !< A diffusivity times a time increment [H2 ~> m2 or kg2 m-4]. + real, intent(in) :: Kddt !< A diffusivity times a time increment [H Z ~> m2 or kg m-1]. real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: dR_dT !< Derivative of locally referenced !! potential density with temperature [R C-1 ~> kg m-3 degC-1] @@ -336,8 +342,9 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h real :: pres(SZI_(G)) ! Interface pressures [R L2 T-2 ~> Pa]. real :: T_EOS(SZI_(G)) ! Filtered and vertically averaged temperatures [C ~> degC] real :: S_EOS(SZI_(G)) ! Filtered and vertically averaged salinities [S ~> ppt] - real :: kap_dt_x2 ! The product of 2*kappa*dt [H2 ~> m2 or kg2 m-4]. - real :: h_neglect, h0 ! Negligible thicknesses to allow for zero thicknesses, + real :: kap_dt_x2 ! The product of 2*kappa*dt [H Z ~> m2 or kg m-1]. + real :: dz_neglect, h0 ! A negligible vertical distances [Z ~> m] + real :: h_neglect ! A negligible thickness to allow for zero thicknesses ! [H ~> m or kg m-2]. real :: h_tr ! The thickness at tracer points, plus h_neglect [H ~> m or kg m-2]. integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state @@ -347,6 +354,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h nz = GV%ke h_neglect = GV%H_subroundoff + dz_neglect = GV%dz_subroundoff kap_dt_x2 = 2.0*Kddt if (Kddt <= 0.0) then @@ -354,9 +362,9 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h T_f(i,k) = tv%T(i,j,k) ; S_f(i,k) = tv%S(i,j,k) enddo ; enddo else - h0 = 1.0e-16*sqrt(Kddt) + h_neglect + h0 = 1.0e-16*sqrt(GV%H_to_m*US%m_to_Z*Kddt) + dz_neglect do i=is,ie - mix(i,2) = kap_dt_x2 / ((h(i,j,1)+h(i,j,2)) + h0) + mix(i,2) = kap_dt_x2 / ((dz(i,1)+dz(i,2)) + h0) h_tr = h(i,j,1) + h_neglect b1(i) = 1.0 / (h_tr + mix(i,2)) @@ -365,7 +373,7 @@ subroutine smoothed_dRdT_dRdS(h, tv, Kddt, dR_dT, dR_dS, G, GV, US, j, p_surf, h S_f(i,1) = (b1(i)*h_tr)*tv%S(i,j,1) enddo do k=2,nz-1 ; do i=is,ie - mix(i,K+1) = kap_dt_x2 / ((h(i,j,k)+h(i,j,k+1)) + h0) + mix(i,K+1) = kap_dt_x2 / ((dz(i,k)+dz(i,k+1)) + h0) c1(i,k) = mix(i,K) * b1(i) h_tr = h(i,j,k) + h_neglect diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index 7ec612f141..3da21b48fb 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -14,6 +14,7 @@ module MOM_int_tide_input use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : slasher, vardesc, MOM_read_data +use MOM_interface_heights, only : thickness_to_dz, find_rho_bottom use MOM_isopycnal_slopes, only : vert_fill_TS use MOM_time_manager, only : time_type, set_time, operator(+), operator(<=) use MOM_unit_scaling, only : unit_scale_type @@ -41,10 +42,11 @@ module MOM_int_tide_input real :: TKE_itide_max !< Maximum Internal tide conversion !! available to mix above the BBL [R Z3 T-3 ~> W m-2] real :: kappa_fill !< Vertical diffusivity used to interpolate sensible values - !! of T & S into thin layers [Z2 T-1 ~> m2 s-1]. + !! of T & S into thin layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, allocatable, dimension(:,:) :: TKE_itidal_coef - !< The time-invariant field that enters the TKE_itidal input calculation [R Z3 T-2 ~> J m-2]. + !< The time-invariant field that enters the TKE_itidal input calculation noting that the + !! stratification and perhaps density are time-varying [R Z4 H-1 T-2 ~> J m-2 or J m kg-1]. character(len=200) :: inputdir !< The directory for input files. logical :: int_tide_source_test !< If true, apply an arbitrary generation site @@ -70,7 +72,8 @@ module MOM_int_tide_input TKE_itidal_input, & !< The internal tide TKE input at the bottom of the ocean [R Z3 T-3 ~> W m-2]. h2, & !< The squared topographic roughness height [Z2 ~> m2]. tideamp, & !< The amplitude of the tidal velocities [Z T-1 ~> m s-1]. - Nb !< The bottom stratification [T-1 ~> s-1]. + Nb, & !< The bottom stratification [T-1 ~> s-1]. + Rho_bot !< The bottom density or the Boussinesq reference density [R ~> kg m-3]. end type int_tide_input_type contains @@ -90,9 +93,12 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) !! to the internal tide sources. real, intent(in) :: dt !< The time increment [T ~> s]. type(int_tide_input_CS), pointer :: CS !< This module's control structure. + ! Local variables real, dimension(SZI_(G),SZJ_(G)) :: & N2_bot ! The bottom squared buoyancy frequency [T-2 ~> s-2]. + real, dimension(SZI_(G),SZJ_(G)) :: & + Rho_bot ! The average near-bottom density or the Boussinesq reference density [R ~> kg m-3]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & T_f, S_f ! The temperature and salinity in [C ~> degC] and [S ~> ppt] with the values in @@ -118,18 +124,28 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) ! Smooth the properties through massless layers. if (use_EOS) then - call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill*dt, T_f, S_f, G, GV, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, CS%kappa_fill*dt, T_f, S_f, G, GV, US, larger_h_denom=.true.) endif - call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot) + call find_N2_bottom(h, tv, T_f, S_f, itide%h2, fluxes, G, GV, US, N2_bot, Rho_bot) avg_enabled = query_averaging_enabled(CS%diag, time_end=time_end) - !$OMP parallel do default(shared) - do j=js,je ; do i=is,ie - itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j)) - itide%TKE_itidal_input(i,j) = min(CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), CS%TKE_itide_max) - enddo ; enddo + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j)) + itide%TKE_itidal_input(i,j) = min(GV%Z_to_H*CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), CS%TKE_itide_max) + enddo ; enddo + else + !$OMP parallel do default(shared) + do j=js,je ; do i=is,ie + itide%Nb(i,j) = G%mask2dT(i,j) * sqrt(N2_bot(i,j)) + itide%Rho_bot(i,j) = G%mask2dT(i,j) * Rho_bot(i,j) + itide%TKE_itidal_input(i,j) = min((GV%RZ_to_H*Rho_bot(i,j)) * CS%TKE_itidal_coef(i,j)*itide%Nb(i,j), & + CS%TKE_itide_max) + enddo ; enddo + endif if (CS%int_tide_source_test) then itide%TKE_itidal_input(:,:) = 0.0 @@ -171,7 +187,7 @@ subroutine set_int_tide_input(u, v, h, tv, fluxes, itide, dt, G, GV, US, CS) end subroutine set_int_tide_input !> Estimates the near-bottom buoyancy frequency (N^2). -subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) +subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot, rho_bot) 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 @@ -186,55 +202,62 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) type(forcing), intent(in) :: fluxes !< A structure of thermodynamic surface fluxes real, dimension(SZI_(G),SZJ_(G)), intent(out) :: N2_bot !< The squared buoyancy frequency at the !! ocean bottom [T-2 ~> s-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: rho_bot !< The average density near the ocean + !! bottom [R ~> kg m-3] ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & + pres, & ! The pressure at each interface [R L2 T-2 ~> Pa]. dRho_int ! The unfiltered density differences across interfaces [R ~> kg m-3]. + real, dimension(SZI_(G),SZK_(GV)) :: dz ! Layer thicknesses in depth units [Z ~> m] real, dimension(SZI_(G)) :: & - pres, & ! The pressure at each interface [R L2 T-2 ~> Pa]. Temp_int, & ! The temperature at each interface [C ~> degC] Salin_int, & ! The salinity at each interface [S ~> ppt] drho_bot, & ! The density difference at the bottom of a layer [R ~> kg m-3] h_amp, & ! The amplitude of topographic roughness [Z ~> m]. - hb, & ! The depth below a layer [Z ~> m]. - z_from_bot, & ! The height of a layer center above the bottom [Z ~> m]. + hb, & ! The thickness of the water column below the midpoint of a layer [H ~> m or kg m-2] + z_from_bot, & ! The distance of a layer center from the bottom [Z ~> m] dRho_dT, & ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1]. - real :: dz_int ! The thickness associated with an interface [Z ~> m]. - real :: G_Rho0 ! The gravitation acceleration divided by the Boussinesq - ! density [Z T-2 R-1 ~> m4 s-2 kg-1]. + real :: dz_int ! The vertical extent of water associated with an interface [Z ~> m] + real :: G_Rho0 ! The gravitational acceleration, sometimes divided by the Boussinesq + ! density [H T-2 R-1 ~> m4 s-2 kg-1 or m s-2]. logical :: do_i(SZI_(G)), do_any integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2*GV%g_Earth) / GV%H_to_RZ EOSdom(:) = EOS_domain(G%HI) ! Find the (limited) density jump across each interface. do i=is,ie dRho_int(i,1) = 0.0 ; dRho_int(i,nz+1) = 0.0 enddo -!$OMP parallel do default(none) shared(is,ie,js,je,nz,tv,fluxes,G,GV,US,h,T_f,S_f, & -!$OMP h2,N2_bot,G_Rho0,EOSdom) & -!$OMP private(pres,Temp_Int,Salin_Int,dRho_dT,dRho_dS, & -!$OMP hb,dRho_bot,z_from_bot,do_i,h_amp, & -!$OMP do_any,dz_int) & -!$OMP firstprivate(dRho_int) + + !$OMP parallel do default(none) shared(is,ie,js,je,nz,tv,fluxes,G,GV,US,h,T_f,S_f, & + !$OMP h2,N2_bot,rho_bot,G_Rho0,EOSdom) & + !$OMP private(pres,Temp_Int,Salin_Int,dRho_dT,dRho_dS, & + !$OMP dz,hb,dRho_bot,z_from_bot,do_i,h_amp,do_any,dz_int) & + !$OMP firstprivate(dRho_int) do j=js,je + + ! Find the vertical distances across layers. + call thickness_to_dz(h, tv, dz, j, G, GV) + if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then - do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo + do i=is,ie ; pres(i,1) = fluxes%p_surf(i,j) ; enddo else - do i=is,ie ; pres(i) = 0.0 ; enddo + do i=is,ie ; pres(i,1) = 0.0 ; enddo endif do K=2,nz do i=is,ie - pres(i) = pres(i) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1) + pres(i,K) = pres(i,K-1) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1) Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1)) Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT(:), dRho_dS(:), & + call calculate_density_derivs(Temp_int, Salin_int, pres(:,K), dRho_dT(:), dRho_dS(:), & tv%eqn_of_state, EOSdom) do i=is,ie dRho_int(i,K) = max(dRho_dT(i)*(T_f(i,j,k) - T_f(i,j,k-1)) + & @@ -250,7 +273,7 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) ! Find the bottom boundary layer stratification. do i=is,ie hb(i) = 0.0 ; dRho_bot(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) + z_from_bot(i) = 0.5*dz(i,nz) do_i(i) = (G%mask2dT(i,j) > 0.0) h_amp(i) = sqrt(h2(i,j)) enddo @@ -258,16 +281,16 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*(dz(i,k) + dz(i,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above - hb(i) = hb(i) + dz_int + hb(i) = hb(i) + 0.5*(h(i,j,k) + h(i,j,k-1)) dRho_bot(i) = dRho_bot(i) + dRho_int(i,K) if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) + hb(i) = hb(i) + 0.5*(h(i,j,k-1) + h(i,j,k-2)) dRho_bot(i) = dRho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. @@ -283,6 +306,15 @@ subroutine find_N2_bottom(h, tv, T_f, S_f, h2, fluxes, G, GV, US, N2_bot) N2_bot(i,j) = (G_Rho0 * dRho_bot(i)) / hb(i) else ; N2_bot(i,j) = 0.0 ; endif enddo + + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do i=is,ie + rho_bot(i,j) = GV%Rho0 + enddo + else + ! Average the density over the envelope of the topography. + call find_rho_bottom(h, dz, pres, h_amp, tv, j, G, GV, US, Rho_bot(:,j)) + endif enddo end subroutine find_N2_bottom @@ -352,13 +384,14 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_fill, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0, scale=US%m_s_to_L_T) allocate(itide%Nb(isd:ied,jsd:jed), source=0.0) + allocate(itide%Rho_bot(isd:ied,jsd:jed), source=0.0) allocate(itide%h2(isd:ied,jsd:jed), source=0.0) allocate(itide%TKE_itidal_input(isd:ied,jsd:jed), source=0.0) allocate(itide%tideamp(isd:ied,jsd:jed), source=utide) @@ -452,8 +485,8 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) if (max_frac_rough >= 0.0) & itide%h2(i,j) = min((max_frac_rough*(G%bathyT(i,j)+G%Z_ref))**2, itide%h2(i,j)) - ! Compute the fixed part of internal tidal forcing; units are [R Z3 T-2 ~> J m-2] here. - CS%TKE_itidal_coef(i,j) = 0.5*US%L_to_Z*kappa_h2_factor*GV%Rho0*& + ! Compute the fixed part of internal tidal forcing; units are [R Z4 H-1 T-2 ~> J m-2 or J m kg-1] here. + CS%TKE_itidal_coef(i,j) = 0.5*US%L_to_Z*kappa_h2_factor * GV%H_to_RZ * & kappa_itides * itide%h2(i,j) * itide%tideamp(i,j)**2 enddo ; enddo diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 78ec0d9391..191b88de0a 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -127,15 +127,15 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & real, dimension(:,:), pointer :: p_surf !< The pressure at the ocean surface [R L2 T-2 ~> Pa] (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. Initially this is the - !! value from the previous timestep, which may + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. Initially this + !! is the value from the previous timestep, which may !! accelerate the iteration toward convergence. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: tke_io !< The turbulent kinetic energy per unit mass at !! each interface (not layer!) [Z2 T-2 ~> m2 s-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(inout) :: kv_io !< The vertical viscosity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. This discards any + !! (not layer!) [H Z T-1 ~> m2 s-1 or Pa s]. This discards any !! previous value (i.e. it is intent out) and !! simply sets Kv = Prandtl * Kd_shear real, intent(in) :: dt !< Time increment [T ~> s]. @@ -312,15 +312,15 @@ subroutine Calculate_kappa_shear(u_in, v_in, h, tv, p_surf, kappa_io, tke_io, & endif ; enddo ! i-loop do K=1,nz+1 ; do i=is,ie - kappa_io(i,j,K) = G%mask2dT(i,j) * kappa_2d(i,K) + kappa_io(i,j,K) = G%mask2dT(i,j) * GV%Z_to_H*kappa_2d(i,K) tke_io(i,j,K) = G%mask2dT(i,j) * tke_2d(i,K) - kv_io(i,j,K) = ( G%mask2dT(i,j) * kappa_2d(i,K) ) * CS%Prandtl_turb + kv_io(i,j,K) = ( G%mask2dT(i,j) * GV%Z_to_H*kappa_2d(i,K) ) * CS%Prandtl_turb enddo ; enddo enddo ! end of j-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(kappa_io, "kappa", G%HI, scale=GV%HZ_T_to_m2_s) call hchksum(tke_io, "tke", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif @@ -353,12 +353,13 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ !! (or NULL). real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(out) :: kappa_io !< The diapycnal diffusivity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. + !! (not layer!) [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & intent(out) :: tke_io !< The turbulent kinetic energy per unit mass at !! each interface (not layer!) [Z2 T-2 ~> m2 s-2]. real, dimension(SZIB_(G),SZJB_(G),SZK_(GV)+1), & - intent(inout) :: kv_io !< The vertical viscosity at each interface [Z2 T-1 ~> m2 s-1]. + intent(inout) :: kv_io !< The vertical viscosity at each interface + !! [H Z T-1 ~> m2 s-1 or Pa s]. !! The previous value is used to initialize kappa !! in the vertex columns as Kappa = Kv/Prandtl !! to accelerate the iteration toward convergence. @@ -577,11 +578,11 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ do K=1,nz+1 ; do I=IsB,IeB tke_io(I,J,K) = G%mask2dBu(I,J) * tke_2d(I,K) - kv_io(I,J,K) = ( G%mask2dBu(I,J) * kappa_2d(I,K,J2) ) * CS%Prandtl_turb + kv_io(I,J,K) = ( G%mask2dBu(I,J) * GV%Z_to_H*kappa_2d(I,K,J2) ) * CS%Prandtl_turb enddo ; enddo if (J>=G%jsc) then ; do K=1,nz+1 ; do i=G%isc,G%iec ! Set the diffusivities in tracer columns from the values at vertices. - kappa_io(i,j,K) = G%mask2dT(i,j) * 0.25 * & + kappa_io(i,j,K) = G%mask2dT(i,j) * 0.25 * GV%Z_to_H * & ((kappa_2d(I-1,K,J2m1) + kappa_2d(I,K,J2)) + & (kappa_2d(I-1,K,J2) + kappa_2d(I,K,J2m1))) enddo ; enddo ; endif @@ -589,7 +590,7 @@ subroutine Calc_kappa_shear_vertex(u_in, v_in, h, T_in, S_in, tv, p_surf, kappa_ enddo ! end of J-loop if (CS%debug) then - call hchksum(kappa_io, "kappa", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(kappa_io, "kappa", G%HI, scale=GV%HZ_T_to_m2_s) call Bchksum(tke_io, "tke", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif @@ -1906,7 +1907,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) CS%diag => diag CS%id_Kd_shear = register_diag_field('ocean_model','Kd_shear', diag%axesTi, Time, & - 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Shear-driven Diapycnal Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) CS%id_TKE = register_diag_field('ocean_model','TKE_shear', diag%axesTi, Time, & 'Shear-driven Turbulent Kinetic Energy', 'm2 s-2', conversion=US%Z_to_m**2*US%s_to_T**2) diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index a8029d031f..ac93e54785 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -1069,22 +1069,25 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "OPTICS_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated expressions for "//& "handling the absorption of small remaining shortwave fluxes.", & - default=default_2018_answers) + default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for optics. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "OPTICS_ANSWER_DATE", optics%answer_date, & "The vintage of the order of arithmetic and expressions in the optics calculations. "//& "Values below 20190101 recover the answers from the end of 2018, while "//& "higher values use updated and more robust forms of the same expressions. "//& "If both OPTICS_2018_ANSWERS and OPTICS_ANSWER_DATE are "//& - "specified, the latter takes precedence.", default=default_answer_date) - + "specified, the latter takes precedence.", & + default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) optics%answer_date = max(optics%answer_date, 20230701) call get_param(param_file, mdl, "PEN_SW_FLUX_ABSORB", optics%PenSW_flux_absorb, & "A minimum remaining shortwave heating rate that will be simply absorbed in "//& diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 5380b4cda0..d4034d699c 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -576,14 +576,14 @@ subroutine regularize_surface(h, tv, dt, ea, eb, G, GV, US, CS) trim(mesg), .true.) fatal_error = .true. endif - if (abs(Th_tot1(i) - Th_tot2(i)) > 1e-12*(Th_tot1(i)+10.0*h_tot1(i))) then + if (abs(Th_tot1(i) - Th_tot2(i)) > 1e-12*abs(Th_tot1(i) + 10.0*US%degC_to_C*h_tot1(i))) then write(mesg,'(ES11.4," became ",ES11.4," diff ",ES11.4," int diff ",ES11.4)') & Th_tot1(i), Th_tot2(i), (Th_tot1(i) - Th_tot2(i)), (Th_tot1(i) - Th_tot3(i)) call MOM_error(WARNING, "regularize_surface: Heat non-conservation."//& trim(mesg), .true.) fatal_error = .true. endif - if (abs(Sh_tot1(i) - Sh_tot2(i)) > 1e-12*(Sh_tot1(i)+10.0*h_tot1(i))) then + if (abs(Sh_tot1(i) - Sh_tot2(i)) > 1e-12*abs(Sh_tot1(i) + 10.0*US%ppt_to_S*h_tot1(i))) then write(mesg,'(ES11.4," became ",ES11.4," diff ",ES11.4," int diff ",ES11.4)') & Sh_tot1(i), Sh_tot2(i), (Sh_tot1(i) - Sh_tot2(i)), (Sh_tot1(i) - Sh_tot3(i)) call MOM_error(WARNING, "regularize_surface: Salinity non-conservation."//& @@ -762,21 +762,24 @@ subroutine regularize_layers_init(Time, G, GV, param_file, diag, CS) default=99991231, do_not_log=just_read) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101), do_not_log=just_read) + default=(default_answer_date<20190101), do_not_log=just_read.or.(.not.GV%Boussinesq)) call get_param(param_file, mdl, "REGULARIZE_LAYERS_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the answers "//& "from the end of 2018. Otherwise, use updated and more robust forms of the "//& - "same expressions.", default=default_2018_answers, do_not_log=just_read) + "same expressions.", default=default_2018_answers, do_not_log=just_read.or.(.not.GV%Boussinesq)) ! Revise inconsistent default answer dates. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "REGULARIZE_LAYERS_ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic and expressions in the regularize "//& "layers calculations. Values below 20190101 recover the answers from the "//& "end of 2018, while higher values use updated and more robust forms of the "//& "same expressions. If both REGULARIZE_LAYERS_2018_ANSWERS and "//& "REGULARIZE_LAYERS_ANSWER_DATE are specified, the latter takes precedence.", & - default=default_answer_date) + default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) endif call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9dc7b81c46..2aac478086 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -22,6 +22,7 @@ module MOM_set_diffusivity use MOM_forcing_type, only : forcing, optics_type use MOM_full_convection, only : full_convection use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : thickness_to_dz, find_rho_bottom use MOM_internal_tides, only : int_tide_CS, get_lowmode_loss use MOM_intrinsic_functions, only : invcosh use MOM_io, only : slasher, MOM_read_data @@ -77,17 +78,19 @@ module MOM_set_diffusivity real :: BBL_effic !< efficiency with which the energy extracted !! by bottom drag drives BBL diffusion [nondim] real :: cdrag !< quadratic drag coefficient [nondim] + real :: dz_BBL_avg_min !< A minimal distance over which to average to determine the average + !! bottom boundary layer density [Z ~> m] real :: IMax_decay !< inverse of a maximum decay scale for !! bottom-drag driven turbulence [Z-1 ~> m-1]. - real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1]. - real :: Kd !< interior diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. - real :: Kd_min !< minimum diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. - real :: Kd_max !< maximum increment for diapycnal diffusivity [Z2 T-1 ~> m2 s-1]. + real :: Kv !< The interior vertical viscosity [H Z T-1 ~> m2 s-1 or Pa s] + real :: Kd !< interior diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real :: Kd_min !< minimum diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real :: Kd_max !< maximum increment for diapycnal diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] !! Set to a negative value to have no limit. real :: Kd_add !< uniform diffusivity added everywhere without - !! filtering or scaling [Z2 T-1 ~> m2 s-1]. + !! filtering or scaling [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: Kd_smooth !< Vertical diffusivity used to interpolate more - !! sensible values of T & S into thin layers [Z2 T-1 ~> m2 s-1]. + !! sensible values of T & S into thin layers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] type(diag_ctrl), pointer :: diag => NULL() !< structure to regulate diagnostic output timing logical :: limit_dissipation !< If enabled, dissipation is limited to be larger @@ -96,7 +99,7 @@ module MOM_set_diffusivity real :: dissip_N0 !< Coefficient a in minimum dissipation = a+b*N [R Z2 T-3 ~> W m-3] real :: dissip_N1 !< Coefficient b in minimum dissipation = a+b*N [R Z2 T-2 ~> J m-3] real :: dissip_N2 !< Coefficient c in minimum dissipation = c*N2 [R Z2 T-1 ~> J s m-3] - real :: dissip_Kd_min !< Minimum Kd [Z2 T-1 ~> m2 s-1], with dissipation Rho0*Kd_min*N^2 + real :: dissip_Kd_min !< Minimum Kd [H Z T-1 ~> m2 s-1 or kg m-1 s-1], with dissipation Rho0*Kd_min*N^2 real :: omega !< Earth's rotation frequency [T-1 ~> s-1] logical :: ML_radiation !< allow a fraction of TKE available from wind work @@ -112,8 +115,8 @@ module MOM_set_diffusivity !! The diapycnal diffusivity is KD(k) = E/(N2(k)+OMEGA2), !! where N2 is the squared buoyancy frequency [T-2 ~> s-2] and OMEGA2 !! is the rotation rate of the earth squared. - real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence - !! radiated from the base of the mixed layer [Z2 T-1 ~> m2 s-1]. + real :: ML_rad_kd_max !< Maximum diapycnal diffusivity due to turbulence radiated from + !! the base of the mixed layer [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real :: ML_rad_efold_coeff !< Coefficient to scale penetration depth [nondim] real :: ML_rad_coeff !< Coefficient which scales MSTAR*USTAR^3 to obtain energy !! available for mixing below mixed layer base [nondim] @@ -148,8 +151,8 @@ module MOM_set_diffusivity logical :: simple_TKE_to_Kd !< If true, uses a simple estimate of Kd/TKE that !! does not rely on a layer-formulation. real :: Max_Rrho_salt_fingers !< max density ratio for salt fingering [nondim] - real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [Z2 T-1 ~> m2 s-1] - real :: Kv_molecular !< Molecular viscosity for double diffusive convection [Z2 T-1 ~> m2 s-1] + real :: Max_salt_diff_salt_fingers !< max salt diffusivity for salt fingers [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real :: Kv_molecular !< Molecular viscosity for double diffusive convection [H Z T-1 ~> m2 s-1 or Pa s] integer :: answer_date !< The vintage of the order of arithmetic and expressions in this module's !! calculations. Values below 20190101 recover the answers from the @@ -178,19 +181,19 @@ module MOM_set_diffusivity type diffusivity_diags real, pointer, dimension(:,:,:) :: & N2_3d => NULL(), & !< squared buoyancy frequency at interfaces [T-2 ~> s-2] - Kd_user => NULL(), & !< user-added diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [Z2 T-1 ~> m2 s-1] + Kd_user => NULL(), & !< user-added diffusivity at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kd_BBL => NULL(), & !< BBL diffusivity at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_work => NULL(), & !< layer integrated work by diapycnal mixing [R Z3 T-3 ~> W m-2] - maxTKE => NULL(), & !< energy required to entrain to h_max [Z3 T-3 ~> m3 s-3] - Kd_bkgnd => NULL(), & !< Background diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - Kv_bkgnd => NULL(), & !< Viscosity from background diffusivity at interfaces [Z2 T-1 ~> m2 s-1] - KT_extra => NULL(), & !< Double diffusion diffusivity for temperature [Z2 T-1 ~> m2 s-1]. - KS_extra => NULL(), & !< Double diffusion diffusivity for salinity [Z2 T-1 ~> m2 s-1]. + maxTKE => NULL(), & !< energy required to entrain to h_max [H Z2 T-3 ~> m3 s-3 or W m-2] + Kd_bkgnd => NULL(), & !< Background diffusivity at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kv_bkgnd => NULL(), & !< Viscosity from background diffusivity at interfaces [H Z T-1 ~> m2 s-1 or Pa s] + KT_extra => NULL(), & !< Double diffusion diffusivity for temperature [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + KS_extra => NULL(), & !< Double diffusion diffusivity for salinity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] drho_rat => NULL() !< The density difference ratio used in double diffusion [nondim]. real, pointer, dimension(:,:,:) :: TKE_to_Kd => NULL() !< conversion rate (~1.0 / (G_Earth + dRho_lay)) between TKE !! dissipated within a layer and Kd in that layer - !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] + !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] end type diffusivity_diags @@ -224,22 +227,26 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i !! boundary layer properties and related fields. real, intent(in) :: dt !< Time increment [T ~> s]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - intent(out) :: Kd_int !< Diapycnal diffusivity at each interface [Z2 T-1 ~> m2 s-1]. + intent(out) :: Kd_int !< Diapycnal diffusivity at each interface + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - optional, intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer [Z2 T-1 ~> m2 s-1]. + optional, intent(out) :: Kd_lay !< Diapycnal diffusivity of each layer + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(out) :: Kd_extra_T !< The extra diffusivity at interfaces of - !! temperature due to double diffusion relative to - !! the diffusivity of density [Z2 T-1 ~> m2 s-1]. + !! temperature due to double diffusion relative + !! to the diffusivity of density + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(out) :: Kd_extra_S !< The extra diffusivity at interfaces of - !! salinity due to double diffusion relative to - !! the diffusivity of density [Z2 T-1 ~> m2 s-1]. + !! salinity due to double diffusion relative + !! to the diffusivity of density + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] ! local variables - real, dimension(SZI_(G)) :: & - N2_bot ! bottom squared buoyancy frequency [T-2 ~> s-2] + real :: N2_bot(SZI_(G)) ! Bottom squared buoyancy frequency [T-2 ~> s-2] + real :: rho_bot(SZI_(G)) ! In situ near-bottom density [T-2 ~> s-2] type(diffusivity_diags) :: dd ! structure with arrays of available diags @@ -249,19 +256,20 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i real, dimension(SZI_(G),SZK_(GV)) :: & N2_lay, & !< Squared buoyancy frequency associated with layers [T-2 ~> s-2] - Kd_lay_2d, & !< The layer diffusivities [Z2 T-1 ~> m2 s-1] - maxTKE, & !< Energy required to entrain to h_max [Z3 T-3 ~> m3 s-3] + Kd_lay_2d, & !< The layer diffusivities [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + dz, & !< Height change across layers [Z ~> m] + maxTKE, & !< Energy required to entrain to h_max [H Z2 T-3 ~> m3 s-3 or W m-2] TKE_to_Kd !< Conversion rate (~1.0 / (G_Earth + dRho_lay)) between !< TKE dissipated within a layer and Kd in that layer - !< [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] + !< [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)+1) :: & N2_int, & !< squared buoyancy frequency associated at interfaces [T-2 ~> s-2] - Kd_int_2d, & !< The interface diffusivities [Z2 T-1 ~> m2 s-1] - Kv_bkgnd, & !< The background diffusion related interface viscosities [Z2 T-1 ~> m2 s-1] + Kd_int_2d, & !< The interface diffusivities [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + Kv_bkgnd, & !< The background diffusion related interface viscosities [H Z T-1 ~> m2 s-1 or Pa s] dRho_int, & !< Locally referenced potential density difference across interfaces [R ~> kg m-3] - KT_extra, & !< Double diffusion diffusivity of temperature [Z2 T-1 ~> m2 s-1] - KS_extra !< Double diffusion diffusivity of salinity [Z2 T-1 ~> m2 s-1] + KT_extra, & !< Double diffusion diffusivity of temperature [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + KS_extra !< Double diffusion diffusivity of salinity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: dissip ! local variable for dissipation calculations [Z2 R T-3 ~> W m-3] real :: Omega2 ! squared absolute rotation rate [T-2 ~> s-2] @@ -274,7 +282,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i integer :: i, j, k, is, ie, js, je, nz, isd, ied, jsd, jed - real :: kappa_dt_fill ! diffusivity times a timestep used to fill massless layers [Z2 ~> m2] + real :: kappa_dt_fill ! diffusivity times a timestep used to fill massless layers [H Z ~> m2 or kg m-1] is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -289,7 +297,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i if (CS%answer_date < 20190101) then ! These hard-coded dimensional parameters are being replaced. - kappa_dt_fill = US%m_to_Z**2 * 1.e-3 * 7200. + kappa_dt_fill = 1.e-3*GV%m2_s_to_HZ_T * 7200.*US%s_to_T else kappa_dt_fill = CS%Kd_smooth * dt endif @@ -340,14 +348,14 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i call cpu_clock_begin(id_clock_kappaShear) if (CS%Vertex_shear) then call full_convection(G, GV, US, h, tv, T_f, S_f, fluxes%p_surf, & - (GV%Z_to_H**2)*kappa_dt_fill, halo=1) + kappa_dt_fill, halo=1) call calc_kappa_shear_vertex(u, v, h, T_f, S_f, tv, fluxes%p_surf, visc%Kd_shear, & visc%TKE_turb, visc%Kv_shear_Bu, dt, G, GV, US, CS%kappaShear_CSp) if (associated(visc%Kv_shear)) visc%Kv_shear(:,:,:) = 0.0 ! needed for other parameterizations if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) - call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(visc%Kd_shear, "after calc_KS_vert visc%Kd_shear", G%HI, scale=GV%HZ_T_to_m2_s) + call Bchksum(visc%Kv_shear_Bu, "after calc_KS_vert visc%Kv_shear_Bu", G%HI, scale=GV%HZ_T_to_m2_s) call Bchksum(visc%TKE_turb, "after calc_KS_vert visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif else @@ -355,8 +363,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i call calculate_kappa_shear(u_h, v_h, h, tv, fluxes%p_surf, visc%Kd_shear, visc%TKE_turb, & visc%Kv_shear, dt, G, GV, US, CS%kappaShear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) - call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(visc%Kd_shear, "after calc_KS visc%Kd_shear", G%HI, scale=GV%HZ_T_to_m2_s) + call hchksum(visc%Kv_shear, "after calc_KS visc%Kv_shear", G%HI, scale=GV%HZ_T_to_m2_s) call hchksum(visc%TKE_turb, "after calc_KS visc%TKE_turb", G%HI, scale=US%Z_to_m**2*US%s_to_T**2) endif endif @@ -366,8 +374,8 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i !NOTE{BGR}: this needs to be cleaned up. It works in 1D case, but has not been tested outside. call calculate_CVMix_shear(u_h, v_h, h, tv, visc%Kd_shear, visc%Kv_shear, G, GV, US, CS%CVMix_shear_CSp) if (CS%debug) then - call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=US%Z2_T_to_m2_s) - call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=US%Z2_T_to_m2_s) + call hchksum(visc%Kd_shear, "after CVMix_shear visc%Kd_shear", G%HI, scale=GV%HZ_T_to_m2_s) + call hchksum(visc%Kv_shear, "after CVMix_shear visc%Kv_shear", G%HI, scale=GV%HZ_T_to_m2_s) endif elseif (associated(visc%Kv_shear)) then visc%Kv_shear(:,:,:) = 0.0 ! needed if calculate_kappa_shear is not enabled @@ -380,7 +388,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i call hchksum(tv%S, "before vert_fill_TS tv%S", G%HI, scale=US%S_to_ppt) call hchksum(h, "before vert_fill_TS h",G%HI, scale=GV%H_to_m) endif - call vert_fill_TS(h, tv%T, tv%S, kappa_dt_fill, T_f, S_f, G, GV, larger_h_denom=.true.) + call vert_fill_TS(h, tv%T, tv%S, kappa_dt_fill, T_f, S_f, G, GV, US, larger_h_denom=.true.) if (CS%debug) then call hchksum(tv%T, "after vert_fill_TS tv%T", G%HI, scale=US%C_to_degC) call hchksum(tv%S, "after vert_fill_TS tv%S", G%HI, scale=US%S_to_ppt) @@ -392,13 +400,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i ! be an appropriate place to add a depth-dependent parameterization or another explicit ! parameterization of Kd. - !$OMP parallel do default(shared) private(dRho_int,N2_lay,Kd_lay_2d,Kd_int_2d,Kv_bkgnd,N2_int,& - !$OMP N2_bot,KT_extra,KS_extra,TKE_to_Kd,maxTKE,dissip,kb)& + !$OMP parallel do default(shared) private(dRho_int,N2_lay,Kd_lay_2d,Kd_int_2d,Kv_bkgnd,N2_int,dz, & + !$OMP N2_bot,rho_bot,KT_extra,KS_extra,TKE_to_Kd,maxTKE,dissip,kb) & !$OMP if(.not. CS%use_CVMix_ddiff) do j=js,je ! Set up variables related to the stratification. - call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, N2_lay, N2_int, N2_bot) + call find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, N2_lay, N2_int, N2_bot, rho_bot) if (associated(dd%N2_3d)) then do K=1,nz+1 ; do i=is,ie ; dd%N2_3d(i,j,K) = N2_int(i,K) ; enddo ; enddo @@ -426,12 +434,12 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i if (KS_extra(i,K) > KT_extra(i,K)) then ! salt fingering Kd_lay_2d(i,k-1) = Kd_lay_2d(i,k-1) + 0.5 * KT_extra(i,K) Kd_lay_2d(i,k) = Kd_lay_2d(i,k) + 0.5 * KT_extra(i,K) - Kd_extra_S(i,j,K) = (KS_extra(i,K) - KT_extra(i,K)) + Kd_extra_S(i,j,K) = KS_extra(i,K) - KT_extra(i,K) Kd_extra_T(i,j,K) = 0.0 elseif (KT_extra(i,K) > 0.0) then ! double-diffusive convection Kd_lay_2d(i,k-1) = Kd_lay_2d(i,k-1) + 0.5 * KS_extra(i,K) Kd_lay_2d(i,k) = Kd_lay_2d(i,k) + 0.5 * KS_extra(i,K) - Kd_extra_T(i,j,K) = (KT_extra(i,K) - KS_extra(i,K)) + Kd_extra_T(i,j,K) = KT_extra(i,K) - KS_extra(i,K) Kd_extra_S(i,j,K) = 0.0 else ! There is no double diffusion at this interface. Kd_extra_T(i,j,K) = 0.0 @@ -492,17 +500,20 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i enddo ; enddo endif + if (CS%ML_radiation .or. CS%use_tidal_mixing .or. associated(dd%Kd_work)) then + call thickness_to_dz(h, tv, dz, j, G, GV) + endif + ! Add the ML_Rad diffusivity. if (CS%ML_radiation) & call add_MLrad_diffusivity(h, fluxes, j, Kd_int_2d, G, GV, US, CS, TKE_to_Kd, Kd_lay_2d) ! Add the Nikurashin and / or tidal bottom-driven mixing if (CS%use_tidal_mixing) & - call calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, & + call calculate_tidal_mixing(dz, j, N2_bot, rho_bot, N2_lay, N2_int, TKE_to_Kd, & maxTKE, G, GV, US, CS%tidal_mixing, & CS%Kd_max, visc%Kv_slow, Kd_lay_2d, Kd_int_2d) - ! This adds the diffusion sustained by the energy extracted from the flow by the bottom drag. if (CS%bottomdraglaw .and. (CS%BBL_effic > 0.0)) then if (CS%use_LOTW_BBL_diffusivity) then @@ -525,7 +536,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_int(i,K)), & ! Floor aka Gargett CS%dissip_N2 * N2_int(i,K)) ! Floor of Kd_min*rho0/F_Ri Kd_int_2d(i,K) = max(Kd_int_2d(i,K) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_int(i,K) + Omega2)))) + dissip * (CS%FluxRi_max / (GV%H_to_RZ * (N2_int(i,K) + Omega2)))) enddo ; enddo endif @@ -550,14 +561,13 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i CS%dissip_N0 + CS%dissip_N1 * sqrt(N2_lay(i,k)), & ! Floor aka Gargett CS%dissip_N2 * N2_lay(i,k)) ! Floor of Kd_min*rho0/F_Ri Kd_lay_2d(i,k) = max(Kd_lay_2d(i,k) , & ! Apply floor to Kd - dissip * (CS%FluxRi_max / (GV%Rho0 * (N2_lay(i,k) + Omega2)))) + dissip * (CS%FluxRi_max / (GV%H_to_RZ * (N2_lay(i,k) + Omega2)))) enddo ; enddo endif if (associated(dd%Kd_work)) then do k=1,nz ; do i=is,ie - dd%Kd_Work(i,j,k) = GV%Rho0 * Kd_lay_2d(i,k) * N2_lay(i,k) * & - GV%H_to_Z*h(i,j,k) ! Watt m-2 s = kg s-3 + dd%Kd_Work(i,j,k) = GV%H_to_RZ * Kd_lay_2d(i,k) * N2_lay(i,k) * GV%H_to_Z*h(i,j,k) ! Watt m-2 s = kg s-3 enddo ; enddo endif @@ -580,18 +590,18 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i endif if (CS%debug) then - if (present(Kd_lay)) call hchksum(Kd_lay, "Kd_lay", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + if (present(Kd_lay)) call hchksum(Kd_lay, "Kd_lay", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) - if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + if (CS%useKappaShear) call hchksum(visc%Kd_shear, "Turbulent Kd", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) if (CS%use_CVMix_ddiff) then - call hchksum(Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) - call hchksum(Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=US%Z2_T_to_m2_s) + call hchksum(Kd_extra_T, "MOM_set_diffusivity: Kd_extra_T", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) + call hchksum(Kd_extra_S, "MOM_set_diffusivity: Kd_extra_S", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif if (allocated(visc%kv_bbl_u) .and. allocated(visc%kv_bbl_v)) then call uvchksum("BBL Kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, & - haloshift=0, symmetric=.true., scale=US%Z2_T_to_m2_s, & + haloshift=0, symmetric=.true., scale=GV%HZ_T_to_m2_s, & scalar_pair=.true.) endif @@ -602,7 +612,7 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, Kd_i endif if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) then - call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=US%Z_to_m*US%s_to_T) + call uvchksum("Ray_[uv]", visc%Ray_u, visc%Ray_v, G%HI, 0, symmetric=.true., scale=GV%H_to_m*US%s_to_T) endif endif @@ -673,9 +683,9 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & !! TKE dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(GV)), intent(out) :: maxTKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] + !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: maxTKE !< The energy required to for a layer to entrain to its + !! maximum realizable thickness [H Z2 T-3 ~> m3 s-3 or W m-2] integer, dimension(SZI_(G)), intent(out) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer. ! Local variables @@ -735,7 +745,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & else; TKE_to_Kd(i,k) = 0.; endif ! The maximum TKE conversion we allow is really a statement ! about the upper diffusivity we allow. Kd_max must be set. - maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of Z3 T-3. + maxTKE(i,k) = hN2pO2 * CS%Kd_max ! Units of H Z2 T-3. enddo ; enddo kb(is:ie) = -1 ! kb should not be used by any code in non-layered mode -AJA return @@ -854,7 +864,7 @@ subroutine find_TKE_to_Kd(h, tv, dRho_int, N2_lay, j, dt, G, GV, US, CS, & dRho_lay = 0.5 * max(dRho_int(i,K) + dRho_int(i,K+1), 0.0) maxTKE(i,k) = I_dt * (G_IRho0 * & (0.5*max(dRho_int(i,K+1) + dsp1_ds(i,k)*dRho_int(i,K), 0.0))) * & - ((GV%H_to_Z*h(i,j,k) + dh_max) * maxEnt(i,k)) + ((h(i,j,k) + GV%Z_to_H*dh_max) * maxEnt(i,k)) ! TKE_to_Kd should be rho_InSitu / G_Earth * (delta rho_InSitu) ! The omega^2 term in TKE_to_Kd is due to a rescaling of the efficiency of turbulent ! mixing by a factor of N^2 / (N^2 + Omega^2), as proposed by Melet et al., 2013? @@ -867,7 +877,7 @@ end subroutine find_TKE_to_Kd !> Calculate Brunt-Vaisala frequency, N^2. subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & - N2_lay, N2_int, N2_bot) + N2_lay, N2_int, N2_bot, Rho_bot) 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 @@ -892,24 +902,28 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & real, dimension(SZI_(G),SZK_(GV)), & intent(out) :: N2_lay !< The squared buoyancy frequency of the layers [T-2 ~> s-2]. real, dimension(SZI_(G)), intent(out) :: N2_bot !< The near-bottom squared buoyancy frequency [T-2 ~> s-2]. + real, dimension(SZI_(G)), intent(out) :: Rho_bot !< Near-bottom density [R ~> kg m-3]. + ! Local variables real, dimension(SZI_(G),SZK_(GV)+1) :: & + pres, & ! pressure at each interface [R L2 T-2 ~> Pa] dRho_int_unfilt, & ! unfiltered density differences across interfaces [R ~> kg m-3] dRho_dT, & ! partial derivative of density wrt temp [R C-1 ~> kg m-3 degC-1] dRho_dS ! partial derivative of density wrt saln [R S-1 ~> kg m-3 ppt-1] - + real, dimension(SZI_(G),SZK_(GV)) :: & + dz ! Height change across layers [Z ~> m] real, dimension(SZI_(G)) :: & - pres, & ! pressure at each interface [R L2 T-2 ~> Pa] Temp_int, & ! temperature at each interface [C ~> degC] Salin_int, & ! salinity at each interface [S ~> ppt] drho_bot, & ! A density difference [R ~> kg m-3] h_amp, & ! The topographic roughness amplitude [Z ~> m]. - hb, & ! The thickness of the bottom layer [Z ~> m]. - z_from_bot ! The hieght above the bottom [Z ~> m]. + dz_BBL_avg, & ! The distance over which to average to find the near-bottom density [Z ~> m] + hb, & ! The thickness of the bottom layer [H ~> m or kg m-2] + z_from_bot ! The height above the bottom [Z ~> m] - real :: dz_int ! thickness associated with an interface [Z ~> m]. - real :: G_Rho0 ! Gravitational acceleration divided by Boussinesq reference density - ! times some unit conversion factors [Z T-2 R-1 ~> m4 s-2 kg-1]. + real :: dz_int ! Vertical distance associated with an interface [Z ~> m] + real :: G_Rho0 ! Gravitational acceleration, perhaps divided by Boussinesq reference density, + ! times some unit conversion factors [H T-2 R-1 ~> m4 s-2 kg-1 or m s-2]. real :: H_neglect ! A negligibly small thickness [H ~> m or kg m-2] logical :: do_i(SZI_(G)), do_any @@ -917,7 +931,7 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & integer :: i, k, is, ie, nz is = G%isc ; ie = G%iec ; nz = GV%ke - G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 + G_Rho0 = (US%L_to_Z**2 * GV%g_Earth) / GV%H_to_RZ H_neglect = GV%H_subroundoff ! Find the (limited) density jump across each interface. @@ -927,24 +941,24 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & enddo if (associated(tv%eqn_of_state)) then if (associated(fluxes%p_surf)) then - do i=is,ie ; pres(i) = fluxes%p_surf(i,j) ; enddo + do i=is,ie ; pres(i,1) = fluxes%p_surf(i,j) ; enddo else - do i=is,ie ; pres(i) = 0.0 ; enddo + do i=is,ie ; pres(i,1) = 0.0 ; enddo endif EOSdom(:) = EOS_domain(G%HI) do K=2,nz do i=is,ie - pres(i) = pres(i) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1) + pres(i,K) = pres(i,K-1) + (GV%g_Earth*GV%H_to_RZ)*h(i,j,k-1) Temp_Int(i) = 0.5 * (T_f(i,j,k) + T_f(i,j,k-1)) Salin_Int(i) = 0.5 * (S_f(i,j,k) + S_f(i,j,k-1)) enddo - call calculate_density_derivs(Temp_int, Salin_int, pres, dRho_dT(:,K), dRho_dS(:,K), & + call calculate_density_derivs(Temp_int, Salin_int, pres(:,K), dRho_dT(:,K), dRho_dS(:,K), & tv%eqn_of_state, EOSdom) do i=is,ie dRho_int(i,K) = max(dRho_dT(i,K)*(T_f(i,j,k) - T_f(i,j,k-1)) + & dRho_dS(i,K)*(S_f(i,j,k) - S_f(i,j,k-1)), 0.0) dRho_int_unfilt(i,K) = max(dRho_dT(i,K)*(tv%T(i,j,k) - tv%T(i,j,k-1)) + & - dRho_dS(i,K)*(tv%S(i,j,k) - tv%S(i,j,k-1)), 0.0) + dRho_dS(i,K)*(tv%S(i,j,k) - tv%S(i,j,k-1)), 0.0) enddo enddo else @@ -953,21 +967,24 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & enddo ; enddo endif + ! Find the vertical distances across layers. + call thickness_to_dz(h, tv, dz, j, G, GV) + ! Set the buoyancy frequencies. do k=1,nz ; do i=is,ie N2_lay(i,k) = G_Rho0 * 0.5*(dRho_int(i,K) + dRho_int(i,K+1)) / & - (GV%H_to_Z*(h(i,j,k) + H_neglect)) + (h(i,j,k) + H_neglect) enddo ; enddo do i=is,ie ; N2_int(i,1) = 0.0 ; N2_int(i,nz+1) = 0.0 ; enddo do K=2,nz ; do i=is,ie N2_int(i,K) = G_Rho0 * dRho_int(i,K) / & - (0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k) + H_neglect)) + (0.5*(h(i,j,k-1) + h(i,j,k) + H_neglect)) enddo ; enddo ! Find the bottom boundary layer stratification, and use this in the deepest layers. do i=is,ie hb(i) = 0.0 ; dRho_bot(i) = 0.0 ; h_amp(i) = 0.0 - z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) + z_from_bot(i) = 0.5*dz(i,nz) do_i(i) = (G%mask2dT(i,j) > 0.0) enddo if (CS%use_tidal_mixing) call tidal_mixing_h_amp(h_amp, G, j, CS%tidal_mixing) @@ -975,16 +992,16 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*(dz(i,k) + dz(i,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above - hb(i) = hb(i) + dz_int + hb(i) = hb(i) + 0.5*(h(i,j,k) + h(i,j,k-1)) drho_bot(i) = drho_bot(i) + dRho_int(i,K) if (z_from_bot(i) > h_amp(i)) then if (k>2) then ! Always include at least one full layer. - hb(i) = hb(i) + 0.5*GV%H_to_Z*(h(i,j,k-1) + h(i,j,k-2)) + hb(i) = hb(i) + 0.5*(h(i,j,k-1) + h(i,j,k-2)) drho_bot(i) = drho_bot(i) + dRho_int(i,K-1) endif do_i(i) = .false. @@ -999,14 +1016,14 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & if (hb(i) > 0.0) then N2_bot(i) = (G_Rho0 * drho_bot(i)) / hb(i) else ; N2_bot(i) = 0.0 ; endif - z_from_bot(i) = 0.5*GV%H_to_Z*h(i,j,nz) + z_from_bot(i) = 0.5*dz(i,nz) do_i(i) = (G%mask2dT(i,j) > 0.0) enddo do k=nz,2,-1 do_any = .false. do i=is,ie ; if (do_i(i)) then - dz_int = 0.5*GV%H_to_Z*(h(i,j,k) + h(i,j,k-1)) + dz_int = 0.5*(dz(i,k) + dz(i,k-1)) z_from_bot(i) = z_from_bot(i) + dz_int ! middle of the layer above N2_int(i,K) = N2_bot(i) @@ -1028,6 +1045,10 @@ subroutine find_N2(h, tv, T_f, S_f, fluxes, j, G, GV, US, CS, dRho_int, & enddo ; enddo endif + ! Average over the larger of the envelope of the topography or a minimal distance. + do i=is,ie ; dz_BBL_avg(i) = max(h_amp(i), CS%dz_BBL_avg_min) ; enddo + call find_rho_bottom(h, dz, pres, dz_BBL_avg, tv, j, G, GV, US, Rho_bot) + end subroutine find_N2 !> This subroutine sets the additional diffusivities of temperature and @@ -1055,10 +1076,10 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) type(set_diffusivity_CS), pointer :: CS !< Module control structure. real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: Kd_T_dd !< Interface double diffusion diapycnal - !! diffusivity for temp [Z2 T-1 ~> m2 s-1]. + !! diffusivity for temp [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZK_(GV)+1), & intent(out) :: Kd_S_dd !< Interface double diffusion diapycnal - !! diffusivity for saln [Z2 T-1 ~> m2 s-1]. + !! diffusivity for saln [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G)) :: & dRho_dT, & ! partial derivatives of density with respect to temperature [R C-1 ~> kg m-3 degC-1] @@ -1072,7 +1093,7 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) real :: Rrho ! vertical density ratio [nondim] real :: diff_dd ! factor for double-diffusion [nondim] - real :: Kd_dd ! The dominant double diffusive diffusivity [Z2 T-1 ~> m2 s-1] + real :: Kd_dd ! The dominant double diffusive diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: prandtl ! flux ratio for diffusive convection regime [nondim] real, parameter :: Rrho0 = 1.9 ! limit for double-diffusive density ratio [nondim] @@ -1124,8 +1145,8 @@ subroutine double_diffusion(tv, h, T_f, S_f, j, G, GV, US, CS, Kd_T_dd, Kd_S_dd) end subroutine double_diffusion !> This routine adds diffusion sustained by flow energy extracted by bottom drag. -subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & - maxTKE, kb, G, GV, US, CS, Kd_lay, Kd_int, Kd_BBL) +subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, maxTKE, & + kb, G, GV, US, CS, Kd_lay, Kd_int, Kd_BBL) 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 @@ -1142,20 +1163,21 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & !! boundary layer properties and related fields integer, intent(in) :: j !< j-index of row to work on real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE - !! TKE dissipated within a layer and the + !! TKE dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(GV)), intent(in) :: maxTKE !< The energy required to for a layer to entrain - !! to its maximum-realizable thickness [Z3 T-3 ~> m3 s-3] + !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: maxTKE !< The energy required to for a layer to entrain to its + !! maximum-realizable thickness [H Z2 T-3 ~> m3 s-3 or W m-2] integer, dimension(SZI_(G)), intent(in) :: kb !< Index of lightest layer denser than the buffer !! layer, or -1 without a bulk mixed layer type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers, - !! [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, - !! [Z2 T-1 ~> m2 s-1]. - real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] ! This routine adds diffusion sustained by flow energy extracted by bottom drag. @@ -1169,19 +1191,18 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! the local ustar, times R0_g [R Z ~> kg m-2] Rho_top, & ! density at top of the BBL [R ~> kg m-3] TKE, & ! turbulent kinetic energy available to drive - ! bottom-boundary layer mixing in a layer [Z3 T-3 ~> m3 s-3] + ! bottom-boundary layer mixing in a layer [H Z2 T-3 ~> m3 s-3 or W m-2] I2decay ! inverse of twice the TKE decay scale [Z-1 ~> m-1]. - real :: TKE_to_layer ! TKE used to drive mixing in a layer [Z3 T-3 ~> m3 s-3] - real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [Z3 T-3 ~> m3 s-3] - real :: TKE_here ! TKE that goes into mixing in this layer [Z3 T-3 ~> m3 s-3] + real :: TKE_to_layer ! TKE used to drive mixing in a layer [H Z2 T-3 ~> m3 s-3 or W m-2] + real :: TKE_Ray ! TKE from layer Rayleigh drag used to drive mixing in layer [H Z2 T-3 ~> m3 s-3 or W m-2] + real :: TKE_here ! TKE that goes into mixing in this layer [H Z2 T-3 ~> m3 s-3 or W m-2] real :: dRl, dRbot ! temporaries holding density differences [R ~> kg m-3] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: ustar_h ! value of ustar at a thickness point [Z T-1 ~> m s-1]. real :: absf ! average absolute Coriolis parameter around a thickness point [T-1 ~> s-1] real :: R0_g ! Rho0 / G_Earth [R T2 Z-1 ~> kg s2 m-4] - real :: I_rho0 ! 1 / RHO0 [R-1 ~> m3 kg-1] - real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [Z2 T-1 ~> m2 s-1]. + real :: delta_Kd ! increment to Kd from the bottom boundary layer mixing [H Z T-1 ~> m2 s-1 or kg m-1 s-1] logical :: Rayleigh_drag ! Set to true if Rayleigh drag velocities ! defined in visc, on the assumption that this ! extracted energy also drives diapycnal mixing. @@ -1200,7 +1221,6 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & TKE_Ray = 0.0 ; Rayleigh_drag = .false. if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) Rayleigh_drag = .true. - I_Rho0 = 1.0 / (GV%Rho0) R0_g = GV%Rho0 / (US%L_to_Z**2 * GV%g_Earth) do K=2,nz ; Rint(K) = 0.5*(GV%Rlay(k-1)+GV%Rlay(k)) ; enddo @@ -1211,7 +1231,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & ! Any turbulence that makes it into the mixed layers is assumed ! to be relatively small and is discarded. do i=is,ie - ustar_h = visc%ustar_BBL(i,j) + ustar_h = GV%H_to_Z*visc%ustar_BBL(i,j) if (associated(fluxes%ustar_tidal)) & ustar_h = ustar_h + fluxes%ustar_tidal(i,j) absf = 0.25 * ((abs(G%CoriolisBu(I-1,J-1)) + abs(G%CoriolisBu(I,J))) + & @@ -1227,7 +1247,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & visc%TKE_BBL(i,j) if (associated(fluxes%TKE_tidal)) & - TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * I_Rho0 * & + TKE(i) = TKE(i) + fluxes%TKE_tidal(i,j) * GV%RZ_to_H * & (CS%BBL_effic * exp(-I2decay(i)*(GV%H_to_Z*h(i,j,nz)))) ! Distribute the work over a BBL of depth 20^2 ustar^2 / g' following @@ -1303,7 +1323,7 @@ subroutine add_drag_diffusivity(h, u, v, tv, fluxes, visc, j, TKE_to_Kd, & delta_Kd = CS%Kd_max Kd_lay(i,k) = Kd_lay(i,k) + delta_Kd else - Kd_lay(i,k) = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) + Kd_lay(i,k) = (TKE_to_layer + TKE_Ray) * TKE_to_Kd(i,k) endif Kd_int(i,K) = Kd_int(i,K) + 0.5 * delta_Kd Kd_int(i,K+1) = Kd_int(i,K+1) + 0.5 * delta_Kd @@ -1377,17 +1397,17 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int real, dimension(SZI_(G),SZK_(GV)+1), & intent(in) :: N2_int !< Square of Brunt-Vaisala at interfaces [T-2 ~> s-2] real, dimension(SZI_(G),SZK_(GV)+1), & - intent(inout) :: Kd_int !< Interface net diffusivity [Z2 T-1 ~> m2 s-1] + intent(inout) :: Kd_int !< Interface net diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure - real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [Z2 T-1 ~> m2 s-1] + real, dimension(:,:,:), pointer :: Kd_BBL !< Interface BBL diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZK_(GV)), & - optional, intent(inout) :: Kd_lay !< Layer net diffusivity [Z2 T-1 ~> m2 s-1] + optional, intent(inout) :: Kd_lay !< Layer net diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] ! Local variables - real :: TKE_column ! net TKE input into the column [Z3 T-3 ~> m3 s-3] - real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [Z3 T-3 ~> m3 s-3] - real :: TKE_consumed ! TKE used for mixing in this layer [Z3 T-3 ~> m3 s-3] - real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [Z3 T-3 ~> m3 s-3] + real :: TKE_column ! net TKE input into the column [H Z2 T-3 ~> m3 s-3 or W m-2] + real :: TKE_remaining ! remaining TKE available for mixing in this layer and above [H Z2 T-3 ~> m3 s-3 or W m-2] + real :: TKE_consumed ! TKE used for mixing in this layer [H Z2 T-3 ~> m3 s-3 or W m-2] + real :: TKE_Kd_wall ! TKE associated with unlimited law of the wall mixing [H Z2 T-3 ~> m3 s-3 or W m-2] real :: cdrag_sqrt ! square root of the drag coefficient [nondim] real :: ustar ! value of ustar at a thickness point [Z T-1 ~> m s-1]. real :: ustar2 ! square of ustar, for convenience [Z2 T-2 ~> m2 s-2] @@ -1397,10 +1417,9 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int real :: D_minus_z ! distance to interface k from surface [Z ~> m]. real :: total_thickness ! total thickness of water column [Z ~> m]. real :: Idecay ! inverse of decay scale used for "Joule heating" loss of TKE with height [Z-1 ~> m-1]. - real :: Kd_wall ! Law of the wall diffusivity [Z2 T-1 ~> m2 s-1]. - real :: Kd_lower ! diffusivity for lower interface [Z2 T-1 ~> m2 s-1] + real :: Kd_wall ! Law of the wall diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real :: Kd_lower ! diffusivity for lower interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: ustar_D ! u* x D [Z2 T-1 ~> m2 s-1]. - real :: I_Rho0 ! 1 / rho0 [R-1 ~> m3 kg-1] real :: N2_min ! Minimum value of N2 to use in calculation of TKE_Kd_wall [T-2 ~> s-2] logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on ! the assumption that this extracted energy also drives diapycnal mixing. @@ -1416,7 +1435,6 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int ! Determine whether to add Rayleigh drag contribution to TKE Rayleigh_drag = .false. if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) Rayleigh_drag = .true. - I_Rho0 = 1.0 / (GV%Rho0) cdrag_sqrt = sqrt(CS%cdrag) do i=G%isc,G%iec ! Developed in single-column mode @@ -1426,7 +1444,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int (abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J-1)))) ! Non-zero on equator! ! u* at the bottom [Z T-1 ~> m s-1]. - ustar = visc%ustar_BBL(i,j) + ustar = GV%H_to_Z*visc%ustar_BBL(i,j) ustar2 = ustar**2 ! In add_drag_diffusivity(), fluxes%ustar_tidal is added in. This might be double counting ! since ustar_BBL should already include all contributions to u*? -AJA @@ -1438,14 +1456,14 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int Idecay = CS%IMax_decay if ((ustar > 0.0) .and. (absf > CS%IMax_decay * ustar)) Idecay = absf / ustar - ! Energy input at the bottom [Z3 T-3 ~> m3 s-3]. - ! (Note that visc%TKE_BBL is in [Z3 T-3 ~> m3 s-3], set in set_BBL_TKE().) + ! Energy input at the bottom [H Z2 T-3 ~> m3 s-3 or W m-2]. + ! (Note that visc%TKE_BBL is in [H Z2 T-3 ~> m3 s-3 or W m-2], set in set_BBL_TKE().) ! I am still unsure about sqrt(cdrag) in this expressions - AJA TKE_column = cdrag_sqrt * visc%TKE_BBL(i,j) - ! Add in tidal dissipation energy at the bottom [Z3 T-3 ~> m3 s-3]. + ! Add in tidal dissipation energy at the bottom [H Z2 T-3 ~> m3 s-3 or W m-2]. ! Note that TKE_tidal is in [R Z3 T-3 ~> W m-2]. if (associated(fluxes%TKE_tidal)) & - TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * I_Rho0 + TKE_column = TKE_column + fluxes%TKE_tidal(i,j) * GV%RZ_to_H TKE_column = CS%BBL_effic * TKE_column ! Only use a fraction of the mechanical dissipation for mixing. TKE_remaining = TKE_column @@ -1481,11 +1499,11 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then Kd_wall = 0. else - Kd_wall = ((CS%von_karm * ustar2) * (z_bot * D_minus_z)) & + Kd_wall = ((GV%Z_to_H*CS%von_karm * ustar2) * (z_bot * D_minus_z)) & / (ustar_D + absf * (z_bot * D_minus_z)) endif - ! TKE associated with Kd_wall [Z3 T-3 ~> m3 s-3]. + ! TKE associated with Kd_wall [H Z2 T-3 ~> m3 s-3 or W m-2]. ! This calculation if for the volume spanning the interface. TKE_Kd_wall = Kd_wall * 0.5 * (dh + dhm1) * max(N2_int(i,k), N2_min) @@ -1526,27 +1544,30 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, type(forcing), intent(in) :: fluxes !< Surface fluxes structure integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(GV)+1), intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces - !! [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] type(set_diffusivity_CS), pointer :: CS !< Diffusivity control structure real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! TKE dissipated within a layer and the !! diapycnal diffusivity witin that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] + !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] real, dimension(SZI_(G),SZK_(GV)), & - optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. + optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. ! This routine adds effects of mixed layer radiation to the layer diffusivities. real, dimension(SZI_(G)) :: h_ml ! Mixed layer thickness [Z ~> m]. - real, dimension(SZI_(G)) :: TKE_ml_flux ! Mixed layer TKE flux [Z3 T-3 ~> m3 s-3] + real, dimension(SZI_(G)) :: TKE_ml_flux ! Mixed layer TKE flux [H Z2 T-3 ~> m3 s-3 or W m-2] real, dimension(SZI_(G)) :: I_decay ! A decay rate [Z-1 ~> m-1]. - real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G)) :: Kd_mlr_ml ! Diffusivities associated with mixed layer radiation + ! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: f_sq ! The square of the local Coriolis parameter or a related variable [T-2 ~> s-2]. real :: h_ml_sq ! The square of the mixed layer thickness [Z2 ~> m2]. real :: ustar_sq ! ustar squared [Z2 T-2 ~> m2 s-2] - real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation [Z2 T-1 ~> m2 s-1]. + real :: Kd_mlr ! A diffusivity associated with mixed layer turbulence radiation + ! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: C1_6 ! 1/6 [nondim] real :: Omega2 ! rotation rate squared [T-2 ~> s-2]. real :: z1 ! layer thickness times I_decay [nondim] @@ -1581,7 +1602,7 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, ustar_sq = max(fluxes%ustar(i,j), CS%ustar_min)**2 - TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (fluxes%ustar(i,j))) + TKE_ml_flux(i) = (CS%mstar * CS%ML_rad_coeff) * (ustar_sq * (GV%Z_to_H*fluxes%ustar(i,j))) I_decay_len2_TKE = CS%TKE_decay**2 * (f_sq / ustar_sq) if (CS%ML_rad_TKE_decay) & @@ -1624,10 +1645,10 @@ subroutine add_MLrad_diffusivity(h, fluxes, j, Kd_int, G, GV, US, CS, TKE_to_Kd, ! This is supposed to be the integrated energy deposited in the layer, ! not the average over the layer as in these expressions. if (z1 > 1e-5) then - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of H Z T-1 US%m_to_Z * ((1.0 - exp(-z1)) / dzL) ! Units of m-1 else - Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of Z2 T-1 + Kd_mlr = (TKE_ml_flux(i) * TKE_to_Kd(i,k)) * & ! Units of H Z T-1 US%m_to_Z * (I_decay(i) * (1.0 - z1 * (0.5 - C1_6*z1))) ! Units of m-1 endif else @@ -1740,7 +1761,7 @@ subroutine set_BBL_TKE(u, v, h, tv, fluxes, visc, G, GV, US, CS, OBC) if (allocated(visc%Kv_bbl_v)) then do i=is,ie ; if ((G%mask2dCv(i,J) > 0.0) .and. (cdrag_sqrt*visc%bbl_thick_v(i,J) > 0.0)) then do_i(i) = .true. - vstar(i,J) = visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) + vstar(i,J) = GV%H_to_Z*visc%Kv_bbl_v(i,J) / (cdrag_sqrt*visc%bbl_thick_v(i,J)) endif ; enddo endif !### What about terms from visc%Ray? @@ -1794,7 +1815,7 @@ subroutine set_BBL_TKE(u, v, h, tv, fluxes, visc, G, GV, US, CS, OBC) if (allocated(visc%bbl_thick_u)) then do I=is-1,ie ; if ((G%mask2dCu(I,j) > 0.0) .and. (cdrag_sqrt*visc%bbl_thick_u(I,j) > 0.0)) then do_i(I) = .true. - ustar(I) = visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) + ustar(I) = GV%H_to_Z*visc%Kv_bbl_u(I,j) / (cdrag_sqrt*visc%bbl_thick_u(I,j)) endif ; enddo endif @@ -1839,12 +1860,12 @@ subroutine set_BBL_TKE(u, v, h, tv, fluxes, visc, G, GV, US, CS, OBC) endif ; enddo do i=is,ie - visc%ustar_BBL(i,j) = sqrt(0.5*G%IareaT(i,j) * & + visc%ustar_BBL(i,j) = GV%Z_to_H*sqrt(0.5*G%IareaT(i,j) * & ((G%areaCu(I-1,j)*(ustar(I-1)*ustar(I-1)) + & G%areaCu(I,j)*(ustar(I)*ustar(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*vstar(i,J-1)) + & G%areaCv(i,J)*(vstar(i,J)*vstar(i,J))) ) ) - visc%TKE_BBL(i,j) = US%L_to_Z**2 * & + visc%TKE_BBL(i,j) = GV%Z_to_H*US%L_to_Z**2 * & (((G%areaCu(I-1,j)*(ustar(I-1)*u2_bbl(I-1)) + & G%areaCu(I,j) * (ustar(I)*u2_bbl(I))) + & (G%areaCv(i,J-1)*(vstar(i,J-1)*v2_bbl(i,J-1)) + & @@ -1995,6 +2016,8 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ # include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. real :: vonKar ! The von Karman constant as used for mixed layer viscosity [nondim] + real :: Kd_z ! The background diapycnal diffusivity in [Z2 T-1 ~> m2 s-1] for use + ! in setting the default for other diffusivities. real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate ! that is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] @@ -2044,20 +2067,23 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "SET_DIFF_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "SET_DIFF_ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic and expressions in the set diffusivity "//& "calculations. Values below 20190101 recover the answers from the end of 2018, "//& "while higher values use updated and more robust forms of the same expressions. "//& "If both SET_DIFF_2018_ANSWERS and SET_DIFF_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) ! CS%use_tidal_mixing is set to True if an internal tidal dissipation scheme is to be used. CS%use_tidal_mixing = tidal_mixing_init(Time, G, GV, US, param_file, & @@ -2085,7 +2111,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ "The maximum diapycnal diffusivity due to turbulence "//& "radiated from the base of the mixed layer. "//& "This is only used if ML_RADIATION is true.", & - units="m2 s-1", default=1.0e-3, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=1.0e-3, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & "The coefficient which scales MSTAR*USTAR^3 to obtain "//& "the energy available for mixing below the base of the "//& @@ -2163,7 +2189,11 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL endif CS%id_Kd_BBL = register_diag_field('ocean_model', 'Kd_BBL', diag%axesTi, Time, & - 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Bottom Boundary Layer Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) + + call get_param(param_file, mdl, "DZ_BBL_AVG_MIN", CS%dz_BBL_avg_min, & + "A minimal distance over which to average to determine the average bottom "//& + "boundary layer density.", units="m", default=0.0, scale=US%m_to_Z) TKE_to_Kd_used = (CS%use_tidal_mixing .or. CS%ML_radiation .or. & (CS%bottomdraglaw .and. .not.CS%use_LOTW_BBL_diffusivity)) @@ -2180,19 +2210,20 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", scale=US%m2_s_to_Z2_T, fail_if_missing=.true.) + units="m2 s-1", scale=GV%m2_s_to_HZ_T, fail_if_missing=.true.) - call get_param(param_file, mdl, "KD", CS%Kd, & + call get_param(param_file, mdl, "KD", Kd_z, & "The background diapycnal diffusivity of density in the "//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, "//& "may be used.", default=0.0, units="m2 s-1", scale=US%m2_s_to_Z2_T) + CS%Kd = (GV%m2_s_to_HZ_T*US%Z2_T_to_m2_s) * Kd_z call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & - units="m2 s-1", default=0.01*CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=0.01*Kd_z*US%Z2_T_to_m2_s, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal "//& "diffusivity from TKE-based parameterizations, or a negative "//& - "value for no limit.", units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T) + "value for no limit.", units="m2 s-1", default=-1.0, scale=GV%m2_s_to_HZ_T) if (CS%simple_TKE_to_Kd) then if (CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") @@ -2205,14 +2236,14 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added "//& "everywhere without any filtering or scaling.", & - units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=0.0, scale=GV%m2_s_to_HZ_T) if (CS%use_LOTW_BBL_diffusivity .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: KD_MAX must be set (positive) when "// & "USE_LOTW_BBL_DIFFUSIVITY=True.") call get_param(param_file, mdl, "KD_SMOOTH", CS%Kd_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & - units="m2 s-1", default=1.0e-6, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & @@ -2237,29 +2268,29 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ units="J m-3", default=0.0, scale=US%W_m2_to_RZ3_T3*US%Z_to_m*US%s_to_T) call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & - units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=0.0, scale=GV%m2_s_to_HZ_T) CS%limit_dissipation = (CS%dissip_min>0.) .or. (CS%dissip_N1>0.) .or. & (CS%dissip_N0>0.) .or. (CS%dissip_Kd_min>0.) CS%dissip_N2 = 0.0 if (CS%FluxRi_max > 0.0) & - CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max + CS%dissip_N2 = CS%dissip_Kd_min * GV%H_to_RZ / CS%FluxRi_max CS%id_Kd_bkgnd = register_diag_field('ocean_model', 'Kd_bkgnd', diag%axesTi, Time, & - 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s) + 'Background diffusivity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%HZ_T_to_m2_s) CS%id_Kv_bkgnd = register_diag_field('ocean_model', 'Kv_bkgnd', diag%axesTi, Time, & - 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=US%Z2_T_to_m2_s) + 'Background viscosity added by MOM_bkgnd_mixing module', 'm2/s', conversion=GV%HZ_T_to_m2_s) CS%id_Kd_layer = register_diag_field('ocean_model', 'Kd_layer', diag%axesTL, Time, & - 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Diapycnal diffusivity of layers (as set)', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) if (CS%use_tidal_mixing) then CS%id_Kd_Work = register_diag_field('ocean_model', 'Kd_Work', diag%axesTL, Time, & 'Work done by Diapycnal Mixing', 'W m-2', conversion=US%RZ3_T3_to_W_m2) CS%id_maxTKE = register_diag_field('ocean_model', 'maxTKE', diag%axesTL, Time, & - 'Maximum layer TKE', 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3)) + 'Maximum layer TKE', 'm3 s-3', conversion=(GV%H_to_m*US%Z_to_m**2*US%s_to_T**3)) CS%id_TKE_to_Kd = register_diag_field('ocean_model', 'TKE_to_Kd', diag%axesTL, Time, & - 'Convert TKE to Kd', 's2 m', conversion=US%Z2_T_to_m2_s*(US%m_to_Z**3*US%T_to_s**3)) + 'Convert TKE to Kd', 's2 m', conversion=GV%HZ_T_to_m2_s*(GV%m_to_H*US%m_to_Z**2*US%T_to_s**3)) CS%id_N2 = register_diag_field('ocean_model', 'N2', diag%axesTi, Time, & 'Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2, cmor_field_name='obvfsq', & cmor_long_name='Square of seawater buoyancy frequency', & @@ -2268,7 +2299,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ if (CS%user_change_diff) & CS%id_Kd_user = register_diag_field('ocean_model', 'Kd_user', diag%axesTi, Time, & - 'User-specified Extra Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'User-specified Extra Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & "If true, increase diffusivites for temperature or salinity based on the "//& @@ -2281,10 +2312,10 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ default=2.55, units="nondim") call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & "Maximum salt diffusivity for salt fingering regime.", & - default=1.e-4, units="m2 s-1", scale=US%m2_s_to_Z2_T) + default=1.e-4, units="m2 s-1", scale=GV%m2_s_to_HZ_T) call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & "Molecular viscosity for calculation of fluxes under double-diffusive "//& - "convection.", default=1.5e-6, units="m2 s-1", scale=US%m2_s_to_Z2_T) + "convection.", default=1.5e-6, units="m2 s-1", scale=GV%m2_s_to_HZ_T) ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. endif ! old double-diffusion @@ -2322,9 +2353,9 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ if (CS%double_diffusion .or. CS%use_CVMix_ddiff) then CS%id_KT_extra = register_diag_field('ocean_model', 'KT_extra', diag%axesTi, Time, & - 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Double-diffusive diffusivity for temperature', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) CS%id_KS_extra = register_diag_field('ocean_model', 'KS_extra', diag%axesTi, Time, & - 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Double-diffusive diffusivity for salinity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) endif if (CS%use_CVMix_ddiff) then CS%id_R_rho = register_diag_field('ocean_model', 'R_rho', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 47d4dffef6..9ab300560b 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -964,12 +964,12 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) if (m==1) then if (Rayleigh > 0.0) then v_at_u = set_v_at_u(v, h, G, GV, i, j, k, mask_v, OBC) - visc%Ray_u(I,j,k) = Rayleigh * sqrt(u(I,j,k)*u(I,j,k) + v_at_u*v_at_u + U_bg_sq) + visc%Ray_u(I,j,k) = GV%Z_to_H*Rayleigh * sqrt(u(I,j,k)*u(I,j,k) + v_at_u*v_at_u + U_bg_sq) else ; visc%Ray_u(I,j,k) = 0.0 ; endif else if (Rayleigh > 0.0) then u_at_v = set_u_at_v(u, h, G, GV, i, j, k, mask_u, OBC) - visc%Ray_v(i,J,k) = Rayleigh * sqrt(v(i,J,k)*v(i,J,k) + u_at_v*u_at_v + U_bg_sq) + visc%Ray_v(i,J,k) = GV%Z_to_H*Rayleigh * sqrt(v(i,J,k)*v(i,J,k) + u_at_v*u_at_v + U_bg_sq) else ; visc%Ray_v(i,J,k) = 0.0 ; endif endif @@ -1027,31 +1027,31 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) endif endif - if (CS%body_force_drag .and. (h_bbl_drag(i) > 0.0)) then + if (CS%body_force_drag) then ; if (h_bbl_drag(i) > 0.0) then ! Increment the Rayleigh drag as a way introduce the bottom drag as a body force. h_sum = 0.0 I_hwtot = 1.0 / h_bbl_drag(i) do k=nz,1,-1 h_bbl_fr = min(h_bbl_drag(i) - h_sum, h_at_vel(i,k)) * I_hwtot if (m==1) then - visc%Ray_u(I,j,k) = visc%Ray_u(I,j,k) + (CS%cdrag*US%L_to_Z*umag_avg(I)) * h_bbl_fr + visc%Ray_u(I,j,k) = visc%Ray_u(I,j,k) + GV%Z_to_H*(CS%cdrag*US%L_to_Z*umag_avg(I)) * h_bbl_fr else - visc%Ray_v(i,J,k) = visc%Ray_v(i,J,k) + (CS%cdrag*US%L_to_Z*umag_avg(i)) * h_bbl_fr + visc%Ray_v(i,J,k) = visc%Ray_v(i,J,k) + GV%Z_to_H*(CS%cdrag*US%L_to_Z*umag_avg(i)) * h_bbl_fr endif h_sum = h_sum + h_at_vel(i,k) if (h_sum >= h_bbl_drag(i)) exit ! The top of this layer is above the drag zone. enddo ! Do not enhance the near-bottom viscosity in this case. Kv_bbl = CS%Kv_BBL_min - endif + endif ; endif kv_bbl = max(CS%Kv_BBL_min, kv_bbl) if (m==1) then visc%bbl_thick_u(I,j) = bbl_thick_Z - if (allocated(visc%Kv_bbl_u)) visc%Kv_bbl_u(I,j) = kv_bbl + if (allocated(visc%Kv_bbl_u)) visc%Kv_bbl_u(I,j) = GV%Z_to_H*kv_bbl else visc%bbl_thick_v(i,J) = bbl_thick_Z - if (allocated(visc%Kv_bbl_v)) visc%Kv_bbl_v(i,J) = kv_bbl + if (allocated(visc%Kv_bbl_v)) visc%Kv_bbl_v(i,J) = GV%Z_to_H*kv_bbl endif endif ; enddo ! end of i loop enddo ; enddo ! end of m & j loops @@ -1076,10 +1076,10 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) if (CS%debug) then if (allocated(visc%Ray_u) .and. allocated(visc%Ray_v)) & - call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=US%Z_to_m*US%s_to_T) + call uvchksum("Ray [uv]", visc%Ray_u, visc%Ray_v, G%HI, haloshift=0, scale=GV%H_to_m*US%s_to_T) if (allocated(visc%kv_bbl_u) .and. allocated(visc%kv_bbl_v)) & call uvchksum("kv_bbl_[uv]", visc%kv_bbl_u, visc%kv_bbl_v, G%HI, & - haloshift=0, scale=US%Z2_T_to_m2_s, scalar_pair=.true.) + haloshift=0, scale=GV%HZ_T_to_m2_s, scalar_pair=.true.) if (allocated(visc%bbl_thick_u) .and. allocated(visc%bbl_thick_v)) & call uvchksum("bbl_thick_[uv]", visc%bbl_thick_u, visc%bbl_thick_v, & G%HI, haloshift=0, scale=US%Z_to_m, scalar_pair=.true.) @@ -1602,7 +1602,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(I)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_u(I,j) = tbl_thick_Z - visc%Kv_tbl_shelf_u(I,j) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%Kv_tbl_shelf_u(I,j) = GV%Z_to_H*max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! I-loop endif ! do_any_shelf @@ -1839,7 +1839,7 @@ subroutine set_viscous_ML(u, v, h, tv, forces, visc, dt, G, GV, US, CS) tbl_thick_Z = GV%H_to_Z * max(CS%Htbl_shelf_min, & ( htot(i)*ustar1 ) / ( 0.5*ustar1 + sqrt((0.5*ustar1)**2 + h2f2 ) ) ) visc%tbl_thick_shelf_v(i,J) = tbl_thick_Z - visc%Kv_tbl_shelf_v(i,J) = max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) + visc%Kv_tbl_shelf_v(i,J) = GV%Z_to_H*max(CS%Kv_TBL_min, cdrag_sqrt*ustar(i)*tbl_thick_Z) endif ; enddo ! i-loop endif ! do_any_shelf @@ -1901,21 +1901,21 @@ subroutine set_visc_register_restarts(HI, GV, US, param_file, visc, restart_CS) call safe_alloc_ptr(visc%Kd_shear, isd, ied, jsd, jed, nz+1) call register_restart_field(visc%Kd_shear, "Kd_shear", .false., restart_CS, & "Shear-driven turbulent diffusivity at interfaces", & - units="m2 s-1", conversion=US%Z2_T_to_m2_s, z_grid='i') + units="m2 s-1", conversion=GV%HZ_T_to_m2_s, z_grid='i') endif if (useKPP .or. useEPBL .or. use_CVMix_shear .or. use_CVMix_conv .or. & (use_kappa_shear .and. .not.KS_at_vertex )) then call safe_alloc_ptr(visc%Kv_shear, isd, ied, jsd, jed, nz+1) call register_restart_field(visc%Kv_shear, "Kv_shear", .false., restart_CS, & "Shear-driven turbulent viscosity at interfaces", & - units="m2 s-1", conversion=US%Z2_T_to_m2_s, z_grid='i') + units="m2 s-1", conversion=GV%HZ_T_to_m2_s, z_grid='i') endif if (use_kappa_shear .and. KS_at_vertex) then call safe_alloc_ptr(visc%TKE_turb, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1) call safe_alloc_ptr(visc%Kv_shear_Bu, HI%IsdB, HI%IedB, HI%JsdB, HI%JedB, nz+1) call register_restart_field(visc%Kv_shear_Bu, "Kv_shear_Bu", .false., restart_CS, & "Shear-driven turbulent viscosity at vertex interfaces", & - units="m2 s-1", conversion=US%Z2_T_to_m2_s, hor_grid="Bu", z_grid='i') + units="m2 s-1", conversion=GV%HZ_T_to_m2_s, hor_grid="Bu", z_grid='i') elseif (use_kappa_shear) then call safe_alloc_ptr(visc%TKE_turb, isd, ied, jsd, jed, nz+1) endif @@ -2050,20 +2050,23 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "SET_VISC_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "SET_VISC_ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic and expressions in the set viscosity "//& "calculations. Values below 20190101 recover the answers from the end of 2018, "//& "while higher values use updated and more robust forms of the same expressions. "//& "If both SET_VISC_2018_ANSWERS and SET_VISC_ANSWER_DATE are specified, "//& - "the latter takes precedence.", default=default_answer_date) + "the latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag "//& "law of the form c_drag*|u|*u. The velocity magnitude "//& @@ -2275,7 +2278,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=US%Z_to_m) CS%id_kv_bbl_u = register_diag_field('ocean_model', 'kv_bbl_u', diag%axesCu1, & - Time, 'BBL viscosity at u points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + Time, 'BBL viscosity at u points', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) CS%id_bbl_u = register_diag_field('ocean_model', 'bbl_u', diag%axesCu1, & Time, 'BBL mean u current', 'm s-1', conversion=US%L_T_to_m_s) if (CS%id_bbl_u>0) then @@ -2284,7 +2287,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=US%Z_to_m) CS%id_kv_bbl_v = register_diag_field('ocean_model', 'kv_bbl_v', diag%axesCv1, & - Time, 'BBL viscosity at v points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + Time, 'BBL viscosity at v points', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) CS%id_bbl_v = register_diag_field('ocean_model', 'bbl_v', diag%axesCv1, & Time, 'BBL mean v current', 'm s-1', conversion=US%L_T_to_m_s) if (CS%id_bbl_v>0) then @@ -2302,9 +2305,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz), source=0.0) allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz), source=0.0) CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & - Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=GV%H_to_m*US%s_to_T) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & - Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + Time, 'Rayleigh drag velocity at v points', 'm s-1', conversion=GV%H_to_m*US%s_to_T) endif diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 430a9225b5..95ffe19afb 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -43,9 +43,11 @@ module MOM_tidal_mixing !> Containers for tidal mixing diagnostics type, public :: tidal_mixing_diags ; private - real, allocatable :: Kd_itidal(:,:,:) !< internal tide diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. - real, allocatable :: Fl_itidal(:,:,:) !< vertical flux of tidal turbulent dissipation [Z3 T-3 ~> m3 s-3] - real, allocatable :: Kd_Niku(:,:,:) !< lee-wave diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. + real, allocatable :: Kd_itidal(:,:,:) !< internal tide diffusivity at interfaces + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real, allocatable :: Fl_itidal(:,:,:) !< vertical flux of tidal turbulent dissipation + !! [H Z2 T-3 ~> m3 s-3 or W m-2] + real, allocatable :: Kd_Niku(:,:,:) !< lee-wave diffusivity at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, allocatable :: Kd_Niku_work(:,:,:) !< layer integrated work by lee-wave driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_Itidal_Work(:,:,:) !< layer integrated work by int tide driven mixing [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_Lowmode_Work(:,:,:) !< layer integrated work by low mode driven mixing [R Z3 T-3 ~> W m-2] @@ -55,14 +57,14 @@ module MOM_tidal_mixing real, allocatable :: tidal_qe_md(:,:,:) !< Input tidal energy dissipated locally, !! interpolated to model vertical coordinate [R Z3 T-3 ~> W m-2] real, allocatable :: Kd_lowmode(:,:,:) !< internal tide diffusivity at interfaces - !! due to propagating low modes [Z2 T-1 ~> m2 s-1]. + !! due to propagating low modes [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, allocatable :: Fl_lowmode(:,:,:) !< vertical flux of tidal turbulent - !! dissipation due to propagating low modes [Z3 T-3 ~> m3 s-3] + !! dissipation due to propagating low modes [H Z2 T-3 ~> m3 s-3 or W m-2] real, allocatable :: TKE_itidal_used(:,:) !< internal tide TKE input at ocean bottom [R Z3 T-3 ~> W m-2] real, allocatable :: N2_bot(:,:) !< bottom squared buoyancy frequency [T-2 ~> s-2] real, allocatable :: N2_meanz(:,:) !< vertically averaged buoyancy frequency [T-2 ~> s-2] - real, allocatable :: Polzin_decay_scale_scaled(:,:) !< vertical scale of decay for tidal dissipation [Z ~> m] - real, allocatable :: Polzin_decay_scale(:,:) !< vertical decay scale for tidal dissipation with Polzin [Z ~> m] + real, allocatable :: Polzin_decay_scale_scaled(:,:) !< Vertical scale of decay for tidal dissipation [Z ~> m] + real, allocatable :: Polzin_decay_scale(:,:) !< Vertical decay scale for tidal dissipation with Polzin [Z ~> m] real, allocatable :: Simmons_coeff_2d(:,:) !< The Simmons et al mixing coefficient [nondim] end type @@ -86,7 +88,7 @@ module MOM_tidal_mixing !! for dissipation of the lee waves. Schemes that are !! currently encoded are St Laurent et al (2002) and !! Polzin (2009). - real :: Int_tide_decay_scale !< decay scale for internal wave TKE [Z ~> m]. + real :: Int_tide_decay_scale !< decay scale for internal wave TKE [Z ~> m] real :: Mu_itides !< efficiency for conversion of dissipation !! to potential energy [nondim] @@ -117,7 +119,7 @@ module MOM_tidal_mixing !! profile in Polzin formulation should not exceed !! Polzin_decay_scale_max_factor * depth of the ocean [nondim]. real :: Polzin_min_decay_scale !< minimum decay scale of the tidal dissipation - !! profile in Polzin formulation [Z ~> m]. + !! profile in Polzin formulation [Z ~> m] real :: TKE_itide_max !< maximum internal tide conversion [R Z3 T-3 ~> W m-2] !! available to mix above the BBL @@ -155,8 +157,9 @@ module MOM_tidal_mixing ! Data containers real, allocatable :: TKE_Niku(:,:) !< Lee wave driven Turbulent Kinetic Energy input !! [R Z3 T-3 ~> W m-2] - real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided - !! by the bottom stratification [R Z3 T-2 ~> J m-2]. + real, allocatable :: TKE_itidal(:,:) !< The internal Turbulent Kinetic Energy input divided by + !! the bottom stratification and in non-Boussinesq mode by + !! the near-bottom density [R Z4 H-1 T-2 ~> J m-2 or J m kg-1] real, allocatable :: Nb(:,:) !< The near bottom buoyancy frequency [T-1 ~> s-1]. real, allocatable :: mask_itidal(:,:) !< A mask of where internal tide energy is input [nondim] real, allocatable :: h2(:,:) !< Squared bottom depth variance [Z2 ~> m2]. @@ -294,37 +297,43 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "TIDAL_MIXING_2018_ANSWERS", tide_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for the tidal mixing. default_tide_ans_date = default_answer_date - if (tide_answers_2018 .and. (default_tide_ans_date >= 20190101)) default_tide_ans_date = 20181231 - if (.not.tide_answers_2018 .and. (default_tide_ans_date < 20190101)) default_tide_ans_date = 20190101 + if (GV%Boussinesq) then + if (tide_answers_2018 .and. (default_tide_ans_date >= 20190101)) default_tide_ans_date = 20181231 + if (.not.tide_answers_2018 .and. (default_tide_ans_date < 20190101)) default_tide_ans_date = 20190101 + endif call get_param(param_file, mdl, "TIDAL_MIXING_ANSWER_DATE", CS%tidal_answer_date, & "The vintage of the order of arithmetic and expressions in the tidal mixing "//& "calculations. Values below 20190101 recover the answers from the end of 2018, "//& "while higher values use updated and more robust forms of the same expressions. "//& "If both TIDAL_MIXING_2018_ANSWERS and TIDAL_MIXING_ANSWER_DATE are specified, "//& - "the latter takes precedence.", default=default_tide_ans_date) + "the latter takes precedence.", default=default_tide_ans_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%tidal_answer_date = max(CS%tidal_answer_date, 20230701) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. default_remap_ans_date = default_answer_date - if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 - if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + if (GV%Boussinesq) then + if (remap_answers_2018 .and. (default_remap_ans_date >= 20190101)) default_remap_ans_date = 20181231 + if (.not.remap_answers_2018 .and. (default_remap_ans_date < 20190101)) default_remap_ans_date = 20190101 + endif call get_param(param_file, mdl, "REMAPPING_ANSWER_DATE", CS%remap_answer_date, & "The vintage of the expressions and order of arithmetic to use for remapping. "//& "Values below 20190101 result in the use of older, less accurate expressions "//& "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_remap_ans_date) + "latter takes precedence.", default=default_remap_ans_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%remap_answer_date = max(CS%remap_answer_date, 20230701) if (CS%int_tide_dissipation) then @@ -545,8 +554,8 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di utide = CS%tideamp(i,j) ! Compute the fixed part of internal tidal forcing. - ! The units here are [R Z3 T-2 ~> J m-2 = kg s-2] here. - CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%Rho0 * & + ! The units here are [R Z4 H-1 T-2 ~> J m-2 or m3 s-2] here. (Note that J m-2 = kg s-2.) + CS%TKE_itidal(i,j) = 0.5 * CS%kappa_h2_factor * GV%H_to_RZ * & CS%kappa_itides * CS%h2(i,j) * utide*utide enddo ; enddo @@ -639,7 +648,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di CS%Lowmode_itidal_dissipation) then CS%id_Kd_itidal = register_diag_field('ocean_model','Kd_itides',diag%axesTi,Time, & - 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Internal Tide Driven Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) if (CS%use_CVMix_tidal) then CS%id_N2_int = register_diag_field('ocean_model','N2_int',diag%axesTi,Time, & @@ -666,24 +675,24 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di CS%id_Kd_lowmode = register_diag_field('ocean_model','Kd_lowmode',diag%axesTi,Time, & 'Internal Tide Driven Diffusivity (from propagating low modes)', & - 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'm2 s-1', conversion=GV%HZ_T_to_m2_s) CS%id_Fl_itidal = register_diag_field('ocean_model','Fl_itides',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation', & - 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3)) + 'm3 s-3', conversion=(GV%H_to_m*US%Z_to_m**2*US%s_to_T**3)) CS%id_Fl_lowmode = register_diag_field('ocean_model','Fl_lowmode',diag%axesTi,Time, & 'Vertical flux of tidal turbulent dissipation (from propagating low modes)', & - 'm3 s-3', conversion=(US%Z_to_m**3*US%s_to_T**3)) + 'm3 s-3', conversion=(GV%H_to_m*US%Z_to_m**2*US%s_to_T**3)) - CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale',diag%axesT1,Time, & + CS%id_Polzin_decay_scale = register_diag_field('ocean_model','Polzin_decay_scale', diag%axesT1, Time, & 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme', & - 'm', conversion=US%Z_to_m) + units='m', conversion=US%Z_to_m) CS%id_Polzin_decay_scale_scaled = register_diag_field('ocean_model', & 'Polzin_decay_scale_scaled', diag%axesT1, Time, & 'Vertical decay scale for the tidal turbulent dissipation with Polzin scheme, '// & - 'scaled by N2_bot/N2_meanz', 'm', conversion=US%Z_to_m) + 'scaled by N2_bot/N2_meanz', units='m', conversion=US%Z_to_m) CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2', conversion=US%s_to_T**2) @@ -708,7 +717,7 @@ logical function tidal_mixing_init(Time, G, GV, US, param_file, int_tide_CSp, di 'Lee wave Driven Turbulent Kinetic Energy', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) CS%id_Kd_Niku = register_diag_field('ocean_model','Kd_Nikurashin',diag%axesTi,Time, & - 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Lee Wave Driven Diffusivity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) endif endif ! S%use_CVMix_tidal endif @@ -719,16 +728,16 @@ end function tidal_mixing_init !> Depending on whether or not CVMix is active, calls the associated subroutine to compute internal !! tidal dissipation and to add the effect of internal-tide-driven mixing to the layer or interface !! diffusivities. -subroutine calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, max_TKE, & +subroutine calculate_tidal_mixing(dz, j, N2_bot, Rho_bot, N2_lay, N2_int, TKE_to_Kd, max_TKE, & G, GV, US, CS, Kd_max, Kv, Kd_lay, Kd_int) 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m] integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy !! frequency [T-2 ~> s-2]. + real, dimension(SZI_(G)), intent(in) :: Rho_bot !< The near-bottom in situ density [R ~> kg m-3] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy frequency at the @@ -737,27 +746,29 @@ subroutine calculate_tidal_mixing(h, j, N2_bot, N2_lay, N2_int, TKE_to_Kd, max_T !! dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] + !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required for a layer to + !! entrain to its maximum realizable + !! thickness [H Z2 T-3 ~> m3 s-3 or W m-2] type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes, - !! [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] !! Set this to a negative value to have no limit. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. + !! (not layer!) [H Z T-1 ~> m2 s-1 or Pa s] real, dimension(SZI_(G),SZK_(GV)), & - optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1]. + optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces, - !! [Z2 T-1 ~> m2 s-1]. + optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1] if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation .or. CS%Lowmode_itidal_dissipation) then if (CS%use_CVMix_tidal) then - call calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) + call calculate_CVMix_tidal(dz, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) else - call add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & + call add_int_tide_diffusivity(dz, j, N2_bot, Rho_bot, N2_lay, TKE_to_Kd, max_TKE, & G, GV, US, CS, Kd_max, Kd_lay, Kd_int) endif endif @@ -766,22 +777,23 @@ end subroutine calculate_tidal_mixing !> Calls the CVMix routines to compute tidal dissipation and to add the effect of internal-tide-driven !! mixing to the interface diffusivities. -subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) +subroutine calculate_CVMix_tidal(dz, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tidal_mixing_cs), intent(inout) :: CS !< This module's control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m] integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G),SZK_(GV)+1), intent(in) :: N2_int !< The squared buoyancy !! frequency at the interfaces [T-2 ~> s-2]. real, dimension(:,:,:), pointer :: Kv !< The "slow" vertical viscosity at each interface - !! (not layer!) [Z2 T-1 ~> m2 s-1]. + !! (not layer!) [H Z T-1 ~> m2 s-1 or Pa s] real, dimension(SZI_(G),SZK_(GV)), & - optional, intent(inout) :: Kd_lay!< The diapycnal diffusivity in the layers [Z2 T-1 ~> m2 s-1]. + optional, intent(inout) :: Kd_lay!< The diapycnal diffusivity in the layers + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G),SZK_(GV)+1), & - optional, intent(inout) :: Kd_int!< The diapycnal diffusivity at interfaces [Z2 T-1 ~> m2 s-1]. + optional, intent(inout) :: Kd_int!< The diapycnal diffusivity at interfaces + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. ! Local variables real, dimension(SZK_(GV)+1) :: Kd_tidal ! tidal diffusivity [m2 s-1] real, dimension(SZK_(GV)+1) :: Kv_tidal ! tidal viscosity [m2 s-1] @@ -801,7 +813,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! related to the distribution of tidal mixing energy, with unusual array ! extents that are not explained, that is set and used by the CVMix ! tidal mixing schemes, perhaps in [m3 kg-1]? - real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] + real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] real :: Simmons_coeff ! A coefficient in the Simmons et al (2004) mixing parameterization [nondim] integer :: i, k, is, ie @@ -820,7 +832,7 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int hcorr = 0.0 ! Compute cell center depth and cell bottom in meters (negative values in the ocean) do k=1,GV%ke - dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights + dh = dz(i,k) ! Nominal thickness to use for increment, in the units of heights dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness @@ -862,24 +874,24 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! Update diffusivity if (present(Kd_lay)) then do k=1,GV%ke - Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) + Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * GV%m2_s_to_HZ_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo endif if (present(Kd_int)) then do K=1,GV%ke+1 - Kd_int(i,K) = Kd_int(i,K) + (US%m2_s_to_Z2_T * Kd_tidal(K)) + Kd_int(i,K) = Kd_int(i,K) + GV%m2_s_to_HZ_T * Kd_tidal(K) enddo endif ! Update viscosity with the proper unit conversion. if (associated(Kv)) then do K=1,GV%ke+1 - Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * Kv_tidal(K) ! Rescale from m2 s-1 to Z2 T-1. + Kv(i,j,K) = Kv(i,j,K) + GV%m2_s_to_HZ_T * Kv_tidal(K) ! Rescale from m2 s-1 to H Z T-1. enddo endif ! diagnostics if (allocated(CS%dd%Kd_itidal)) then - CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T * Kd_tidal(:) + CS%dd%Kd_itidal(i,j,:) = GV%m2_s_to_HZ_T * Kd_tidal(:) endif if (allocated(CS%dd%N2_int)) then CS%dd%N2_int(i,j,:) = N2_int(i,:) @@ -908,8 +920,8 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int hcorr = 0.0 ! Compute heights at cell center and interfaces, and rescale layer thicknesses do k=1,GV%ke - h_m(k) = h(i,j,k)*GV%H_to_m ! Rescale thicknesses to m for use by CVmix. - dh = h(i,j,k) * GV%H_to_Z ! Nominal thickness to use for increment, in the units of heights + h_m(k) = dz(i,k)*US%Z_to_m ! Rescale thicknesses to m for use by CVmix. + dh = dz(i,k) ! Nominal thickness to use for increment, in the units of heights dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max(dh, CS%min_thickness) ! Limited increment dh>=min_thickness @@ -963,25 +975,25 @@ subroutine calculate_CVMix_tidal(h, j, N2_int, G, GV, US, CS, Kv, Kd_lay, Kd_int ! Update diffusivity if (present(Kd_lay)) then do k=1,GV%ke - Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * US%m2_s_to_Z2_T * (Kd_tidal(k) + Kd_tidal(k+1)) + Kd_lay(i,k) = Kd_lay(i,k) + 0.5 * GV%m2_s_to_HZ_T * (Kd_tidal(k) + Kd_tidal(k+1)) enddo endif if (present(Kd_int)) then do K=1,GV%ke+1 - Kd_int(i,K) = Kd_int(i,K) + (US%m2_s_to_Z2_T * Kd_tidal(K)) + Kd_int(i,K) = Kd_int(i,K) + (GV%m2_s_to_HZ_T * Kd_tidal(K)) enddo endif ! Update viscosity if (associated(Kv)) then do K=1,GV%ke+1 - Kv(i,j,K) = Kv(i,j,K) + US%m2_s_to_Z2_T * Kv_tidal(K) ! Rescale from m2 s-1 to Z2 T-1. + Kv(i,j,K) = Kv(i,j,K) + GV%m2_s_to_HZ_T * Kv_tidal(K) ! Rescale from m2 s-1 to H Z T-1. enddo endif ! diagnostics if (allocated(CS%dd%Kd_itidal)) then - CS%dd%Kd_itidal(i,j,:) = US%m2_s_to_Z2_T*Kd_tidal(:) + CS%dd%Kd_itidal(i,j,:) = GV%m2_s_to_HZ_T*Kd_tidal(:) endif if (allocated(CS%dd%N2_int)) then CS%dd%N2_int(i,j,:) = N2_int(i,:) @@ -1013,76 +1025,76 @@ end subroutine calculate_CVMix_tidal !! low modes (rays) of the internal tide ("lowmode"), and (3) local dissipation of internal lee waves. !! Will eventually need to add diffusivity due to other wave-breaking processes (e.g. Bottom friction, !! Froude-number-depending breaking, PSI, etc.). -subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & +subroutine add_int_tide_diffusivity(dz, j, N2_bot, Rho_bot, N2_lay, TKE_to_Kd, max_TKE, & G, GV, US, CS, Kd_max, Kd_lay, Kd_int) 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: dz !< The vertical distance across layers [Z ~> m] integer, intent(in) :: j !< The j-index to work on real, dimension(SZI_(G)), intent(in) :: N2_bot !< The near-bottom squared buoyancy frequency !! frequency [T-2 ~> s-2]. + real, dimension(SZI_(G)), intent(in) :: Rho_bot !< The near-bottom in situ density [R ~> kg m-3] real, dimension(SZI_(G),SZK_(GV)), intent(in) :: N2_lay !< The squared buoyancy frequency of the !! layers [T-2 ~> s-2]. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: TKE_to_Kd !< The conversion rate between the TKE !! dissipated within a layer and the !! diapycnal diffusivity within that layer, !! usually (~Rho_0 / (G_Earth * dRho_lay)) - !! [Z2 T-1 / Z3 T-3 = T2 Z-1 ~> s2 m-1] - real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required to for a layer to entrain - !! to its maximum realizable thickness [Z3 T-3 ~> m3 s-3] + !! [H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1] + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: max_TKE !< The energy required for a layer + !! to entrain to its maximum realizable + !! thickness [H Z2 T-3 ~> m3 s-3 or W m-2] type(tidal_mixing_cs), intent(inout) :: CS !< The control structure for this module real, intent(in) :: Kd_max !< The maximum increment for diapycnal !! diffusivity due to TKE-based processes - !! [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. !! Set this to a negative value to have no limit. real, dimension(SZI_(G),SZK_(GV)), & - optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers [Z2 T-1 ~> m2 s-1] + optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity in layers + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. real, dimension(SZI_(G),SZK_(GV)+1), & optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at interfaces - !! [Z2 T-1 ~> m2 s-1]. + !! [H Z T-1 ~> m2 s-1 or kg m-1 s-1]. ! local real, dimension(SZI_(G)) :: & - htot, & ! total thickness above or below a layer, or the - ! integrated thickness in the BBL [Z ~> m]. - htot_WKB, & ! WKB scaled distance from top to bottom [Z ~> m]. - TKE_itidal_bot, & ! internal tide TKE at ocean bottom [Z3 T-3 ~> m3 s-3] - TKE_Niku_bot, & ! lee-wave TKE at ocean bottom [Z3 T-3 ~> m3 s-3] - TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes [Z3 T-3 ~> m3 s-3] (BDM) + dztot, & ! Vertical distance between the top and bottom of the ocean [Z ~> m] + dztot_WKB, & ! WKB scaled distance from top to bottom [Z ~> m] + TKE_itidal_bot, & ! internal tide TKE at ocean bottom [H Z2 T-3 ~> m3 s-3 or W m-2] + TKE_Niku_bot, & ! lee-wave TKE at ocean bottom [H Z2 T-3 ~> m3 s-3 or W m-2] + TKE_lowmode_bot, & ! internal tide TKE at ocean bottom lost from all remote low modes [H Z2 T-3 ~> m3 s-3 or W m-2] Inv_int, & ! inverse of TKE decay for int tide over the depth of the ocean [nondim] Inv_int_lee, & ! inverse of TKE decay for lee waves over the depth of the ocean [nondim] - Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean [nondim] (BDM) - z0_Polzin, & ! TKE decay scale in Polzin formulation [Z ~> m]. + Inv_int_low, & ! inverse of TKE decay for low modes over the depth of the ocean [nondim] + z0_Polzin, & ! TKE decay scale in Polzin formulation [Z ~> m] z0_Polzin_scaled, & ! TKE decay scale in Polzin formulation [Z ~> m]. ! multiplied by N2_bot/N2_meanz to be coherent with the WKB scaled z ! z*=int(N2/N2_bot) * N2_bot/N2_meanz = int(N2/N2_meanz) ! z0_Polzin_scaled = z0_Polzin * N2_bot/N2_meanz N2_meanz, & ! vertically averaged squared buoyancy frequency [T-2 ~> s-2] for WKB scaling - TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) [Z3 T-3 ~> m3 s-3] - TKE_Niku_rem, & ! remaining lee-wave TKE [Z3 T-3 ~> m3 s-3] - TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) [Z3 T-3 ~> m3 s-3] (BDM) + TKE_itidal_rem, & ! remaining internal tide TKE (from barotropic source) [H Z2 T-3 ~> m3 s-3 or W m-2] + TKE_Niku_rem, & ! remaining lee-wave TKE [H Z2 T-3 ~> m3 s-3 or W m-2] + TKE_lowmode_rem, & ! remaining internal tide TKE (from propagating low mode source) [H Z2 T-3 ~> m3 s-3 or W m-2] TKE_frac_top, & ! fraction of bottom TKE that should appear at top of a layer [nondim] TKE_frac_top_lee, & ! fraction of bottom TKE that should appear at top of a layer [nondim] TKE_frac_top_lowmode, & - ! fraction of bottom TKE that should appear at top of a layer [nondim] (BDM) - z_from_bot, & ! distance from bottom [Z ~> m]. - z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m]. - - real :: I_rho0 ! Inverse of the Boussinesq reference density, i.e. 1 / RHO0 [R-1 ~> m3 kg-1] - real :: Kd_add ! diffusivity to add in a layer [Z2 T-1 ~> m2 s-1]. - real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [Z3 T-3 ~> m3 s-3] - real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [Z3 T-3 ~> m3 s-3] - real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [Z3 T-3 ~> m3 s-3] (BDM) + ! fraction of bottom TKE that should appear at top of a layer [nondim] + z_from_bot, & ! distance from bottom [Z ~> m] + z_from_bot_WKB ! WKB scaled distance from bottom [Z ~> m] + + real :: Kd_add ! Diffusivity to add in a layer [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real :: TKE_itide_lay ! internal tide TKE imparted to a layer (from barotropic) [H Z2 T-3 ~> m3 s-3 or W m-2] + real :: TKE_Niku_lay ! lee-wave TKE imparted to a layer [H Z2 T-3 ~> m3 s-3 or W m-2] + real :: TKE_lowmode_lay ! internal tide TKE imparted to a layer (from low mode) [H Z2 T-3 ~> m3 s-3 or W m-2] real :: frac_used ! fraction of TKE that can be used in a layer [nondim] - real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1]. - real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1]. - real :: z0Ps_num ! The numerator of the unlimited z0_Polzin_scaled [Z T-3 ~> m s-3]. + real :: Izeta ! inverse of TKE decay scale [Z-1 ~> m-1] + real :: Izeta_lee ! inverse of TKE decay scale for lee waves [Z-1 ~> m-1] + real :: z0Ps_num ! The numerator of the unlimited z0_Polzin_scaled [Z T-3 ~> m s-3] real :: z0Ps_denom ! The denominator of the unlimited z0_Polzin_scaled [T-3 ~> s-3]. - real :: z0_psl ! temporary variable [Z ~> m]. - real :: TKE_lowmode_tot ! TKE from all low modes [R Z3 T-3 ~> W m-2] (BDM) + real :: z0_psl ! temporary variable [Z ~> m] + real :: TKE_lowmode_tot ! TKE from all low modes [R Z3 T-3 ~> W m-2] logical :: use_Polzin, use_Simmons integer :: i, k, is, ie, nz @@ -1091,13 +1103,11 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & if (.not.(CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation)) return - do i=is,ie ; htot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ;enddo + do i=is,ie ; dztot(i) = 0.0 ; Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - htot(i) = htot(i) + GV%H_to_Z*h(i,j,k) + dztot(i) = dztot(i) + dz(i,k) enddo ; enddo - I_Rho0 = 1.0 / (GV%Rho0) - use_Polzin = ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09)) .or. & (CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09))) @@ -1108,29 +1118,28 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & ! Calculate parameters for vertical structure of dissipation ! Simmons: if ( use_Simmons ) then - Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%H_subroundoff*GV%H_to_Z) - Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, & - GV%H_subroundoff*GV%H_to_Z) + Izeta = 1.0 / max(CS%Int_tide_decay_scale, GV%dz_subroundoff) + Izeta_lee = 1.0 / max(CS%Int_tide_decay_scale*CS%Decay_scale_factor_lee, GV%dz_subroundoff) do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) if (allocated(CS%dd%N2_bot)) & CS%dd%N2_bot(i,j) = N2_bot(i) if ( CS%Int_tide_dissipation ) then - if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. - Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) + if (Izeta*dztot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. + Inv_int(i) = 1.0 / (1.0 - exp(-Izeta*dztot(i))) endif endif if ( CS%Lee_wave_dissipation ) then - if (Izeta_lee*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. - Inv_int_lee(i) = 1.0 / (1.0 - exp(-Izeta_lee*htot(i))) + if (Izeta_lee*dztot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. + Inv_int_lee(i) = 1.0 / (1.0 - exp(-Izeta_lee*dztot(i))) endif endif if ( CS%Lowmode_itidal_dissipation) then - if (Izeta*htot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. - Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*htot(i))) + if (Izeta*dztot(i) > 1.0e-14) then ! L'Hospital's version of Adcroft's reciprocal rule. + Inv_int_low(i) = 1.0 / (1.0 - exp(-Izeta*dztot(i))) endif endif - z_from_bot(i) = GV%H_to_Z*h(i,j,nz) + z_from_bot(i) = dz(i,nz) enddo endif ! Simmons @@ -1139,109 +1148,109 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & ! WKB scaling of the vertical coordinate do i=is,ie ; N2_meanz(i) = 0.0 ; enddo do k=1,nz ; do i=is,ie - N2_meanz(i) = N2_meanz(i) + N2_lay(i,k) * GV%H_to_Z * h(i,j,k) + N2_meanz(i) = N2_meanz(i) + N2_lay(i,k) * dz(i,k) enddo ; enddo do i=is,ie - N2_meanz(i) = N2_meanz(i) / (htot(i) + GV%H_subroundoff*GV%H_to_Z) + N2_meanz(i) = N2_meanz(i) / (dztot(i) + GV%dz_subroundoff) if (allocated(CS%dd%N2_meanz)) & CS%dd%N2_meanz(i,j) = N2_meanz(i) enddo ! WKB scaled z*(z=H) z* at the surface using the modified Polzin WKB scaling - do i=is,ie ; htot_WKB(i) = htot(i) ; enddo -! do i=is,ie ; htot_WKB(i) = 0.0 ; enddo + do i=is,ie ; dztot_WKB(i) = dztot(i) ; enddo +! do i=is,ie ; dztot_WKB(i) = 0.0 ; enddo ! do k=1,nz ; do i=is,ie -! htot_WKB(i) = htot_WKB(i) + GV%H_to_Z*h(i,j,k) * N2_lay(i,k) / N2_meanz(i) +! dztot_WKB(i) = dztot_WKB(i) + dz(i,k) * N2_lay(i,k) / N2_meanz(i) ! enddo ; enddo - ! htot_WKB(i) = htot(i) ! Nearly equivalent and simpler + ! dztot_WKB(i) = dztot(i) ! Nearly equivalent and simpler do i=is,ie CS%Nb(i,j) = sqrt(N2_bot(i)) if (CS%tidal_answer_date < 20190101) then if ((CS%tideamp(i,j) > 0.0) .and. & (CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 > 1.0e-14*US%T_to_s**3) ) then - z0_polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & + z0_Polzin(i) = CS%Polzin_decay_scale_factor * CS%Nu_Polzin * & CS%Nbotref_Polzin**2 * CS%tideamp(i,j) / & ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j)**3 ) - if (z0_polzin(i) < CS%Polzin_min_decay_scale) & - z0_polzin(i) = CS%Polzin_min_decay_scale + if (z0_Polzin(i) < CS%Polzin_min_decay_scale) & + z0_Polzin(i) = CS%Polzin_min_decay_scale if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then - z0_polzin_scaled(i) = z0_polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) + z0_Polzin_scaled(i) = z0_Polzin(i)*CS%Nb(i,j)**2 / N2_meanz(i) else - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0_Polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * dztot(i) endif - if (z0_polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * htot(i)) ) & - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + if (z0_Polzin_scaled(i) > (CS%Polzin_decay_scale_max_factor * dztot(i)) ) & + z0_Polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * dztot(i) else - z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0_Polzin(i) = CS%Polzin_decay_scale_max_factor * dztot(i) + z0_Polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * dztot(i) endif else z0Ps_num = (CS%Polzin_decay_scale_factor * CS%Nu_Polzin * CS%Nbotref_Polzin**2) * CS%tideamp(i,j) z0Ps_denom = ( CS%kappa_itides**2 * CS%h2(i,j) * CS%Nb(i,j) * N2_meanz(i) ) if ((CS%tideamp(i,j) > 0.0) .and. & - (z0Ps_num < z0Ps_denom * CS%Polzin_decay_scale_max_factor * htot(i))) then - z0_polzin_scaled(i) = z0Ps_num / z0Ps_denom + (z0Ps_num < z0Ps_denom * CS%Polzin_decay_scale_max_factor * dztot(i))) then + z0_Polzin_scaled(i) = z0Ps_num / z0Ps_denom - if (abs(N2_meanz(i) * z0_polzin_scaled(i)) < & - CS%Nb(i,j)**2 * (CS%Polzin_decay_scale_max_factor * htot(i))) then - z0_polzin(i) = z0_polzin_scaled(i) * (N2_meanz(i) / CS%Nb(i,j)**2) + if (abs(N2_meanz(i) * z0_Polzin_scaled(i)) < & + CS%Nb(i,j)**2 * (CS%Polzin_decay_scale_max_factor * dztot(i))) then + z0_Polzin(i) = z0_Polzin_scaled(i) * (N2_meanz(i) / CS%Nb(i,j)**2) else - z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0_Polzin(i) = CS%Polzin_decay_scale_max_factor * dztot(i) endif else - z0_polzin(i) = CS%Polzin_decay_scale_max_factor * htot(i) - z0_polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * htot(i) + z0_Polzin(i) = CS%Polzin_decay_scale_max_factor * dztot(i) + z0_Polzin_scaled(i) = CS%Polzin_decay_scale_max_factor * dztot(i) endif endif if (allocated(CS%dd%Polzin_decay_scale)) & - CS%dd%Polzin_decay_scale(i,j) = z0_polzin(i) + CS%dd%Polzin_decay_scale(i,j) = z0_Polzin(i) if (allocated(CS%dd%Polzin_decay_scale_scaled)) & - CS%dd%Polzin_decay_scale_scaled(i,j) = z0_polzin_scaled(i) + CS%dd%Polzin_decay_scale_scaled(i,j) = z0_Polzin_scaled(i) if (allocated(CS%dd%N2_bot)) & CS%dd%N2_bot(i,j) = CS%Nb(i,j)*CS%Nb(i,j) if (CS%tidal_answer_date < 20190101) then ! These expressions use dimensional constants to avoid NaN values. if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if (dztot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int(i) = ( z0_Polzin_scaled(i) / dztot_WKB(i) ) + 1.0 endif if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 + if (dztot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int_lee(i) = ( z0_Polzin_scaled(i)*CS%Decay_scale_factor_lee / dztot_WKB(i) ) + 1.0 endif if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - if (htot_WKB(i) > 1.0e-14*US%m_to_Z) & - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if (dztot_WKB(i) > 1.0e-14*US%m_to_Z) & + Inv_int_low(i) = ( z0_Polzin_scaled(i) / dztot_WKB(i) ) + 1.0 endif else ! These expressions give values of Inv_int < 10^14 using a variant of Adcroft's reciprocal rule. Inv_int(i) = 0.0 ; Inv_int_lee(i) = 0.0 ; Inv_int_low(i) = 0.0 if ( CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & - Inv_int(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if (z0_Polzin_scaled(i) < 1.0e14 * dztot_WKB(i)) & + Inv_int(i) = ( z0_Polzin_scaled(i) / dztot_WKB(i) ) + 1.0 endif if ( CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09) ) then - if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & - Inv_int_lee(i) = ( z0_polzin_scaled(i)*CS%Decay_scale_factor_lee / htot_WKB(i) ) + 1.0 + if (z0_Polzin_scaled(i) < 1.0e14 * dztot_WKB(i)) & + Inv_int_lee(i) = ( z0_Polzin_scaled(i)*CS%Decay_scale_factor_lee / dztot_WKB(i) ) + 1.0 endif if ( CS%Lowmode_itidal_dissipation .and. (CS%int_tide_profile == POLZIN_09) ) then - if (z0_polzin_scaled(i) < 1.0e14 * htot_WKB(i)) & - Inv_int_low(i) = ( z0_polzin_scaled(i) / htot_WKB(i) ) + 1.0 + if (z0_Polzin_scaled(i) < 1.0e14 * dztot_WKB(i)) & + Inv_int_low(i) = ( z0_Polzin_scaled(i) / dztot_WKB(i) ) + 1.0 endif endif - z_from_bot(i) = GV%H_to_Z*h(i,j,nz) + z_from_bot(i) = dz(i,nz) ! Use the new formulation for WKB scaling. N2 is referenced to its vertical mean. if (CS%tidal_answer_date < 20190101) then if (N2_meanz(i) > 1.0e-14*US%T_to_s**2 ) then - z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) + z_from_bot_WKB(i) = dz(i,nz) * N2_lay(i,nz) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif else - if (GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) < N2_meanz(i) * (1.0e14 * htot_WKB(i))) then - z_from_bot_WKB(i) = GV%H_to_Z*h(i,j,nz) * N2_lay(i,nz) / N2_meanz(i) + if (dz(i,nz) * N2_lay(i,nz) < N2_meanz(i) * (1.0e14 * dztot_WKB(i))) then + z_from_bot_WKB(i) = dz(i,nz) * N2_lay(i,nz) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif endif enddo @@ -1251,14 +1260,19 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & ! Both Polzin and Simmons: do i=is,ie ! Dissipation of locally trapped internal tide (non-propagating high modes) - TKE_itidal_bot(i) = min(CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max) + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + TKE_itidal_bot(i) = min(GV%Z_to_H*CS%TKE_itidal(i,j)*CS%Nb(i,j), CS%TKE_itide_max) + else + TKE_itidal_bot(i) = min(GV%RZ_to_H*Rho_bot(i) * (CS%TKE_itidal(i,j)*CS%Nb(i,j)), & + CS%TKE_itide_max) + endif if (allocated(CS%dd%TKE_itidal_used)) & CS%dd%TKE_itidal_used(i,j) = TKE_itidal_bot(i) - TKE_itidal_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) + TKE_itidal_bot(i) = (GV%RZ_to_H * CS%Mu_itides * CS%Gamma_itides) * TKE_itidal_bot(i) ! Dissipation of locally trapped lee waves TKE_Niku_bot(i) = 0.0 if (CS%Lee_wave_dissipation) then - TKE_Niku_bot(i) = (I_rho0 * CS%Mu_itides * CS%Gamma_lee) * CS%TKE_Niku(i,j) + TKE_Niku_bot(i) = (GV%RZ_to_H * CS%Mu_itides * CS%Gamma_lee) * CS%TKE_Niku(i,j) endif ! Dissipation of propagating internal tide (baroclinic low modes; rays) (BDM) TKE_lowmode_tot = 0.0 @@ -1266,7 +1280,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & if (CS%Lowmode_itidal_dissipation) then ! get loss rate due to wave drag on low modes (already multiplied by q) call get_lowmode_loss(i,j,G,CS%int_tide_CSp,"WaveDrag",TKE_lowmode_tot) - TKE_lowmode_bot(i) = CS%Mu_itides * I_rho0 * TKE_lowmode_tot + TKE_lowmode_bot(i) = CS%Mu_itides * GV%RZ_to_H * TKE_lowmode_tot endif ! Vertical energy flux at bottom TKE_itidal_rem(i) = Inv_int(i) * TKE_itidal_bot(i) @@ -1282,7 +1296,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & if ( use_Simmons ) then do k=nz-1,2,-1 ; do i=is,ie if (max_TKE(i,k) <= 0.0) cycle - z_from_bot(i) = z_from_bot(i) + GV%H_to_Z*h(i,j,k) + z_from_bot(i) = z_from_bot(i) + dz(i,k) ! Fraction of bottom flux predicted to reach top of this layer TKE_frac_top(i) = Inv_int(i) * exp(-Izeta * z_from_bot(i)) @@ -1296,7 +1310,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)* TKE_frac_top_lowmode(i) ! Actual power expended may be less than predicted if stratification is weak; adjust - if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (max_TKE(i,k))) then + if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then frac_used = (max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) TKE_itide_lay = frac_used * TKE_itide_lay TKE_Niku_lay = frac_used * TKE_Niku_lay @@ -1331,7 +1345,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & if (k 1.0e-14*US%T_to_s**2 ) then - z_from_bot_WKB(i) = z_from_bot_WKB(i) & - + GV%H_to_Z * h(i,j,k) * N2_lay(i,k) / N2_meanz(i) + z_from_bot_WKB(i) = z_from_bot_WKB(i) + dz(i,k) * N2_lay(i,k) / N2_meanz(i) else ; z_from_bot_WKB(i) = 0 ; endif else - if (GV%H_to_Z*h(i,j,k) * N2_lay(i,k) < (1.0e14 * htot_WKB(i)) * N2_meanz(i)) then - z_from_bot_WKB(i) = z_from_bot_WKB(i) + & - GV%H_to_Z*h(i,j,k) * N2_lay(i,k) / N2_meanz(i) + if (dz(i,k) * N2_lay(i,k) < (1.0e14 * dztot_WKB(i)) * N2_meanz(i)) then + z_from_bot_WKB(i) = z_from_bot_WKB(i) + dz(i,k) * N2_lay(i,k) / N2_meanz(i) endif endif ! Fraction of bottom flux predicted to reach top of this layer - TKE_frac_top(i) = ( Inv_int(i) * z0_polzin_scaled(i) ) / & - ( z0_polzin_scaled(i) + z_from_bot_WKB(i) ) - z0_psl = z0_polzin_scaled(i)*CS%Decay_scale_factor_lee + TKE_frac_top(i) = ( Inv_int(i) * z0_Polzin_scaled(i) ) / & + ( z0_Polzin_scaled(i) + z_from_bot_WKB(i) ) + z0_psl = z0_Polzin_scaled(i)*CS%Decay_scale_factor_lee TKE_frac_top_lee(i) = (Inv_int_lee(i) * z0_psl) / (z0_psl + z_from_bot_WKB(i)) - TKE_frac_top_lowmode(i) = ( Inv_int_low(i) * z0_polzin_scaled(i) ) / & - ( z0_polzin_scaled(i) + z_from_bot_WKB(i) ) + TKE_frac_top_lowmode(i) = ( Inv_int_low(i) * z0_Polzin_scaled(i) ) / & + ( z0_Polzin_scaled(i) + z_from_bot_WKB(i) ) ! Actual influx at bottom of layer minus predicted outflux at top of layer to give ! predicted power expended @@ -1394,8 +1406,8 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & TKE_lowmode_lay = TKE_lowmode_rem(i) - TKE_lowmode_bot(i)*TKE_frac_top_lowmode(i) ! Actual power expended may be less than predicted if stratification is weak; adjust - if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > (max_TKE(i,k))) then - frac_used = (max_TKE(i,k)) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) + if (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay > max_TKE(i,k)) then + frac_used = max_TKE(i,k) / (TKE_itide_lay + TKE_Niku_lay + TKE_lowmode_lay) TKE_itide_lay = frac_used * TKE_itide_lay TKE_Niku_lay = frac_used * TKE_Niku_lay TKE_lowmode_lay = frac_used * TKE_lowmode_lay @@ -1429,7 +1441,7 @@ subroutine add_int_tide_diffusivity(h, j, N2_bot, N2_lay, TKE_to_Kd, max_TKE, & if (k @@ -44,18 +45,18 @@ module MOM_vert_friction !> The control structure with parameters and memory for the MOM_vert_friction module type, public :: vertvisc_CS ; private logical :: initialized = .false. !< True if this control structure has been initialized. - real :: Hmix !< The mixed layer thickness in thickness units [H ~> m or kg m-2]. + real :: Hmix !< The mixed layer thickness [Z ~> m]. real :: Hmix_stress !< The mixed layer thickness over which the wind !! stress is applied with direct_stress [H ~> m or kg m-2]. - real :: Kvml_invZ2 !< The extra vertical viscosity scale in [Z2 T-1 ~> m2 s-1] in a + real :: Kvml_invZ2 !< The extra vertical viscosity scale in [H Z T-1 ~> m2 s-1 or Pa s] in a !! surface mixed layer with a characteristic thickness given by Hmix, !! and scaling proportional to (Hmix/z)^2, where z is the distance !! from the surface; this can get very large with thin layers. - real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1]. - real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. - real :: Hbbl_gl90 !< The static bottom boundary layer thickness used for GL90 [H ~> m or kg m-2]. + real :: Kv !< The interior vertical viscosity [H Z T-1 ~> m2 s-1 or Pa s]. + real :: Hbbl !< The static bottom boundary layer thickness [Z ~> m]. + real :: Hbbl_gl90 !< The static bottom boundary layer thickness used for GL90 [Z ~> m]. real :: Kv_extra_bbl !< An extra vertical viscosity in the bottom boundary layer of thickness - !! Hbbl when there is not a bottom drag law in use [Z2 T-1 ~> m2 s-1]. + !! Hbbl when there is not a bottom drag law in use [H Z T-1 ~> m2 s-1 or Pa s]. real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nondim] logical :: use_GL90_in_SSW !< If true, use the GL90 parameterization in stacked shallow water mode (SSW). @@ -65,12 +66,12 @@ module MOM_vert_friction logical :: use_GL90_N2 !< If true, use GL90 vertical viscosity coefficient that is depth-independent; !! this corresponds to a kappa_GM that scales as N^2 with depth. real :: kappa_gl90 !< The scalar diffusivity used in the GL90 vertical viscosity scheme - !! [L2 T-1 ~> m2 s-1] + !! [L2 H Z-1 T-1 ~> m2 s-1 or Pa s] logical :: read_kappa_gl90 !< If true, read a file containing the spatially varying kappa_gl90 real :: alpha_gl90 !< Coefficient used to compute a depth-independent GL90 vertical !! viscosity via Kv_gl90 = alpha_gl90 * f^2. Note that the implied !! Kv_gl90 corresponds to a kappa_gl90 that scales as N^2 with depth. - !! [L2 T ~> m2 s] + !! [H Z T ~> m2 s or kg s m-1] real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow !! are set to 0 [L T-1 ~> m s-1]. @@ -90,21 +91,21 @@ module MOM_vert_friction type(time_type) :: rampStartTime !< The time at which the ramping of CFL_trunc starts real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u !< The u-drag coefficient across an interface [Z T-1 ~> m s-1]. + a_u !< The u-drag coefficient across an interface [H T-1 ~> m s-1 or Pa s m-1] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: & - a_u_gl90 !< The u-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1]. + a_u_gl90 !< The u-drag coefficient associated with GL90 across an interface [H T-1 ~> m s-1 or Pa s m-1] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & h_u !< The effective layer thickness at u-points [H ~> m or kg m-2]. real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & - a_v !< The v-drag coefficient across an interface [Z T-1 ~> m s-1]. + a_v !< The v-drag coefficient across an interface [H T-1 ~> m s-1 or Pa s m-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: & - a_v_gl90 !< The v-drag coefficient associated with GL90 across an interface [Z T-1 ~> m s-1]. + a_v_gl90 !< The v-drag coefficient associated with GL90 across an interface [H T-1 ~> m s-1 or Pa s m-1] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & h_v !< The effective layer thickness at v-points [H ~> m or kg m-2]. real, pointer, dimension(:,:) :: a1_shelf_u => NULL() !< The u-momentum coupling coefficient under - !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves. + !! ice shelves [H T-1 ~> m s-1 or Pa s m-1]. Retained to determine stress under shelves. real, pointer, dimension(:,:) :: a1_shelf_v => NULL() !< The v-momentum coupling coefficient under - !! ice shelves [Z T-1 ~> m s-1]. Retained to determine stress under shelves. + !! ice shelves [H T-1 ~> m s-1 or Pa s m-1]. Retained to determine stress under shelves. logical :: split !< If true, use the split time stepping scheme. logical :: bottomdraglaw !< If true, the bottom stress is calculated with a @@ -158,7 +159,7 @@ module MOM_vert_friction type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the !! timing of diagnostic output. - real, allocatable, dimension(:,:) :: kappa_gl90_2d !< 2D kappa_gl90 at h-points [L2 T-1 ~> m2 s-1] + real, allocatable, dimension(:,:) :: kappa_gl90_2d !< 2D kappa_gl90 at h-points [L2 H Z-1 T-1 ~> m2 s-1 or Pa s] !>@{ Diagnostic identifiers integer :: id_du_dt_visc = -1, id_dv_dt_visc = -1, id_du_dt_visc_gl90 = -1, id_dv_dt_visc_gl90 = -1 @@ -206,8 +207,8 @@ module MOM_vert_friction subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, VarMix, work_on_u) type(ocean_grid_type), intent(in) :: G !< Grid structure. type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure. - real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Layer thickness used at a velocity - !! grid point [H ~> m or kg m-2]. + real, dimension(SZIB_(G),SZK_(GV)), intent(in) :: hvel !< Distance between interfaces + !! at velocity points [Z ~> m] logical, dimension(SZIB_(G)), intent(in) :: do_i !< If true, determine coupling coefficient !! for a column real, dimension(SZIB_(G),SZK_(GV)+1), intent(in) :: z_i !< Estimate of interface heights above the @@ -215,7 +216,7 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va !! boundary layer thickness [nondim] real, dimension(SZIB_(G),SZK_(GV)+1), intent(inout) :: a_cpl_gl90 !< Coupling coefficient associated !! with GL90 across interfaces; is not - !! included in a_cpl [Z T-1 ~> m s-1]. + !! included in a_cpl [H T-1 ~> m s-1 or Pa s m-1]. integer, intent(in) :: j !< j-index to find coupling coefficient for type(vertvisc_cs), pointer :: CS !< Vertical viscosity control structure type(VarMix_CS), intent(in) :: VarMix !< Variable mixing coefficients @@ -223,23 +224,19 @@ subroutine find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i, j, G, GV, CS, Va !! otherwise they are v-points. ! local variables - logical :: kdgl90_use_ebt_struct - integer :: i, k, is, ie, nz, Isq, Ieq - real :: f2 !< Squared Coriolis parameter at a - !! velocity grid point [T-2 ~> s-2]. - real :: h_neglect ! A thickness that is so small - !! it is usually lost in roundoff error - !! and can be neglected [H ~> m or kg m-2]. - real :: botfn ! A function that is 1 at the bottom - !! and small far from it [nondim] - real :: z2 ! The distance from the bottom, - !! normalized by Hbbl_gl90 [nondim] + logical :: kdgl90_use_ebt_struct + integer :: i, k, is, ie, nz, Isq, Ieq + real :: f2 !< Squared Coriolis parameter at a velocity grid point [T-2 ~> s-2]. + real :: h_neglect ! A vertical distance that is so small it is usually lost in roundoff error + ! and can be neglected [Z ~> m]. + real :: botfn ! A function that is 1 at the bottom and small far from it [nondim] + real :: z2 ! The distance from the bottom, normalized by Hbbl_gl90 [nondim] is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB nz = GV%ke - h_neglect = GV%H_subroundoff + h_neglect = GV%dZ_subroundoff kdgl90_use_ebt_struct = .false. if (VarMix%use_variable_mixing) then kdgl90_use_ebt_struct = VarMix%kdgl90_use_ebt_struct @@ -348,7 +345,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. - real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. + real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [H T-1 ~> m s-1 or Pa s m-1] real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. real :: Hmix ! The mixed layer thickness over which stress @@ -356,8 +353,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & real :: I_Hmix ! The inverse of Hmix [H-1 ~> m-1 or m2 kg-1]. real :: Idt ! The inverse of the time step [T-1 ~> s-1]. real :: dt_Rho0 ! The time step divided by the mean density [T H Z-1 R-1 ~> s m3 kg-1 or s]. - real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness - [T H Z-1 ~> s or s kg m-3]. real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. @@ -402,7 +397,6 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & I_Hmix = 1.0 / Hmix endif dt_Rho0 = dt / GV%H_to_RZ - dt_Z_to_H = dt*GV%Z_to_H h_neglect = GV%H_subroundoff Idt = 1.0 / dt @@ -473,9 +467,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! and the superdiagonal as c_k. The right-hand side terms are d_k. ! ! ignoring the Rayleigh drag contribution, - ! we have a_k = -dt_Z_to_H * a_u(k) - ! b_k = h_u(k) + dt_Z_to_H * (a_u(k) + a_u(k+1)) - ! c_k = -dt_Z_to_H * a_u(k+1) + ! we have a_k = -dt * a_u(k) + ! b_k = h_u(k) + dt * (a_u(k) + a_u(k+1)) + ! c_k = -dt * a_u(k+1) ! ! for forward elimination, we want to: ! calculate c'_k = - c_k / (b_k + a_k c'_(k-1)) @@ -494,23 +488,23 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! and the right-hand-side is destructively updated to be d'_k ! do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) - b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) + b_denom_1 = CS%h_u(I,j,1) + dt * (Ray(I,1) + CS%a_u(I,j,1)) + b1(I) = 1.0 / (b_denom_1 + dt*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) u(I,j,1) = b1(I) * (CS%h_u(I,j,1) * u(I,j,1) + surface_stress(I)) if (associated(ADp%du_dt_str)) & ADp%du_dt_str(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_str(I,j,1) + surface_stress(I)*Idt) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K) * b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1)) + c1(I,k) = dt * CS%a_u(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt * CS%a_u(I,j,K+1)) d1(I) = b_denom_1 * b1(I) u(I,j,k) = (CS%h_u(I,j,k) * u(I,j,k) + & - dt_Z_to_H * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) + dt * CS%a_u(I,j,K) * u(I,j,k-1)) * b1(I) if (associated(ADp%du_dt_str)) & ADp%du_dt_str(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_str(I,j,k) + & - dt_Z_to_H * CS%a_u(I,j,K) * ADp%du_dt_str(I,j,k-1)) * b1(I) + dt * CS%a_u(I,j,K) * ADp%du_dt_str(I,j,k-1)) * b1(I) endif ; enddo ; enddo ! back substitute to solve for the new velocities @@ -534,17 +528,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (associated(ADp%du_dt_visc_gl90)) then do I=Isq,Ieq ; if (do_i(I)) then b_denom_1 = CS%h_u(I,j,1) ! CS%a_u_gl90(I,j,1) is zero - b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u_gl90(I,j,2)) + b1(I) = 1.0 / (b_denom_1 + dt*CS%a_u_gl90(I,j,2)) d1(I) = b_denom_1 * b1(I) ADp%du_dt_visc_gl90(I,j,1) = b1(I) * (CS%h_u(I,j,1) * ADp%du_dt_visc_gl90(I,j,1)) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_Z_to_H * CS%a_u_gl90(I,j,K) * b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (CS%a_u_gl90(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u_gl90(I,j,K+1)) + c1(I,k) = dt * CS%a_u_gl90(I,j,K) * b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt * (CS%a_u_gl90(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt * CS%a_u_gl90(I,j,K+1)) d1(I) = b_denom_1 * b1(I) ADp%du_dt_visc_gl90(I,j,k) = (CS%h_u(I,j,k) * ADp%du_dt_visc_gl90(I,j,k) + & - dt_Z_to_H * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I) + dt * CS%a_u_gl90(I,j,K) * ADp%du_dt_visc_gl90(I,j,k-1)) * b1(I) endif ; enddo ; enddo ! back substitute to solve for new velocities, held by ADp%du_dt_visc_gl90 do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then @@ -573,15 +567,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (allocated(visc%taux_shelf)) then ; do I=Isq,Ieq - visc%taux_shelf(I,j) = -GV%Rho0*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? + visc%taux_shelf(I,j) = -GV%H_to_RZ*CS%a1_shelf_u(I,j)*u(I,j,1) ! - u_shelf? enddo ; endif if (PRESENT(taux_bot)) then do I=Isq,Ieq - taux_bot(I,j) = GV%Rho0 * (u(I,j,nz)*CS%a_u(I,j,nz+1)) + taux_bot(I,j) = GV%H_to_RZ * (u(I,j,nz)*CS%a_u(I,j,nz+1)) enddo if (allocated(visc%Ray_u)) then ; do k=1,nz ; do I=Isq,Ieq - taux_bot(I,j) = taux_bot(I,j) + GV%Rho0 * (Ray(I,k)*u(I,j,k)) + taux_bot(I,j) = taux_bot(I,j) + GV%H_to_RZ * (Ray(I,k)*u(I,j,k)) enddo ; enddo ; endif endif @@ -640,22 +634,22 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1)) - b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) + b_denom_1 = CS%h_v(i,J,1) + dt * (Ray(i,1) + CS%a_v(i,J,1)) + b1(i) = 1.0 / (b_denom_1 + dt*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) v(i,J,1) = b1(i) * (CS%h_v(i,J,1) * v(i,J,1) + surface_stress(i)) if (associated(ADp%dv_dt_str)) & ADp%dv_dt_str(i,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_str(i,J,1) + surface_stress(i)*Idt) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K) * b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) + c1(i,k) = dt * CS%a_v(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) - v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) + v(i,J,k) = (CS%h_v(i,J,k) * v(i,J,k) + dt * CS%a_v(i,J,K) * v(i,J,k-1)) * b1(i) if (associated(ADp%dv_dt_str)) & ADp%dv_dt_str(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_str(i,J,k) + & - dt_Z_to_H * CS%a_v(i,J,K) * ADp%dv_dt_str(i,J,k-1)) * b1(i) + dt * CS%a_v(i,J,K) * ADp%dv_dt_str(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then v(i,J,k) = v(i,J,k) + c1(i,k+1) * v(i,J,k+1) @@ -676,17 +670,17 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & if (associated(ADp%dv_dt_visc_gl90)) then do i=is,ie ; if (do_i(i)) then b_denom_1 = CS%h_v(i,J,1) ! CS%a_v_gl90(i,J,1) is zero - b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v_gl90(i,J,2)) + b1(i) = 1.0 / (b_denom_1 + dt*CS%a_v_gl90(i,J,2)) d1(i) = b_denom_1 * b1(i) ADp%dv_dt_visc_gl90(I,J,1) = b1(i) * (CS%h_v(i,J,1) * ADp%dv_dt_visc_gl90(i,J,1)) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_Z_to_H * CS%a_v_gl90(i,J,K) * b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (CS%a_v_gl90(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v_gl90(i,J,K+1)) + c1(i,k) = dt * CS%a_v_gl90(i,J,K) * b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt * (CS%a_v_gl90(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt * CS%a_v_gl90(i,J,K+1)) d1(i) = b_denom_1 * b1(i) ADp%dv_dt_visc_gl90(i,J,k) = (CS%h_v(i,J,k) * ADp%dv_dt_visc_gl90(i,J,k) + & - dt_Z_to_H * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i) + dt * CS%a_v_gl90(i,J,K) * ADp%dv_dt_visc_gl90(i,J,k-1)) * b1(i) endif ; enddo ; enddo ! back substitute to solve for new velocities, held by ADp%dv_dt_visc_gl90 do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then @@ -716,15 +710,15 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & enddo ; enddo ; endif if (allocated(visc%tauy_shelf)) then ; do i=is,ie - visc%tauy_shelf(i,J) = -GV%Rho0*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? + visc%tauy_shelf(i,J) = -GV%H_to_RZ*CS%a1_shelf_v(i,J)*v(i,J,1) ! - v_shelf? enddo ; endif if (present(tauy_bot)) then do i=is,ie - tauy_bot(i,J) = GV%Rho0 * (v(i,J,nz)*CS%a_v(i,J,nz+1)) + tauy_bot(i,J) = GV%H_to_RZ * (v(i,J,nz)*CS%a_v(i,J,nz+1)) enddo if (allocated(visc%Ray_v)) then ; do k=1,nz ; do i=is,ie - tauy_bot(i,J) = tauy_bot(i,J) + GV%Rho0 * (Ray(i,k)*v(i,J,k)) + tauy_bot(i,J) = tauy_bot(i,J) + GV%H_to_RZ * (Ray(i,k)*v(i,J,k)) enddo ; enddo ; endif endif @@ -851,10 +845,8 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) real :: b1(SZIB_(G)) ! A variable used by the tridiagonal solver [H-1 ~> m-1 or m2 kg-1]. real :: c1(SZIB_(G),SZK_(GV)) ! A variable used by the tridiagonal solver [nondim]. real :: d1(SZIB_(G)) ! d1=1-c1 is used by the tridiagonal solver [nondim]. - real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [Z T-1 ~> m s-1]. + real :: Ray(SZIB_(G),SZK_(GV)) ! Ray is the Rayleigh-drag velocity [H T-1 ~> m s-1 or Pa s m-1] real :: b_denom_1 ! The first term in the denominator of b1 [H ~> m or kg m-2]. - real :: dt_Z_to_H ! The time step times the conversion from Z to the - ! units of thickness [T H Z-1 ~> s or s kg m-3]. logical :: do_i(SZIB_(G)) integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz @@ -867,8 +859,6 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) if (.not.CS%initialized) call MOM_error(FATAL,"MOM_vert_friction(remant): "// & "Module must be initialized before it is used.") - dt_Z_to_H = dt*GV%Z_to_H - do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo ! Find the zonal viscous remnant using a modification of a standard tridagonal solver. @@ -881,17 +871,17 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) enddo ; enddo ; endif do I=Isq,Ieq ; if (do_i(I)) then - b_denom_1 = CS%h_u(I,j,1) + dt_Z_to_H * (Ray(I,1) + CS%a_u(I,j,1)) - b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_u(I,j,2)) + b_denom_1 = CS%h_u(I,j,1) + dt * (Ray(I,1) + CS%a_u(I,j,1)) + b1(I) = 1.0 / (b_denom_1 + dt*CS%a_u(I,j,2)) d1(I) = b_denom_1 * b1(I) visc_rem_u(I,j,1) = b1(I) * CS%h_u(I,j,1) endif ; enddo do k=2,nz ; do I=Isq,Ieq ; if (do_i(I)) then - c1(I,k) = dt_Z_to_H * CS%a_u(I,j,K)*b1(I) - b_denom_1 = CS%h_u(I,j,k) + dt_Z_to_H * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) - b1(I) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_u(I,j,K+1)) + c1(I,k) = dt * CS%a_u(I,j,K)*b1(I) + b_denom_1 = CS%h_u(I,j,k) + dt * (Ray(I,k) + CS%a_u(I,j,K)*d1(I)) + b1(I) = 1.0 / (b_denom_1 + dt * CS%a_u(I,j,K+1)) d1(I) = b_denom_1 * b1(I) - visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt_Z_to_H * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I) + visc_rem_u(I,j,k) = (CS%h_u(I,j,k) + dt * CS%a_u(I,j,K) * visc_rem_u(I,j,k-1)) * b1(I) endif ; enddo ; enddo do k=nz-1,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then visc_rem_u(I,j,k) = visc_rem_u(I,j,k) + c1(I,k+1)*visc_rem_u(I,j,k+1) @@ -910,17 +900,17 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, US, CS) enddo ; enddo ; endif do i=is,ie ; if (do_i(i)) then - b_denom_1 = CS%h_v(i,J,1) + dt_Z_to_H * (Ray(i,1) + CS%a_v(i,J,1)) - b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H*CS%a_v(i,J,2)) + b_denom_1 = CS%h_v(i,J,1) + dt * (Ray(i,1) + CS%a_v(i,J,1)) + b1(i) = 1.0 / (b_denom_1 + dt*CS%a_v(i,J,2)) d1(i) = b_denom_1 * b1(i) visc_rem_v(i,J,1) = b1(i) * CS%h_v(i,J,1) endif ; enddo do k=2,nz ; do i=is,ie ; if (do_i(i)) then - c1(i,k) = dt_Z_to_H * CS%a_v(i,J,K)*b1(i) - b_denom_1 = CS%h_v(i,J,k) + dt_Z_to_H * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) - b1(i) = 1.0 / (b_denom_1 + dt_Z_to_H * CS%a_v(i,J,K+1)) + c1(i,k) = dt * CS%a_v(i,J,K)*b1(i) + b_denom_1 = CS%h_v(i,J,k) + dt * (Ray(i,k) + CS%a_v(i,J,K)*d1(i)) + b1(i) = 1.0 / (b_denom_1 + dt * CS%a_v(i,J,K+1)) d1(i) = b_denom_1 * b1(i) - visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt_Z_to_H * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) + visc_rem_v(i,J,k) = (CS%h_v(i,J,k) + dt * CS%a_v(i,J,K) * visc_rem_v(i,J,k-1)) * b1(i) endif ; enddo ; enddo do k=nz-1,1,-1 ; do i=is,ie ; if (do_i(i)) then visc_rem_v(i,J,k) = visc_rem_v(i,J,k) + c1(i,k+1)*visc_rem_v(i,J,k+1) @@ -970,52 +960,65 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, h_arith, & ! The arithmetic mean thickness [H ~> m or kg m-2]. h_delta, & ! The lateral difference of thickness [H ~> m or kg m-2]. hvel, & ! hvel is the thickness used at a velocity grid point [H ~> m or kg m-2]. - hvel_shelf ! The equivalent of hvel under shelves [H ~> m or kg m-2]. + hvel_shelf, & ! The equivalent of hvel under shelves [H ~> m or kg m-2]. + dz_harm, & ! Harmonic mean of the vertical distances around a velocity grid point, + ! given by 2*(h+ * h-)/(h+ + h-) [Z ~> m]. + dz_arith, & ! The arithmetic mean of the vertical distances around a velocity grid point [Z ~> m] + dz_vel, & ! The vertical distance between interfaces used at a velocity grid point [Z ~> m]. + dz_vel_shelf ! The equivalent of dz_vel under shelves [Z ~> m]. real, dimension(SZIB_(G),SZK_(GV)+1) :: & - a_cpl, & ! The drag coefficients across interfaces [Z T-1 ~> m s-1]. a_cpl times + a_cpl, & ! The drag coefficients across interfaces [H T-1 ~> m s-1 or Pa s m-1]. a_cpl times ! the velocity difference gives the stress across an interface. - a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [Z T-1 ~> m s-1]. + a_cpl_gl90, & ! The drag coefficients across interfaces associated with GL90 [H T-1 ~> m s-1 or Pa s m-1]. ! a_cpl_gl90 times the velocity difference gives the GL90 stress across an interface. ! a_cpl_gl90 is part of a_cpl. a_shelf, & ! The drag coefficients across interfaces in water columns under - ! ice shelves [Z T-1 ~> m s-1]. + ! ice shelves [H T-1 ~> m s-1 or Pa s m-1]. z_i, & ! An estimate of each interface's height above the bottom, ! normalized by the bottom boundary layer thickness [nondim] z_i_gl90 ! An estimate of each interface's height above the bottom, ! normalized by the GL90 bottom boundary layer thickness [nondim] real, dimension(SZIB_(G)) :: & - kv_bbl, & ! The bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. - bbl_thick, & ! The bottom boundary layer thickness [H ~> m or kg m-2]. - I_Hbbl, & ! The inverse of the bottom boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. + kv_bbl, & ! The bottom boundary layer viscosity [H Z T-1 ~> m2 s-1 or Pa s]. + bbl_thick, & ! The bottom boundary layer thickness [Z ~> m]. + I_Hbbl, & ! The inverse of the bottom boundary layer thickness [Z-1 ~> m-1]. I_Hbbl_gl90, &! The inverse of the bottom boundary layer thickness used for the GL90 scheme - ! [H-1 ~> m-1 or m2 kg-1]. - I_Htbl, & ! The inverse of the top boundary layer thickness [H-1 ~> m-1 or m2 kg-1]. - zcol1, & ! The height of the interfaces to the south of a v-point [H ~> m or kg m-2]. - zcol2, & ! The height of the interfaces to the north of a v-point [H ~> m or kg m-2]. - Ztop_min, & ! The deeper of the two adjacent surface heights [H ~> m or kg m-2]. - Dmin, & ! The shallower of the two adjacent bottom depths converted to - ! thickness units [H ~> m or kg m-2]. + ! [Z-1 ~> m-1]. + I_HTbl, & ! The inverse of the top boundary layer thickness [Z-1 ~> m-1]. + zcol1, & ! The height of the interfaces to the south of a v-point [Z ~> m]. + zcol2, & ! The height of the interfaces to the north of a v-point [Z ~> m]. + Ztop_min, & ! The deeper of the two adjacent surface heights [Z ~> m]. + Dmin, & ! The shallower of the two adjacent bottom depths [Z ~> m]. zh, & ! An estimate of the interface's distance from the bottom - ! based on harmonic mean thicknesses [H ~> m or kg m-2]. - h_ml ! The mixed layer depth [H ~> m or kg m-2]. - real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points [H ~> m or kg m-2]. - real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [H ~> m or kg m-2]. - real, allocatable, dimension(:,:,:) :: Kv_u !< Total vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv_gl90_u !< GL90 vertical viscosity at u-points [Z2 T-1 ~> m2 s-1]. - real, allocatable, dimension(:,:,:) :: Kv_gl90_v !< GL90 vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. - real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. + ! based on harmonic mean thicknesses [Z ~> m]. + h_ml ! The mixed layer depth [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G)) :: & + Ustar_2d ! The wind friction velocity, calculated using the Boussinesq reference density or + ! the time-evolving surface density in non-Boussinesq mode [Z T-1 ~> m s-1] + real, allocatable, dimension(:,:) :: hML_u ! Diagnostic of the mixed layer depth at u points [Z ~> m]. + real, allocatable, dimension(:,:) :: hML_v ! Diagnostic of the mixed layer depth at v points [Z ~> m]. + real, allocatable, dimension(:,:,:) :: Kv_u ! Total vertical viscosity at u-points in + ! thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_v ! Total vertical viscosity at v-points in + ! thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_gl90_u ! GL90 vertical viscosity at u-points in + ! thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1]. + real, allocatable, dimension(:,:,:) :: Kv_gl90_v ! GL90 vertical viscosity at v-points in + ! thickness-based units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1]. + real :: zcol(SZI_(G)) ! The height of an interface at h-points [Z ~> m]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more ! than Hbbl into the interior [nondim]. real :: topfn ! A function which goes from 1 at the top to 0 much more ! than Htbl into the interior [nondim]. real :: z2 ! The distance from the bottom, normalized by Hbbl [nondim] real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2 [nondim]. - real :: z_clear ! The clearance of an interface above the surrounding topography [H ~> m or kg m-2]. + real :: z_clear ! The clearance of an interface above the surrounding topography [Z ~> m]. real :: a_cpl_max ! The maximum drag coefficient across interfaces, set so that it will be - ! representable as a 32-bit float in MKS units [Z T-1 ~> m s-1] + ! representable as a 32-bit float in MKS units [H T-1 ~> m s-1 or Pa s m-1] real :: h_neglect ! A thickness that is so small it is usually lost ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: dz_neglect ! A vertical distance that is so small it is usually lost + ! in roundoff and can be neglected [Z ~> m]. real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum @@ -1036,10 +1039,11 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, "Module must be initialized before it is used.") h_neglect = GV%H_subroundoff - a_cpl_max = 1.0e37 * US%m_to_Z * US%T_to_s - I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) + dz_neglect = GV%dZ_subroundoff + a_cpl_max = 1.0e37 * GV%m_to_H * US%T_to_s + I_Hbbl(:) = 1.0 / (CS%Hbbl + dz_neglect) if (CS%use_GL90_in_SSW) then - I_Hbbl_gl90 = 1.0 / (CS%Hbbl_gl90 + h_neglect) + I_Hbbl_gl90(:) = 1.0 / (CS%Hbbl_gl90 + dz_neglect) endif I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val @@ -1063,15 +1067,18 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) endif - !$OMP parallel do default(private) shared(G,GV,US,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & - !$OMP OBC,h_neglect,dt,I_valBL,Kv_u,a_cpl_max) & - !$OMP firstprivate(i_hbbl) + call find_ustar(forces, tv, Ustar_2d, G, GV, US, halo=1) + + !$OMP parallel do default(private) shared(G,GV,US,CS,tv,visc,OBC,Isq,Ieq,nz,u,h,dz,forces, & + !$OMP Ustar_2d,h_neglect,dz_neglect,dt,I_valBL,hML_u,Kv_u, & + !$OMP a_cpl_max,I_Hbbl_gl90,Kv_gl90_u) & + !$OMP firstprivate(I_Hbbl) do j=G%Jsc,G%Jec do I=Isq,Ieq ; do_i(I) = (G%mask2dCu(I,j) > 0.0) ; enddo if (CS%bottomdraglaw) then ; do I=Isq,Ieq kv_bbl(I) = visc%Kv_bbl_u(I,j) - bbl_thick(I) = visc%bbl_thick_u(I,j) * GV%Z_to_H + h_neglect + bbl_thick(I) = visc%bbl_thick_u(I,j) + dz_neglect if (do_i(I)) I_Hbbl(I) = 1.0 / bbl_thick(I) enddo ; endif @@ -1079,9 +1086,11 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, h_harm(I,k) = 2.0*h(i,j,k)*h(i+1,j,k) / (h(i,j,k)+h(i+1,j,k)+h_neglect) h_arith(I,k) = 0.5*(h(i+1,j,k)+h(i,j,k)) h_delta(I,k) = h(i+1,j,k) - h(i,j,k) + dz_harm(I,k) = 2.0*dz(i,j,k)*dz(i+1,j,k) / (dz(i,j,k)+dz(i+1,j,k)+dz_neglect) + dz_arith(I,k) = 0.5*(dz(i+1,j,k)+dz(i,j,k)) endif ; enddo ; enddo do I=Isq,Ieq - Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) * GV%Z_to_H + Dmin(I) = min(G%bathyT(i,j), G%bathyT(i+1,j)) zi_dir(I) = 0 enddo @@ -1089,19 +1098,25 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, if (associated(OBC)) then ; if (OBC%number_of_segments > 0) then do I=Isq,Ieq ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then - do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * GV%Z_to_H + do k=1,nz + h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(I,k) = 0. + dz_harm(I,k) = dz(i,j,k) ; dz_arith(I,k) = dz(i,j,k) + enddo + Dmin(I) = G%bathyT(i,j) zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then - do k=1,nz ; h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. ; enddo - Dmin(I) = G%bathyT(i+1,j) * GV%Z_to_H + do k=1,nz + h_harm(I,k) = h(i+1,j,k) ; h_arith(I,k) = h(i+1,j,k) ; h_delta(I,k) = 0. + dz_harm(I,k) = dz(i+1,j,k) ; dz_arith(I,k) = dz(i+1,j,k) + enddo + Dmin(I) = G%bathyT(i+1,j) zi_dir(I) = 1 endif endif ; enddo endif ; endif ! The following block calculates the thicknesses at velocity -! grid points for the vertical viscosity (hvel). Near the +! grid points for the vertical viscosity (hvel and dz_vel). Near the ! bottom an upwind biased thickness is used to control the effect ! of spurious Montgomery potential gradients at the bottom where ! nearly massless layers layers ride over the topography. @@ -1109,19 +1124,21 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, do I=Isq,Ieq ; z_i(I,nz+1) = 0.0 ; enddo do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then hvel(I,k) = h_harm(I,k) + dz_vel(I,k) = dz_harm(I,k) if (u(I,j,k) * h_delta(I,k) < 0) then z2 = z_i(I,k+1) ; botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) hvel(I,k) = (1.0-botfn)*h_harm(I,k) + botfn*h_arith(I,k) + dz_vel(I,k) = (1.0-botfn)*dz_harm(I,k) + botfn*dz_arith(I,k) endif - z_i(I,k) = z_i(I,k+1) + h_harm(I,k)*I_Hbbl(I) + z_i(I,k) = z_i(I,k+1) + dz_harm(I,k)*I_Hbbl(I) endif ; enddo ; enddo ! i & k loops else ! Not harmonic_visc do I=Isq,Ieq ; zh(I) = 0.0 ; z_i(I,nz+1) = 0.0 ; enddo - do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) * GV%Z_to_H ; enddo + do i=Isq,Ieq+1 ; zcol(i) = -G%bathyT(i,j) ; enddo do k=nz,1,-1 - do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + h(i,j,k) ; enddo + do i=Isq,Ieq+1 ; zcol(i) = zcol(i) + dz(i,j,k) ; enddo do I=Isq,Ieq ; if (do_i(I)) then - zh(I) = zh(I) + h_harm(I,k) + zh(I) = zh(I) + dz_harm(I,k) z_clear = max(zcol(i),zcol(i+1)) + Dmin(I) if (zi_dir(I) < 0) z_clear = zcol(i) + Dmin(I) @@ -1130,15 +1147,18 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, z_i(I,k) = max(zh(I), z_clear) * I_Hbbl(I) hvel(I,k) = h_arith(I,k) + dz_vel(I,k) = dz_arith(I,k) if (u(I,j,k) * h_delta(I,k) > 0) then if (zh(I) * I_Hbbl(I) < CS%harm_BL_val) then hvel(I,k) = h_harm(I,k) + dz_vel(I,k) = dz_harm(I,k) else z2_wt = 1.0 ; if (zh(I) * I_Hbbl(I) < 2.0*CS%harm_BL_val) & z2_wt = max(0.0, min(1.0, zh(I) * I_Hbbl(I) * I_valBL - 1.0)) z2 = z2_wt * (max(zh(I), z_clear) * I_Hbbl(I)) botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) hvel(I,k) = (1.0-botfn)*h_arith(I,k) + botfn*h_harm(I,k) + dz_vel(I,k) = (1.0-botfn)*dz_arith(I,k) + botfn*dz_harm(I,k) endif endif @@ -1146,8 +1166,8 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, enddo ! k loop endif - call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, work_on_u=.true., OBC=OBC) + call find_coupling_coef(a_cpl, dz_vel, do_i, dz_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, Ustar_2d, tv, work_on_u=.true., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then ! The following block calculates the normalized height above the GL90 @@ -1160,9 +1180,9 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, ! over topography, small enough to not contaminate the interior. do I=Isq,Ieq ; z_i_gl90(I,nz+1) = 0.0 ; enddo do k=nz,1,-1 ; do I=Isq,Ieq ; if (do_i(I)) then - z_i_gl90(I,k) = z_i_gl90(I,k+1) + h_harm(I,k)*I_Hbbl_gl90(I) + z_i_gl90(I,k) = z_i_gl90(I,k+1) + dz_harm(I,k)*I_Hbbl_gl90(I) endif ; enddo ; enddo ! i & k loops - call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.) + call find_coupling_coef_gl90(a_cpl_gl90, dz_vel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.true.) endif if (allocated(hML_u)) then @@ -1178,35 +1198,39 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, enddo if (do_any_shelf) then if (CS%harmonic_visc) then - do k=1,nz ; do I=Isq,Ieq ; hvel_shelf(I,k) = hvel(I,k) ; enddo ; enddo + do k=1,nz ; do I=Isq,Ieq + hvel_shelf(I,k) = hvel(I,k) ; dz_vel_shelf(I,k) = dz_vel(I,k) + enddo ; enddo else ! Find upwind-biased thickness near the surface. ! Perhaps this needs to be done more carefully, via find_eta. do I=Isq,Ieq ; if (do_i_shelf(I)) then zh(I) = 0.0 ; Ztop_min(I) = min(zcol(i), zcol(i+1)) - I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j)*GV%Z_to_H + h_neglect) + I_HTbl(I) = 1.0 / (visc%tbl_thick_shelf_u(I,j) + dz_neglect) endif ; enddo do k=1,nz - do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - h(i,j,k) ; enddo + do i=Isq,Ieq+1 ; zcol(i) = zcol(i) - dz(i,j,k) ; enddo do I=Isq,Ieq ; if (do_i_shelf(I)) then - zh(I) = zh(I) + h_harm(I,k) + zh(I) = zh(I) + dz_harm(I,k) - hvel_shelf(I,k) = hvel(I,k) + hvel_shelf(I,k) = hvel(I,k) ; dz_vel_shelf(I,k) = dz_vel(I,k) if (u(I,j,k) * h_delta(I,k) > 0) then if (zh(I) * I_HTbl(I) < CS%harm_BL_val) then hvel_shelf(I,k) = min(hvel(I,k), h_harm(I,k)) + dz_vel_shelf(I,k) = min(dz_vel(I,k), dz_harm(I,k)) else z2_wt = 1.0 ; if (zh(I) * I_HTbl(I) < 2.0*CS%harm_BL_val) & z2_wt = max(0.0, min(1.0, zh(I) * I_HTbl(I) * I_valBL - 1.0)) z2 = z2_wt * (max(zh(I), Ztop_min(I) - min(zcol(i),zcol(i+1))) * I_HTbl(I)) topfn = 1.0 / (1.0 + 0.09*z2**6) hvel_shelf(I,k) = min(hvel(I,k), (1.0-topfn)*h_arith(I,k) + topfn*h_harm(I,k)) + dz_vel_shelf(I,k) = min(dz_vel(I,k), (1.0-topfn)*dz_arith(I,k) + topfn*dz_harm(I,k)) endif endif endif ; enddo enddo endif - call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & - kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, & + call find_coupling_coef(a_shelf, dz_vel_shelf, do_i_shelf, dz_harm, bbl_thick, & + kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, Ustar_2d, tv, & work_on_u=.true., OBC=OBC, shelf=.true.) do I=Isq,Ieq ; if (do_i_shelf(I)) CS%a1_shelf_u(I,j) = a_shelf(I,1) ; enddo endif @@ -1232,10 +1256,10 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, endif ; enddo ; enddo else do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then - CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) + CS%a_u(I,j,K) = min(a_cpl_max, a_cpl(I,K) + a_cpl_gl90(I,K)) endif; enddo ; enddo do K=1,nz+1 ; do I=Isq,Ieq ; if (do_i(I)) then - CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) + CS%a_u_gl90(I,j,K) = min(a_cpl_max, a_cpl_gl90(I,K)) endif; enddo ; enddo do k=1,nz ; do I=Isq,Ieq ; if (do_i(I)) CS%h_u(I,j,k) = hvel(I,k) + h_neglect ; enddo ; enddo endif @@ -1243,28 +1267,29 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, ! Diagnose total Kv at u-points if (CS%id_Kv_u > 0) then do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) Kv_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) + if (do_i(I)) Kv_u(I,j,k) = 0.5 * (CS%a_u(I,j,K)+CS%a_u(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif ! Diagnose GL90 Kv at u-points if (CS%id_Kv_gl90_u > 0) then do k=1,nz ; do I=Isq,Ieq - if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * GV%H_to_Z*(CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k) + if (do_i(I)) Kv_gl90_u(I,j,k) = 0.5 * (CS%a_u_gl90(I,j,K)+CS%a_u_gl90(I,j,K+1)) * CS%h_u(I,j,k) enddo ; enddo endif enddo ! Now work on v-points. - !$OMP parallel do default(private) shared(G,GV,CS,US,visc,is,ie,Jsq,Jeq,nz,v,h,forces,hML_v, & - !$OMP OBC,h_neglect,dt,I_valBL,Kv_v,a_cpl_max) & - !$OMP firstprivate(i_hbbl) + !$OMP parallel do default(private) shared(G,GV,US,CS,tv,OBC,visc,is,ie,Jsq,Jeq,nz,v,h,dz,forces, & + !$OMP Ustar_2d,h_neglect,dz_neglect,dt,I_valBL,hML_v,Kv_v, & + !$OMP a_cpl_max,I_Hbbl_gl90,Kv_gl90_v) & + !$OMP firstprivate(I_Hbbl) do J=Jsq,Jeq do i=is,ie ; do_i(i) = (G%mask2dCv(i,J) > 0.0) ; enddo if (CS%bottomdraglaw) then ; do i=is,ie kv_bbl(i) = visc%Kv_bbl_v(i,J) - bbl_thick(i) = visc%bbl_thick_v(i,J) * GV%Z_to_H + h_neglect + bbl_thick(i) = visc%bbl_thick_v(i,J) + dz_neglect if (do_i(i)) I_Hbbl(i) = 1.0 / bbl_thick(i) enddo ; endif @@ -1272,9 +1297,11 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, h_harm(i,k) = 2.0*h(i,j,k)*h(i,j+1,k) / (h(i,j,k)+h(i,j+1,k)+h_neglect) h_arith(i,k) = 0.5*(h(i,j+1,k)+h(i,j,k)) h_delta(i,k) = h(i,j+1,k) - h(i,j,k) + dz_harm(i,k) = 2.0*dz(i,j,k)*dz(i,j+1,k) / (dz(i,j,k)+dz(i,j+1,k)+dz_neglect) + dz_arith(i,k) = 0.5*(dz(i,j+1,k)+dz(i,j,k)) endif ; enddo ; enddo do i=is,ie - Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) * GV%Z_to_H + Dmin(i) = min(G%bathyT(i,j), G%bathyT(i,j+1)) zi_dir(i) = 0 enddo @@ -1282,12 +1309,18 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, if (associated(OBC)) then ; if (OBC%number_of_segments > 0) then do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then - do k=1,nz ; h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. ; enddo - Dmin(I) = G%bathyT(i,j) * GV%Z_to_H + do k=1,nz + h_harm(I,k) = h(i,j,k) ; h_arith(I,k) = h(i,j,k) ; h_delta(i,k) = 0. + dz_harm(I,k) = dz(i,j,k) ; dz_arith(I,k) = dz(i,j,k) + enddo + Dmin(I) = G%bathyT(i,j) zi_dir(I) = -1 elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then - do k=1,nz ; h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. ; enddo - Dmin(i) = G%bathyT(i,j+1) * GV%Z_to_H + do k=1,nz + h_harm(i,k) = h(i,j+1,k) ; h_arith(i,k) = h(i,j+1,k) ; h_delta(i,k) = 0. + dz_harm(i,k) = dz(i,j+1,k) ; dz_arith(i,k) = dz(i,j+1,k) + enddo + Dmin(i) = G%bathyT(i,j+1) zi_dir(i) = 1 endif endif ; enddo @@ -1303,21 +1336,23 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then hvel(i,k) = h_harm(i,k) + dz_vel(i,k) = dz_harm(i,k) if (v(i,J,k) * h_delta(i,k) < 0) then z2 = z_i(i,k+1) ; botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) hvel(i,k) = (1.0-botfn)*h_harm(i,k) + botfn*h_arith(i,k) + dz_vel(i,k) = (1.0-botfn)*dz_harm(i,k) + botfn*dz_arith(i,k) endif - z_i(i,k) = z_i(i,k+1) + h_harm(i,k)*I_Hbbl(i) + z_i(i,k) = z_i(i,k+1) + dz_harm(i,k)*I_Hbbl(i) endif ; enddo ; enddo ! i & k loops else ! Not harmonic_visc do i=is,ie zh(i) = 0.0 ; z_i(i,nz+1) = 0.0 - zcol1(i) = -G%bathyT(i,j) * GV%Z_to_H - zcol2(i) = -G%bathyT(i,j+1) * GV%Z_to_H + zcol1(i) = -G%bathyT(i,j) + zcol2(i) = -G%bathyT(i,j+1) enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then - zh(i) = zh(i) + h_harm(i,k) - zcol1(i) = zcol1(i) + h(i,j,k) ; zcol2(i) = zcol2(i) + h(i,j+1,k) + zh(i) = zh(i) + dz_harm(i,k) + zcol1(i) = zcol1(i) + dz(i,j,k) ; zcol2(i) = zcol2(i) + dz(i,j+1,k) z_clear = max(zcol1(i),zcol2(i)) + Dmin(i) if (zi_dir(i) < 0) z_clear = zcol1(i) + Dmin(I) @@ -1326,23 +1361,26 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, z_i(I,k) = max(zh(i), z_clear) * I_Hbbl(i) hvel(i,k) = h_arith(i,k) + dz_vel(i,k) = dz_arith(i,k) if (v(i,J,k) * h_delta(i,k) > 0) then if (zh(i) * I_Hbbl(i) < CS%harm_BL_val) then hvel(i,k) = h_harm(i,k) + dz_vel(i,k) = dz_harm(i,k) else z2_wt = 1.0 ; if (zh(i) * I_Hbbl(i) < 2.0*CS%harm_BL_val) & z2_wt = max(0.0, min(1.0, zh(i) * I_Hbbl(i) * I_valBL - 1.0)) z2 = z2_wt * (max(zh(i), max(zcol1(i),zcol2(i)) + Dmin(i)) * I_Hbbl(i)) botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) hvel(i,k) = (1.0-botfn)*h_arith(i,k) + botfn*h_harm(i,k) + dz_vel(i,k) = (1.0-botfn)*dz_arith(i,k) + botfn*dz_harm(i,k) endif endif endif ; enddo ; enddo ! i & k loops endif - call find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, work_on_u=.false., OBC=OBC) + call find_coupling_coef(a_cpl, dz_vel, do_i, dz_harm, bbl_thick, kv_bbl, z_i, h_ml, & + dt, j, G, GV, US, CS, visc, Ustar_2d, tv, work_on_u=.false., OBC=OBC) a_cpl_gl90(:,:) = 0.0 if (CS%use_GL90_in_SSW) then ! The following block calculates the normalized height above the GL90 @@ -1356,10 +1394,10 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, do i=is,ie ; z_i_gl90(i,nz+1) = 0.0 ; enddo do k=nz,1,-1 ; do i=is,ie ; if (do_i(i)) then - z_i_gl90(i,k) = z_i_gl90(i,k+1) + h_harm(i,k)*I_Hbbl_gl90(i) + z_i_gl90(i,k) = z_i_gl90(i,k+1) + dz_harm(i,k)*I_Hbbl_gl90(i) endif ; enddo ; enddo ! i & k loops - call find_coupling_coef_gl90(a_cpl_gl90, hvel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.) + call find_coupling_coef_gl90(a_cpl_gl90, dz_vel, do_i, z_i_gl90, j, G, GV, CS, VarMix, work_on_u=.false.) endif if ( allocated(hML_v)) then @@ -1374,35 +1412,39 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, enddo if (do_any_shelf) then if (CS%harmonic_visc) then - do k=1,nz ; do i=is,ie ; hvel_shelf(i,k) = hvel(i,k) ; enddo ; enddo + do k=1,nz ; do i=is,ie + hvel_shelf(i,k) = hvel(i,k) ; dz_vel_shelf(i,k) = dz_vel(i,k) + enddo ; enddo else ! Find upwind-biased thickness near the surface. ! Perhaps this needs to be done more carefully, via find_eta. do i=is,ie ; if (do_i_shelf(i)) then zh(i) = 0.0 ; Ztop_min(I) = min(zcol1(i), zcol2(i)) - I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J)*GV%Z_to_H + h_neglect) + I_HTbl(i) = 1.0 / (visc%tbl_thick_shelf_v(i,J) + dz_neglect) endif ; enddo do k=1,nz do i=is,ie ; if (do_i_shelf(i)) then - zcol1(i) = zcol1(i) - h(i,j,k) ; zcol2(i) = zcol2(i) - h(i,j+1,k) - zh(i) = zh(i) + h_harm(i,k) + zcol1(i) = zcol1(i) - dz(i,j,k) ; zcol2(i) = zcol2(i) - dz(i,j+1,k) + zh(i) = zh(i) + dz_harm(i,k) - hvel_shelf(i,k) = hvel(i,k) + hvel_shelf(i,k) = hvel(i,k) ; dz_vel_shelf(i,k) = dz_vel(i,k) if (v(i,J,k) * h_delta(i,k) > 0) then if (zh(i) * I_HTbl(i) < CS%harm_BL_val) then hvel_shelf(i,k) = min(hvel(i,k), h_harm(i,k)) + dz_vel_shelf(i,k) = min(dz_vel(i,k), dz_harm(i,k)) else z2_wt = 1.0 ; if (zh(i) * I_HTbl(i) < 2.0*CS%harm_BL_val) & z2_wt = max(0.0, min(1.0, zh(i) * I_HTbl(i) * I_valBL - 1.0)) z2 = z2_wt * (max(zh(i), Ztop_min(i) - min(zcol1(i),zcol2(i))) * I_HTbl(i)) topfn = 1.0 / (1.0 + 0.09*z2**6) hvel_shelf(i,k) = min(hvel(i,k), (1.0-topfn)*h_arith(i,k) + topfn*h_harm(i,k)) + dz_vel_shelf(i,k) = min(dz_vel(i,k), (1.0-topfn)*dz_arith(i,k) + topfn*dz_harm(i,k)) endif endif endif ; enddo enddo endif - call find_coupling_coef(a_shelf, hvel_shelf, do_i_shelf, h_harm, bbl_thick, & - kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, forces, & + call find_coupling_coef(a_shelf, dz_vel_shelf, do_i_shelf, dz_harm, bbl_thick, & + kv_bbl, z_i, h_ml, dt, j, G, GV, US, CS, visc, Ustar_2d, tv, & work_on_u=.false., OBC=OBC, shelf=.true.) do i=is,ie ; if (do_i_shelf(i)) CS%a1_shelf_v(i,J) = a_shelf(i,1) ; enddo endif @@ -1432,20 +1474,20 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, endif ; enddo ; enddo do K=1,nz+1 ; do i=is,ie ; if (do_i(i)) then CS%a_v_gl90(i,J,K) = min(a_cpl_max, a_cpl_gl90(i,K)) - endif ; enddo ; enddo + endif ; enddo ; enddo do k=1,nz ; do i=is,ie ; if (do_i(i)) CS%h_v(i,J,k) = hvel(i,k) + h_neglect ; enddo ; enddo endif ! Diagnose total Kv at v-points if (CS%id_Kv_v > 0) then do k=1,nz ; do i=is,ie - if (do_i(I)) Kv_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) + if (do_i(I)) Kv_v(i,J,k) = 0.5 * (CS%a_v(i,J,K)+CS%a_v(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif ! Diagnose GL90 Kv at v-points if (CS%id_Kv_gl90_v > 0) then do k=1,nz ; do i=is,ie - if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * GV%H_to_Z*(CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k) + if (do_i(I)) Kv_gl90_v(i,J,k) = 0.5 * (CS%a_v_gl90(i,J,K)+CS%a_v_gl90(i,J,K+1)) * CS%h_v(i,J,k) enddo ; enddo endif enddo ! end of v-point j loop @@ -1454,10 +1496,10 @@ subroutine vertvisc_coef(u, v, h, dz, forces, visc, tv, dt, G, GV, US, CS, OBC, call uvchksum("vertvisc_coef h_[uv]", CS%h_u, CS%h_v, G%HI, haloshift=0, & scale=GV%H_to_m, scalar_pair=.true.) call uvchksum("vertvisc_coef a_[uv]", CS%a_u, CS%a_v, G%HI, haloshift=0, & - scale=US%Z_to_m*US%s_to_T, scalar_pair=.true.) + scale=GV%H_to_m*US%s_to_T, scalar_pair=.true.) if (allocated(hML_u) .and. allocated(hML_v)) & call uvchksum("vertvisc_coef hML_[uv]", hML_u, hML_v, G%HI, & - haloshift=0, scale=GV%H_to_m, scalar_pair=.true.) + haloshift=0, scale=US%Z_to_m, scalar_pair=.true.) endif ! Offer diagnostic fields for averaging. @@ -1487,32 +1529,38 @@ end subroutine vertvisc_coef !! If BOTTOMDRAGLAW is defined, the minimum of Hbbl and half the adjacent !! layer thicknesses are used to calculate a_cpl near the bottom. subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_ml, & - dt, j, G, GV, US, CS, visc, forces, work_on_u, OBC, shelf) + dt, j, G, GV, US, CS, visc, Ustar_2d, tv, work_on_u, OBC, shelf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZIB_(G),SZK_(GV)+1), & - intent(out) :: a_cpl !< Coupling coefficient across interfaces [Z T-1 ~> m s-1]. + intent(out) :: a_cpl !< Coupling coefficient across interfaces [H T-1 ~> m s-1 or Pa s m-1] real, dimension(SZIB_(G),SZK_(GV)), & - intent(in) :: hvel !< Thickness at velocity points [H ~> m or kg m-2] + intent(in) :: hvel !< Distance between interfaces at velocity points [Z ~> m] logical, dimension(SZIB_(G)), & intent(in) :: do_i !< If true, determine coupling coefficient for a column real, dimension(SZIB_(G),SZK_(GV)), & intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity - !! grid point [H ~> m or kg m-2] - real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness [H ~> m or kg m-2] + !! grid point [Z ~> m] + real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness [Z ~> m] real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, exclusive of !! any depth-dependent contributions from - !! visc%Kv_shear [Z2 T-1 ~> m2 s-1]. + !! visc%Kv_shear [H Z T-1 ~> m2 s-1 or Pa s] real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, !! normalized by the bottom boundary layer thickness [nondim] - real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth [H ~> m or kg m-2] + real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth [Z ~> m] integer, intent(in) :: j !< j-index to find coupling coefficient for real, intent(in) :: dt !< Time increment [T ~> s] type(vertvisc_CS), pointer :: CS !< Vertical viscosity control structure type(vertvisc_type), intent(in) :: visc !< Structure containing viscosities and bottom drag - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: Ustar_2d !< The wind friction velocity, calculated using + !! the Boussinesq reference density or the + !! time-evolving surface density in non-Boussinesq + !! mode [Z T-1 ~> m s-1] + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any available + !! thermodynamic fields. logical, intent(in) :: work_on_u !< If true, u-points are being calculated, !! otherwise they are v-points type(ocean_OBC_type), pointer :: OBC !< Open boundary condition structure @@ -1522,38 +1570,38 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! Local variables real, dimension(SZIB_(G)) :: & - u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1]. - tau_mag, & ! The magnitude of the wind stress at a velocity point including gustiness, - ! divided by the Boussinesq refernce density [Z2 T-2 ~> m2 s-2] + u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1] + tau_mag, & ! The magnitude of the wind stress at a velocity point including gustiness [H Z T-2 ~> m2 s-2 or Pa] absf, & ! The average of the neighboring absolute values of f [T-1 ~> s-1]. -! h_ml, & ! The mixed layer depth [H ~> m or kg m-2]. + rho_av1, & ! The harmonic mean surface layer density at velocity points [R ~> kg m-3] z_t, & ! The distance from the top, sometimes normalized - ! by Hmix, [H ~> m or kg m-2] or [nondim]. - kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1]. - tbl_thick ! The thickness of the top boundary layer [H ~> m or kg m-2] + ! by Hmix, [Z ~> m] or [nondim]. + kv_TBL, & ! The viscosity in a top boundary layer under ice [H Z T-1 ~> m2 s-1 or Pa s] + tbl_thick ! The thickness of the top boundary layer [Z ~> m] real, dimension(SZIB_(G),SZK_(GV)+1) :: & - Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1]. - Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. + Kv_tot, & ! The total viscosity at an interface [H Z T-1 ~> m2 s-1 or Pa s] + Kv_add ! A viscosity to add [H Z T-1 ~> m2 s-1 or Pa s] integer, dimension(SZIB_(G)) :: & nk_in_ml ! The index of the deepest interface in the mixed layer. - real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. - real :: dhc ! The distance between the center of adjacent layers [H ~> m or kg m-2]. - real :: visc_ml ! The mixed layer viscosity [Z2 T-1 ~> m2 s-1]. - real :: I_Hmix ! The inverse of the mixed layer thickness [H-1 ~> m-1 or m2 kg-1]. + real :: h_shear ! The distance over which shears occur [Z ~> m]. + real :: dhc ! The distance between the center of adjacent layers [Z ~> m]. + real :: visc_ml ! The mixed layer viscosity [H Z T-1 ~> m2 s-1 or Pa s]. + real :: tau_scale ! A scaling factor for the interpolated wind stress magnitude [H R-1 L-1 ~> m3 kg-1 or nondim] + real :: I_Hmix ! The inverse of the mixed layer thickness [Z-1 ~> m-1]. real :: a_ml ! The layer coupling coefficient across an interface in - ! the mixed layer [Z T-1 ~> m s-1]. + ! the mixed layer [H T-1 ~> m s-1 or Pa s m-1]. real :: a_floor ! A lower bound on the layer coupling coefficient across an interface in - ! the mixed layer [Z T-1 ~> m s-1]. - real :: I_amax ! The inverse of the maximum coupling coefficient [T Z-1 ~> s m-1]. - real :: temp1 ! A temporary variable [H Z ~> m2 or kg m-1] + ! the mixed layer [H T-1 ~> m s-1 or Pa s m-1]. + real :: I_amax ! The inverse of the maximum coupling coefficient [T H-1 ~> s m-1 or s m2 kg-1]. + real :: temp1 ! A temporary variable [Z2 ~> m2] real :: ustar2_denom ! A temporary variable in the surface boundary layer turbulence - ! calculations [Z H-1 T-1 ~> s-1 or m3 kg-1 s-1] - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2]. + ! calculations [H Z-1 T-1 ~> s-1 or kg m-3 s-1] + real :: h_neglect ! A vertical distance that is so small it is usually lost + ! in roundoff and can be neglected [Z ~> m]. real :: z2 ! A copy of z_i [nondim] real :: botfn ! A function that is 1 at the bottom and small far from it [nondim] real :: topfn ! A function that is 1 at the top and small far from it [nondim] - real :: kv_top ! A viscosity associated with the top boundary layer [Z2 T-1 ~> m2 s-1] + real :: kv_top ! A viscosity associated with the top boundary layer [H Z T-1 ~> m2 s-1 or Pa s] logical :: do_shelf, do_OBCs, can_exit integer :: i, k, is, ie, max_nk integer :: nz @@ -1564,13 +1612,15 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (work_on_u) then ; is = G%IscB ; ie = G%IecB else ; is = G%isc ; ie = G%iec ; endif nz = GV%ke - h_neglect = GV%H_subroundoff + h_neglect = GV%dZ_subroundoff + + tau_scale = US%L_to_Z * GV%RZ_to_H if (CS%answer_date < 20190101) then ! The maximum coupling coefficient was originally introduced to avoid ! truncation error problems in the tridiagonal solver. Effectively, the 1e-10 ! sets the maximum coupling coefficient increment to 1e10 m per timestep. - I_amax = (1.0e-10*US%Z_to_m) * dt + I_amax = (1.0e-10*GV%H_to_m) * dt else I_amax = 0.0 endif @@ -1648,11 +1698,11 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! to further modify these viscosities here to take OBCs into account. if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then - Kv_tot(I,K) = Kv_tot(I,K) + (0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) + Kv_tot(I,K) = Kv_tot(I,K) + 0.5*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo else do K=2,nz ; do i=is,ie ; if (do_i(i)) then - Kv_tot(i,K) = Kv_tot(i,K) + (0.5)*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) + Kv_tot(i,K) = Kv_tot(i,K) + 0.5*(visc%Kv_shear_Bu(I-1,J,k) + visc%Kv_shear_Bu(I,J,k)) endif ; enddo ; enddo endif endif @@ -1665,9 +1715,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! These expressions assume that Kv_tot(i,nz+1) = CS%Kv, consistent with ! the suppression of turbulent mixing by the presence of a solid boundary. if (dhc < bbl_thick(i)) then - a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + (dhc+h_neglect)*GV%H_to_Z) + a_cpl(i,nz+1) = kv_bbl(i) / ((dhc+h_neglect) + I_amax*kv_bbl(i)) else - a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + (bbl_thick(i)+h_neglect)*GV%H_to_Z) + a_cpl(i,nz+1) = kv_bbl(i) / ((bbl_thick(i)+h_neglect) + I_amax*kv_bbl(i)) endif endif ; enddo do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then @@ -1685,14 +1735,14 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif ! Calculate the coupling coefficients from the viscosities. - a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) + a_cpl(i,K) = Kv_tot(i,K) / (h_shear + I_amax*Kv_tot(i,K)) endif ; enddo ; enddo ! i & k loops elseif (abs(CS%Kv_extra_bbl) > 0.0) then ! There is a simple enhancement of the near-bottom viscosities, but no adjustment ! of the viscous coupling length scales to give a particular bottom stress. do i=is,ie ; if (do_i(i)) then a_cpl(i,nz+1) = (Kv_tot(i,nz+1) + CS%Kv_extra_bbl) / & - ((0.5*hvel(i,nz)+h_neglect)*GV%H_to_Z + I_amax*(Kv_tot(i,nz+1)+CS%Kv_extra_bbl)) + ((0.5*hvel(i,nz)+h_neglect) + I_amax*(Kv_tot(i,nz+1)+CS%Kv_extra_bbl)) endif ; enddo do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then ! botfn determines when a point is within the influence of the bottom @@ -1704,18 +1754,18 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect) ! Calculate the coupling coefficients from the viscosities. - a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) + a_cpl(i,K) = Kv_tot(i,K) / (h_shear + I_amax*Kv_tot(i,K)) endif ; enddo ; enddo ! i & k loops else ! Any near-bottom viscous enhancements were already incorporated into Kv_tot, and there is ! no adjustment of the viscous coupling length scales to give a particular bottom stress. do i=is,ie ; if (do_i(i)) then - a_cpl(i,nz+1) = Kv_tot(i,nz+1) / ((0.5*hvel(i,nz)+h_neglect)*GV%H_to_Z + I_amax*Kv_tot(i,nz+1)) + a_cpl(i,nz+1) = Kv_tot(i,nz+1) / ((0.5*hvel(i,nz)+h_neglect) + I_amax*Kv_tot(i,nz+1)) endif ; enddo do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect) ! Calculate the coupling coefficients from the viscosities. - a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) + a_cpl(i,K) = Kv_tot(i,K) / (h_shear + I_amax*Kv_tot(i,K)) endif ; enddo ; enddo ! i & k loops endif @@ -1727,18 +1777,18 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do i=is,ie ; if (do_i(i)) then if (work_on_u) then kv_TBL(i) = visc%Kv_tbl_shelf_u(I,j) - tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) * GV%Z_to_H + h_neglect + tbl_thick(i) = visc%tbl_thick_shelf_u(I,j) + h_neglect else kv_TBL(i) = visc%Kv_tbl_shelf_v(i,J) - tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) * GV%Z_to_H + h_neglect + tbl_thick(i) = visc%tbl_thick_shelf_v(i,J) + h_neglect endif z_t(i) = 0.0 ! If a_cpl(i,1) were not already 0, it would be added here. if (0.5*hvel(i,1) > tbl_thick(i)) then - a_cpl(i,1) = kv_TBL(i) / (tbl_thick(i)*GV%H_to_Z + I_amax*kv_TBL(i)) + a_cpl(i,1) = kv_TBL(i) / (tbl_thick(i) + I_amax*kv_TBL(i)) else - a_cpl(i,1) = kv_TBL(i) / ((0.5*hvel(i,1)+h_neglect)*GV%H_to_Z + I_amax*kv_TBL(i)) + a_cpl(i,1) = kv_TBL(i) / ((0.5*hvel(i,1)+h_neglect) + I_amax*kv_TBL(i)) endif endif ; enddo @@ -1754,35 +1804,78 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif kv_top = topfn * kv_TBL(i) - a_cpl(i,K) = a_cpl(i,K) + kv_top / (h_shear*GV%H_to_Z + I_amax*kv_top) + a_cpl(i,K) = a_cpl(i,K) + kv_top / (h_shear + I_amax*kv_top) endif ; enddo ; enddo elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0) .or. CS%fixed_LOTW_ML .or. CS%apply_LOTW_floor) then ! Find the friction velocity and the absolute value of the Coriolis parameter at this point. u_star(:) = 0.0 ! Zero out the friction velocity on land points. - if (work_on_u) then - do I=is,ie ; if (do_i(I)) then - u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) - absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) - endif ; enddo - if (do_OBCs) then ; do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then - if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & - u_star(I) = forces%ustar(i,j) - if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & - u_star(I) = forces%ustar(i+1,j) - endif ; enddo ; endif - else - do i=is,ie ; if (do_i(i)) then - u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) - endif ; enddo - if (do_OBCs) then ; do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then - if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & - u_star(i) = forces%ustar(i,j) - if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & - u_star(i) = forces%ustar(i,j+1) - endif ; enddo ; endif + tau_mag(:) = 0.0 ! Zero out the friction velocity on land points. + + if (allocated(tv%SpV_avg)) then + rho_av1(:) = 0.0 + if (work_on_u) then + do I=is,ie ; if (do_i(I)) then + u_star(I) = 0.5 * (Ustar_2d(i,j) + Ustar_2d(i+1,j)) + rho_av1(I) = 2.0 / (tv%SpV_avg(i,j,1) + tv%SpV_avg(i+1,j,1)) + absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + endif ; enddo + if (do_OBCs) then ; do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then + u_star(I) = Ustar_2d(i,j) + rho_av1(I) = 1.0 / tv%SpV_avg(i,j,1) + elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then + u_star(I) = Ustar_2d(i+1,j) + rho_av1(I) = 1.0 / tv%SpV_avg(i+1,j,1) + endif + endif ; enddo ; endif + else ! Work on v-points + do i=is,ie ; if (do_i(i)) then + u_star(i) = 0.5 * (Ustar_2d(i,j) + Ustar_2d(i,j+1)) + rho_av1(i) = 2.0 / (tv%SpV_avg(i,j,1) + tv%SpV_avg(i,j+1,1)) + absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + endif ; enddo + if (do_OBCs) then ; do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then + u_star(i) = Ustar_2d(i,j) + rho_av1(i) = 1.0 / tv%SpV_avg(i,j,1) + elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then + u_star(i) = Ustar_2d(i,j+1) + rho_av1(i) = 1.0 / tv%SpV_avg(i,j+1,1) + endif + endif ; enddo ; endif + endif + do I=is,ie + tau_mag(I) = GV%RZ_to_H*rho_av1(i) * u_star(I)**2 + enddo + else ! (.not.allocated(tv%SpV_avg)) + if (work_on_u) then + do I=is,ie ; if (do_i(I)) then + u_star(I) = 0.5*(Ustar_2d(i,j) + Ustar_2d(i+1,j)) + absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + endif ; enddo + if (do_OBCs) then ; do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & + u_star(I) = Ustar_2d(i,j) + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & + u_star(I) = Ustar_2d(i+1,j) + endif ; enddo ; endif + else + do i=is,ie ; if (do_i(i)) then + u_star(i) = 0.5*(Ustar_2d(i,j) + Ustar_2d(i,j+1)) + absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + endif ; enddo + if (do_OBCs) then ; do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & + u_star(i) = Ustar_2d(i,j) + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & + u_star(i) = Ustar_2d(i,j+1) + endif ; enddo ; endif + endif + do I=is,ie + tau_mag(I) = GV%Z_to_H*u_star(I)**2 + enddo endif ! Determine the thickness of the surface ocean boundary layer and its extent in index space. @@ -1863,12 +1956,16 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, ! The viscosity in visc_ml is set to go to 0 at the mixed layer top and bottom ! (in a log-layer) and be further limited by rotation to give the natural Ekman length. - temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z - ustar2_denom = (CS%vonKar * u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i)) + if (GV%Boussinesq) then + ustar2_denom = (CS%vonKar * GV%Z_to_H*u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + else + ustar2_denom = (CS%vonKar * tau_mag(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + endif visc_ml = temp1 * ustar2_denom ! Set the viscous coupling based on the model's vertical resolution. The omission of ! the I_amax factor here is consistent with answer dates above 20190101. - a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z) + a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect)) ! As a floor on the viscous coupling, assume that the length scale in the denominator can ! not be larger than the distance from the surface, consistent with a logarithmic velocity @@ -1883,8 +1980,12 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do K=2,max_nk ; do i=is,ie ; if (k <= nk_in_ml(i)) then z_t(i) = z_t(i) + hvel(i,k-1) - temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z - ustar2_denom = (CS%vonKar * u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i)) + if (GV%Boussinesq) then + ustar2_denom = (CS%vonKar * GV%Z_to_H*u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + else + ustar2_denom = (CS%vonKar * tau_mag(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + endif ! As a floor on the viscous coupling, assume that the length scale in the denominator can not ! be larger than the distance from the surface, consistent with a logarithmic velocity profile. @@ -1894,16 +1995,17 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, do K=2,max_nk ; do i=is,ie ; if (k <= nk_in_ml(i)) then z_t(i) = z_t(i) + hvel(i,k-1) - temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i)) ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) ! and be further limited by rotation to give the natural Ekman length. + ! The following expressions are mathematically equivalent. if (GV%Boussinesq .or. (CS%answer_date < 20230601)) then - visc_ml = u_star(i) * CS%vonKar * (temp1*u_star(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + visc_ml = u_star(i) * CS%vonKar * (GV%Z_to_H*temp1*u_star(i)) / & + (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) else - tau_mag(i) = u_star(i)**2 visc_ml = CS%vonKar * (temp1*tau_mag(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) endif - a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 0.5*I_amax*visc_ml) + a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) + 0.5*I_amax*visc_ml) ! Choose the largest estimate of a_cpl, but these could be changed to be additive. a_cpl(i,K) = max(a_cpl(i,K), a_ml) @@ -2005,7 +2107,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS enddo ! j-loop else ! Do not report accelerations leading to large velocities. if (CS%CFL_based_trunc) then -!$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,dt,G,CS,h,H_report) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 elseif ((u(I,j,k) * (dt * G%dy_Cu(I,j))) * G%IareaT(i+1,j) < -CS%CFL_trunc) then @@ -2017,7 +2119,7 @@ subroutine vertvisc_limit_vel(u, v, h, ADp, CDp, forces, visc, dt, G, GV, US, CS endif enddo ; enddo ; enddo else -!$OMP parallel do default(none) shared(nz,js,je,Isq,Ieq,u,G,CS,truncvel,maxvel,h,H_report) + !$OMP parallel do default(shared) do k=1,nz ; do j=js,je ; do I=Isq,Ieq if (abs(u(I,j,k)) < CS%vel_underflow) then ; u(I,j,k) = 0.0 elseif (abs(u(I,j,k)) > maxvel) then @@ -2142,8 +2244,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! Local variables - real :: Kv_BBL ! A viscosity in the bottom boundary layer with a simple scheme [Z2 T-1 ~> m2 s-1]. - real :: Hmix_z ! A boundary layer thickness [Z ~> m]. + real :: Kv_BBL ! A viscosity in the bottom boundary layer with a simple scheme [H Z T-1 ~> m2 s-1 or Pa s] + real :: Kv_back_z ! A background kinematic viscosity [Z2 T-1 ~> m2 s-1] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: answers_2018 !< If true, use the order of arithmetic and expressions that recover the @@ -2182,15 +2284,17 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "VERT_FRICTION_2018_ANSWERS", answers_2018, & "If true, use the order of arithmetic and expressions that recover the answers "//& "from the end of 2018. Otherwise, use expressions that do not use an arbitrary "//& "hard-coded maximum viscous coupling coefficient between layers.", & - default=default_2018_answers) + default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates. - if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 - if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + if (GV%Boussinesq) then + if (answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 + if (.not.answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 + endif call get_param(param_file, mdl, "VERT_FRICTION_ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic and expressions in the viscous "//& "calculations. Values below 20190101 recover the answers from the end of 2018, "//& @@ -2199,7 +2303,9 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "recover a form of the viscosity within the mixed layer that breaks up the "//& "magnitude of the wind stress in some non-Boussinesq cases. "//& "If both VERT_FRICTION_2018_ANSWERS and VERT_FRICTION_ANSWER_DATE are "//& - "specified, the latter takes precedence.", default=default_answer_date) + "specified, the latter takes precedence.", & + default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag "//& @@ -2252,17 +2358,16 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) if (GV%nkml < 1) then - call get_param(param_file, mdl, "HMIX_FIXED", Hmix_z, & + call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface viscosity and "//& "diffusivity are elevated when the bulk mixed layer is not used.", & units="m", scale=US%m_to_Z, fail_if_missing=.true.) - CS%Hmix = GV%Z_to_H * Hmix_z endif if (CS%direct_stress) then if (GV%nkml < 1) then call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if DIRECT_STRESS is true.", & - units="m", default=US%Z_to_m*Hmix_z, scale=GV%m_to_H) + units="m", default=US%Z_to_m*CS%Hmix, scale=GV%m_to_H) else call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if DIRECT_STRESS is true.", & @@ -2271,17 +2376,20 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // & "HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.") endif - call get_param(param_file, mdl, "KV", CS%Kv, & + call get_param(param_file, mdl, "KV", Kv_back_z, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T) + ! Convert input kinematic viscosity to dynamic viscosity when non-Boussinesq. + CS%Kv = (US%Z2_T_to_m2_s*GV%m2_s_to_HZ_T) * Kv_back_z + call get_param(param_file, mdl, "USE_GL90_IN_SSW", CS%use_GL90_in_SSW, & "If true, use simpler method to calculate 1/N^2 in GL90 vertical "// & "viscosity coefficient. This method is valid in stacked shallow water mode.", & default=.false.) call get_param(param_file, mdl, "KD_GL90", CS%kappa_gl90, & "The scalar diffusivity used in GL90 vertical viscosity scheme.", & - units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, & + units="m2 s-1", default=0.0, scale=US%m_to_L*US%Z_to_L*GV%m_to_H*US%T_to_s, & do_not_log=.not.CS%use_GL90_in_SSW) call get_param(param_file, mdl, "READ_KD_GL90", CS%read_kappa_gl90, & "If true, read a file (given by KD_GL90_FILE) containing the "//& @@ -2305,7 +2413,8 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & kappa_gl90_file = trim(inputdir) // trim(kappa_gl90_file) allocate(CS%kappa_gl90_2d(G%isd:G%ied, G%jsd:G%jed), source=0.0) - call MOM_read_data(kappa_gl90_file, kdgl90_varname, CS%kappa_gl90_2d(:,:), G%domain, scale=US%m_to_L**2*US%T_to_s) + call MOM_read_data(kappa_gl90_file, kdgl90_varname, CS%kappa_gl90_2d(:,:), G%domain, & + scale=US%m_to_L*US%Z_to_L*GV%m_to_H*US%T_to_s) call pass_var(CS%kappa_gl90_2d, G%domain) endif call get_param(param_file, mdl, "USE_GL90_N2", CS%use_GL90_N2, & @@ -2328,7 +2437,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "viscosity via Kv_GL90 = alpha_GL90 * f2. Is only used "// & "if USE_GL90_N2 is true. Note that the implied Kv_GL90 "// & "corresponds to a KD_GL90 that scales as N^2 with depth.", & - units="m2 s", default=0.0, scale=US%m_to_Z**2*US%s_to_T, & + units="m2 s", default=0.0, scale=GV%m_to_H*US%m_to_Z*US%s_to_T, & do_not_log=.not.CS%use_GL90_in_SSW) endif call get_param(param_file, mdl, "HBBL_GL90", CS%Hbbl_gl90, & @@ -2336,7 +2445,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "which defines the range over which the GL90 coupling "//& "coefficient is zeroed out, in order to avoid fluxing "//& "momentum into vanished layers over steep topography.", & - units="m", default=5.0, scale=GV%m_to_H, do_not_log=.not.CS%use_GL90_in_SSW) + units="m", default=5.0, scale=US%m_to_Z, do_not_log=.not.CS%use_GL90_in_SSW) CS%Kvml_invZ2 = 0.0 if (GV%nkml < 1) then @@ -2355,19 +2464,20 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "transmitted through infinitesimally thin surface layers. This is an "//& "older option for numerical convenience without a strong physical basis, "//& "and its use is now discouraged.", & - units="m2 s-1", default=Kv_mks, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=Kv_mks, scale=GV%m2_s_to_HZ_T) endif if (.not.CS%bottomdraglaw) then call get_param(param_file, mdl, "KV_EXTRA_BBL", CS%Kv_extra_bbl, & "An extra kinematic viscosity in the benthic boundary layer. "//& "KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", & - units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + units="m2 s-1", default=0.0, scale=GV%m2_s_to_HZ_T, do_not_log=.true.) if (CS%Kv_extra_bbl == 0.0) then call get_param(param_file, mdl, "KVBBL", Kv_BBL, & "An extra kinematic viscosity in the benthic boundary layer. "//& "KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", & - units="m2 s-1", default=US%Z2_T_to_m2_s*CS%Kv, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + units="m2 s-1", default=US%Z2_T_to_m2_s*Kv_back_z, scale=GV%m2_s_to_HZ_T, & + do_not_log=.true.) if (abs(Kv_BBL - CS%Kv) > 1.0e-15*abs(CS%Kv)) then call MOM_error(WARNING, "KVBBL is a deprecated parameter. Use KV_EXTRA_BBL instead.") CS%Kv_extra_bbl = Kv_BBL - CS%Kv @@ -2376,14 +2486,14 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call log_param(param_file, mdl, "KV_EXTRA_BBL", CS%Kv_extra_bbl, & "An extra kinematic viscosity in the benthic boundary layer. "//& "KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", & - units="m2 s-1", default=0.0, unscale=US%Z2_T_to_m2_s) + units="m2 s-1", default=0.0, unscale=GV%HZ_T_to_m2_s) endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a viscosity increased by "//& "KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which "//& "near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is "//& "defined but LINEAR_DRAG is not.", & - units="m", fail_if_missing=.true., scale=GV%m_to_H) + units="m", fail_if_missing=.true., scale=US%m_to_Z) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity components are truncated.", & units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) @@ -2440,31 +2550,31 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ALLOC_(CS%h_v(isd:ied,JsdB:JedB,nz)) ; CS%h_v(:,:,:) = 0.0 CS%id_Kv_slow = register_diag_field('ocean_model', 'Kv_slow', diag%axesTi, Time, & - 'Slow varying vertical viscosity', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Slow varying vertical viscosity', 'm2 s-1', conversion=GV%HZ_T_to_m2_s) CS%id_Kv_u = register_diag_field('ocean_model', 'Kv_u', diag%axesCuL, Time, & - 'Total vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Total vertical viscosity at u-points', 'm2 s-1', conversion=GV%H_to_m**2*US%s_to_T) CS%id_Kv_v = register_diag_field('ocean_model', 'Kv_v', diag%axesCvL, Time, & - 'Total vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'Total vertical viscosity at v-points', 'm2 s-1', conversion=GV%H_to_m**2*US%s_to_T) CS%id_Kv_gl90_u = register_diag_field('ocean_model', 'Kv_gl90_u', diag%axesCuL, Time, & - 'GL90 vertical viscosity at u-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'GL90 vertical viscosity at u-points', 'm2 s-1', conversion=GV%H_to_m**2*US%s_to_T) CS%id_Kv_gl90_v = register_diag_field('ocean_model', 'Kv_gl90_v', diag%axesCvL, Time, & - 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=US%Z2_T_to_m2_s) + 'GL90 vertical viscosity at v-points', 'm2 s-1', conversion=GV%H_to_m**2*US%s_to_T) CS%id_au_vv = register_diag_field('ocean_model', 'au_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Zonal Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%H_to_m*US%s_to_T) CS%id_av_vv = register_diag_field('ocean_model', 'av_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Meridional Viscous Vertical Coupling Coefficient', 'm s-1', conversion=GV%H_to_m*US%s_to_T) CS%id_au_gl90_vv = register_diag_field('ocean_model', 'au_gl90_visc', diag%axesCui, Time, & - 'Zonal Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Zonal Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=GV%H_to_m*US%s_to_T) CS%id_av_gl90_vv = register_diag_field('ocean_model', 'av_gl90_visc', diag%axesCvi, Time, & - 'Meridional Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=US%Z_to_m*US%s_to_T) + 'Meridional Viscous Vertical GL90 Coupling Coefficient', 'm s-1', conversion=GV%H_to_m*US%s_to_T) CS%id_h_u = register_diag_field('ocean_model', 'Hu_visc', diag%axesCuL, Time, & 'Thickness at Zonal Velocity Points for Viscosity', & @@ -2478,11 +2588,11 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & CS%id_hML_u = register_diag_field('ocean_model', 'HMLu_visc', diag%axesCu1, Time, & 'Mixed Layer Thickness at Zonal Velocity Points for Viscosity', & - thickness_units, conversion=GV%H_to_MKS) + thickness_units, conversion=US%Z_to_m) CS%id_hML_v = register_diag_field('ocean_model', 'HMLv_visc', diag%axesCv1, Time, & 'Mixed Layer Thickness at Meridional Velocity Points for Viscosity', & - thickness_units, conversion=GV%H_to_MKS) + thickness_units, conversion=US%Z_to_m) CS%id_du_dt_visc = register_diag_field('ocean_model', 'du_dt_visc', diag%axesCuL, Time, & 'Zonal Acceleration from Vertical Viscosity', 'm s-2', conversion=US%L_T2_to_m_s2) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 98788843e3..e0bd659a60 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -10,6 +10,7 @@ module DOME_tracer use MOM_forcing_type, only : forcing use MOM_hor_index, only : hor_index_type use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : thickness_to_dz use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_tracer_type use MOM_open_boundary, only : OBC_segment_type @@ -19,7 +20,7 @@ module DOME_tracer use MOM_tracer_registry, only : register_tracer, tracer_registry_type use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface +use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -156,7 +157,7 @@ end function register_DOME_tracer !> Initializes the NTR tracer fields in tr(:,:,:,:) and sets up the tracer output. subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & - sponge_CSp, param_file) + sponge_CSp, tv) 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 @@ -170,27 +171,27 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & !! call to DOME_register_tracer. type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure !! for the sponges, if they are in use. - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables -! Local variables + ! Local variables real, allocatable :: temp(:,:,:) ! Target values for the tracers in the sponges, perhaps in [g kg-1] character(len=16) :: name ! A variable's name in a NetCDF file. real, pointer :: tr_ptr(:,:,:) => NULL() ! A pointer to one of the tracers, perhaps in [g kg-1] + real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m] real :: tr_y ! Initial zonally uniform tracer concentrations, perhaps in [g kg-1] - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: dz_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [Z ~> m or kg m-2]. real :: e(SZK_(GV)+1) ! Interface heights relative to the sea surface (negative down) [Z ~> m] real :: e_top ! Height of the top of the tracer band relative to the sea surface [Z ~> m] real :: e_bot ! Height of the bottom of the tracer band relative to the sea surface [Z ~> m] real :: d_tr ! A change in tracer concentrations, in tracer units, perhaps [g kg-1] integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz, m - integer :: IsdB, IedB, JsdB, JedB if (.not.associated(CS)) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - h_neglect = GV%H_subroundoff + + dz_neglect = GV%dz_subroundoff CS%Time => day CS%diag => diag @@ -225,31 +226,34 @@ subroutine initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS, & enddo ; enddo ; enddo if (NTR >= 7) then - do j=js,je ; do i=is,ie - e(1) = 0.0 - do k=1,nz - e(K+1) = e(K) - h(i,j,k)*GV%H_to_Z - do m=7,NTR - e_top = -CS%sheet_spacing * (real(m-6)) - e_bot = -CS%sheet_spacing * (real(m-6) + 0.5) - if (e_top < e(K)) then - if (e_top < e(K+1)) then ; d_tr = 0.0 - elseif (e_bot < e(K+1)) then - d_tr = 1.0 * (e_top-e(K+1)) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) - else ; d_tr = 1.0 * (e_top-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) + do j=js,je + call thickness_to_dz(h, tv, dz, j, G, GV) + do i=is,ie + e(1) = 0.0 + do k=1,nz + e(K+1) = e(K) - dz(i,k) + do m=7,NTR + e_top = -CS%sheet_spacing * (real(m-6)) + e_bot = -CS%sheet_spacing * (real(m-6) + 0.5) + if (e_top < e(K)) then + if (e_top < e(K+1)) then ; d_tr = 0.0 + elseif (e_bot < e(K+1)) then + d_tr = 1.0 * (e_top-e(K+1)) / (dz(i,k)+dz_neglect) + else ; d_tr = 1.0 * (e_top-e_bot) / (dz(i,k)+dz_neglect) + endif + elseif (e_bot < e(K)) then + if (e_bot < e(K+1)) then ; d_tr = 1.0 + else ; d_tr = 1.0 * (e(K)-e_bot) / (dz(i,k)+dz_neglect) + endif + else + d_tr = 0.0 endif - elseif (e_bot < e(K)) then - if (e_bot < e(K+1)) then ; d_tr = 1.0 - else ; d_tr = 1.0 * (e(K)-e_bot) / ((h(i,j,k)+h_neglect)*GV%H_to_Z) - endif - else - d_tr = 0.0 - endif - if (h(i,j,k) < 2.0*GV%Angstrom_H) d_tr=0.0 - CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + d_tr + if (dz(i,k) < 2.0*GV%Angstrom_Z) d_tr=0.0 + CS%tr(i,j,k,m) = CS%tr(i,j,k,m) + d_tr + enddo enddo enddo - enddo ; enddo + enddo endif endif diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 479713863f..21201db590 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -193,11 +193,11 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, default=99991231) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & - default=(default_answer_date<20190101)) + default=(default_answer_date<20190101), do_not_log=.not.GV%Boussinesq) call get_param(param_file, mdl, "REMAPPING_2018_ANSWERS", remap_answers_2018, & "If true, use the order of arithmetic and expressions that recover the "//& "answers from the end of 2018. Otherwise, use updated and more robust "//& - "forms of the same expressions.", default=default_2018_answers) + "forms of the same expressions.", default=default_2018_answers, do_not_log=.not.GV%Boussinesq) ! Revise inconsistent default answer dates for remapping. if (remap_answers_2018 .and. (default_answer_date >= 20190101)) default_answer_date = 20181231 if (.not.remap_answers_2018 .and. (default_answer_date < 20190101)) default_answer_date = 20190101 @@ -207,7 +207,8 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, "that were in use at the end of 2018. Higher values result in the use of more "//& "robust and accurate forms of mathematically equivalent expressions. "//& "If both REMAPPING_2018_ANSWERS and REMAPPING_ANSWER_DATE are specified, the "//& - "latter takes precedence.", default=default_answer_date) + "latter takes precedence.", default=default_answer_date, do_not_log=.not.GV%Boussinesq) + if (.not.GV%Boussinesq) CS%remap_answer_date = max(CS%remap_answer_date, 20230701) call initialize_remapping( CS%remap_CS, string, boundary_extrapolation=boundary_extrap, & answer_date=CS%remap_answer_date ) call extract_member_remapping_CS(CS%remap_CS, degree=CS%deg) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 5abca6e578..dde110f959 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -655,7 +655,7 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & enddo ! diagnostics - if (associated(Tr(m)%ad_x)) then ; do i=is,ie ; if (do_i(i,j)) then + if (associated(Tr(m)%ad_x)) then ; do I=is-1,ie ; if (do_i(i,j)) then Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + flux_x(I,j,m)*Idt endif ; enddo ; endif @@ -682,13 +682,13 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! compute ad2d_x diagnostic outside above j-loop so as to make the summation ordered when OMP is active. !$OMP ordered - do j=js,je ; if (domore_u_initial(j,k)) then - do m=1,ntr - if (associated(Tr(m)%ad2d_x)) then ; do i=is,ie ; if (do_i(i,j)) then + do m=1,ntr ; if (associated(Tr(m)%ad2d_x)) then + do j=js,je ; if (domore_u_initial(j,k)) then + do I=is-1,ie ; if (do_i(i,j)) then Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + flux_x(I,j,m)*Idt - endif ; enddo ; endif - enddo - endif ; enddo ! End of j-loop. + endif ; enddo + endif ; enddo + endif ; enddo ! End of m-loop. !$OMP end ordered end subroutine advect_x @@ -756,6 +756,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & logical :: usePLMslope integer :: i, j, j2, m, n, j_up, stencil type(OBC_segment_type), pointer :: segment=>NULL() + logical :: domore_v_initial(SZJB_(G)) ! Initial state of domore_v usePLMslope = .not. (usePPM .and. useHuynh) ! stencil for calculating slope values @@ -778,6 +779,7 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! this would require an additional loop, etc. do_j_tr(:) = .false. do J=js-1,je ; if (domore_v(J,k)) then ; do j2=1-stencil,stencil ; do_j_tr(j+j2) = .true. ; enddo ; endif ; enddo + domore_v_initial(:) = domore_v(:,k) ! Calculate the j-direction profiles (slopes) of each tracer that ! is being advected. @@ -1034,11 +1036,6 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & (flux_y(i,m,J) - flux_y(i,m,J-1))) * Ihnew(i) endif ; enddo - ! diagnostics - if (associated(Tr(m)%ad_y)) then ; do i=is,ie ; if (do_i(i,j)) then - Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt - endif ; enddo ; endif - ! diagnose convergence of flux_y and add to convergence of flux_x. ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. if (associated(Tr(m)%advection_xy)) then @@ -1058,16 +1055,24 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & enddo ; enddo endif ; enddo - ! compute ad2d_y diagnostic outside above j-loop so as to make the summation ordered when OMP is active. - + ! compute ad_y and ad2d_y diagnostic outside above j-loop so as to make the summation ordered when OMP is active. !$OMP ordered - do j=js,je ; if (do_j_tr(j)) then - do m=1,ntr - if (associated(Tr(m)%ad2d_y)) then ; do i=is,ie ; if (do_i(i,j)) then + do m=1,ntr ; if (associated(Tr(m)%ad_y)) then + do J=js-1,je ; if (domore_v_initial(J)) then + ! (The logical test could be "do_i(i,j) .or. do_i(i+1,j)" to be clearer, but not needed) + do i=is,ie ; if (do_i(i,j)) then + Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt + endif ; enddo + endif ; enddo + endif ; enddo ! End of m-loop. + + do m=1,ntr ; if (associated(Tr(m)%ad2d_y)) then + do J=js-1,je ; if (domore_v_initial(J)) then + do i=is,ie ; if (do_i(i,j)) then Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + flux_y(i,m,J)*Idt - endif ; enddo ; endif - enddo - endif ; enddo ! End of j-loop. + endif ; enddo + endif ; enddo + endif ; enddo ! End of m-loop. !$OMP end ordered end subroutine advect_y diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index fc50fc4d1b..bf4988488b 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -317,34 +317,31 @@ subroutine tracer_flow_control_init(restart, day, G, GV, US, h, param_file, diag sponge_CSp) if (CS%use_DOME_tracer) & call initialize_DOME_tracer(restart, day, G, GV, US, h, diag, OBC, CS%DOME_tracer_CSp, & - sponge_CSp, param_file) + sponge_CSp, tv) if (CS%use_ISOMIP_tracer) & call initialize_ISOMIP_tracer(restart, day, G, GV, h, diag, OBC, CS%ISOMIP_tracer_CSp, & ALE_sponge_CSp) if (CS%use_RGC_tracer) & - call initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, & - CS%RGC_tracer_CSp, sponge_CSp, ALE_sponge_CSp) + call initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS%RGC_tracer_CSp, & + sponge_CSp, ALE_sponge_CSp) if (CS%use_ideal_age) & call initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS%ideal_age_tracer_CSp, & - sponge_CSp) + sponge_CSp) if (CS%use_regional_dyes) & - call initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS%dye_tracer_CSp, & - sponge_CSp) + call initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS%dye_tracer_CSp, sponge_CSp, tv) if (CS%use_oil) & - call initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS%oil_tracer_CSp, & - sponge_CSp) + call initialize_oil_tracer(restart, day, G, GV, US, h, diag, OBC, CS%oil_tracer_CSp, sponge_CSp) if (CS%use_advection_test_tracer) & call initialize_advection_test_tracer(restart, day, G, GV, h, diag, OBC, CS%advection_test_tracer_CSp, & sponge_CSp) if (CS%use_OCMIP2_CFC) & - call initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS%OCMIP2_CFC_CSp, & - sponge_CSp) + call initialize_OCMIP2_CFC(restart, day, G, GV, US, h, diag, OBC, CS%OCMIP2_CFC_CSp, sponge_CSp) if (CS%use_CFC_cap) & call initialize_CFC_cap(restart, day, G, GV, US, h, diag, OBC, CS%CFC_cap_CSp) if (CS%use_MOM_generic_tracer) & call initialize_MOM_generic_tracer(restart, day, G, GV, US, h, param_file, diag, OBC, & - CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp) + CS%MOM_generic_tracer_CSp, sponge_CSp, ALE_sponge_CSp) if (CS%use_pseudo_salt_tracer) & call initialize_pseudo_salt_tracer(restart, day, G, GV, US, h, diag, OBC, CS%pseudo_salt_tracer_CSp, & sponge_CSp, tv) @@ -488,13 +485,13 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, minimum_forcing_depth=minimum_forcing_depth) if (CS%use_ideal_age) & call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%ideal_age_tracer_CSp, & + G, GV, US, tv, CS%ideal_age_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth, & Hbl=Hml) if (CS%use_regional_dyes) & call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%dye_tracer_CSp, & + G, GV, US, tv, CS%dye_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) if (CS%use_oil) & @@ -567,10 +564,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, G, GV, US, CS%RGC_tracer_CSp) if (CS%use_ideal_age) & call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%ideal_age_tracer_CSp, Hbl=Hml) + G, GV, US, tv, CS%ideal_age_tracer_CSp, Hbl=Hml) if (CS%use_regional_dyes) & call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%dye_tracer_CSp) + G, GV, US, tv, CS%dye_tracer_CSp) if (CS%use_oil) & call oil_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%oil_tracer_CSp, tv) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index fbc2b28a95..ff2199fc80 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -11,6 +11,7 @@ module regional_dyes use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type +use MOM_interface_heights, only : thickness_to_dz 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 @@ -21,7 +22,7 @@ module regional_dyes 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 -use MOM_variables, only : surface +use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -189,7 +190,7 @@ end function register_dye_tracer !> This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) !! and it sets up the tracer output. -subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp) +subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_CSp, tv) logical, intent(in) :: restart !< .true. if the fields have already been !! read from a restart file. type(time_type), target, intent(in) :: day !< Time of the start of the run. @@ -202,10 +203,12 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C !! conditions are used. type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_dye_tracer. - type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure - !! for the sponges, if they are in use. + type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure + !! for the sponges, if they are in use. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables -! Local variables + ! Local variables + real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m] real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] integer :: i, j, k, m @@ -216,8 +219,9 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C CS%diag => diag ! Establish location of source - do m= 1, CS%ntr - do j=G%jsd,G%jed ; do i=G%isd,G%ied + do j=G%jsc,G%jec + call thickness_to_dz(h, tv, dz, j, G, GV) + do m=1,CS%ntr ; do i=G%isc,G%iec ! A dye is set dependent on the center of the cell being inside the rectangular box. if (CS%dye_source_minlon(m) < G%geoLonT(i,j) .and. & CS%dye_source_maxlon(m) >= G%geoLonT(i,j) .and. & @@ -226,8 +230,8 @@ subroutine initialize_dye_tracer(restart, day, G, GV, h, diag, OBC, CS, sponge_C G%mask2dT(i,j) > 0.0 ) then z_bot = 0.0 do k = 1, GV%ke - z_bot = z_bot - h(i,j,k)*GV%H_to_Z - z_center = z_bot + 0.5*h(i,j,k)*GV%H_to_Z + z_bot = z_bot - dz(i,k) + z_center = z_bot + 0.5*dz(i,k) if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 @@ -244,7 +248,7 @@ end subroutine initialize_dye_tracer !! This is a simple example of a set of advected passive tracers. !! The arguments to this subroutine are redundant in that !! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) -subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, & +subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, tv, CS, & 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 @@ -264,6 +268,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US !! and tracer forcing fields. Unused fields have NULL ptrs. real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(dye_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_dye_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -271,8 +276,9 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [H ~> m or kg m-2] -! Local variables + ! 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 :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m] real :: z_bot ! Height of the bottom of the layer relative to the sea surface [Z ~> m] real :: z_center ! Height of the center of the layer relative to the sea surface [Z ~> m] integer :: i, j, k, is, ie, js, je, nz, m @@ -284,7 +290,7 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then do m=1,CS%ntr - do k=1,nz ;do j=js,je ; do i=is,ie + 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%tr(:,:,:,m), dt, fluxes, h_work, & @@ -297,8 +303,9 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US enddo endif - do m=1,CS%ntr - do j=G%jsd,G%jed ; do i=G%isd,G%ied + do j=js,je + call thickness_to_dz(h_new, tv, dz, j, G, GV) + do m=1,CS%ntr ; do i=is,ie ! A dye is set dependent on the center of the cell being inside the rectangular box. if (CS%dye_source_minlon(m) < G%geoLonT(i,j) .and. & CS%dye_source_maxlon(m) >= G%geoLonT(i,j) .and. & @@ -307,8 +314,8 @@ subroutine dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US G%mask2dT(i,j) > 0.0 ) then z_bot = 0.0 do k=1,nz - z_bot = z_bot - h_new(i,j,k)*GV%H_to_Z - z_center = z_bot + 0.5*h_new(i,j,k)*GV%H_to_Z + z_bot = z_bot - dz(i,k) + z_center = z_bot + 0.5*dz(i,k) if ( z_center > -CS%dye_source_maxdepth(m) .and. & z_center < -CS%dye_source_mindepth(m) ) then CS%tr(i,j,k,m) = 1.0 diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index dfa5e894db..8492437cb6 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -12,6 +12,7 @@ module ideal_age_example use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc +use MOM_interface_heights, only : thickness_to_dz use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS use MOM_spatial_means, only : global_mass_int_EFP @@ -21,7 +22,7 @@ module ideal_age_example 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 -use MOM_variables, only : surface +use MOM_variables, only : surface, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -46,13 +47,13 @@ module ideal_age_example 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 tracer registry - real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package, in g m-3? - real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value. - real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface. - real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out. - real, dimension(NTR_MAX) :: growth_rate !< The exponential growth rate for the young value [year-1]. + real, pointer :: tr(:,:,:,:) => NULL() !< The array of tracers used in this package [years] or other units + real, dimension(NTR_MAX) :: IC_val = 0.0 !< The (uniform) initial condition value [years] or other units + real, dimension(NTR_MAX) :: young_val = 0.0 !< The value assigned to tr at the surface [years] or other units + real, dimension(NTR_MAX) :: land_val = -1.0 !< The value of tr used where land is masked out [years] or other units + real, dimension(NTR_MAX) :: growth_rate !< The exponential growth rate for the young value [year-1] real, dimension(NTR_MAX) :: tracer_start_year !< The year in which tracers start aging, or at which the - !! surface value equals young_val, in years. + !! surface value equals young_val [years]. logical :: use_real_BL_depth !< If true, uses the BL scheme to determine the number of !! layers above the BL depth instead of the fixed nkbl value. integer :: BL_residence_num !< The tracer number assigned to the BL residence tracer in this module @@ -296,7 +297,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS end subroutine initialize_ideal_age_tracer !> Applies diapycnal diffusion, aging and regeneration at the surface to the ideal age tracers -subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, & +subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, tv, CS, & evap_CFL_limit, minimum_forcing_depth, Hbl) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -316,6 +317,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, !! and tracer forcing fields. Unused fields have NULL ptrs. real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -331,12 +333,12 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, ! The arguments to this subroutine are redundant in that ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: BL_layers ! Stores number of layers in boundary layer - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified - real :: young_val ! The "young" value for the tracers. + real, dimension(SZI_(G),SZJ_(G)) :: BL_layers ! Stores number of layers in boundary layer [nondim] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + real :: young_val ! The "young" value for the tracers [years] or other units real :: Isecs_per_year ! The inverse of the amount of time in a year [T-1 ~> s-1] - real :: year ! The time in years. - real :: layer_frac + real :: year ! The time in years [years] + real :: layer_frac ! The fraction of the current layer that is within the mixed layer [nondim] integer :: i, j, k, is, ie, js, je, nz, m, nk character(len=255) :: msg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -347,7 +349,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, endif if (CS%use_real_BL_depth .and. present(Hbl)) then - call count_BL_layers(G, GV, h_old, Hbl, BL_layers) + call count_BL_layers(G, GV, h_old, Hbl, tv, BL_layers) endif if (.not.associated(CS)) return @@ -576,33 +578,37 @@ subroutine ideal_age_example_end(CS) endif end subroutine ideal_age_example_end -subroutine count_BL_layers(G, GV, h, Hbl, BL_layers) +subroutine count_BL_layers(G, GV, h, Hbl, tv, BL_layers) 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 !< Layer thicknesses [H ~> m or kg m-2]. + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hbl !< Boundary layer depth [Z ~> m] - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BL_layers !< Number of model layers in the boundary layer + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BL_layers !< Number of model layers in the boundary layer [nondim] - real :: current_depth + real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m] + real :: current_depth ! Distance from the free surface [Z ~> m] integer :: i, j, k, is, ie, js, je, nz, m, nk character(len=255) :: msg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke BL_layers(:,:) = 0. - do j=js,je ; do i=is,ie - - current_depth = 0. - do k=1,nz - current_depth = current_depth + h(i,j,k)*GV%H_to_Z - if (Hbl(i,j) <= current_depth) then - BL_layers(i,j) = BL_layers(i,j) + (1.0 - (current_depth - Hbl(i,j)) / (h(i,j,k)*GV%H_to_Z)) - exit - else - BL_layers(i,j) = BL_layers(i,j) + 1.0 - endif + do j=js,je + call thickness_to_dz(h, tv, dz, j, G, GV) + do i=is,ie + current_depth = 0. + do k=1,nz + current_depth = current_depth + dz(i,k) + if (Hbl(i,j) <= current_depth) then + BL_layers(i,j) = BL_layers(i,j) + (1.0 - (current_depth - Hbl(i,j)) / dz(i,k)) + exit + else + BL_layers(i,j) = BL_layers(i,j) + 1.0 + endif + enddo enddo - enddo ; enddo + enddo end subroutine count_BL_layers diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 index e9d0bd5ef7..3c8fbe4ae8 100644 --- a/src/tracer/nw2_tracers.F90 +++ b/src/tracer/nw2_tracers.F90 @@ -9,6 +9,7 @@ module nw2_tracers use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type +use MOM_interface_heights, only : thickness_to_dz use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS use MOM_time_manager, only : time_type, time_type_to_real @@ -115,7 +116,7 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS) 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 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various !! thermodynamic variables @@ -124,7 +125,8 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS) type(nw2_tracers_CS), pointer :: CS !< The control structure returned by a previous !! call to register_nw2_tracer. ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Interface heights [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Vertical extent of layers [Z ~> m] real :: rscl ! z* scaling factor [nondim] character(len=8) :: var_name ! The variable's name. integer :: i, j, k, m @@ -135,20 +137,22 @@ subroutine initialize_nw2_tracers(restart, day, G, GV, US, h, tv, diag, CS) CS%diag => diag ! Calculate z* interface positions + call thickness_to_dz(h, tv, dz, G, GV, US) + if (GV%Boussinesq) then ! First calculate interface positions in z-space (m) do j=G%jsc,G%jec ; do i=G%isc,G%iec eta(i,j,GV%ke+1) = - G%mask2dT(i,j) * G%bathyT(i,j) enddo ; enddo do k=GV%ke,1,-1 ; do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h(i,j,k) * GV%H_to_Z + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * dz(i,j,k) enddo ; enddo ; enddo ! Re-calculate for interface positions in z*-space (m) do j=G%jsc,G%jec ; do i=G%isc,G%iec if (G%bathyT(i,j)>0.) then rscl = G%bathyT(i,j) / ( eta(i,j,1) + G%bathyT(i,j) ) do K=GV%ke, 1, -1 - eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h(i,j,k) * GV%H_to_Z * rscl + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * dz(i,j,k) * rscl enddo endif enddo ; enddo @@ -176,15 +180,15 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US 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_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be !! added [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: eb !< an array to which the amount of fluid entrained !! from the layer below during this call will be !! added [H ~> m or kg m-2]. @@ -206,8 +210,9 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US ! The arguments to this subroutine are redundant in that ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1) :: eta ! Interface heights [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_work ! Used so that h can be modified [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Interface heights [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: dz ! Vertical extent of layers [Z ~> m] integer :: i, j, k, m real :: dt_x_rate ! dt * restoring rate [nondim] real :: rscl ! z* scaling factor [nondim] @@ -231,20 +236,22 @@ subroutine nw2_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US endif ! Calculate z* interface positions + call thickness_to_dz(h_new, tv, dz, G, GV, US) + if (GV%Boussinesq) then - ! First calculate interface positions in z-space (m) + ! First calculate interface positions in z-space [Z ~> m] do j=G%jsc,G%jec ; do i=G%isc,G%iec eta(i,j,GV%ke+1) = - G%mask2dT(i,j) * G%bathyT(i,j) enddo ; enddo do k=GV%ke,1,-1 ; do j=G%jsc,G%jec ; do i=G%isc,G%iec - eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h_new(i,j,k) * GV%H_to_Z + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * dz(i,j,k) enddo ; enddo ; enddo - ! Re-calculate for interface positions in z*-space (m) + ! Re-calculate for interface positions in z*-space [Z ~> m] do j=G%jsc,G%jec ; do i=G%isc,G%iec if (G%bathyT(i,j)>0.) then rscl = G%bathyT(i,j) / ( eta(i,j,1) + G%bathyT(i,j) ) do K=GV%ke, 1, -1 - eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * h_new(i,j,k) * GV%H_to_Z * rscl + eta(i,j,K) = eta(i,j,K+1) + G%mask2dT(i,j) * dz(i,j,k) * rscl enddo endif enddo ; enddo @@ -269,7 +276,7 @@ real function nw2_tracer_dist(m, G, GV, eta, i, j, k) integer, intent(in) :: m !< Indicates the NW2 tracer 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),0:SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & intent(in) :: eta !< Interface position [Z ~> m] integer, intent(in) :: i !< Cell index i integer, intent(in) :: j !< Cell index j @@ -280,7 +287,7 @@ real function nw2_tracer_dist(m, G, GV, eta, i, j, k) pi = 2.*acos(0.) x = ( G%geolonT(i,j) - G%west_lon ) / G%len_lon ! 0 ... 1 y = -G%geolatT(i,j) / G%south_lat ! -1 ... 1 - z = - 0.5 * ( eta(i,j,K-1) + eta(i,j,K) ) / GV%max_depth ! 0 ... 1 + z = - 0.5 * ( eta(i,j,K) + eta(i,j,K+1) ) / GV%max_depth ! 0 ... 1 select case ( mod(m-1,3) ) case (0) ! sin(2 pi x/L) nw2_tracer_dist = sin( 2.0 * pi * x ) diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index a548436329..580e293f4f 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -97,7 +97,7 @@ module MOM_wave_interface !! Horizontal -> V points !! Vertical -> Mid-points real, allocatable, dimension(:,:,:), public :: & - KvS !< Viscosity for Stokes Drift shear [Z2 T-1 ~> m2 s-1] + KvS !< Viscosity for Stokes Drift shear [H Z T-1 ~> m2 s-1 or Pa s] ! The remainder of this control structure is private integer :: WaveMethod = -99 !< Options for including wave information @@ -197,6 +197,8 @@ module MOM_wave_interface real :: VonKar = -1.0 !< The von Karman coefficient as used in the MOM_wave_interface module [nondim] real :: rho_air !< A typical density of air at sea level, as used in wave calculations [R ~> kg m-3] real :: nu_air !< The viscosity of air, as used in wave calculations [Z2 T-1 ~> m2 s-1] + real :: rho_ocn !< A typical surface density of seawater, as used in wave calculations in + !! comparison with the density of air [R ~> kg m-3]. The default is RHO_0. real :: SWH_from_u10sq !< A factor for converting the square of the 10 m wind speed to the !! significant wave height [Z T2 L-2 ~> s2 m-1] real :: Charnock_min !< The minimum value of the Charnock coefficient, which relates the square of @@ -259,7 +261,7 @@ module MOM_wave_interface contains !> Initializes parameters related to MOM_wave_interface -subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restart_CSp) +subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag) type(time_type), target, intent(in) :: Time !< Model time type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure @@ -267,7 +269,6 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar type(param_file_type), intent(in) :: param_file !< Input parameter structure type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure type(diag_ctrl), target, intent(inout) :: diag !< Diagnostic Pointer - type(MOM_restart_CS), optional, pointer:: restart_CSp!< Restart control structure ! Local variables character(len=40) :: mdl = "MOM_wave_interface" !< This module's name. @@ -320,7 +321,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "\t >= 20230101 - More robust expressions for Update_Stokes_Drift\n"//& "\t >= 20230102 - More robust expressions for get_StokesSL_LiFoxKemper\n"//& "\t >= 20230103 - More robust expressions for ust_2_u10_coare3p5", & - default=20221231) ! In due course change the default to default=default_answer_date) + default=20221231, do_not_log=.not.GV%Boussinesq) + !### In due course change the default to default=default_answer_date) + if (.not.GV%Boussinesq) CS%answer_date = max(CS%answer_date, 20230701) ! Langmuir number Options call get_param(param_file, mdl, "LA_DEPTH_RATIO", CS%LA_FracHBL, & @@ -333,7 +336,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar if (StatisticalWaves) then CS%WaveMethod = LF17 - call set_LF17_wave_params(param_file, mdl, US, CS) + call set_LF17_wave_params(param_file, mdl, GV, US, CS) if (.not.use_waves) return else CS%WaveMethod = NULL_WaveMethod @@ -499,7 +502,7 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar "Flag to disable updating DHH85 Stokes drift.", default=.false.) case (LF17_STRING) !Li and Fox-Kemper 17 wind-sea Langmuir number CS%WaveMethod = LF17 - call set_LF17_wave_params(param_file, mdl, US, CS) + call set_LF17_wave_params(param_file, mdl, GV, US, CS) case (EFACTOR_STRING) !Li and Fox-Kemper 16 CS%WaveMethod = EFACTOR case default @@ -577,9 +580,10 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag, restar end subroutine MOM_wave_interface_init !> Set the parameters that are used to determine the averaged Stokes drift and Langmuir numbers -subroutine set_LF17_wave_params(param_file, mdl, US, CS) +subroutine set_LF17_wave_params(param_file, mdl, GV, US, CS) type(param_file_type), intent(in) :: param_file !< Input parameter structure character(len=*), intent(in) :: mdl !< A module name to use in the get_param calls + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(wave_parameters_CS), pointer :: CS !< Wave parameter control structure @@ -595,6 +599,10 @@ subroutine set_LF17_wave_params(param_file, mdl, US, CS) call get_param(param_file, mdl, "RHO_AIR", CS%rho_air, & "A typical density of air at sea level, as used in wave calculations", & units="kg m-3", default=1.225, scale=US%kg_m3_to_R) + call get_param(param_file, mdl, "RHO_SFC_WAVES", CS%Rho_ocn, & + "A typical surface density of seawater, as used in wave calculations in "//& + "comparison with the density of air. The default is RHO_0.", & + units="kg m-3", default=GV%Rho0*US%R_to_kg_m3, scale=US%kg_m3_to_R) call get_param(param_file, mdl, "WAVE_HEIGHT_SCALE_FACTOR", CS%SWH_from_u10sq, & "A factor relating the square of the 10 m wind speed to the significant "//& "wave height, with a default value based on the Pierson-Moskowitz spectrum.", & @@ -712,13 +720,13 @@ end subroutine Update_Surface_Waves !> Constructs the Stokes Drift profile on the model grid based on !! desired coupling options -subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) +subroutine Update_Stokes_Drift(G, GV, US, CS, dz, ustar, dt, dynamics_step) type(wave_parameters_CS), pointer :: CS !< Wave parameter Control structure type(ocean_grid_type), intent(inout) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Thickness [H ~> m or kg m-2] + intent(in) :: dz !< Thickness in height units [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: ustar !< Wind friction velocity [Z T-1 ~> m s-1]. real, intent(in) :: dt !< Time-step for computing Stokes-tendency [T ~> s] @@ -727,7 +735,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! Local Variables real :: Top, MidPoint, Bottom ! Positions within the layer [Z ~> m] real :: level_thick ! The thickness of each layer [Z ~> m] - real :: DecayScale ! A vertical decay scale in the test profile [Z ~> m] + real :: DecayScale ! A vertical decay scale in the test profile [Z-1 ~> m-1] real :: CMN_FAC ! A nondimensional factor [nondim] real :: WN ! Model wavenumber [Z-1 ~> m-1] real :: UStokes ! A Stokes drift velocity [L T-1 ~> m s-1] @@ -754,8 +762,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) MidPoint = 0.0 do kk = 1,GV%ke Top = Bottom - MidPoint = Bottom - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) - Bottom = Bottom - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) + MidPoint = Bottom - 0.25*(dz(II,jj,kk)+dz(IIm1,jj,kk)) + Bottom = Bottom - 0.5*(dz(II,jj,kk)+dz(IIm1,jj,kk)) CS%Us_x(II,jj,kk) = CS%TP_STKX0*exp(MidPoint*DecayScale) enddo enddo @@ -767,8 +775,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) MidPoint = 0.0 do kk = 1,GV%ke Top = Bottom - MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) - Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + MidPoint = Bottom - 0.25*(dz(ii,JJ,kk)+dz(ii,JJm1,kk)) + Bottom = Bottom - 0.5*(dz(ii,JJ,kk)+dz(ii,JJm1,kk)) CS%Us_y(ii,JJ,kk) = CS%TP_STKY0*exp(MidPoint*DecayScale) enddo enddo @@ -795,7 +803,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) do kk = 1,GV%ke Top = Bottom IIm1 = max(II-1,1) - level_thick = 0.5*GV%H_to_Z*(h(II,jj,kk)+h(IIm1,jj,kk)) + level_thick = 0.5*(dz(II,jj,kk)+dz(IIm1,jj,kk)) MidPoint = Top - 0.5*level_thick Bottom = Top - level_thick @@ -853,7 +861,7 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) do kk = 1,GV%ke Top = Bottom JJm1 = max(JJ-1,1) - level_thick = 0.5*GV%H_to_Z*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + level_thick = 0.5*(dz(ii,JJ,kk)+dz(ii,JJm1,kk)) MidPoint = Top - 0.5*level_thick Bottom = Top - level_thick @@ -907,8 +915,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) do kk = 1,GV%ke Top = Bottom IIm1 = max(II-1,1) - MidPoint = Top - GV%H_to_Z*0.25*(h(II,jj,kk)+h(IIm1,jj,kk)) - Bottom = Top - GV%H_to_Z*0.5*(h(II,jj,kk)+h(IIm1,jj,kk)) + MidPoint = Top - 0.25*(dz(II,jj,kk)+dz(IIm1,jj,kk)) + Bottom = Top - 0.5*(dz(II,jj,kk)+dz(IIm1,jj,kk)) !bgr note that this is using a u-point ii on h-point ustar ! this code has only been previous used for uniform ! grid cases. This needs fixed if DHH85 is used for non @@ -925,8 +933,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) do kk=1, GV%ke Top = Bottom JJm1 = max(JJ-1,1) - MidPoint = Bottom - GV%H_to_Z*0.25*(h(ii,JJ,kk)+h(ii,JJm1,kk)) - Bottom = Bottom - GV%H_to_Z*0.5*(h(ii,JJ,kk)+h(ii,JJm1,kk)) + MidPoint = Bottom - 0.25*(dz(ii,JJ,kk)+dz(ii,JJm1,kk)) + Bottom = Bottom - 0.5*(dz(ii,JJ,kk)+dz(ii,JJm1,kk)) !bgr note that this is using a v-point jj on h-point ustar ! this code has only been previous used for uniform ! grid cases. This needs fixed if DHH85 is used for non @@ -964,9 +972,8 @@ subroutine Update_Stokes_Drift(G, GV, US, CS, h, ustar, dt, dynamics_step) ! in the routine it is needed by (e.g. KPP or ePBL). do jj = G%jsc, G%jec do ii = G%isc,G%iec - Top = h(ii,jj,1)*GV%H_to_Z - call get_Langmuir_Number( La, G, GV, US, Top, ustar(ii,jj), ii, jj, & - h(ii,jj,:), CS, Override_MA=.false.) + call get_Langmuir_Number( La, G, GV, US, dz(ii,jj,1), ustar(ii,jj), ii, jj, & + dz(ii,jj,:), CS, Override_MA=.false.) CS%La_turb(ii,jj) = La enddo enddo @@ -1137,7 +1144,7 @@ end subroutine Surface_Bands_by_data_override !! Note this can be called with an unallocated Waves pointer, which is okay if we !! want the wind-speed only dependent Langmuir number. Therefore, we need to be !! careful about what we try to access here. -subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & +subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, dz, Waves, & U_H, V_H, Override_MA ) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -1147,7 +1154,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & real, intent(in) :: ustar !< Friction velocity [Z T-1 ~> m s-1] integer, intent(in) :: i !< Meridional index of h-point integer, intent(in) :: j !< Zonal index of h-point - real, dimension(SZK_(GV)), intent(in) :: h !< Grid layer thickness [H ~> m or kg m-2] + real, dimension(SZK_(GV)), intent(in) :: dz !< Grid layer thickness [Z ~> m] type(Wave_parameters_CS), pointer :: Waves !< Surface wave control structure. real, dimension(SZK_(GV)), & optional, intent(in) :: U_H !< Zonal velocity at H point [L T-1 ~> m s-1] or [m s-1] @@ -1160,7 +1167,7 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & !Local Variables - real :: Top, bottom, midpoint ! Positions within each layer [Z ~> m] + real :: Top, Bottom, MidPoint ! Positions within each layer [Z ~> m] real :: Dpt_LASL ! Averaging depth for Stokes drift [Z ~> m] real :: ShearDirection ! Shear angular direction from atan2 [radians] real :: WaveDirection ! Wave angular direction from atan2 [radians] @@ -1184,8 +1191,11 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & bottom = 0.0 do kk = 1,GV%ke Top = Bottom - MidPoint = Bottom + GV%H_to_Z*0.5*h(kk) - Bottom = Bottom + GV%H_to_Z*h(kk) + MidPoint = Bottom + 0.5*dz(kk) + Bottom = Bottom + dz(kk) + !### Given the sign convention that Dpt_LASL is negative, the next line seems to have a bug. + ! To correct this bug, this line should be changed to: + ! if (MidPoint > abs(Dpt_LASL) .and. (kk > 1) .and. ContinueLoop) then if (MidPoint > Dpt_LASL .and. kk > 1 .and. ContinueLoop) then ShearDirection = atan2(V_H(1)-V_H(kk),U_H(1)-U_H(kk)) ContinueLoop = .false. @@ -1198,8 +1208,8 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & US_H(kk) = 0.5*(Waves%US_X(I,j,kk)+Waves%US_X(I-1,j,kk)) VS_H(kk) = 0.5*(Waves%US_Y(i,J,kk)+Waves%US_Y(i,J-1,kk)) enddo - call Get_SL_Average_Prof( GV, Dpt_LASL, h, US_H, LA_STKx) - call Get_SL_Average_Prof( GV, Dpt_LASL, h, VS_H, LA_STKy) + call Get_SL_Average_Prof( GV, Dpt_LASL, dz, US_H, LA_STKx) + call Get_SL_Average_Prof( GV, Dpt_LASL, dz, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX*LA_STKX+LA_STKY*LA_STKY) elseif (Waves%WaveMethod==SURFBANDS) then allocate(StkBand_X(Waves%NumBands), StkBand_Y(Waves%NumBands)) @@ -1217,11 +1227,11 @@ subroutine get_Langmuir_Number( LA, G, GV, US, HBL, ustar, i, j, h, Waves, & US_H(kk) = 0.5*(Waves%US_X(I,j,kk)+Waves%US_X(I-1,j,kk)) VS_H(kk) = 0.5*(Waves%US_Y(i,J,kk)+Waves%US_Y(i,J-1,kk)) enddo - call Get_SL_Average_Prof( GV, Dpt_LASL, h, US_H, LA_STKx) - call Get_SL_Average_Prof( GV, Dpt_LASL, h, VS_H, LA_STKy) + call Get_SL_Average_Prof( GV, Dpt_LASL, dz, US_H, LA_STKx) + call Get_SL_Average_Prof( GV, Dpt_LASL, dz, VS_H, LA_STKy) LA_STK = sqrt(LA_STKX**2 + LA_STKY**2) elseif (Waves%WaveMethod==LF17) then - call get_StokesSL_LiFoxKemper(ustar, hbl*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA) + call get_StokesSL_LiFoxKemper(ustar, HBL*Waves%LA_FracHBL, GV, US, Waves, LA_STK, LA) elseif (Waves%WaveMethod==Null_WaveMethod) then call MOM_error(FATAL, "Get_Langmuir_number called without defining a WaveMethod. "//& "Suggest to make sure USE_LT is set/overridden to False or choose "//& @@ -1321,7 +1331,7 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) ! This code should be revised to minimize the number of divisions and cancel out common factors. ! Computing u10 based on u_star and COARE 3.5 relationships - call ust_2_u10_coare3p5(ustar*sqrt(GV%Rho0/CS%rho_air), u10, GV, US, CS) + call ust_2_u10_coare3p5(ustar*sqrt(CS%rho_ocn/CS%rho_air), u10, GV, US, CS) ! surface Stokes drift UStokes = us_to_u10*u10 ! @@ -1405,19 +1415,19 @@ subroutine get_StokesSL_LiFoxKemper(ustar, hbl, GV, US, CS, UStokes_SL, LA) end subroutine Get_StokesSL_LiFoxKemper !> Get SL Averaged Stokes drift from a Stokes drift Profile -subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) +subroutine Get_SL_Average_Prof( GV, AvgDepth, dz, Profile, Average ) type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid structure - real, intent(in) :: AvgDepth !< Depth to average over (negative) [Z ~> m]. + real, intent(in) :: AvgDepth !< Depth to average over (negative) [Z ~> m] real, dimension(SZK_(GV)), & - intent(in) :: H !< Grid thickness [H ~> m or kg m-2] + intent(in) :: dz !< Grid thickness [Z ~> m] real, dimension(SZK_(GV)), & intent(in) :: Profile !< Profile of quantity to be averaged in arbitrary units [A] !! (used here for Stokes drift) real, intent(out) :: Average !< Output quantity averaged over depth AvgDepth [A] !! (used here for Stokes drift) !Local variables - real :: top, midpoint, bottom ! Depths, negative downward [Z ~> m]. + real :: Top, Bottom ! Depths, negative downward [Z ~> m] real :: Sum ! The depth weighted vertical sum of a quantity [A Z ~> A m] integer :: kk @@ -1428,10 +1438,9 @@ subroutine Get_SL_Average_Prof( GV, AvgDepth, H, Profile, Average ) bottom = 0.0 do kk = 1, GV%ke Top = Bottom - MidPoint = Bottom - GV%H_to_Z * 0.5*h(kk) - Bottom = Bottom - GV%H_to_Z * h(kk) + Bottom = Bottom - dz(kk) if (AvgDepth < Bottom) then ! The whole cell is within H_LA - Sum = Sum + Profile(kk) * (GV%H_to_Z * H(kk)) + Sum = Sum + Profile(kk) * dz(kk) elseif (AvgDepth < Top) then ! A partial cell is within H_LA Sum = Sum + Profile(kk) * (Top-AvgDepth) exit @@ -1545,7 +1554,7 @@ end subroutine DHH85_mid !> Explicit solver for Stokes mixing. !! Still in development do not use. -subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) +subroutine StokesMixing(G, GV, dt, h, dz, u, v, Waves ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & @@ -1553,6 +1562,8 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) real, intent(in) :: dt !< Time step of MOM6 [T ~> s] for explicit solver real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: dz !< Vertical distance between interfaces around a layer [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & intent(inout) :: u !< Velocity i-component [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & @@ -1560,8 +1571,9 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) type(Wave_parameters_CS), & pointer :: Waves !< Surface wave related control structure. ! Local variables - real :: dTauUp, dTauDn ! Vertical momentum fluxes [Z L T-2 ~> m2 s-2] - real :: h_Lay ! The layer thickness at a velocity point [Z ~> m]. + real :: dTauUp, dTauDn ! Vertical momentum fluxes [H L T-2 ~> m2 s-2 or Pa] + real :: h_lay ! The layer thickness at a velocity point [H ~> m or kg m-2] + real :: dz_lay ! The distance between interfaces at a velocity point [Z ~> m] integer :: i, j, k ! This is a template to think about down-Stokes mixing. @@ -1570,18 +1582,19 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) do k = 1, GV%ke do j = G%jsc, G%jec do I = G%iscB, G%iecB - h_lay = GV%H_to_Z*0.5*(h(i,j,k)+h(i+1,j,k)) + h_lay = 0.5*(h(i,j,k)+h(i+1,j,k)) + dz_lay = 0.5*(dz(i,j,k)+dz(i+1,j,k)) dTauUp = 0.0 if (k > 1) & - dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k)) * & + dTauUp = (0.5*(waves%Kvs(i,j,k)+waves%Kvs(i+1,j,k))) * & (waves%us_x(i,j,k-1)-waves%us_x(i,j,k)) / & - (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k-1)+h(i+1,j,k-1)) )) + (0.5*(dz_lay + 0.5*(dz(i,j,k-1)+dz(i+1,j,k-1)) )) dTauDn = 0.0 if (k < GV%ke-1) & - dTauDn = 0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i+1,j,k+1)) * & + dTauDn = (0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i+1,j,k+1))) * & (waves%us_x(i,j,k)-waves%us_x(i,j,k+1)) / & - (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k+1)+h(i+1,j,k+1)) )) - u(i,j,k) = u(i,j,k) + dt * (dTauUp-dTauDn) / h_Lay + (0.5*(dz_lay + 0.5*(dz(i,j,k+1)+dz(i+1,j,k+1)) )) + u(i,j,k) = u(i,j,k) + dt * (dTauUp-dTauDn) / h_lay enddo enddo enddo @@ -1589,18 +1602,19 @@ subroutine StokesMixing(G, GV, dt, h, u, v, Waves ) do k = 1, GV%ke do J = G%jscB, G%jecB do i = G%isc, G%iec - h_Lay = GV%H_to_Z*0.5*(h(i,j,k)+h(i,j+1,k)) + h_lay = 0.5*(h(i,j,k)+h(i,j+1,k)) + dz_lay = 0.5*(dz(i,j,k)+dz(i,j+1,k)) dTauUp = 0. if (k > 1) & - dTauUp = 0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k)) * & + dTauUp = (0.5*(waves%Kvs(i,j,k)+waves%Kvs(i,j+1,k))) * & (waves%us_y(i,j,k-1)-waves%us_y(i,j,k)) / & - (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k-1)+h(i,j+1,k-1)) )) + (0.5*(dz_lay + 0.5*(dz(i,j,k-1)+dz(i,j+1,k-1)) )) dTauDn = 0.0 if (k < GV%ke-1) & - dTauDn =0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1)) * & + dTauDn = (0.5*(waves%Kvs(i,j,k+1)+waves%Kvs(i,j+1,k+1))) * & (waves%us_y(i,j,k)-waves%us_y(i,j,k+1)) / & - (0.5*(h_lay + GV%H_to_Z*0.5*(h(i,j,k+1)+h(i,j+1,k+1)) )) - v(i,J,k) = v(i,J,k) + dt * (dTauUp-dTauDn) / h_Lay + (0.5*(dz_lay + 0.5*(dz(i,j,k+1)+dz(i,j+1,k+1)) )) + v(i,J,k) = v(i,J,k) + dt * (dTauUp-dTauDn) / h_lay enddo enddo enddo @@ -1657,13 +1671,15 @@ end subroutine CoriolisStokes !! including analytical integration of Stokes shear using multiple-exponential decay !! Stokes drift profile and vertical integration of the resulting pressure !! anomaly to the total pressure gradient force -subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) +subroutine Stokes_PGF(G, GV, US, dz, u, v, PFu_Stokes, PFv_Stokes, CS ) type(ocean_grid_type), & intent(in) :: G !< Ocean grid type(verticalGrid_type), & intent(in) :: GV !< Ocean vertical grid + type(unit_scale_type), & + intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(G)),& - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + intent(in) :: dz !< Layer thicknesses in height units [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & intent(in) :: u !< Lagrangian Velocity i-component [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & @@ -1736,12 +1752,13 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) zi_l(1) = 0.0 zi_r(1) = 0.0 do k = 1, G%ke - h_l = h(i,j,k)*GV%H_to_Z - h_r = h(i+1,j,k)*GV%H_to_Z + h_l = dz(i,j,k) + h_r = dz(i+1,j,k) zi_l(k+1) = zi_l(k) - h_l zi_r(k+1) = zi_r(k) - h_r - Idz_l(k) = 1./max(0.1,h_l) - Idz_r(k) = 1./max(0.1,h_r) + !### If the code were properly refactored, the following hard-coded constants would be unnecessary. + Idz_l(k) = 1./max(0.1*US%m_to_Z, h_l) + Idz_r(k) = 1./max(0.1*US%m_to_Z, h_r) enddo do k = 1,G%ke ! Computing (left/right) Eulerian velocities assuming the velocity passed to this routine is the @@ -1829,12 +1846,13 @@ subroutine Stokes_PGF(G, GV, h, u, v, PFu_Stokes, PFv_Stokes, CS ) zi_l(1) = 0.0 zi_r(1) = 0.0 do k = 1, G%ke - h_l = h(i,j,k)*GV%H_to_Z - h_r = h(i,j+1,k)*GV%H_to_Z + h_l = dz(i,j,k) + h_r = dz(i,j+1,k) zi_l(k+1) = zi_l(k) - h_l zi_r(k+1) = zi_r(k) - h_r - Idz_l(k) = 1./max(0.1,h_l) - Idz_r(k) = 1./max(0.1,h_r) + !### If the code were properly refactored, the following hard-coded constants would be unnecessary. + Idz_l(k) = 1. / max(0.1*US%m_to_Z, h_l) + Idz_r(k) = 1. / max(0.1*US%m_to_Z, h_r) enddo do k = 1,G%ke ! Computing (left/right) Eulerian velocities assuming the velocity passed to this routine is the diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index 4f213d86d9..b76e69bb44 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -40,21 +40,23 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(out) :: h !< The thickness that is being initialized [Z ~> m] + intent(out) :: h !< The thickness that is being initialized [H ~> m or kg m-2] type(param_file_type), intent(in) :: param_file !< A structure indicating the open file !! to parse for model parameter values. logical, intent(in) :: just_read !< If true, this call will only read !! parameters without changing h. - integer :: i, j, k, is, ie, js, je, nz - real :: Tz ! Vertical temperature gradient [C Z-1 ~> degC m-1] - real :: Dml ! Mixed layer depth [Z ~> m] - real :: eta ! An interface height depth [Z ~> m] + ! Local variables + real :: Tz ! Vertical temperature gradient [C H-1 ~> degC m2 kg-1] + real :: Dml ! Mixed layer depth [H ~> m or kg m-2] + real :: eta ! An interface height depth [H ~> m or kg m-2] real :: stretch ! A nondimensional stretching factor [nondim] - real :: h0 ! The stretched thickness per layer [Z ~> m] + real :: h0 ! The stretched thickness per layer [H ~> m or kg m-2] real :: T_range ! Range of temperatures over the vertical [C ~> degC] real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] + real :: max_depth ! Maximum depth of the model bathymetry [H ~> m or kg m-2] character(len=40) :: verticalCoordinate + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -69,40 +71,57 @@ subroutine Rossby_front_initialize_thickness(h, G, GV, US, param_file, just_read units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) call get_param(param_file, mdl, "DRHO_DT", dRho_dT, & units="kg m-3 degC-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.) + call get_param(param_file, mdl, "MAXIMUM_DEPTH", max_depth, & + units="m", default=-1.e9, scale=GV%m_to_H, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. - Tz = T_range / G%max_depth - - select case ( coordinateMode(verticalCoordinate) ) - - case (REGRIDDING_LAYER, REGRIDDING_RHO) - do j = G%jsc,G%jec ; do i = G%isc,G%iec - Dml = Hml( G, G%geoLatT(i,j) ) - eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) - stretch = ( ( G%max_depth + eta ) / G%max_depth ) - h0 = ( G%max_depth / real(nz) ) * stretch - do k = 1, nz - h(i,j,k) = h0 - enddo - enddo ; enddo - - case (REGRIDDING_ZSTAR, REGRIDDING_SIGMA) - do j = G%jsc,G%jec ; do i = G%isc,G%iec - Dml = Hml( G, G%geoLatT(i,j) ) - eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) - stretch = ( ( G%max_depth + eta ) / G%max_depth ) - h0 = ( G%max_depth / real(nz) ) * stretch - do k = 1, nz - h(i,j,k) = h0 - enddo - enddo ; enddo - - case default - call MOM_error(FATAL,"Rossby_front_initialize: "// & - "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE") - - end select + if (max_depth <= 0.0) call MOM_error(FATAL, & + "Rossby_front_initialize_thickness, Rossby_front_initialize_thickness: "//& + "This module requires a positive value of MAXIMUM_DEPTH.") + + Tz = T_range / max_depth + + if (GV%Boussinesq) then + select case ( coordinateMode(verticalCoordinate) ) + + case (REGRIDDING_LAYER, REGRIDDING_RHO) + ! This code is identical to the REGRIDDING_ZSTAR case but probably should not be. + do j = G%jsc,G%jec ; do i = G%isc,G%iec + Dml = Hml( G, G%geoLatT(i,j), max_depth ) + eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) + stretch = ( ( max_depth + eta ) / max_depth ) + h0 = ( max_depth / real(nz) ) * stretch + do k = 1, nz + h(i,j,k) = h0 + enddo + enddo ; enddo + + case (REGRIDDING_ZSTAR, REGRIDDING_SIGMA) + do j = G%jsc,G%jec ; do i = G%isc,G%iec + Dml = Hml( G, G%geoLatT(i,j), max_depth ) + ! The free surface height is set so that the bottom pressure gradient is 0. + eta = -( -dRho_dT / GV%Rho0 ) * Tz * 0.5 * ( Dml * Dml ) + stretch = ( ( max_depth + eta ) / max_depth ) + h0 = ( max_depth / real(nz) ) * stretch + do k = 1, nz + h(i,j,k) = h0 + enddo + enddo ; enddo + + case default + call MOM_error(FATAL,"Rossby_front_initialize: "// & + "Unrecognized i.c. setup - set REGRIDDING_COORDINATE_MODE") + + end select + else + ! In non-Boussinesq mode with a flat bottom, the only requirement for no bottom pressure + ! gradient and no abyssal flow is that all columns have the same mass. + h0 = max_depth / real(nz) + do k=1,nz ; do j=G%jsc,G%jec ; do i=G%isc,G%iec + h(i,j,k) = h0 + enddo ; enddo ; enddo + endif end subroutine Rossby_front_initialize_thickness @@ -114,20 +133,22 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T !< Potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: S !< Salinity [S ~> ppt] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [Z ~> m] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Thickness [H ~> m or kg m-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Parameter file handle logical, intent(in) :: just_read !< If true, this call will !! only read parameters without changing T & S. - - integer :: i, j, k, is, ie, js, je, nz + ! Local variables real :: T_ref ! Reference temperature within the surface layer [C ~> degC] real :: S_ref ! Reference salinity within the surface layer [S ~> ppt] real :: T_range ! Range of temperatures over the vertical [C ~> degC] - real :: zc ! Position of the middle of the cell [Z ~> m] - real :: zi ! Bottom interface position relative to the sea surface [Z ~> m] - real :: dTdz ! Vertical temperature gradient [C Z-1 ~> degC m-1] + real :: zc ! Position of the middle of the cell [H ~> m or kg m-2] + real :: zi ! Bottom interface position relative to the sea surface [H ~> m or kg m-2] + real :: dTdz ! Vertical temperature gradient [C H-1 ~> degC m-1 or degC m2 kg-1] + real :: Dml ! Mixed layer depth [H ~> m or kg m-2] + real :: max_depth ! Maximum depth of the model bathymetry [H ~> m or kg m-2] character(len=40) :: verticalCoordinate + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke @@ -135,24 +156,32 @@ subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, GV, US, & default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=just_read) - call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', & + call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & units='C', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=just_read) - call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range',& + call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "MAXIMUM_DEPTH", max_depth, & + units="m", default=-1.e9, scale=GV%m_to_H, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. + if (max_depth <= 0.0) call MOM_error(FATAL, & + "Rossby_front_initialize_thickness, Rossby_front_initialize_temperature_salinity: "//& + "This module requires a positive value of MAXIMUM_DEPTH.") + T(:,:,:) = 0.0 S(:,:,:) = S_ref - dTdz = T_range / G%max_depth + dTdz = T_range / max_depth + ! This sets the temperature to the value at the base of the specified mixed layer + ! depth from a horizontally uniform constant thermal stratification. do j = G%jsc,G%jec ; do i = G%isc,G%iec zi = 0. + Dml = Hml(G, G%geoLatT(i,j), max_depth) do k = 1, nz zi = zi - h(i,j,k) ! Bottom interface position zc = zi - 0.5*h(i,j,k) ! Position of middle of cell - zc = min( zc, -Hml(G, G%geoLatT(i,j)) ) ! Bound by depth of mixed layer - T(i,j,k) = T_ref + dTdz * zc ! Linear temperature profile + T(i,j,k) = T_ref + dTdz * min( zc, -Dml ) ! Linear temperature profile below the mixed layer enddo enddo ; enddo @@ -176,13 +205,24 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just !! read parameters without setting u & v. real :: T_range ! Range of temperatures over the vertical [C ~> degC] - real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f [L2 Z-1 T-1 C-1 ~> m s-1 degC-1] + real :: T_ref ! Reference temperature within the surface layer [C ~> degC] + real :: S_ref ! Reference salinity within the surface layer [S ~> ppt] + real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f with rescaling + ! [L2 H-1 T-1 C-1 ~> m s-1 degC-1 or m4 kg-1 s-1 degC-1] + real :: Rho_T0_S0 ! The density at T=0, S=0 [R ~> kg m-3] real :: dRho_dT ! The partial derivative of density with temperature [R C-1 ~> kg m-3 degC-1] - real :: Dml ! Mixed layer depth [Z ~> m] - real :: zi, zc, zm ! Depths [Z ~> m]. + real :: dRho_dS ! The partial derivative of density with salinity [R S-1 ~> kg m-3 ppt-1] + real :: dSpV_dT ! The partial derivative of specific volume with temperature [R-1 C-1 ~> m3 kg-1 degC-1] + real :: T_here ! The temperature in the middle of a layer [C ~> degC] + real :: dTdz ! Vertical temperature gradient [C H-1 ~> degC m-1 or degC m2 kg-1] + real :: Dml ! Mixed layer depth [H ~> m or kg m-2] + real :: zi, zc, zm ! Depths in thickness units [H ~> m or kg m-2]. real :: f ! The local Coriolis parameter [T-1 ~> s-1] + real :: I_f ! The Adcroft reciprocal of the local Coriolis parameter [T ~> s] real :: Ty ! The meridional temperature gradient [C L-1 ~> degC m-1] - real :: hAtU ! Interpolated layer thickness [Z ~> m]. + real :: hAtU ! Interpolated layer thickness in height units [H ~> m or kg m-2]. + real :: u_int ! The zonal velocity at an interface [L T-1 ~> m s=1] + real :: max_depth ! Maximum depth of the model bathymetry [H ~> m or kg m-2] integer :: i, j, k, is, ie, js, je, nz character(len=40) :: verticalCoordinate @@ -192,30 +232,73 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, US, param_file, just default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & units='C', default=0.0, scale=US%degC_to_C, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', & + default=35.0, units='1e-3', scale=US%ppt_to_S, do_not_log=.true.) + call get_param(param_file, mdl, "T_REF", T_ref, 'Reference temperature', & + units='C', scale=US%degC_to_C, fail_if_missing=.not.just_read, do_not_log=.true.) + call get_param(param_file, mdl, "RHO_T0_S0", Rho_T0_S0, & + units="kg m-3", default=1000.0, scale=US%kg_m3_to_R, do_not_log=.true.) call get_param(param_file, mdl, "DRHO_DT", dRho_dT, & - units='kg m-3 degC-1', default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.) + units="kg m-3 degC-1", default=-0.2, scale=US%kg_m3_to_R*US%C_to_degC, do_not_log=.true.) + call get_param(param_file, mdl, "DRHO_DS", dRho_dS, & + units="kg m-3 ppt-1", default=0.8, scale=US%kg_m3_to_R*US%S_to_ppt, do_not_log=.true.) + call get_param(param_file, mdl, "MAXIMUM_DEPTH", max_depth, & + units="m", default=-1.e9, scale=GV%m_to_H, do_not_log=.true.) if (just_read) return ! All run-time parameters have been read, so return. + if (max_depth <= 0.0) call MOM_error(FATAL, & + "Rossby_front_initialize_thickness, Rossby_front_initialize_velocity: "//& + "This module requires a positive value of MAXIMUM_DEPTH.") + v(:,:,:) = 0.0 u(:,:,:) = 0.0 - do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 - f = 0.5* (G%CoriolisBu(I,j) + G%CoriolisBu(I,j-1) ) - dUdT = 0.0 ; if (abs(f) > 0.0) & - dUdT = ( GV%g_Earth*dRho_dT ) / ( f * GV%Rho0 ) - Dml = Hml( G, G%geoLatT(i,j) ) - Ty = dTdy( G, T_range, G%geoLatT(i,j), US ) - zi = 0. - do k = 1, nz - hAtU = 0.5*(h(i,j,k)+h(i+1,j,k)) * GV%H_to_Z - zi = zi - hAtU ! Bottom interface position - zc = zi - 0.5*hAtU ! Position of middle of cell - zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer - u(I,j,k) = dUdT * Ty * zm ! Thermal wind starting at base of ML - enddo - enddo ; enddo - + if (GV%Boussinesq) then + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 + f = 0.5* (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) + dUdT = 0.0 ; if (abs(f) > 0.0) & + dUdT = ( GV%H_to_Z*GV%g_Earth*dRho_dT ) / ( f * GV%Rho0 ) + Dml = Hml( G, G%geoLatCu(I,j), max_depth ) + Ty = dTdy( G, T_range, G%geoLatCu(I,j), US ) + zi = 0. + do k = 1, nz + hAtU = 0.5 * (h(i,j,k) + h(i+1,j,k)) + zi = zi - hAtU ! Bottom interface position + zc = zi - 0.5*hAtU ! Position of middle of cell + zm = max( zc + Dml, 0. ) ! Height above bottom of mixed layer + u(I,j,k) = dUdT * Ty * zm ! Thermal wind starting at base of ML + enddo + enddo ; enddo + else + ! With an equation of state that is linear in density, the nonlinearies in + ! specific volume require that temperature be calculated for each layer. + + dTdz = T_range / max_depth + + do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 + f = 0.5* (G%CoriolisBu(I,J) + G%CoriolisBu(I,J-1) ) + I_f = 0.0 ; if (abs(f) > 0.0) I_f = 1.0 / f + Dml = Hml( G, G%geoLatCu(I,j), max_depth ) + Ty = dTdy( G, T_range, G%geoLatCu(I,j), US ) + zi = -max_depth + u_int = 0.0 ! The velocity at an interface + ! Work upward in non-Boussinesq mode + do k = nz, 1, -1 + hAtU = 0.5 * (h(i,j,k) + h(i+1,j,k)) + zc = zi + 0.5*hAtU ! Position of middle of cell + T_here = T_ref + dTdz * min(zc, -Dml) ! Linear temperature profile below the mixed layer + dSpV_dT = -dRho_dT / (Rho_T0_S0 + (dRho_dS * S_ref + dRho_dT * T_here) )**2 + dUdT = -( GV%H_to_RZ * GV%g_Earth * dSpV_dT ) * I_f + + ! There is thermal wind shear only within the mixed layer. + u(I,j,k) = u_int + dUdT * Ty * min(max((zi + Dml) + 0.5*hAtU, 0.0), 0.5*hAtU) + u_int = u_int + dUdT * Ty * min(max((zi + Dml) + hAtU, 0.0), hAtU) + + zi = zi + hAtU ! Update the layer top interface position + enddo + enddo ; enddo + endif end subroutine Rossby_front_initialize_velocity !> Pseudo coordinate across domain used by Hml() and dTdy() @@ -234,15 +317,16 @@ end function yPseudo !> Analytic prescription of mixed layer depth in 2d Rossby front test, -!! in the same units as G%max_depth (usually [Z ~> m]) -real function Hml( G, lat ) +!! in the same units as max_depth (usually [Z ~> m] or [H ~> m or kg m-2]) +real function Hml( G, lat, max_depth ) type(ocean_grid_type), intent(in) :: G !< Grid structure real, intent(in) :: lat !< Latitude in arbitrary units, often [km] + real, intent(in) :: max_depth !< The maximum depth of the ocean [Z ~> m] or [H ~> m or kg m-2] ! Local - real :: dHML, HMLmean ! The range and mean of the mixed layer depths [Z ~> m] + real :: dHML, HMLmean ! The range and mean of the mixed layer depths [Z ~> m] or [H ~> m or kg m-2] - dHML = 0.5 * ( HMLmax - HMLmin ) * G%max_depth - HMLmean = 0.5 * ( HMLmin + HMLmax ) * G%max_depth + dHML = 0.5 * ( HMLmax - HMLmin ) * max_depth + HMLmean = 0.5 * ( HMLmin + HMLmax ) * max_depth Hml = HMLmean + dHML * sin( yPseudo(G, lat) ) end function Hml diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index c12d34a721..9a56c12b9c 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -26,8 +26,8 @@ module user_change_diffusivity !> Control structure for user_change_diffusivity type, public :: user_change_diff_CS ; private logical :: initialized = .false. !< True if this control structure has been initialized. - real :: Kd_add !< The scale of a diffusivity that is added everywhere - !! without any filtering or scaling [Z2 T-1 ~> m2 s-1]. + real :: Kd_add !< The scale of a diffusivity that is added everywhere without + !! any filtering or scaling [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real :: lat_range(4) !< 4 values that define the latitude range over which !! a diffusivity scaled by Kd_add is added [degrees_N]. real :: rho_range(4) !< 4 values that define the coordinate potential @@ -54,17 +54,17 @@ subroutine user_change_diff(h, tv, G, GV, US, CS, Kd_lay, Kd_int, T_f, S_f, Kd_i !! fields. Absent fields have NULL ptrs. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(user_change_diff_CS), pointer :: CS !< This module's control structure. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of - !! each layer [Z2 T-1 ~> m2 s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity - !! at each interface [Z2 T-1 ~> m2 s-1]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: Kd_lay !< The diapycnal diffusivity of each + !! layer [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity at each + !! interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: T_f !< Temperature with massless !! layers filled in vertically [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), optional, intent(in) :: S_f !< Salinity with massless !! layers filled in vertically [S ~> ppt]. real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal !! diffusivity that is being added at - !! each interface [Z2 T-1 ~> m2 s-1]. + !! each interface [H Z T-1 ~> m2 s-1 or kg m-1 s-1] ! Local variables real :: Rcv(SZI_(G),SZK_(GV)) ! The coordinate density in layers [R ~> kg m-3]. real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures [R L2 T-2 ~> Pa]. @@ -222,7 +222,7 @@ subroutine user_change_diff_init(Time, G, GV, US, param_file, diag, CS) call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "USER_KD_ADD", CS%Kd_add, & "A user-specified additional diffusivity over a range of "//& - "latitude and density.", default=0.0, units="m2 s-1", scale=US%m2_s_to_Z2_T) + "latitude and density.", default=0.0, units="m2 s-1", scale=GV%m2_s_to_HZ_T) if (CS%Kd_add /= 0.0) then call get_param(param_file, mdl, "USER_KD_ADD_LAT_RANGE", CS%lat_range(:), & "Four successive values that define a range of latitudes "//&