diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 00ef5ae2be..ce699b1397 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -632,7 +632,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, CS) call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) endif - + forces%initialized = .true. endif diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 1f5cc53989..af4dddbadb 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -585,7 +585,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & reset_therm=Ocn_fluxes_used) !### What to do with these? , start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) - + elseif (OS%single_step_call) then call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) else diff --git a/config_src/solo_driver/coupler_types.F90 b/config_src/solo_driver/coupler_types.F90 index 0de045fa02..ba4ce0d3fa 100644 --- a/config_src/solo_driver/coupler_types.F90 +++ b/config_src/solo_driver/coupler_types.F90 @@ -68,7 +68,8 @@ module coupler_types_mod type, public :: coupler_3d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_3d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type @@ -115,7 +116,8 @@ module coupler_types_mod type, public :: coupler_2d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_2d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized integer :: isd, isc, iec, ied !< The i-direction data and computational domain index ranges for this type integer :: jsd, jsc, jec, jed !< The j-direction data and computational domain index ranges for this type @@ -156,7 +158,8 @@ module coupler_types_mod type, public :: coupler_1d_bc_type integer :: num_bcs = 0 !< The number of boundary condition fields - type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary condition fields + type(coupler_1d_field_type), dimension(:), pointer :: bc => NULL() !< A pointer to the array of boundary + !! condition fields logical :: set = .false. !< If true, this type has been initialized end type coupler_1d_bc_type @@ -291,7 +294,8 @@ subroutine coupler_type_copy_1d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then + !! don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -340,7 +344,8 @@ subroutine coupler_type_copy_1d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then + !! don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -383,7 +388,8 @@ subroutine coupler_type_copy_2d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -432,7 +438,8 @@ subroutine coupler_type_copy_2d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -475,7 +482,8 @@ subroutine coupler_type_copy_3d_2d(var_in, var_out, is, ie, js, je, & integer, intent(in) :: ie !< upper bound of first dimension integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -524,7 +532,8 @@ subroutine coupler_type_copy_3d_3d(var_in, var_out, is, ie, js, je, kd, & integer, intent(in) :: js !< lower bound of second dimension integer, intent(in) :: je !< upper bound of second dimension integer, intent(in) :: kd !< third dimension - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field character(len=*), optional, intent(in) :: suffix !< optional suffix to make the name identifier unique @@ -1174,8 +1183,10 @@ subroutine CT_copy_data_2d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: copy_bc @@ -1249,8 +1260,10 @@ subroutine CT_copy_data_3d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: copy_bc @@ -1329,8 +1342,10 @@ subroutine CT_copy_data_2d_3d(var_in, var, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this integer, optional, intent(in) :: ind3_start !< The starting value of the 3rd @@ -1563,8 +1578,10 @@ subroutine CT_rescale_data_2d(var, scale, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: do_bc @@ -1640,8 +1657,10 @@ subroutine CT_rescale_data_3d(var, scale, halo_size, bc_index, field_index, & !! that is being copied integer, optional, intent(in) :: field_index !< The index of the field in the !! boundary condition that is being copied - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this copy. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this copy. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this copy. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this copy. logical, optional, intent(in) :: pass_through_ice !< If true, only copy BCs whose !! value of pass_through ice matches this logical :: do_bc @@ -1718,8 +1737,10 @@ subroutine CT_increment_data_2d_2d(var_in, var, halo_size, bc_index, field_index !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1802,8 +1823,10 @@ subroutine CT_increment_data_3d_3d(var_in, var, halo_size, bc_index, field_index !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1893,8 +1916,10 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi !! boundary condition that is being copied real, optional, intent(in) :: scale_factor !< A scaling factor for the data that is being added real, optional, intent(in) :: scale_prev !< A scaling factor for the data that is already here - character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types of fluxes to exclude from this increment. - character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types of fluxes to include from this increment. + character(len=*), optional, intent(in) :: exclude_flux_type !< A string describing which types + !! of fluxes to exclude from this increment. + character(len=*), optional, intent(in) :: only_flux_type !< A string describing which types + !! of fluxes to include from this increment. logical, optional, intent(in) :: pass_through_ice !< If true, only increment BCs whose !! value of pass_through ice matches this @@ -1946,7 +1971,8 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi elseif ((1+var_in%ied-var_in%isd) == size(weights,1)) then iow = 1 + (var_in%isc - var_in%isd) - var%isc else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size of a computational or data domain.") + call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the i-size "//& + "of a computational or data domain.") endif if ((1+var%jec-var%jsc) == size(weights,2)) then jow = 1 - var%jsc @@ -1955,7 +1981,8 @@ subroutine CT_increment_data_2d_3d(var_in, weights, var, halo_size, bc_index, fi elseif ((1+var_in%jed-var_in%jsd) == size(weights,2)) then jow = 1 + (var_in%jsc - var_in%jsd) - var%jsc else - call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size of a computational or data domain.") + call mpp_error(FATAL, "CT_increment_data_2d_3d: weights array must be the j-size "//& + "of a computational or data domain.") endif io1 = var_in%isc - var%isc ; jo1 = var_in%jsc - var%jsc ; kow = 1 - var_in%ks @@ -2720,7 +2747,8 @@ end subroutine CT_set_data_3d !> This routine registers the diagnostics of a coupler_2d_bc_type. subroutine CT_set_diags_2d(var, diag_name, axes, time) type(coupler_2d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field @@ -2746,7 +2774,8 @@ end subroutine CT_set_diags_2d !> This routine registers the diagnostics of a coupler_3d_bc_type. subroutine CT_set_diags_3d(var, diag_name, axes, time) type(coupler_3d_bc_type), intent(inout) :: var !< BC_type structure for which to register diagnostics - character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, then don't register the fields + character(len=*), intent(in) :: diag_name !< name for diagnostic file--if blank, + !! then don't register the fields integer, dimension(:), intent(in) :: axes !< array of axes identifiers for diagnostic variable registration type(time_type), intent(in) :: time !< model time variable for registering diagnostic field diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index 34ad978cd2..c39dbec562 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -295,7 +295,8 @@ end subroutine ALE_end subroutine ALE_main( G, GV, h, u, v, tv, Reg, CS, dt, frac_shelf_h) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field (m/s) real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field (m/s) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure @@ -381,7 +382,8 @@ end subroutine ALE_main subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, dt) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options @@ -514,7 +516,7 @@ end subroutine ALE_offline_inputs subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step (m or Pa) type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_target !< Current 3D grid obtained after @@ -556,9 +558,10 @@ end subroutine ALE_offline_tracer_final !> Check grid for negative thicknesses subroutine check_grid( G, GV, h, threshold ) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the last time step (H units) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the + !! last time step (H units) real, intent(in) :: threshold !< Value below which to flag issues (H units) ! Local variables integer :: i, j @@ -586,7 +589,8 @@ subroutine ALE_build_grid( G, GV, regridCS, remapCS, h, tv, debug, frac_shelf_h type(regridding_CS), intent(in) :: regridCS !< Regridding parameters and options type(remapping_CS), intent(in) :: remapCS !< Remapping parameters and options type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamical variable structure - real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the + !! last time step (m or Pa) logical, optional, intent(in) :: debug !< If true, show the call tree real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage ! Local variables @@ -640,7 +644,8 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n, u, v, Reg, dt, dzRegrid, real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & optional, intent(inout) :: dzRegrid !< Final change in interface positions - logical, optional, intent(in) :: initial !< Whether we're being called from an initialization routine (and expect diagnostics to work) + logical, optional, intent(in) :: initial !< Whether we're being called from an initialization + !! routine (and expect diagnostics to work) ! Local variables integer :: i, j, k, nz @@ -707,18 +712,21 @@ end subroutine ALE_regrid_accelerated !! remap initiali conditions to the model grid. It is also called during a !! time step to update the state. subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, dxInterface, u, v, debug, dt) - type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure - type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid (m or Pa) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid (m or Pa) - type(tracer_registry_type), pointer :: Reg !< Tracer registry structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1),optional, intent(in) :: dxInterface !< Change in interface position (Hm or Pa) - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), optional, intent(inout) :: u !< Zonal velocity component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), optional, intent(inout) :: v !< Meridional velocity component (m/s) - logical, optional, intent(in) :: debug !< If true, show the call tree - real, optional, intent(in) :: dt !< time step for diagnostics + type(remapping_CS), intent(in) :: CS_remapping !< Remapping control structure + type(ALE_CS), intent(in) :: CS_ALE !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid (m or Pa) + type(tracer_registry_type), pointer :: Reg !< Tracer registry structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + optional, intent(in) :: dxInterface !< Change in interface position (Hm or Pa) + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + optional, intent(inout) :: u !< Zonal velocity component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + optional, intent(inout) :: v !< Meridional velocity component (m/s) + logical, optional, intent(in) :: debug !< If true, show the call tree + real, optional, intent(in) :: dt !< time step for diagnostics ! Local variables integer :: i, j, k, m integer :: nz, ntr @@ -740,8 +748,8 @@ subroutine remap_all_state_vars(CS_remapping, CS_ALE, G, GV, h_old, h_new, Reg, ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dxInterface. Otherwise, ! u and v can be remapped without dxInterface if ( .not. present(dxInterface) .and. (CS_ALE%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then - call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm and u/v are to"// & - "be remapped") + call MOM_error(FATAL, "remap_all_state_vars: dxInterface must be present if using old algorithm "// & + "and u/v are to be remapped") endif !### Try replacing both of these with GV%H_subroundoff diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index a7879ae063..dee2e20bd8 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -224,9 +224,11 @@ subroutine remapping_core_h(CS, n0, h0, u0, n1, h1, u1, h_neglect, h_neglect_ed .or. (u1minu0max) ) then write(0,*) 'iMethod = ',iMethod write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' + if (abs(h1tot-h0tot)>h0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min if (u1minh0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min if (u1minh0err+h2err) & + write(0,*) 'H non-conservation difference=',h2tot-h0tot,'allowed err=',h0err+h2err,' <-----!' + write(0,*) 'UH: u0tot=',u0tot,'u2tot=',u2tot,'duh=',u2tot-u0tot,'u0err=',u0err,'u2err=',u2err,& + 'adjustment err=',u02_err + if (abs(u2tot-u0tot)>u0err+u2err) & + write(0,*) 'U non-conservation difference=',u2tot-u0tot,'allowed err=',u0err+u2err,' <-----!' write(0,*) 'Sub-cells to target:' write(0,*) 'H: h2tot=',h2tot,'h1tot=',h1tot,'dh=',h1tot-h2tot,'h2err=',h2err,'h1err=',h1err - if (abs(h1tot-h2tot)>h2err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h2tot,'allowed err=',h2err+h1err,' <-----!' + if (abs(h1tot-h2tot)>h2err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h2tot,'allowed err=',h2err+h1err,' <-----!' write(0,*) 'UH: u2tot=',u2tot,'u1tot=',u1tot,'duh=',u1tot-u2tot,'u2err=',u2err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u2tot)>u2err+u1err) write(0,*) 'U non-conservation difference=',u1tot-u2tot,'allowed err=',u2err+u1err,' <-----!' + if (abs(u1tot-u2tot)>u2err+u1err) & + write(0,*) 'U non-conservation difference=',u1tot-u2tot,'allowed err=',u2err+u1err,' <-----!' write(0,*) 'Source to target:' write(0,*) 'H: h0tot=',h0tot,'h1tot=',h1tot,'dh=',h1tot-h0tot,'h0err=',h0err,'h1err=',h1err - if (abs(h1tot-h0tot)>h0err+h1err) write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' + if (abs(h1tot-h0tot)>h0err+h1err) & + write(0,*) 'H non-conservation difference=',h1tot-h0tot,'allowed err=',h0err+h1err,' <-----!' write(0,*) 'UH: u0tot=',u0tot,'u1tot=',u1tot,'duh=',u1tot-u0tot,'u0err=',u0err,'u1err=',u1err,'uh_err=',uh_err - if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' + if (abs(u1tot-u0tot)>(u0err+u1err)+uh_err) & + write(0,*) 'U non-conservation difference=',u1tot-u0tot,'allowed err=',u0err+u1err+uh_err,' <-----!' write(0,*) 'U: u0min=',u0min,'u1min=',u1min,'u2min=',u2min if (u1min Clean up the coordinate control structure subroutine end_coord_adapt(CS) - type(adapt_CS), pointer :: CS + type(adapt_CS), pointer :: CS !< The control structure for this module ! nothing to do if (.not. associated(CS)) return @@ -74,7 +74,7 @@ end subroutine end_coord_adapt subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoomCoeff, & adaptBuoyCoeff, adaptDrho0, adaptDoMin) - type(adapt_CS), pointer :: CS + type(adapt_CS), pointer :: CS !< The control structure for this module real, optional, intent(in) :: adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoomCoeff real, optional, intent(in) :: adaptBuoyCoeff, adaptDrho0 logical, optional, intent(in) :: adaptDoMin @@ -91,14 +91,17 @@ subroutine set_adapt_params(CS, adaptTimeRatio, adaptAlpha, adaptZoom, adaptZoom end subroutine set_adapt_params subroutine build_adapt_column(CS, G, GV, tv, i, j, zInt, tInt, sInt, h, zNext) - type(adapt_CS), intent(in) :: CS + type(adapt_CS), intent(in) :: CS !< The control structure for this module 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(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - integer, intent(in) :: i, j - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt, tInt, sInt + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + integer, intent(in) :: i, j !< The indices of the column to work on + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: zInt !< Interface heights, in H (m or kg m-2). + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: tInt !< Interface temperatures, in C + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: sInt !< Interface salinities, in psu real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZK_(GV)+1), intent(inout) :: zNext ! updated interface positions + real, dimension(SZK_(GV)+1), intent(inout) :: zNext !< updated interface positions ! Local variables integer :: k, nz diff --git a/src/ALE/coord_zlike.F90 b/src/ALE/coord_zlike.F90 index ca68aa7b0b..41fb61f6c3 100644 --- a/src/ALE/coord_zlike.F90 +++ b/src/ALE/coord_zlike.F90 @@ -66,8 +66,10 @@ subroutine build_zstar_column(CS, depth, total_thickness, zInterface, & real, intent(in) :: depth !< Depth of ocean bottom (positive in m or H) real, intent(in) :: total_thickness !< Column thickness (positive in the same units as depth) real, dimension(CS%nk+1), intent(inout) :: zInterface !< Absolute positions of interfaces - real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (negative in the same units as depth) - real, optional, intent(in) :: eta_orig !< The actual original height of the top in the same units as depth + real, optional, intent(in) :: z_rigid_top !< The height of a rigid top (negative in the + !! same units as depth) + real, optional, intent(in) :: eta_orig !< The actual original height of the top in the + !! same units as depth real, optional, intent(in) :: zScale !< Scaling factor from the target coordinate resolution !! in m to desired units for zInterface, perhaps m_to_H ! Local variables diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index a343bca4d1..a30f8e9974 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -618,19 +618,21 @@ end subroutine PressureForce_Mont_Bouss !> Determines the partial derivative of the acceleration due !! to pressure forces with the free surface height. subroutine Set_pbce_Bouss(e, tv, G, GV, g_Earth, Rho0, GFS_scale, pbce, rho_star) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface height, in H. - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables real, intent(in) :: g_Earth !< The gravitational acceleration, in m s-2. real, intent(in) :: Rho0 !< The "Boussinesq" ocean density, in kg m-3. real, intent(in) :: GFS_scale !< Ratio between gravity applied to top interface - !! and the gravitational acceleration of the planet. - !! Usually this ratio is 1. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due - !! to free surface height anomalies, in m2 H-1 s-2. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: rho_star !< The layer densities (maybe - !! compressibility compensated), times g/rho_0, in m s-2. + !! and the gravitational acceleration of the planet. + !! Usually this ratio is 1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(out) :: pbce !< The baroclinic pressure anomaly in each layer due + !! to free surface height anomalies, in m2 H-1 s-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: rho_star !< The layer densities (maybe compressibility + !! compensated), times g/rho_0, in m s-2. ! Local variables real :: Ihtot(SZI_(G)) ! The inverse of the sum of the layer ! thicknesses, in m-1. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 49d786191d..63f271089e 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2427,8 +2427,10 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, in H m. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, in H m. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, + !! in H m. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, + !! in H m. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2697,8 +2699,10 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, MS, halo, use_BT_co integer, intent(in) :: halo !< The extra halo size to use here. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, in H m. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, in H m. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points, + !! in H m. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points, + !! in H m. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index e7f84ed944..c47b16989e 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -200,7 +200,7 @@ subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer !! due to free surface height anomalies, in - !! m2 s-2 H-1. !! NULL. + !! m2 s-2 H-1. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the !! barotropic solver,in m s-2. diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 9ea47bd37b..c430179917 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -99,13 +99,13 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, CS, uhbt, vhbt, OBC, optional, pointer :: OBC !< Open boundaries control structure. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & optional, intent(in) :: visc_rem_u !< The fraction of zonal momentum originally - !! in a layer that remains after a time-step of viscosity, and the + !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that !! a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & optional, intent(in) :: visc_rem_v !< The fraction of meridional momentum originally - !! in a layer that remains after a time-step of viscosity, and the + !! in a layer that remains after a time-step of viscosity, and the !! fraction of a time-step's worth of a barotropic acceleration that !! a layer experiences after viscosity is applied. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 6735e35063..9688ca2dcc 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -93,27 +93,34 @@ module MOM_dynamics_split_RK2 !! that were fed into the barotopic calculation, in m s-2. ! The following variables are only used with the split time stepping scheme. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq mode) - !! or column mass anomaly (in non-Boussinesq mode), - !! in units of H (m or kg m-2) - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic timestep (m s-1) - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by - !! time-mean barotropic velocity over a baroclinic timestep (m s-1) - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer thicknesses (m or kg m-2) - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and PFv (meter) - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by barotropic solver - !! (m3 s-1 or kg s-1). uhbt should (roughly?) equal to vertical sum of uh. - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by barotropic solver - !! (m3 s-1 or kg s-1). vhbt should (roughly?) equal to vertical sum of vh. - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure anomaly in each layer due - !! to free surface height anomalies. pbce has units of m2 H-1 s-2. - - real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) - real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) - type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the - !! effective summed open face areas as a function - !! of barotropic flow. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta !< Instantaneous free surface height (in Boussinesq + !! mode) or column mass anomaly (in non-Boussinesq + !! mode), in units of H (m or kg m-2) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_av !< layer x-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep (m s-1) + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_av !< layer y-velocity with vertical mean replaced by + !! time-mean barotropic velocity over a baroclinic + !! timestep (m s-1) + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: h_av !< arithmetic mean of two successive layer + !! thicknesses (m or kg m-2) + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_PF !< instantaneous SSH used in calculating PFu and + !! PFv (meter) + real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: uhbt !< average x-volume or mass flux determined by the + !! barotropic solver (m3 s-1 or kg s-1). uhbt should + !! be (roughly?) equal to vertical sum of uh. + real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: vhbt !< average y-volume or mass flux determined by the + !! barotropic solver (m3 s-1 or kg s-1). vhbt should + !! be (roughly?) equal to vertical sum of vh. + real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure + !! anomaly in each layer due to free surface height + !! anomalies. pbce has units of m2 H-1 s-2. + + real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean to the seafloor (Pa) + real, pointer, dimension(:,:) :: tauy_bot => NULL() !< frictional y-bottom stress from the ocean to the seafloor (Pa) + type(BT_cont_type), pointer :: BT_cont => NULL() !< A structure with elements that describe the + !! effective summed open face areas as a function + !! of barotropic flow. ! This is to allow the previous, velocity-based coupling with between the ! baroclinic and barotropic modes. @@ -205,27 +212,39 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & Time_local, dt, forces, p_surf_begin, p_surf_end, & uh, vh, uhtr, vhtr, eta_av, & G, GV, CS, calc_dtbt, VarMix, MEKE) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: v !< merid velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thickness (m or kg/m2) - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type - type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related - type(time_type), intent(in) :: Time_local !< model time at end of time step - real, intent(in) :: dt !< time step (sec) - type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces - real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic time step (Pa) - real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic time step (Pa) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulatated zonal volume/mass transport since last tracer advection (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulatated merid volume/mass transport since last tracer advection (m3 or kg) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time averaged over time step (m or kg/m2) - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step - type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities - type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: v !< merid velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< layer thickness (m or kg/m2) + type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic type + type(vertvisc_type), intent(inout) :: visc !< vertical visc, bottom drag, and related + type(time_type), intent(in) :: Time_local !< model time at end of time step + real, intent(in) :: dt !< time step (sec) + type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces + real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic + !! time step (Pa) + real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic + !! time step (Pa) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< accumulatated zonal volume/mass transport + !! since last tracer advection (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< accumulatated merid volume/mass transport + !! since last tracer advection (m3 or kg) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< free surface height or column mass time + !! averaged over time step (m or kg/m2) + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + logical, intent(in) :: calc_dtbt !< if true, recalculate barotropic time step + type(VarMix_CS), pointer :: VarMix !< specify the spatially varying viscosities + type(MEKE_type), pointer :: MEKE !< related to mesoscale eddy kinetic energy param real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping. @@ -842,8 +861,10 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u type(param_file_type), intent(in) :: param_file !< parameter file type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) - real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) + real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) + real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) type(vardesc) :: vd character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. @@ -915,34 +936,41 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc, calc_dtbt) - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< zonal velocity (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< merid velocity (m/s) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness (m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh !< zonal volume/mass transport (m3 s-1 or kg s-1) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh !< merid volume/mass transport (m3 s-1 or kg s-1) - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass (m or kg m-2) - type(time_type), target, intent(in) :: Time !< current model time - type(param_file_type), intent(in) :: param_file !< parameter file for parsing - type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics - type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure - type(MOM_restart_CS), pointer :: restart_CS !< restart control structure - real, intent(in) :: dt !< time step (sec) - type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for budget analysis - type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation - type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass diagnostic pointers - type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities - type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields - type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields - type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields - type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure - type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. - type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related - type(directories), intent(in) :: dirs !< contains directory paths - integer, target, intent(inout) :: ntrunc !< A target for the variable that records the number of times - !! the velocity is truncated (this should be 0). - logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step + type(ocean_grid_type), intent(inout) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: u !< zonal velocity (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v !< merid velocity (m/s) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< layer thickness (m or kg/m2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< zonal volume/mass transport (m3 s-1 or kg s-1) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< merid volume/mass transport (m3 s-1 or kg s-1) + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta !< free surface height or column mass (m or kg m-2) + type(time_type), target, intent(in) :: Time !< current model time + type(param_file_type), intent(in) :: param_file !< parameter file for parsing + type(diag_ctrl), target, intent(inout) :: diag !< to control diagnostics + type(MOM_dyn_split_RK2_CS), pointer :: CS !< module control structure + type(MOM_restart_CS), pointer :: restart_CS !< restart control structure + real, intent(in) :: dt !< time step (sec) + type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< points to momentum equation terms for + !! budget analysis + type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< points to terms in continuity equation + type(ocean_internal_state), intent(inout) :: MIS !< "MOM6 internal state" used to pass + !! diagnostic pointers + type(VarMix_CS), pointer :: VarMix !< points to spatially variable viscosities + type(MEKE_type), pointer :: MEKE !< points to mesoscale eddy kinetic energy fields + type(ocean_OBC_type), pointer :: OBC !< points to OBC related fields + type(update_OBC_CS), pointer :: update_OBC_CSp !< points to OBC update related fields + type(ALE_CS), pointer :: ALE_CSp !< points to ALE control structure + type(set_visc_CS), pointer :: setVisc_CSp !< points to the set_visc control structure. + type(vertvisc_type), intent(inout) :: visc !< vertical viscosities, bottom drag, and related + type(directories), intent(in) :: dirs !< contains directory paths + integer, target, intent(inout) :: ntrunc !< A target for the variable that records + !! the number of times the velocity is + !! truncated (this should be 0). + logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index e092c2a5ab..6a65c7e844 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -316,67 +316,73 @@ module MOM_forcing_type !! This routine multiplies fluxes by dt, so that the result is an accumulation of fluxes !! over a time step. subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & + FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent, & h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, & - aggregate_FW_forcing, nonpenSW, netmassInOut_rate,net_Heat_Rate, & + aggregate_FW, nonpenSW, netmassInOut_rate,net_Heat_Rate, & net_salt_rate, pen_sw_bnd_Rate, skip_diags) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(forcing), intent(inout) :: fluxes !< structure containing pointers to possible - !! forcing fields. NULL unused fields. - type(optics_type), pointer :: optics !< pointer to optics - integer, intent(in) :: nsw !< number of bands of penetrating SW - integer, intent(in) :: j !< j-index to work on - real, intent(in) :: dt !< time step in seconds - real, intent(in) :: DepthBeforeScalingFluxes !< min ocean depth before scale away fluxes (H) - logical, intent(in) :: useRiverHeatContent !< logical for river heat content - logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< structure containing pointers to possible + !! forcing fields. NULL unused fields. + type(optics_type), pointer :: optics !< pointer to optics + integer, intent(in) :: nsw !< number of bands of penetrating SW + integer, intent(in) :: j !< j-index to work on + real, intent(in) :: dt !< time step in seconds + real, intent(in) :: FluxRescaleDepth !< min ocean depth before scale away fluxes (H) + logical, intent(in) :: useRiverHeatContent !< logical for river heat content + logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: h !< layer thickness (in H units) + intent(in) :: h !< layer thickness (in H units) real, dimension(SZI_(G),SZK_(G)), & - intent(in) :: T !< layer temperatures (deg C) - real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water in/out of ocean over - !! a time step (H units) - real, dimension(SZI_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water leaving ocean surface - !! over a time step (H units). - !! netMassOut < 0 means mass leaves ocean. - real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a - !! time step for coupler + restoring. - !! Exclude two terms from net_heat: - !! (1) downwelling (penetrative) SW, - !! (2) evaporation heat content, - !! (since do not yet know evap temperature). - !! Units of net_heat are (K * H). - real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt * H) - real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. - !! Units are (deg K * H) and array size - !! nsw x SZI_(G), where nsw=number of SW bands - !! in pen_SW_bnd. This heat flux is not part - !! of net_heat. - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available - !! thermodynamic fields. Used to keep - !! track of the heat flux associated with net - !! mass fluxes into the ocean. - logical, intent(in) :: aggregate_FW_forcing !< For determining how to aggregate forcing. - real, dimension(SZI_(G)), optional, intent(out) :: nonpenSW !< non-downwelling SW; use in net_heat. - !! Sum over SW bands when diagnosing nonpenSW. - !! Units are (K * H). - real, dimension(SZI_(G)), optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1. - real, dimension(SZI_(G)), optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1. - real, dimension(SZI_(G)), optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1. - real, dimension(:,:), optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating in degC H s-1. - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics + intent(in) :: T !< layer temperatures (deg C) + real, dimension(SZI_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water in/out of ocean over + !! a time step (H units) + real, dimension(SZI_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water leaving ocean surface + !! over a time step (H units). + !! netMassOut < 0 means mass leaves ocean. + real, dimension(SZI_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a + !! time step for coupler + restoring. + !! Exclude two terms from net_heat: + !! (1) downwelling (penetrative) SW, + !! (2) evaporation heat content, + !! (since do not yet know evap temperature). + !! Units of net_heat are (K * H). + real, dimension(SZI_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated + !! over a time step (ppt * H) + real, dimension(:,:), intent(out) :: pen_SW_bnd !< penetrating SW flux, split into bands. + !! Units are (deg K * H) and array size + !! nsw x SZI_(G), where nsw=number of SW bands + !! in pen_SW_bnd. This heat flux is not part + !! of net_heat. + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available + !! thermodynamic fields. Used to keep + !! track of the heat flux associated with net + !! mass fluxes into the ocean. + logical, intent(in) :: aggregate_FW !< For determining how to aggregate forcing. + real, dimension(SZI_(G)), & + optional, intent(out) :: nonpenSW !< non-downwelling SW; use in net_heat. + !! Sum over SW bands when diagnosing nonpenSW. + !! Units are (K * H). + real, dimension(SZI_(G)), & + optional, intent(out) :: net_Heat_rate !< Rate of net surface heating in H K s-1. + real, dimension(SZI_(G)), & + optional, intent(out) :: net_salt_rate !< Surface salt flux into the ocean in ppt H s-1. + real, dimension(SZI_(G)), & + optional, intent(out) :: netmassInOut_rate !< Rate of net mass flux into the ocean in H s-1. + real, dimension(:,:), & + optional, intent(out) :: pen_sw_bnd_rate !< Rate of penetrative shortwave heating + !! in degC H s-1. + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating diagnostics ! local real :: htot(SZI_(G)) ! total ocean depth (m for Bouss or kg/m^2 for non-Bouss) real :: Pen_sw_tot(SZI_(G)) ! sum across all bands of Pen_SW (K * H) real :: pen_sw_tot_rate(SZI_(G)) ! Similar but sum but as a rate (no dt in calculation) real :: Ih_limit ! inverse depth at which surface fluxes start to be limited (1/H) - real :: scale ! scale scales away fluxes if depth < DepthBeforeScalingFluxes + real :: scale ! scale scales away fluxes if depth < FluxRescaleDepth real :: J_m2_to_H ! converts J/m^2 to H units (m for Bouss and kg/m^2 for non-Bouss) real :: Irho0 ! 1.0 / Rho0 real :: I_Cp ! 1.0 / C_p @@ -400,7 +406,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, if (present(pen_sw_bnd_rate)) do_PSWBR = .true. !}BGR - Ih_limit = 1.0 / DepthBeforeScalingFluxes + Ih_limit = 1.0 / FluxRescaleDepth Irho0 = 1.0 / GV%Rho0 I_Cp = 1.0 / fluxes%C_p J_m2_to_H = 1.0 / (GV%H_to_kg_m2 * fluxes%C_p) @@ -637,11 +643,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. if (associated(fluxes%heat_content_massin)) then - if (aggregate_FW_forcing) then + if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt else ! net is "out" - fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + T(i,1) * GV%H_to_kg_m2 / dt endif else fluxes%heat_content_massin(i,j) = 0. @@ -651,11 +658,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! Initialize heat_content_massout that is diagnosed in mixedlayer_convection or ! applyBoundaryFluxes such that the meaning is as the sum of all outgoing components. if (associated(fluxes%heat_content_massout)) then - if (aggregate_FW_forcing) then + if (aggregate_FW) then if (netMassInOut(i) > 0.0) then ! net is "in" fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt else ! net is "out" - fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * & + T(i,1) * GV%H_to_kg_m2 / dt endif else fluxes%heat_content_massout(i,j) = 0.0 @@ -737,58 +745,59 @@ end subroutine extractFluxes1d !> 2d wrapper for 1d extract fluxes from surface fluxes type. !! This subroutine extracts fluxes from the surface fluxes type. It multiplies the !! fluxes by dt, so that the result is an accumulation of the fluxes over a time step. -subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & - h, T, netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & - aggregate_FW_forcing) - - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. - type(optics_type), pointer :: optics !< pointer to optics - integer, intent(in) :: nsw !< number of bands of penetrating SW - real, intent(in) :: dt !< time step in seconds - real, intent(in) :: DepthBeforeScalingFluxes !< min ocean depth before scale away fluxes (H) - logical, intent(in) :: useRiverHeatContent !< logical for river heat content - logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< layer thickness (in H units) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T !< layer temperatures (deg C) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water in/out of ocean over - !! a time step (H units) - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux - !! (if Bouss) of water leaving ocean surface - !! over a time step (H units). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a - !! time step associated with coupler + restore. - !! Exclude two terms from net_heat: - !! (1) downwelling (penetrative) SW, - !! (2) evaporation heat content, - !! (since do not yet know temperature of evap). - !! Units of net_heat are (K * H). - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated - !! over a time step (ppt * H) - real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. - !! Units (deg K * H) & array size nsw x SZI_(G), - !! where nsw=number of SW bands in pen_SW_bnd. - !! This heat flux is not in net_heat. - type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available - !! thermodynamic fields. Here it is used to keep - !! track of the heat flux associated with net - !! mass fluxes into the ocean. - logical, intent(in) :: aggregate_FW_forcing !< For determining how to aggregate the forcing. - +subroutine extractFluxes2d(G, GV, fluxes, optics, nsw, dt, FluxRescaleDepth, & + useRiverHeatContent, useCalvingHeatContent, h, T, & + netMassInOut, netMassOut, net_heat, Net_salt, Pen_SW_bnd, tv, & + aggregate_FW) + + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< structure containing pointers to forcing. + type(optics_type), pointer :: optics !< pointer to optics + integer, intent(in) :: nsw !< number of bands of penetrating SW + real, intent(in) :: dt !< time step in seconds + real, intent(in) :: FluxRescaleDepth !< min ocean depth before scale away fluxes (H) + logical, intent(in) :: useRiverHeatContent !< logical for river heat content + logical, intent(in) :: useCalvingHeatContent !< logical for calving heat content + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< layer thickness (in H units) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: T !< layer temperatures (deg C) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassInOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water in/out of ocean over + !! a time step (H units) + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: netMassOut !< net mass flux (non-Bouss) or volume flux + !! (if Bouss) of water leaving ocean surface + !! over a time step (H units). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_heat !< net heat at the surface accumulated over a + !! time step associated with coupler + restore. + !! Exclude two terms from net_heat: + !! (1) downwelling (penetrative) SW, + !! (2) evaporation heat content, + !! (since do not yet know temperature of evap). + !! Units of net_heat are (K * H). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: net_salt !< surface salt flux into the ocean accumulated + !! over a time step (ppt * H) + real, dimension(:,:,:), intent(out) :: pen_SW_bnd !< penetrating shortwave flux, split into bands. + !! Units (deg K * H) & array size nsw x SZI_(G), + !! where nsw=number of SW bands in pen_SW_bnd. + !! This heat flux is not in net_heat. + type(thermo_var_ptrs), intent(inout) :: tv !< structure containing pointers to available + !! thermodynamic fields. Here it is used to keep + !! track of the heat flux associated with net + !! mass fluxes into the ocean. + logical, intent(in) :: aggregate_FW !< For determining how to aggregate the forcing. integer :: j -!$OMP parallel do default(none) shared(G, GV, fluxes, optics, nsw,dt,DepthBeforeScalingFluxes, & +!$OMP parallel do default(none) shared(G, GV, fluxes, optics, nsw,dt,FluxRescaleDepth, & !$OMP useRiverHeatContent, useCalvingHeatContent, & !$OMP h,T,netMassInOut,netMassOut,Net_heat,Net_salt,Pen_SW_bnd,tv, & -!$OMP aggregate_FW_forcing) +!$OMP aggregate_FW) do j=G%jsc, G%jec call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & - DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent,& + FluxRescaleDepth, useRiverHeatContent, useCalvingHeatContent,& h(:,j,:), T(:,j,:), netMassInOut(:,j), netMassOut(:,j), & - net_heat(:,j), net_salt(:,j), pen_SW_bnd(:,:,j), tv, aggregate_FW_forcing) + net_heat(:,j), net_salt(:,j), pen_SW_bnd(:,:,j), tv, aggregate_FW) enddo end subroutine extractFluxes2d @@ -812,7 +821,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux (m^2/s^3) real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux (K H/s) real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux (ppt H/s) - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables integer :: nsw, start, npts, k @@ -900,7 +909,7 @@ subroutine calculateBuoyancyFlux2d(G, GV, fluxes, optics, h, Temp, Salt, tv, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux (m^2/s^3) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux (K H) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux (ppt H) - logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating !! diagnostics inside extractFluxes1d() ! local variables real, dimension( SZI_(G) ) :: netT ! net temperature flux (K m/s) @@ -1522,7 +1531,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_total_net_heat_surface = register_scalar_field('ocean_model', & 'total_net_heat_surface', Time, diag, & - long_name='Area integrated surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & + long_name='Area integrated surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & units='W', & cmor_field_name='total_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_integrated', & @@ -1609,7 +1618,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use handles%id_net_heat_surface_ga = register_scalar_field('ocean_model', & 'net_heat_surface_ga', Time, diag, & - long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & + long_name='Area averaged surface heat flux from SW+LW+lat+sens+mass+frazil+restore or flux adjustments', & units='W m-2', & cmor_field_name='ave_hfds', & cmor_standard_name='surface_downward_heat_flux_in_sea_water_area_averaged', & @@ -2244,7 +2253,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) call post_data(handles%id_total_heat_content_massin, total_transport, diag) endif - if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. handles%id_net_heat_coupler_ga > 0. ) then + if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. & + handles%id_net_heat_coupler_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) @@ -2263,7 +2273,8 @@ subroutine forcing_diagnostics(fluxes, sfc_state, dt, G, diag, handles) endif endif - if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. handles%id_net_heat_surface_ga > 0. ) then + if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. & + handles%id_net_heat_surface_ga > 0. ) then do j=js,je ; do i=is,ie res(i,j) = 0.0 if (associated(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index c65504041b..75140c3d4f 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -569,18 +569,21 @@ end subroutine MOM_grid_end !! !! Grid metrics and their inverses are labelled according to their staggered location on a Arakawa C (or B) grid. !! - Metrics centered on h- or T-points are labelled T, e.g. dxT is the distance across the cell in the x-direction. -!! - Metrics centered on u-points are labelled Cu (C-grid u location). e.g. dyCu is the y-distance between two corners of a T-cell. +!! - Metrics centered on u-points are labelled Cu (C-grid u location). e.g. dyCu is the y-distance between +!! two corners of a T-cell. !! - Metrics centered on v-points are labelled Cv (C-grid v location). e.g. dyCv is the y-distance between two -points. !! - Metrics centered on q-points are labelled Bu (B-grid u,v location). e.g. areaBu is the area centered on a q-point. !! -!! \image html Grid_metrics.png "The labelling of distances (grid metrics) at various staggered location on an T-cell and around a q-point. +!! \image html Grid_metrics.png +!! "The labelling of distances (grid metrics) at various staggered location on an T-cell and around a q-point. !! !! Areas centered at T-, u-, v- and q- points are `areaT`, `areaCu`, `areaCv` and `areaBu` respectively. !! !! The reciprocal of metrics are pre-calculated and also stored in the ocean_grid_type with a I prepended to the name. !! For example, `1./areaT` is called `IareaT`, and `1./dyCv` is `IdyCv`. !! -!! Geographic latitude and longitude (or model coordinates if not on a sphere) are stored in `geoLatT`, `geoLonT` for T-points. +!! Geographic latitude and longitude (or model coordinates if not on a sphere) are stored in +!! `geoLatT`, `geoLonT` for T-points. !! u-, v- and q- point coordinates are follow same pattern of replacing T with Cu, Cv and Bu respectively. !! !! Each location also has a 2D mask indicating whether the entire column is land or ocean. diff --git a/src/core/MOM_isopycnal_slopes.F90 b/src/core/MOM_isopycnal_slopes.F90 index f6aafaef63..c677f3863c 100644 --- a/src/core/MOM_isopycnal_slopes.F90 +++ b/src/core/MOM_isopycnal_slopes.F90 @@ -23,14 +23,18 @@ subroutine calc_isoneutral_slopes(G, GV, h, e, tv, dt_kappa_smooth, & type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(in) :: e !< Interface heights (m) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing timescale, in s. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables + real, intent(in) :: dt_kappa_smooth !< A vertical diffusive smoothing + !! timescale, in s. real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: slope_x !< Isopycnal slope in i-direction (nondim) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(inout) :: slope_y !< Isopycnal slope in j-direction (nondim) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), & - optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at u-points (s-2) + optional, intent(inout) :: N2_u !< Brunt-Vaisala frequency squared at + !! interfaces between u-points (s-2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), & - optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at u-points (s-2) + optional, intent(inout) :: N2_v !< Brunt-Vaisala frequency squared at + !! interfaces between u-points (s-2) integer, optional, intent(in) :: halo !< Halo width over which to compute ! Local variables real, dimension(SZI_(G), SZJ_(G), SZK_(G)) :: & @@ -308,16 +312,16 @@ 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) - 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)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) - real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) - real, intent(in) :: dt !< The time increment, in s. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) - integer, optional, intent(in) :: halo_here !< Halo width over which to compute + 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)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: T_in !< Temperature (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: S_in !< Salinity (psu) + real, intent(in) :: kappa !< A vertical diffusivity to use for smoothing (m2 s-1) + real, intent(in) :: dt !< The time increment, in s. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T_f !< Filled temperature (deg C) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S_f !< Filed salinity (psu) + integer, optional, intent(in) :: halo_here !< Halo width over which to compute ! Local variables real :: ent(SZI_(G),SZK_(G)+1) ! The diffusive entrainment (kappa*dt)/dz ! between layers in a timestep in m or kg m-2. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index 41893d8dd5..90ee212e93 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -905,7 +905,8 @@ subroutine parse_segment_str(ni_global, nj_global, segment_str, l, m, n, action_ integer, intent(out) :: n !< The value of J=n, if segment_str begins with I=, or the value of I=n character(len=*), intent(out) :: action_str(:) !< The "string" part of segment_str ! Local variables - character(len=24) :: word1, word2, m_word, n_word !< Words delineated by commas in a string in form of "I=%,J=%:%,string" + character(len=24) :: word1, word2, m_word, n_word !< Words delineated by commas in a string in form of + !! "I=%,J=%:%,string" integer :: l_max !< Either ni_global or nj_global, depending on whether segment_str begins with "I=" or "J=" integer :: mn_max !< Either nj_global or ni_global, depending on whether segment_str begins with "I=" or "J=" integer :: j @@ -989,15 +990,17 @@ end subroutine parse_segment_str !> Parse an OBC_SEGMENT_%%%_DATA string subroutine parse_segment_data_str(segment_str, var, value, filenam, fieldnam, fields, num_fields, debug ) - character(len=*), intent(in) :: segment_str !< A string in form of "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), optional, intent(in) :: var !< The name of the variable for which parameters are needed - character(len=*), optional, intent(out) :: filenam !< The name of the input file if using "file" method - character(len=*), optional, intent(out) :: fieldnam !< The name of the variable in the input file if using "file" method - real, optional, intent(out) :: value !< A constant value if using the "value" method + character(len=*), intent(in) :: segment_str !< A string in form of + !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." + character(len=*), optional, intent(in) :: var !< The name of the variable for which parameters are needed + character(len=*), optional, intent(out) :: filenam !< The name of the input file if using "file" method + character(len=*), optional, intent(out) :: fieldnam !< The name of the variable in the input file if using + !! "file" method + real, optional, intent(out) :: value !< A constant value if using the "value" method character(len=*), dimension(MAX_OBC_FIELDS), & - optional, intent(out) :: fields !< List of fieldnames for each segment - integer, optional, intent(out) :: num_fields !< The number of fields in the segment data - logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages + optional, intent(out) :: fields !< List of fieldnames for each segment + integer, optional, intent(out) :: num_fields !< The number of fields in the segment data + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages ! Local variables character(len=128) :: word1, word2, word3, method integer :: lword, nfields, n, m, orient @@ -1075,10 +1078,11 @@ end subroutine parse_segment_data_str !> Parse an OBC_SEGMENT_%%%_PARAMS string subroutine parse_segment_param_real(segment_str, var, param_value, debug ) - character(len=*), intent(in) :: segment_str !< A string in form of "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." - character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed - real, intent(out) :: param_value !< The value of the parameter - logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages + character(len=*), intent(in) :: segment_str !< A string in form of + !! "VAR1=file:foo1.nc(varnam1),VAR2=file:foo2.nc(varnam2),..." + character(len=*), intent(in) :: var !< The name of the variable for which parameters are needed + real, intent(out) :: param_value !< The value of the parameter + logical, optional, intent(in) :: debug !< If present and true, write verbose debugging messages ! Local variables character(len=128) :: word1, word2, word3, method integer :: lword, nfields, n, m, orient @@ -1169,13 +1173,14 @@ subroutine open_boundary_init(G, param_file, OBC) end subroutine open_boundary_init -logical function open_boundary_query(OBC, apply_open_OBC, apply_specified_OBC, apply_Flather_OBC, apply_nudged_OBC, needs_ext_seg_data) - type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure - logical, optional, intent(in) :: apply_open_OBC !< If present, returns True if specified_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_specified_OBC !< If present, returns True if specified_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_Flather_OBC !< If present, returns True if Flather_*_BCs_exist_globally is true - logical, optional, intent(in) :: apply_nudged_OBC !< If present, returns True if nudged_*_BCs_exist_globally is true - logical, optional, intent(in) :: needs_ext_seg_data !< If present, returns True if external segment data needed +logical function open_boundary_query(OBC, apply_open_OBC, apply_specified_OBC, apply_Flather_OBC, & + apply_nudged_OBC, needs_ext_seg_data) + type(ocean_OBC_type), pointer :: OBC !< Open boundary control structure + logical, optional, intent(in) :: apply_open_OBC !< Returns True if open_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_specified_OBC !< Returns True if specified_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_Flather_OBC !< Returns True if Flather_*_BCs_exist_globally is true + logical, optional, intent(in) :: apply_nudged_OBC !< Returns True if nudged_*_BCs_exist_globally is true + logical, optional, intent(in) :: needs_ext_seg_data !< Returns True if external segment data needed open_boundary_query = .false. if (.not. associated(OBC)) return if (present(apply_open_OBC)) open_boundary_query = OBC%open_u_BCs_exist_globally .or. & @@ -2219,15 +2224,19 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (OBC%brushcutter_mode) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + segment%field(m)%buffer_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) else - segment%field(m)%buffer_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + segment%field(m)%buffer_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) endif else if (segment%field(m)%name == 'U') then - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + segment%field(m)%buffer_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) else - segment%field(m)%buffer_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + segment%field(m)%buffer_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) endif endif else @@ -2250,15 +2259,19 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) if (OBC%brushcutter_mode) then if (segment%is_E_or_W) then if (segment%field(m)%name == 'V') then - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) + segment%field(m)%dz_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset)+1:2,:) else - segment%field(m)%dz_src(is_obc,:,:)=tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) + segment%field(m)%dz_src(is_obc,:,:) = & + tmp_buffer(1,2*(js_obc+G%jdg_offset)+1:2*(je_obc+G%jdg_offset):2,:) endif else if (segment%field(m)%name == 'U') then - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) + segment%field(m)%dz_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset)+1:2,1,:) else - segment%field(m)%dz_src(:,js_obc,:)=tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) + segment%field(m)%dz_src(:,js_obc,:) = & + tmp_buffer(2*(is_obc+G%idg_offset)+1:2*(ie_obc+G%idg_offset):2,1,:) endif endif else diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 7425906de4..09305eb9fb 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -281,7 +281,8 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. - logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically integrated fields. + logical, optional, intent(in) :: do_integrals !< If true, allocate the space for vertically + !! integrated fields. type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the ocean !! ocean and surface-ice fields that will participate diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index 097a0e13b3..6e557426c7 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -62,7 +62,8 @@ module MOM_diagnostics type, public :: diagnostics_CS ; private real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as - !! monotonic for the purposes of calculating the equivalent barotropic wave speed. + !! monotonic for the purposes of calculating the equivalent + !! barotropic wave speed. real :: mono_N2_depth = -1. !< The depth below which N2 is limited as monotonic for the purposes of !! calculating the equivalent barotropic wave speed. (m) @@ -1307,7 +1308,8 @@ end subroutine post_surface_diagnostics !> This routine posts diagnostics of the transports, including the subgridscale !! contributions. -subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, diag, dt_trans, diag_to_Z_CSp, Reg) +subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, diag, dt_trans, & + diag_to_Z_CSp, Reg) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & @@ -1352,7 +1354,7 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d call post_data(IDs%id_umo_2d, umo2d, diag) endif if (IDs%id_umo > 0) then - ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below + ! Convert to kg/s. do k=1,nz ; do j=js,je ; do I=is-1,ie umo(I,j,k) = uhtr(I,j,k) * H_to_kg_m2_dt enddo ; enddo ; enddo @@ -1366,7 +1368,7 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d call post_data(IDs%id_vmo_2d, vmo2d, diag) endif if (IDs%id_vmo > 0) then - ! Convert to kg/s. Modifying the array for diagnostics is allowed here since it is set to zero immediately below + ! Convert to kg/s. do k=1,nz ; do J=js-1,je ; do i=is,ie vmo(i,J,k) = vhtr(i,J,k) * H_to_kg_m2_dt enddo ; enddo ; enddo @@ -1375,7 +1377,8 @@ subroutine post_transport_diagnostics(G, GV, uhtr, vhtr, h, IDs, diag_pre_dyn, d if (IDs%id_uhtr > 0) call post_data(IDs%id_uhtr, uhtr, diag, alt_h = diag_pre_dyn%h_state) if (IDs%id_vhtr > 0) call post_data(IDs%id_vhtr, vhtr, diag, alt_h = diag_pre_dyn%h_state) - if (IDs%id_dynamics_h > 0 ) call post_data(IDs%id_dynamics_h, diag_pre_dyn%h_state, diag, alt_h = diag_pre_dyn%h_state) + if (IDs%id_dynamics_h > 0) call post_data(IDs%id_dynamics_h, diag_pre_dyn%h_state, diag, & + alt_h = diag_pre_dyn%h_state) ! Post the change in thicknesses if (IDs%id_dynamics_h_tendency > 0) then h_tend(:,:,:) = 0. diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 18de7c2902..a036509437 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -38,15 +38,15 @@ module MOM_sum_output !********+*********+*********+*********+*********+*********+*********+** use MOM_coms, only : sum_across_PEs, PE_here, root_PE, num_PEs, max_across_PEs -use MOM_coms, only : reproducing_sum -use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=), EFP_to_real, real_to_EFP +use MOM_coms, only : reproducing_sum, EFP_to_real, real_to_EFP +use MOM_coms, only : EFP_type, operator(+), operator(-), assignment(=) use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg 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 : find_eta -use MOM_io, only : create_file, fieldtype, flush_file, open_file, reopen_file, get_filename_appendix -use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field +use MOM_io, only : create_file, fieldtype, flush_file, open_file, reopen_file +use MOM_io, only : file_exists, slasher, vardesc, var_desc, write_field, get_filename_appendix use MOM_io, only : APPEND_FILE, ASCII_FILE, SINGLE_FILE, WRITEONLY_FILE use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S @@ -949,24 +949,18 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp, OBC, dt_forc endif end subroutine write_energy -!> This subroutine accumates the net input of volume, and perhaps later salt and -!! heat, through the ocean surface for use in diagnosing conservation. +!> This subroutine accumates the net input of volume, salt and heat, through +!! the ocean surface for use in diagnosing conservation. subroutine accumulate_net_input(fluxes, sfc_state, dt, G, CS) - type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible forcing fields. Unused fields are unallocated. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible + !! forcing fields. Unused fields are unallocated. type(surface), intent(in) :: sfc_state !< A structure containing fields that !! describe the surface state of the ocean. real, intent(in) :: dt !< The amount of time over which to average, in s. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call to MOM_sum_output_init. - -! This subroutine accumates the net input of volume, and perhaps later salt and -! heat, through the ocean surface for use in diagnosing conservation. -! Arguments: fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields are unallocated. -! (in) dt - The amount of time over which to average. -! (in) G - The ocean's grid structure. -! (in) CS - The control structure returned by a previous call to -! MOM_sum_output_init. + type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call + !! to MOM_sum_output_init. + real, dimension(SZI_(G),SZJ_(G)) :: & FW_in, & ! The net fresh water input, integrated over a timestep in kg. salt_in, & ! The total salt added by surface fluxes, integrated diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index fbd0ce2daa..6b0c90e55e 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -25,9 +25,9 @@ module MOM_wave_speed !! This parameter controls the default behavior of wave_speed() which !! can be overridden by optional arguments. real :: mono_N2_column_fraction = 0. !< The lower fraction of water column over which N2 is limited as - !! monotonic for the purposes of calculating the equivalent barotropic wave speed. - !! This parameter controls the default behavior of wave_speed() which - !! can be overridden by optional arguments. + !! monotonic for the purposes of calculating the equivalent barotropic + !! wave speed. 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. (m) !! This parameter controls the default behavior of wave_speed() which @@ -42,23 +42,25 @@ module MOM_wave_speed !> Calculates the wave speed of the first baroclinic mode. subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & mono_N2_column_fraction, mono_N2_depth, modal_structure) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in units of H (m or kg/m2) - type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) - type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed - logical, optional, intent(in) :: full_halos !< If true, do the calculation - !! over the entire computational domain. - logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent - !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction - !! of water column over which N2 is limited as monotonic - !! for the purposes of calculating vertical modal structure. - real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as - !! monotonic for the purposes of calculating vertical modal structure. + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thickness in units of H (m or kg/m2) + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: cg1 !< First mode internal wave speed (m/s) + type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed + logical, optional, intent(in) :: full_halos !< If true, do the calculation + !! over the entire computational domain. + logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent + !! barotropic mode instead of the first baroclinic mode. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction + !! of water column over which N2 is limited as monotonic + !! for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_depth !< A depth below which N2 is limited as + !! monotonic for the purposes of calculating vertical + !! modal structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) + optional, intent(out) :: modal_structure !< Normalized model structure (non-dim) ! Local variables real, dimension(SZK_(G)+1) :: & @@ -354,7 +356,8 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & do itt=1,max_itt lam_it(itt) = lam if (l_use_ebt_mode) then - ! This initialization of det,ddet imply Neumann boundary conditions so that first 3 rows of the matrix are + ! This initialization of det,ddet imply Neumann boundary conditions so that first 3 rows + ! of the matrix are ! / b(1)-lam igl(1) 0 0 0 ... \ ! | igu(2) b(2)-lam igl(2) 0 0 ... | ! | 0 igu(3) b(3)-lam igl(3) 0 ... | @@ -373,7 +376,8 @@ subroutine wave_speed(h, tv, G, GV, cg1, CS, full_halos, use_ebt_mode, & ! | ... 0 igu(kc-1) b(kc-1)-lam igl(kc-1) | ! \ ... 0 0 igu(kc) b(kc)-lam / else - ! This initialization of det,ddet imply Dirichlet boundary conditions so that first 3 rows of the matrix are + ! This initialization of det,ddet imply Dirichlet boundary conditions so that first 3 rows + ! of the matrix are ! / b(2)-lam igl(2) 0 0 0 ... | ! | igu(3) b(3)-lam igl(3) 0 0 ... | ! | 0 igu43) b(4)-lam igl(4) 0 ... | @@ -1088,10 +1092,12 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over + !! which N2 is limited as monotonic for the purposes of + !! calculating the vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + !! as monotonic for the purposes of calculating the + !! vertical modal structure. ! This include declares and sets the variable "version". #include "version_variable.h" character(len=40) :: mdl = "MOM_wave_speed" ! This module's name. @@ -1116,10 +1122,12 @@ subroutine wave_speed_set_param(CS, use_ebt_mode, mono_N2_column_fraction, mono_ type(wave_speed_CS), pointer :: CS !< Control structure for MOM_wave_speed logical, optional, intent(in) :: use_ebt_mode !< If true, use the equivalent !! barotropic mode instead of the first baroclinic mode. - real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + real, optional, intent(in) :: mono_N2_column_fraction !< The lower fraction of water column over + !! which N2 is limited as monotonic for the purposes of + !! calculating the vertical modal structure. real, optional, intent(in) :: mono_N2_depth !< The depth below which N2 is limited - !! as monotonic for the purposes of calculating vertical modal structure. + !! as monotonic for the purposes of calculating the + !! vertical modal structure. if (.not.associated(CS)) call MOM_error(FATAL, & "wave_speed_set_param called with an associated control structure.") diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index e94f945c57..f504bf220b 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -274,7 +274,8 @@ end subroutine calculate_spec_vol_array subroutine calculate_TFreeze_scalar(S, pressure, T_fr, EOS) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: T_fr !< Freezing point potential temperature referenced to the surface (degC) + real, intent(out) :: T_fr !< Freezing point potential temperature referenced + !! to the surface (degC) type(EOS_type), pointer :: EOS !< Equation of state structure if (.not.associated(EOS)) call MOM_error(FATAL, & @@ -299,7 +300,8 @@ end subroutine calculate_TFreeze_scalar subroutine calculate_TFreeze_array(S, pressure, T_fr, start, npts, EOS) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: T_fr !< Freezing point potential temperature referenced to the surface (degC) + real, dimension(:), intent(out) :: T_fr !< Freezing point potential temperature referenced + !! to the surface (degC) integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -327,8 +329,10 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential tempetature, in kg m-3 K-1. - real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity, in kg m-3 psu-1. + real, dimension(:), intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature, in kg m-3 K-1. + real, dimension(:), intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in kg m-3 psu-1. integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -338,8 +342,8 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, EOS%dRho_dT, EOS%dRho_dS, & - start, npts) + call calculate_density_derivs_linear(T, S, pressure, drho_dT, drho_dS, EOS%Rho_T0_S0, & + EOS%dRho_dT, EOS%dRho_dS, start, npts) case (EOS_UNESCO) call calculate_density_derivs_unesco(T, S, pressure, drho_dT, drho_dS, start, npts) case (EOS_WRIGHT) @@ -355,13 +359,16 @@ subroutine calculate_density_derivs_array(T, S, pressure, drho_dT, drho_dS, star end subroutine calculate_density_derivs_array -!> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar to a one-element array +!> Calls the appropriate subroutines to calculate density derivatives by promoting a scalar +!! to a one-element array subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface (degC) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) - real, intent(out) :: drho_dT !< The partial derivative of density with potential tempetature, in kg m-3 K-1. - real, intent(out) :: drho_dS !< The partial derivative of density with salinity, in kg m-3 psu-1. + real, intent(out) :: drho_dT !< The partial derivative of density with potential + !! temperature, in kg m-3 K-1. + real, intent(out) :: drho_dS !< The partial derivative of density with salinity, + !! in kg m-3 psu-1. type(EOS_type), pointer :: EOS !< Equation of state structure if (.not.associated(EOS)) call MOM_error(FATAL, & "calculate_density_derivs called with an unassociated EOS_type EOS.") @@ -382,8 +389,8 @@ subroutine calculate_density_derivs_scalar(T, S, pressure, drho_dT, drho_dS, EOS end subroutine calculate_density_derivs_scalar !> Calls the appropriate subroutine to calculate density second derivatives for 1-D array inputs. -subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & - start, npts, EOS) +subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & + drho_dS_dP, drho_dT_dP, start, npts, EOS) real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) @@ -401,14 +408,14 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) + call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) case default call MOM_error(FATAL, & "calculate_density_derivs: EOS%form_of_EOS is not valid.") @@ -417,8 +424,8 @@ subroutine calculate_density_second_derivs_array(T, S, pressure, drho_dS_dS, drh end subroutine calculate_density_second_derivs_array !> Calls the appropriate subroutine to calculate density second derivatives for scalar nputs. -subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP, & - EOS) +subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, & + drho_dS_dP, drho_dT_dP, EOS) real, intent(in) :: T !< Potential temperature referenced to the surface (degC) real, intent(in) :: S !< Salinity (PSU) real, intent(in) :: pressure !< Pressure (Pa) @@ -434,14 +441,14 @@ subroutine calculate_density_second_derivs_scalar(T, S, pressure, drho_dS_dS, dr select case (EOS%form_of_EOS) case (EOS_LINEAR) - call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_linear(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_WRIGHT) - call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_wright(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case (EOS_TEOS10) - call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) + call calculate_density_second_derivs_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) case default call MOM_error(FATAL, & "calculate_density_derivs: EOS%form_of_EOS is not valid.") @@ -454,8 +461,10 @@ subroutine calculate_specific_vol_derivs(T, S, pressure, dSV_dT, dSV_dS, start, real, dimension(:), intent(in) :: T !< Potential temperature referenced to the surface (degC) real, dimension(:), intent(in) :: S !< Salinity (PSU) real, dimension(:), intent(in) :: pressure !< Pressure (Pa) - real, dimension(:), intent(out) :: dSV_dT !< The partial derivative of specific volume with potential temperature, in m3 kg-1 K-1. - real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity, in m3 kg-1 / (g/kg). + real, dimension(:), intent(out) :: dSV_dT !< The partial derivative of specific volume with potential + !! temperature, in m3 kg-1 K-1. + real, dimension(:), intent(out) :: dSV_dS !< The partial derivative of specific volume with salinity, + !! in m3 kg-1 / (g/kg). integer, intent(in) :: start !< Starting index within the array integer, intent(in) :: npts !< The number of values to calculate type(EOS_type), pointer :: EOS !< Equation of state structure @@ -771,7 +780,8 @@ subroutine EOS_init(param_file, EOS) units="deg C Pa-1", default=0.0) endif - if ((EOS%form_of_EOS == EOS_TEOS10 .OR. EOS%form_of_EOS == EOS_NEMO) .AND. EOS%form_of_TFreeze /= TFREEZE_TEOS10) then + if ((EOS%form_of_EOS == EOS_TEOS10 .OR. EOS%form_of_EOS == EOS_NEMO) .AND. & + EOS%form_of_TFreeze /= TFREEZE_TEOS10) then call MOM_error(FATAL, "interpret_eos_selection: EOS_TEOS10 or EOS_NEMO \n" //& "should only be used along with TFREEZE_FORM = TFREEZE_TEOS10 .") endif @@ -780,8 +790,8 @@ subroutine EOS_init(param_file, EOS) end subroutine EOS_init !> Manually initialized an EOS type (intended for unit testing of routines which need a specific EOS) -subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, Rho_T0_S0, drho_dT, & - dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) +subroutine EOS_manual_init(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & + Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) type(EOS_type), pointer :: EOS integer, optional, intent(in ) :: form_of_EOS integer, optional, intent(in ) :: form_of_TFreeze @@ -2335,8 +2345,8 @@ subroutine convert_temp_salt_for_TEOS10(T, S, press, G, kd, mask_z, EOS) end subroutine convert_temp_salt_for_TEOS10 ! Extractor routine for the EOS type if the members need to be accessed outside this module -subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, Rho_T0_S0, drho_dT, & - dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) +subroutine extract_member_EOS(EOS, form_of_EOS, form_of_TFreeze, EOS_quadrature, Compressible, & + Rho_T0_S0, drho_dT, dRho_dS, TFr_S0_P0, dTFr_dS, dTFr_dp) type(EOS_type), pointer :: EOS integer, optional, intent(out) :: form_of_EOS integer, optional, intent(out) :: form_of_TFreeze diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index d6a211b6c3..f0811422d5 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -236,8 +236,8 @@ subroutine calculate_specvol_derivs_teos10(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_specvol_derivs_teos10 !> Calculate the 5 second derivatives of the equation of state for scalar inputs -subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP) +subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP) real, intent(in) :: T, S, pressure real, intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S real, intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T @@ -264,8 +264,8 @@ subroutine calculate_density_second_derivs_scalar_teos10(T, S, pressure, drho_dS end subroutine calculate_density_second_derivs_scalar_teos10 !> Calculate the 5 second derivatives of the equation of state for scalar inputs -subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, & - drho_dT_dP, start, npts) +subroutine calculate_density_second_derivs_array_teos10(T, S, pressure, drho_dS_dS, drho_dS_dT, & + drho_dT_dT, drho_dS_dP, drho_dT_dP, start, npts) real, dimension(:), intent(in) :: T, S, pressure real, dimension(:), intent(out) :: drho_dS_dS !< Partial derivative of beta with respect to S real, dimension(:), intent(out) :: drho_dS_dT !< Partial derivative of beta with resepct to T diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 9f738f6322..01678dce41 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -235,7 +235,8 @@ subroutine chksum_pair_B_2d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit character(len=*), intent(in) :: mesg !< Identifying messages type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%isd:,HI%jsd:), intent(in) :: arrayA, arrayB !< The arrays to be checksummed - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -261,7 +262,8 @@ subroutine chksum_pair_B_3d(mesg, arrayA, arrayB, HI, haloshift, symmetric, omit type(hor_index_type), intent(in) :: HI !< A horizontal index type real, dimension(HI%IsdB:,HI%JsdB:, :), intent(in) :: arrayA, arrayB !< The arrays to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -425,7 +427,8 @@ subroutine chksum_uv_2d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: arrayU !< The u-component array to be checksummed real, dimension(HI%isd:,HI%JsdB:), intent(in) :: arrayV !< The v-component array to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for these arrays. @@ -445,7 +448,8 @@ subroutine chksum_uv_3d(mesg, arrayU, arrayV, HI, haloshift, symmetric, omit_cor real, dimension(HI%IsdB:,HI%jsd:,:), intent(in) :: arrayU !< The u-component array to be checksummed real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: arrayV !< The v-component array to be checksummed integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for these arrays. @@ -465,7 +469,8 @@ subroutine chksum_u_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%IsdB:,HI%jsd:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -608,7 +613,8 @@ subroutine chksum_v_2d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isd:,HI%JsdB:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -874,7 +880,8 @@ subroutine chksum_B_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%IsdB:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1017,7 +1024,8 @@ subroutine chksum_u_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isdB:,HI%Jsd:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1154,7 +1162,8 @@ end subroutine chksum_u_3d !---chksum_general interface routines !> Return the bitcount of an arbitrarily sized 3d array -integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) result(subchk) +integer function chksum_general_3d( array, scale_factor, istart, iend, jstart, jend, kstart, kend ) & + result(subchk) real, dimension(:,:,:), intent(in) :: array !< Array to be checksummed real, optional, intent(in) :: scale_factor !< Factor to scale array by before checksum integer, optional, intent(in) :: istart !< Starting index in the i-direction @@ -1232,7 +1241,8 @@ subroutine chksum_v_3d(array, mesg, HI, haloshift, symmetric, omit_corners, scal real, dimension(HI%isd:,HI%JsdB:,:), intent(in) :: array !< The array to be checksummed character(len=*), intent(in) :: mesg !< An identifying message integer, optional, intent(in) :: haloshift !< The width of halos to check (default 0) - logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full symmetric computational domain. + logical, optional, intent(in) :: symmetric !< If true, do the checksums on the full + !! symmetric computational domain. logical, optional, intent(in) :: omit_corners !< If true, avoid checking diagonal shifts real, optional, intent(in) :: scale !< A scaling factor for this array. @@ -1512,7 +1522,8 @@ end function is_NaN_0d !> This function returns .true. if any element of x is a NaN, and .false. otherwise. function is_NaN_1d(x, skip_mpp) real, dimension(:), intent(in) :: x !< The array to be checked for NaNs. - logical, optional, intent(in) :: skip_mpp !< If true, only check this array only on the local PE (default false). + logical, optional, intent(in) :: skip_mpp !< If true, only check this array only + !! on the local PE (default false). logical :: is_NaN_1d integer :: i, n diff --git a/src/framework/MOM_diag_manager_wrapper.F90 b/src/framework/MOM_diag_manager_wrapper.F90 index 81e26634a7..0274617d32 100644 --- a/src/framework/MOM_diag_manager_wrapper.F90 +++ b/src/framework/MOM_diag_manager_wrapper.F90 @@ -19,20 +19,25 @@ module MOM_diag_manager_wrapper integer function register_diag_field_array_fms(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or + !! "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - integer, intent(in) :: axes(:) !< Container w/ up to 3 integer handles that indicates axes for this field + integer, intent(in) :: axes(:) !< Container w/ up to 3 integer handles that + !! indicates axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be + !! interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) integer, optional, intent(in) :: area !< The FMS id of cell area integer, optional, intent(in) :: volume !< The FMS id of cell volume @@ -50,7 +55,8 @@ end function register_diag_field_array_fms integer function register_diag_field_scalar_fms(module_name, field_name, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, area, volume) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. @@ -58,11 +64,14 @@ integer function register_diag_field_scalar_fms(module_name, field_name, init_ti character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might + !! be placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not + !! be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) integer, optional, intent(in) :: area !< The FMS id of cell area (not used for scalars) integer, optional, intent(in) :: volume !< The FMS id of cell volume (not used for scalars) diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index cd378cff09..e37e4bddff 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -78,9 +78,12 @@ module MOM_diag_mediator type(diag_ctrl), pointer :: diag_cs => null() !< Circular link back to the main diagnostics control structure !! (Used to avoid passing said structure into every possible call). ! ID's for cell_methods - character(len=9) :: x_cell_method = '' !< Default nature of data representation, if axes group includes x-direction. - character(len=9) :: y_cell_method = '' !< Default nature of data representation, if axes group includes y-direction. - character(len=9) :: v_cell_method = '' !< Default nature of data representation, if axes group includes vertical direction. + character(len=9) :: x_cell_method = '' !< Default nature of data representation, if axes group + !! includes x-direction. + character(len=9) :: y_cell_method = '' !< Default nature of data representation, if axes group + !! includes y-direction. + character(len=9) :: v_cell_method = '' !< Default nature of data representation, if axes group + !! includes vertical direction. ! For remapping integer :: nz = 0 !< Vertical dimension of diagnostic integer :: vertical_coordinate_number = 0 !< Index of the corresponding diag_remap_ctrl for this axis group @@ -90,18 +93,21 @@ module MOM_diag_mediator logical :: is_u_point = .false. !< If true, indicates that this axes group is for a u-point located field. logical :: is_v_point = .false. !< If true, indicates that this axes group is for a v-point located field. logical :: is_layer = .false. !< If true, indicates that this axes group is for a layer vertically-located field. - logical :: is_interface = .false. !< If true, indicates that this axes group is for an interface vertically-located field. - logical :: is_native = .true. !< If true, indicates that this axes group is for a native model grid. False for any other - !! grid. Used for rank>2. - logical :: needs_remapping = .false. !< If true, indicates that this axes group is for a intensive layer-located field - !! that must be remapped to these axes. Used for rank>2. - logical :: needs_interpolating = .false. !< If true, indicates that this axes group is for a sampled interface-located field - !! that must be interpolated to these axes. Used for rank>2. + logical :: is_interface = .false. !< If true, indicates that this axes group is for an interface + !! vertically-located field. + logical :: is_native = .true. !< If true, indicates that this axes group is for a native model grid. + !! False for any other grid. Used for rank>2. + logical :: needs_remapping = .false. !< If true, indicates that this axes group is for a intensive layer-located + !! field that must be remapped to these axes. Used for rank>2. + logical :: needs_interpolating = .false. !< If true, indicates that this axes group is for a sampled + !! interface-located field that must be interpolated to + !! these axes. Used for rank>2. ! For horizontally averaged diagnositcs (applies to 2d and 3d fields only) type(axes_grp), pointer :: xyave_axes => null() !< The associated 1d axes for horizontall area-averaged diagnostics ! ID's for cell_measures integer :: id_area = -1 !< The diag_manager id for area to be used for cell_measure of variables with this axes_grp. - integer :: id_volume = -1 !< The diag_manager id for volume to be used for cell_measure of variables with this axes_grp. + integer :: id_volume = -1 !< The diag_manager id for volume to be used for cell_measure of variables + !! with this axes_grp. ! For masking real, pointer, dimension(:,:) :: mask2d => null() !< Mask for 2d (x-y) axes real, pointer, dimension(:,:,:) :: mask3d => null() !< Mask for 3d axes @@ -133,7 +139,8 @@ module MOM_diag_mediator type(axes_grp), pointer :: axes => null() type(diag_type), pointer :: next => null() !< Pointer to the next diag. real :: conversion_factor = 0. !< A factor to multiply data by before posting to FMS, if non-zero. - logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). False for intensive (concentrations). + logical :: v_extensive = .false. !< True for vertically extensive fields (vertically integrated). + !! False for intensive (concentrations). end type diag_type !> The following data type a list of diagnostic fields an their variants, @@ -347,7 +354,8 @@ subroutine set_axes_info(G, GV, param_file, diag_cs, set_vertical) is_h_point=.true., is_layer=.true., is_native=.false., needs_remapping=.true., & xyave_axes=diag_cs%remap_axesZL(i)) - !! \note Remapping for B points is not yet implemented so needs_remapping is not provided for remap_axesBL + !! \note Remapping for B points is not yet implemented so needs_remapping is not + !! provided for remap_axesBL call define_axes_group(diag_cs, (/ id_xq, id_yq, id_zL /), diag_cs%remap_axesBL(i), & nz=nz, vertical_coordinate_number=i, & x_cell_method='point', y_cell_method='point', v_cell_method='mean', & @@ -584,21 +592,34 @@ subroutine define_axes_group(diag_cs, handles, axes, nz, vertical_coordinate_num type(axes_grp), intent(out) :: axes !< The group of 1D axes integer, optional, intent(in) :: nz !< Number of layers in this diagnostic grid integer, optional, intent(in) :: vertical_coordinate_number !< Index number for vertical coordinate - character(len=*), optional, intent(in) :: x_cell_method !< A x-direction cell method used to construct the "cell_methods" attribute in CF convention - character(len=*), optional, intent(in) :: y_cell_method !< A y-direction cell method used to construct the "cell_methods" attribute in CF convention - character(len=*), optional, intent(in) :: v_cell_method !< A vertical direction cell method used to construct the "cell_methods" attribute in CF convention - logical, optional, intent(in) :: is_h_point !< If true, indicates this axes group for h-point located fields - logical, optional, intent(in) :: is_q_point !< If true, indicates this axes group for q-point located fields - logical, optional, intent(in) :: is_u_point !< If true, indicates this axes group for u-point located fields - logical, optional, intent(in) :: is_v_point !< If true, indicates this axes group for v-point located fields - logical, optional, intent(in) :: is_layer !< If true, indicates that this axes group is for a layer vertically-located field. - logical, optional, intent(in) :: is_interface !< If true, indicates that this axes group is for an interface vertically-located field. - logical, optional, intent(in) :: is_native !< If true, indicates that this axes group is for a native model grid. False for any other grid. - logical, optional, intent(in) :: needs_remapping !< If true, indicates that this axes group is for a intensive layer-located field - !! that must be remapped to these axes. Used for rank>2. - logical, optional, intent(in) :: needs_interpolating !< If true, indicates that this axes group is for a sampled interface-located field - !! that must be interpolated to these axes. Used for rank>2. - type(axes_grp), optional, target :: xyave_axes !< The corresponding axes group for horizontally area-average diagnostics + character(len=*), optional, intent(in) :: x_cell_method !< A x-direction cell method used to construct the + !! "cell_methods" attribute in CF convention + character(len=*), optional, intent(in) :: y_cell_method !< A y-direction cell method used to construct the + !! "cell_methods" attribute in CF convention + character(len=*), optional, intent(in) :: v_cell_method !< A vertical direction cell method used to construct + !! the "cell_methods" attribute in CF convention + logical, optional, intent(in) :: is_h_point !< If true, indicates this axes group for h-point + !! located fields + logical, optional, intent(in) :: is_q_point !< If true, indicates this axes group for q-point + !! located fields + logical, optional, intent(in) :: is_u_point !< If true, indicates this axes group for + !! u-point located fields + logical, optional, intent(in) :: is_v_point !< If true, indicates this axes group for + !! v-point located fields + logical, optional, intent(in) :: is_layer !< If true, indicates that this axes group is + !! for a layer vertically-located field. + logical, optional, intent(in) :: is_interface !< If true, indicates that this axes group + !! is for an interface vertically-located field. + logical, optional, intent(in) :: is_native !< If true, indicates that this axes group is + !! for a native model grid. False for any other grid. + logical, optional, intent(in) :: needs_remapping !< If true, indicates that this axes group is + !! for a intensive layer-located field that must + !! be remapped to these axes. Used for rank>2. + logical, optional, intent(in) :: needs_interpolating !< If true, indicates that this axes group + !! is for a sampled interface-located field that must + !! be interpolated to these axes. Used for rank>2. + type(axes_grp), optional, target :: xyave_axes !< The corresponding axes group for horizontally + !! area-average diagnostics ! Local variables integer :: n @@ -1074,7 +1095,8 @@ subroutine post_data_3d_low(diag, field, diag_cs, is_static, mask) if ((diag%conversion_factor /= 0.) .and. (diag%conversion_factor /= 1.)) then ks = lbound(field,3) ; ke = ubound(field,3) allocate( locfield( lbound(field,1):ubound(field,1), lbound(field,2):ubound(field,2), ks:ke ) ) - ! locfield(:,:,:) = 0.0 ! Zeroing out this array would be a good idea, but it appears not to be necessary. + ! locfield(:,:,:) = 0.0 ! Zeroing out this array would be a good idea, but it appears + ! not to be necessary. isv_c = isv ; jsv_c = jsv if (diag%fms_xyave_diag_id>0) then staggered_in_x = diag%axes%is_u_point .or. diag%axes%is_q_point @@ -1258,39 +1280,50 @@ function get_diag_time_end(diag_cs) get_diag_time_end = diag_cs%time_end end function get_diag_time_end -!> Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics derived from one field. +!> Returns the "diag_mediator" handle for a group (native, CMOR, z-coord, ...) of diagnostics +!! derived from one field. integer function register_diag_field(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count, cmor_field_name, & cmor_long_name, cmor_units, cmor_standard_name, cell_methods, & x_cell_method, y_cell_method, v_cell_method, conversion, v_extensive) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that + !! indicates axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with + !! post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not + !! be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name of a field character(len=*), optional, intent(in) :: cmor_long_name !< CMOR long name of a field character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to + !! have no attribute. If present, this overrides the + !! default constructed from the default for !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically + !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value type(diag_ctrl), pointer :: diag_cs @@ -1378,31 +1411,40 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, integer, intent(inout) :: dm_id !< The diag_mediator ID for this diagnostic group character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes + !! for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided + !! with post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should + !! not be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name of a field character(len=*), optional, intent(in) :: cmor_long_name !< CMOR long name of a field character(len=*), optional, intent(in) :: cmor_units !< CMOR units of a field character(len=*), optional, intent(in) :: cmor_standard_name !< CMOR standardized name associated with a field - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for - !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. + !! Use '' to have no attribute. If present, this + !! overrides the default constructed from the default + !! for each individual axis direction. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically + !! integrated). Default/absent for intensive. ! Local variables real :: MOM_missing_value type(diag_ctrl), pointer :: diag_cs @@ -1462,9 +1504,9 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, ! For the CMOR variation of the above diagnostic if (present(cmor_field_name)) then ! Fallback values for strings set to "NULL" - posted_cmor_units = "not provided" ! - posted_cmor_standard_name = "not provided" ! Values might be able to be replaced with a CS%missing field? - posted_cmor_long_name = "not provided" ! + posted_cmor_units = "not provided" ! + posted_cmor_standard_name = "not provided" ! Values might be able to be replaced with a CS%missing field? + posted_cmor_long_name = "not provided" ! ! If attributes are present for MOM variable names, use them first for the register_diag_field ! call for CMOR verison of the variable @@ -1478,9 +1520,9 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, if (present(cmor_long_name)) posted_cmor_long_name = cmor_long_name fms_id = register_diag_field_expand_axes(module_name, cmor_field_name, axes, init_time, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & - standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & + standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & err_msg=err_msg, interp_method=interp_method, tile_count=tile_count) call attach_cell_methods(fms_id, axes, cm_string, & cell_methods, x_cell_method, y_cell_method, v_cell_method, & @@ -1496,16 +1538,16 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, if (associated(axes%xyave_axes)) then fms_xyave_id = register_diag_field_expand_axes(module_name, trim(cmor_field_name)//'_xyave', & axes%xyave_axes, init_time, & - long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & - missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & - standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & + long_name=trim(posted_cmor_long_name), units=trim(posted_cmor_units), & + missing_value=MOM_missing_value, range=range, mask_variant=mask_variant, & + standard_name=trim(posted_cmor_standard_name), verbose=verbose, do_not_log=do_not_log, & err_msg=err_msg, interp_method=interp_method, tile_count=tile_count) call attach_cell_methods(fms_xyave_id, axes%xyave_axes, cm_string, & cell_methods, v_cell_method, v_extensive=v_extensive) if (is_root_pe() .and. diag_CS%available_diag_doc_unit > 0) then msg = 'native name is "'//trim(field_name)//'_xyave"' - call log_available_diag(fms_xyave_id>0, module_name, trim(cmor_field_name)//'_xyave', cm_string, & - msg, diag_CS, posted_cmor_long_name, posted_cmor_units, & + call log_available_diag(fms_xyave_id>0, module_name, trim(cmor_field_name)//'_xyave', & + cm_string, msg, diag_CS, posted_cmor_long_name, posted_cmor_units, & posted_cmor_standard_name) endif endif @@ -1522,25 +1564,31 @@ logical function register_diag_field_expand_cmor(dm_id, module_name, field_name, end function register_diag_field_expand_cmor -!> Returns an FMS id from register_diag_field_fms (the diag_manager routine) after expanding axes (axes-group) -!! into handles and conditionally adding an FMS area_id for cell_measures. +!> Returns an FMS id from register_diag_field_fms (the diag_manager routine) after expanding axes +!! (axes-group) into handles and conditionally adding an FMS area_id for cell_measures. integer function register_diag_field_expand_axes(module_name, field_name, axes, init_time, & long_name, units, missing_value, range, mask_variant, standard_name, & verbose, do_not_log, err_msg, interp_method, tile_count) - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" + !! or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of the diagnostic field - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates + !! axes for this field type(time_type), intent(in) :: init_time !< Time at which a field is first available? character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field real, optional, intent(in) :: missing_value !< A value that indicates missing values. real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) - logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with post_data calls (not used in MOM?) + logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided + !! with post_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) - logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) - character(len=*), optional, intent(out):: err_msg !< String into which an error message might be placed (not used in MOM?) - character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not be interpolated as a scalar + logical, optional, intent(in) :: do_not_log !< If true, do not log something + !! (not used in MOM?) + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should + !! not be interpolated as a scalar integer, optional, intent(in) :: tile_count !< no clue (not used in MOM?) ! Local variables integer :: fms_id, area_id, volume_id @@ -1624,8 +1672,10 @@ subroutine add_diag_to_list(diag_cs, dm_id, fms_id, this_diag, axes, module_name integer, intent(inout) :: dm_id !< The diag_mediator ID for this diagnostic group integer, intent(in) :: fms_id !< The FMS diag_manager ID for this diagnostic type(diag_type), pointer :: this_diag !< This diagnostic - type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field - character(len=*), intent(in) :: module_name !< Name of this module, usually "ocean_model" or "ice_shelf_model" + type(axes_grp), target, intent(in) :: axes !< Container w/ up to 3 integer handles that + !! indicates axes for this field + character(len=*), intent(in) :: module_name !< Name of this module, usually + !! "ocean_model" or "ice_shelf_model" character(len=*), intent(in) :: field_name !< Name of diagnostic character(len=*), intent(in) :: msg !< Message for errors @@ -1645,15 +1695,21 @@ end subroutine add_diag_to_list subroutine attach_cell_methods(id, axes, ostring, cell_methods, & x_cell_method, y_cell_method, v_cell_method, v_extensive) integer, intent(in) :: id !< Handle to diagnostic - type(axes_grp), intent(in) :: axes !< Container w/ up to 3 integer handles that indicates axes for this field + type(axes_grp), intent(in) :: axes !< Container w/ up to 3 integer handles that indicates + !! axes for this field character(len=*), intent(out) :: ostring !< The cell_methods strings that would appear in the file - character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. Use '' to have no attribute. - !! If present, this overrides the default constructed from the default for - !! each individual axis direction. - character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. Use '' have no method. - character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. Use '' have no method. - character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. Use '' have no method. - logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields (vertically integrated). Default/absent for intensive. + character(len=*), optional, intent(in) :: cell_methods !< String to append as cell_methods attribute. + !! Use '' to have no attribute. If present, this + !! overrides the default constructed from the default + !! for each individual axis direction. + character(len=*), optional, intent(in) :: x_cell_method !< Specifies the cell method for the x-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: y_cell_method !< Specifies the cell method for the y-direction. + !! Use '' have no method. + character(len=*), optional, intent(in) :: v_cell_method !< Specifies the cell method for the vertical direction. + !! Use '' have no method. + logical, optional, intent(in) :: v_extensive !< True for vertically extensive fields + !! (vertically integrated). Default/absent for intensive. ! Local variables character(len=9) :: axis_name logical :: x_mean, y_mean, x_sum, y_sum diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index 144e10c15d..a6ca5db387 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -739,7 +739,7 @@ end subroutine doc_function subroutine doc_init(docFileBase, doc, minimal, complete, layout, debugging) character(len=*), intent(in) :: docFileBase !< The base file name for this set of parameters, - !! for example MOM_parameter_doc + !! for example MOM_parameter_doc type(doc_type), pointer :: doc !< A pointer to a structure that controls where the !! documentation occurs and its formatting logical, optional, intent(in) :: minimal !< If present and true, write out the files (.short) documenting diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index d708fcdf27..54ce188bb9 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -227,8 +227,9 @@ subroutine create_file(unit, filename, vars, novars, fields, threading, timeunit if ((use_layer .or. use_int) .and. .not.present(GV)) call MOM_error(FATAL, & "create_file: A vertical grid type is required to create a file with a vertical coordinate.") -! Specify all optional arguments to mpp_write_meta: name, units, longname, cartesian, calendar, sense, domain, data, min) -! Otherwise if optional arguments are added to mpp_write_meta the compiler may (and in case of GNU is) get confused and crash. +! Specify all optional arguments to mpp_write_meta: name, units, longname, cartesian, calendar, sense, +! domain, data, min). Otherwise if optional arguments are added to mpp_write_meta the compiler may +! (and in case of GNU does) get confused and crash. if (use_lath) & call mpp_write_meta(unit, axis_lath, name="lath", units=y_axis_units, longname="Latitude", & cartesian='Y', domain = y_domain, data=gridLatT(jsg:jeg)) @@ -635,19 +636,19 @@ end function var_desc !! All arguments are optional, except the vardesc type to be modified. subroutine modify_vardesc(vd, name, units, longname, hor_grid, z_grid, t_grid, & cmor_field_name, cmor_units, cmor_longname, conversion, caller) - type(vardesc), intent(inout) :: vd !< vardesc type that is modified - character(len=*), optional, intent(in) :: name !< name of variable - character(len=*), optional, intent(in) :: units !< units of variable - character(len=*), optional, intent(in) :: longname !< long name of variable - character(len=*), optional, intent(in) :: hor_grid !< horizonal staggering of variable - character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable - character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 - character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name - character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable - character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name - real , optional, intent(in) :: conversion !< for unit conversions, such as needed to - !! convert from intensive to extensive - character(len=*), optional, intent(in) :: caller !< calling routine? + type(vardesc), intent(inout) :: vd !< vardesc type that is modified + character(len=*), optional, intent(in) :: name !< name of variable + character(len=*), optional, intent(in) :: units !< units of variable + character(len=*), optional, intent(in) :: longname !< long name of variable + character(len=*), optional, intent(in) :: hor_grid !< horizonal staggering of variable + character(len=*), optional, intent(in) :: z_grid !< vertical staggering of variable + character(len=*), optional, intent(in) :: t_grid !< time description: s, p, or 1 + character(len=*), optional, intent(in) :: cmor_field_name !< CMOR name + character(len=*), optional, intent(in) :: cmor_units !< CMOR physical dimensions of variable + character(len=*), optional, intent(in) :: cmor_longname !< CMOR long name + real , optional, intent(in) :: conversion !< for unit conversions, such as needed + !! to convert from intensive to extensive + character(len=*), optional, intent(in) :: caller !< calling routine? character(len=120) :: cllr cllr = "mod_vardesc" diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 4004801a02..52436cf827 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1,6 +1,6 @@ !> Implements the thermodynamic aspects of ocean / ice-shelf interactions, -! along with a crude placeholder for a later implementation of full -! ice shelf dynamics, all using the MOM framework and coding style. +!! along with a crude placeholder for a later implementation of full +!! ice shelf dynamics, all using the MOM framework and coding style. module MOM_ice_shelf ! This file is part of MOM6. See LICENSE.md for the license. @@ -150,7 +150,8 @@ module MOM_ice_shelf !!! OVS !!! t_boundary_values => NULL(), & - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal law exponent + taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - + ! exact form depends on basal law exponent ! and/or whether flow is "hybridized" a la Goldberg 2011 taub_beta_eff_lower_tri => NULL(), & taub_beta_eff_upper_tri => NULL(), & @@ -233,7 +234,8 @@ module MOM_ice_shelf ! ~ once a day (maybe longer) because it will depend on ocean values ! that are averaged over this time interval, and the solve will begin ! to lose meaning if it is done too frequently - integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; the counter will have to be stored + integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; + ! the counter will have to be stored integer :: velocity_update_counter ! the "outer" timestep number integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) @@ -812,7 +814,8 @@ subroutine shelf_calc_flux(state, forces, fluxes, Time, time_step, CS) CS%velocity_update_sub_counter = CS%velocity_update_sub_counter+1 if (CS%GL_couple .and. .not. CS%solo_ice_sheet) then - call update_OD_ffrac (CS, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, CS%time_step, CS%velocity_update_time_step) + call update_OD_ffrac(CS, state%ocean_mass, CS%velocity_update_sub_counter, CS%nstep_velocity, & + CS%time_step, CS%velocity_update_time_step) else call update_OD_ffrac_uncoupled (CS) endif @@ -3192,8 +3195,8 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ ! i may not cover all the cases.. but i cover the realistic ones - if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it stencil (-1) = CS%thickness_boundary_values(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh @@ -3240,8 +3243,8 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh @@ -3302,13 +3305,15 @@ subroutine ice_shelf_advect_thickness_x (CS, time_step, h0, h_after_uflux, flux_ endif if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask(i,j) = 2 elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask(i,j) = 2 @@ -3423,8 +3428,8 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v ! i may not cover all the cases.. but i cover the realistic ones - if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid @@ -3471,8 +3476,8 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) @@ -3522,12 +3527,14 @@ subroutine ice_shelf_advect_thickness_y (CS, time_step, h_after_uflux, h_after_v endif if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask (i,j) = 2 elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered hmask (i,j) = 2 endif @@ -3809,7 +3816,8 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) real :: rho, rhow, sx, sy, neumann_val, dxh, dyh, dxdyh type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off G => CS%grid @@ -3983,28 +3991,35 @@ subroutine calc_shelf_driving_stress (CS, TAUD_X, TAUD_Y, OD, FE) endif - if ((u_face_mask(i-1,j) .eq. 2) .OR. (hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2) ) then ! left face of the cell is at a stress boundary - ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated pressure on either side of the face + if ((u_face_mask(i-1,j) .eq. 2) .OR. (hmask(i-1,j) .eq. 0) .OR. (hmask(i-1,j) .eq. 2) ) then + ! left face of the cell is at a stress boundary + ! the depth-integrated longitudinal stress is equal to the difference of depth-integrated + ! pressure on either side of the face ! on the ice side, it is rho g h^2 / 2 ! on the ocean side, it is rhow g (delta OD)^2 / 2 - ! OD can be zero under the ice; but it is ASSUMED on the ice-free side of the face, topography elevation is not above the base of the - ! ice in the current cell - taud_x(i-1,j-1) = taud_x(i-1,j-1) - .5 * dyh * neumann_val ! note negative sign is due to direction of normal vector + ! OD can be zero under the ice; but it is ASSUMED on the ice-free side of the face, topography elevation + ! is not above the base of the ice in the current cell + + ! note negative sign due to direction of normal vector + taud_x(i-1,j-1) = taud_x(i-1,j-1) - .5 * dyh * neumann_val taud_x(i-1,j) = taud_x(i-1,j) - .5 * dyh * neumann_val endif - if ((u_face_mask(i,j) .eq. 2) .OR. (hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2) ) then ! right face of the cell is at a stress boundary + if ((u_face_mask(i,j) .eq. 2) .OR. (hmask(i+1,j) .eq. 0) .OR. (hmask(i+1,j) .eq. 2) ) then + ! right face of the cell is at a stress boundary taud_x(i,j-1) = taud_x(i,j-1) + .5 * dyh * neumann_val taud_x(i,j) = taud_x(i,j) + .5 * dyh * neumann_val endif - if ((v_face_mask(i,j-1) .eq. 2) .OR. (hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2) ) then ! south face of the cell is at a stress boundary + if ((v_face_mask(i,j-1) .eq. 2) .OR. (hmask(i,j-1) .eq. 0) .OR. (hmask(i,j-1) .eq. 2) ) then + ! south face of the cell is at a stress boundary taud_y(i-1,j-1) = taud_y(i-1,j-1) - .5 * dxh * neumann_val taud_y(i,j-1) = taud_y(i,j-1) - .5 * dxh * neumann_val endif - if ((v_face_mask(i,j) .eq. 2) .OR. (hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2) ) then ! north face of the cell is at a stress boundary - taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign is due to direction of normal vector + if ((v_face_mask(i,j) .eq. 2) .OR. (hmask(i,j+1) .eq. 0) .OR. (hmask(i,j+1) .eq. 2) ) then + ! north face of the cell is at a stress boundary + taud_y(i-1,j) = taud_y(i-1,j) + .5 * dxh * neumann_val ! note negative sign due to direction of normal vector taud_y(i,j) = taud_y(i,j) + .5 * dxh * neumann_val endif @@ -4037,7 +4052,8 @@ subroutine init_boundary_values (CS, time, input_flux, input_thick, new_sim) v_boundary_values, & u_face_mask, v_face_mask, hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: gjec, gisc, gjsc, cnt, isc, jsc, iec, jec integer :: i_off, j_off real :: A, n, ux, uy, vx, vy, eps_min, domain_width @@ -4399,7 +4415,8 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif Ucontr(iphi,jphi) = Ucontr(iphi,jphi) + .25 * area * uq * xquad(ilq) * xquad(jlq) * beta(i,j) -! if((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) +! if((i.eq.27) .and. (j.eq.8) .and. (iphi.eq.1) .and. (jphi.eq.1)) & +! print *, "grid", uq, .25 * area * uq * xquad(ilq) * xquad(jlq) !endif enddo ; enddo @@ -4416,7 +4433,8 @@ subroutine CG_action_bilinear (uret, vret, u, v, Phi, Phisub, umask, vmask, hmas endif if (vmask (i-2+iphi,j-2+jphi) .eq. 1) then vret (i-2+iphi,j-2+jphi) = vret (i-2+iphi,j-2+jphi) + Vsubcontr (iphi,jphi) * beta(i,j) - !if ( (iphi.eq.1) .and. (jphi.eq.1)) print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) + !if ( (iphi.eq.1) .and. (jphi.eq.1)) 8 + ! print *, i,j, Usubcontr (iphi,jphi) * beta(i,j), " ", Ucontr(iphi,jphi) endif enddo ; enddo endif @@ -4470,8 +4488,8 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat uq = 0 ; vq = 0 do k=1,2 do l=1,2 - !Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * U(k,l) - !Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * V(k,l) + !Ucontr(m,n) = Ucontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * U(k,l) + !Vcontr(m,n) = Vcontr(m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * Phisub(i,j,k,l,qx,qy) * V(k,l) uq = uq + Phisub(i,j,k,l,qx,qy) * U(k,l) ; vq = vq + Phisub(i,j,k,l,qx,qy) * V(k,l) enddo enddo @@ -4479,7 +4497,8 @@ subroutine CG_action_subgrid_basal_bilinear (Phisub, H, U, V, DXDYH, D, dens_rat Ucontr (m,n) = Ucontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * uq Vcontr (m,n) = Vcontr (m,n) + subarea * 0.25 * Phisub(i,j,m,n,qx,qy) * vq - ! if ((i_m .eq. 27) .and. (j_m .eq. 8) .and. (m.eq.1) .and. (n.eq.1)) print *, "in subgrid", uq, Phisub(i,j,m,n,qx,qy) + ! if ((i_m .eq. 27) .and. (j_m .eq. 8) .and. (m.eq.1) .and. (n.eq.1)) & + print *, "in subgrid", uq, Phisub(i,j,m,n,qx,qy) endif @@ -5009,7 +5028,8 @@ subroutine apply_boundary_values_triangle (CS, time, u_boundary_contr, v_boundar end subroutine apply_boundary_values_triangle -subroutine apply_boundary_values_bilinear (CS, time, Phisub, H_node, float_cond, dens_ratio, u_boundary_contr, v_boundary_contr) +subroutine apply_boundary_values_bilinear(CS, time, Phisub, H_node, float_cond, dens_ratio, & + u_boundary_contr, v_boundary_contr) type(time_type), intent(in) :: Time real, dimension (:,:,:,:,:,:),pointer:: Phisub @@ -5207,7 +5227,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed + integer :: iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh G => CS%grid @@ -5253,7 +5274,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) nu_lower(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) ux = (u(i,j)-u(i-1,j)) / dxh vx = (v(i,j)-v(i-1,j)) / dxh @@ -5263,7 +5285,8 @@ subroutine calc_shelf_visc_triangular (CS,u,v) nu_upper(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy+0.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) - unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) endif enddo @@ -5288,7 +5311,8 @@ subroutine calc_shelf_visc_bilinear (CS, u, v) hmask type(ocean_grid_type), pointer :: G - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh G => CS%grid @@ -5562,12 +5586,14 @@ subroutine update_velocity_masks (CS) ! sets masks for velocity solve ! ignores the fact that their might be ice-free cells - this only considers the computational boundary - ! !!!!IMPORTANT!!!! relies on thickness mask - assumed that this is called after hmask has been updated (and halo-updated) + ! !!!IMPORTANT!!! relies on thickness mask - assumed that this is called after hmask has been updated & halo-updated - integer :: isym, i, j, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, k + integer :: isym, i, j, k, iscq, iecq, jscq, jecq, isd, jsd, is, js, iegq, jegq + integer :: giec, gjec, gisc, gjsc, isc, jsc, iec, jec integer :: i_off, j_off type(ocean_grid_type), pointer :: G => NULL() - real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask, u_face_mask_boundary, v_face_mask_boundary + real, dimension(:,:), pointer :: umask, vmask, u_face_mask, v_face_mask, hmask + real, dimension(:,:), pointer :: u_face_mask_boundary, v_face_mask_boundary G => CS%grid isc = G%isc ; jsc = G%jsc ; iec = G%iec ; jec = G%jec @@ -6027,7 +6053,8 @@ subroutine ice_shelf_temp(CS, time_step, melt_rate, Time) ! t_after_uflux - an array containing the temperature after advection in u-direction ! t_after_vflux - similar ! -! This subroutine takes the velocity (on the Bgrid) and timesteps (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H +! This subroutine takes the velocity (on the Bgrid) and timesteps +! (HT)_t = - div (uHT) + (adot Tsurd -bdot Tbot) once and then calculates T=HT/H ! ! The flux overflows are included here. That is because they will be used to advect 3D scalars ! into partial cells @@ -6271,8 +6298,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter ! i may not cover all the cases.. but i cover the realistic ones - if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_west_bdry .AND. (hmask(i-1,j).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it stencil (-1) = CS%t_boundary_values(i-1,j)*CS%h_shelf(i-1,j) flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(-1) / dxdyh @@ -6322,8 +6349,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (u_face .lt. 0) then !flux is into cell - we need info from h(i+2), h(i+1) if available - if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_east_bdry .AND. (hmask(i+1,j).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(u_face) * dyh * time_step * stencil(1) / dxdyh @@ -6372,7 +6399,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (at_west_bdry .AND. (hmask(i-1,j) .EQ. 3)) then u_face = 0.5 * (CS%u_shelf(i-1,j-1) + CS%u_shelf(i-1,j)) - flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)*CS%thickness_boundary_values(i+1,j) + flux_enter (i,j,1) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i-1,j)* & + CS%thickness_boundary_values(i+1,j) elseif (u_face_mask (i-1,j) .eq. 4.) then flux_enter (i,j,1) = G%dyT(i,j) * time_step * u_flux_boundary_values (i-1,j)*t_boundary(i-1,j) ! flux_enter (i,j,1) = G%dyh(i,j) * time_step * CS%u_shelf(i,j)*t_boundary (i-1,j) @@ -6381,7 +6409,8 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter if (at_east_bdry .AND. (hmask(i+1,j) .EQ. 3)) then u_face = 0.5 * (CS%u_shelf(i,j-1) + CS%u_shelf(i,j)) - flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)*CS%thickness_boundary_values(i+1,j) + flux_enter(i,j,2) = ABS(u_face) * G%dyT(i,j) * time_step * t_boundary(i+1,j)* & + CS%thickness_boundary_values(i+1,j) elseif (u_face_mask (i+1,j) .eq. 4.) then flux_enter (i,j,2) = G%dyT(i,j) * time_step * u_flux_boundary_values (i+1,j) * t_boundary(i+1,j) ! assume no flux bc for temp @@ -6389,14 +6418,14 @@ subroutine ice_shelf_advect_temp_x (CS, time_step, h0, h_after_uflux, flux_enter endif ! if ((i .eq. is) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i-1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered - + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask(i,j) = 2 ! elseif ((i .eq. ie) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i+1,j) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered - + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask(i,j) = 2 ! endif @@ -6500,7 +6529,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (v_face_mask (i,j-1) .eq. 4.) then - flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) * t_boundary(i,j-1)/ dxdyh + flux_diff_cell = flux_diff_cell + dxh * time_step * v_flux_boundary_values (i,j-1) * & + t_boundary(i,j-1)/ dxdyh ! assume no flux bc for temp ! flux_diff_cell = flux_diff_cell + dxh * time_step * CS%v_shelf(i,j)*t_boundary (i,j-1) / dxdyh @@ -6513,8 +6543,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, ! i may not cover all the cases.. but i cover the realistic ones - if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_south_bdry .AND. (hmask(i,j-1).eq.3)) then ! at western bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(-1) / dxdyh elseif (hmask(i,j-1) * hmask(i,j-2) .eq. 1) then ! h(j-2) and h(j-1) are valid @@ -6564,8 +6594,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (v_face .lt. 0) then !flux is into cell - we need info from h(j+2), h(j+1) if available - if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a thickness bdry condition, - ! and the stencil contains it + if (at_north_bdry .AND. (hmask(i,j+1).eq.3)) then ! at eastern bdry but there is a + ! thickness bdry condition, and the stencil contains it flux_diff_cell = flux_diff_cell + ABS(v_face) * dxh * time_step * stencil(1) / dxdyh elseif (hmask(i,j+1) * hmask(i,j+2) .eq. 1) then ! h(j+2) and h(j+1) are valid phi = slope_limiter (stencil(1)-stencil(2), stencil(0)-stencil(1)) @@ -6602,7 +6632,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (at_south_bdry .AND. (hmask(i,j-1) .EQ. 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j-1) + CS%v_shelf(i,j-1)) - flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)*CS%thickness_boundary_values(i,j-1) + flux_enter (i,j,3) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j-1)* & + CS%thickness_boundary_values(i,j-1) elseif (v_face_mask(i,j-1) .eq. 4.) then flux_enter (i,j,3) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j-1)*t_boundary(i,j-1) ! assume no flux bc for temp @@ -6612,7 +6643,8 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, if (at_north_bdry .AND. (hmask(i,j+1) .EQ. 3)) then v_face = 0.5 * (CS%v_shelf(i-1,j) + CS%v_shelf(i,j)) - flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)*CS%thickness_boundary_values(i,j+1) + flux_enter (i,j,4) = ABS(v_face) * G%dxT(i,j) * time_step * t_boundary(i,j+1)* & + CS%thickness_boundary_values(i,j+1) elseif (v_face_mask(i,j+1) .eq. 4.) then flux_enter (i,j,4) = G%dxT(i,j) * time_step * v_flux_boundary_values (i,j+1)*t_boundary(i,j+1) ! assume no flux bc for temp @@ -6620,12 +6652,14 @@ subroutine ice_shelf_advect_temp_y (CS, time_step, h_after_uflux, h_after_vflux, endif ! if ((j .eq. js) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j-1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing + ! the front without having to call pass_var - if cell is empty and cell to left + ! is ice-covered then this cell will become partly covered ! hmask (i,j) = 2 ! elseif ((j .eq. je) .AND. (hmask(i,j) .eq. 0) .AND. (hmask(i,j+1) .eq. 1)) then - ! this is solely for the purposes of keeping the mask consistent while advancing the front without having - ! to call pass_var - if cell is empty and cell to left is ice-covered then this cell will become partly covered + ! this is solely for the purposes of keeping the mask consistent while advancing the + ! front without having to call pass_var - if cell is empty and cell to left is + ! ice-covered then this cell will become partly covered ! hmask (i,j) = 2 ! endif @@ -6674,7 +6708,8 @@ end subroutine ice_shelf_advect_temp_y !! calc_shelf_driving_stress - Determine the driving stresses using h_shelf, (water) column thickness, bathymetry !! - does not modify any permanent arrays !! init_boundary_values - -!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and bilinear nodal basis +!! bilinear_shape_functions - shape function for FEM solve using (convex) quadrilateral elements and +!! bilinear nodal basis !! calc_shelf_visc_bilinear - Glen's law viscosity and nonlinear sliding law (called by ice_shelf_solve_outer) !! calc_shelf_visc_triangular - LET'S TAKE THIS OUT !! apply_boundary_values_bilinear - same as CG_action_bilinear, but input is zero except for dirichlet bdry conds diff --git a/src/ice_shelf/shelf_triangular_FEstuff.F90 b/src/ice_shelf/shelf_triangular_FEstuff.F90 index 72c0043ebf..6829774386 100644 --- a/src/ice_shelf/shelf_triangular_FEstuff.F90 +++ b/src/ice_shelf/shelf_triangular_FEstuff.F90 @@ -67,8 +67,8 @@ module shelf_triangular_FEstuff v_boundary_values => NULL(), & - taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal law exponent - ! and/or whether flow is "hybridized" a la Goldberg 2011 + taub_beta_eff_bilinear => NULL(), & ! nonlinear part of "linearized" basal stress - exact form depends on basal + ! law exponent and/or whether flow is "hybridized" a la Goldberg 2011 taub_beta_eff_lower_tri => NULL(), & taub_beta_eff_upper_tri => NULL(), & @@ -124,7 +124,8 @@ module shelf_triangular_FEstuff ! ~ once a day (maybe longer) because it will depend on ocean values ! that are averaged over this time interval, and the solve will begin ! to lose meaning if it is done too frequently - integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; the counter will have to be stored + integer :: velocity_update_sub_counter ! there is no outer loop for the velocity solve; + ! the counter will have to be stored integer :: velocity_update_counter ! the "outer" timestep number integer :: nstep_velocity ! ~ (velocity_update_time_step / time_step) @@ -518,7 +519,8 @@ end subroutine matrix_diagonal_triangle !~ hmask !~ type(ocean_grid_type), pointer :: G - !~ integer :: 0, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq, giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js + !~ integer :: 0, i, j, iscq, iecq, jscq, jecq, isd, jsd, ied, jed, iegq, jegq + !~ integer :: giec, gjec, gisc, gjsc, cnt, isc, jsc, iec, jec, is, js !~ real :: A, n, ux, uy, vx, vy, eps_min, umid, vmid, unorm, C_basal_friction, n_basal_friction, dxh, dyh, dxdyh !~ G => CS%grid @@ -558,7 +560,8 @@ end subroutine matrix_diagonal_triangle !~ nu_lower(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) !~ umid = 1./3 * (u(i-1,j-1)+u(i-1,j)+u(i,j-1)) !~ vmid = 1./3 * (v(i-1,j-1)+v(i-1,j)+v(i,j-1)) - !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + !~ beta_eff_lower (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) !~ ux = (u(i,j)-u(i-1,j)) / dxh !~ vx = (v(i,j)-v(i-1,j)) / dxh @@ -568,7 +571,8 @@ end subroutine matrix_diagonal_triangle !~ nu_upper(i,j) = A**(-1/n) * (ux**2+vy**2+ux*vy.25*(uy+vx)**2+eps_min**2) ** ((1-n)/(2*n)) * H(i,j) !~ umid = 1./3 * (u(i,j)+u(i-1,j)+u(i,j-1)) !~ vmid = 1./3 * (v(i,j)+v(i-1,j)+v(i,j-1)) - !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) ; beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) + !~ unorm = sqrt (umid**2+vmid**2+(eps_min*dxh)**2) + !~ beta_eff_upper (i,j) = C_basal_friction * unorm ** (n_basal_friction-1) !~ endif !~ enddo diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4ef3af5949..b26e13b61e 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -268,8 +268,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t USER - call a user modified routine.", & fail_if_missing=new_sim, do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_thickness_from_file(h, G, GV, PF, .false., just_read_params=just_read) - case ("thickness_file"); call initialize_thickness_from_file(h, G, GV, PF, .true., just_read_params=just_read) + case ("file") + call initialize_thickness_from_file(h, G, GV, PF, .false., just_read_params=just_read) + case ("thickness_file") + call initialize_thickness_from_file(h, G, GV, PF, .true., just_read_params=just_read) case ("coord") if (new_sim .and. useALE) then call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) @@ -469,7 +471,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & call get_param(PF, mdl, "DT", dt, "Timestep", fail_if_missing=.true.) - call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, dt=dt, initial=.true.) + call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, u, v, tracer_Reg, & + dt=dt, initial=.true.) endif endif ! This is the end of the block of code that might have initialized fields @@ -613,19 +616,11 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. -! Arguments: h - The thickness that is being initialized. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. -! (in) file_has_thickness - If true, this file contains thicknesses; -! otherwise it contains interface heights. - ! This subroutine reads the layer thicknesses from file. real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) integer :: inconsistent = 0 logical :: correct_thickness - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz @@ -709,8 +704,8 @@ end subroutine initialize_thickness_from_file subroutine adjustEtaToFitBathymetry(G, GV, eta, h) 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)+1), intent(inout) :: eta !< Interface heights, in m - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: eta !< Interface heights, in m + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H ! Local variables integer :: i, j, k, is, ie, js, je, nz, contractions, dilations real, parameter :: hTolerance = 0.1 !< Tolerance to exceed adjustment criteria (m) @@ -789,19 +784,13 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. -! Arguments: h - The thickness that is being initialized. -! (in) G - The ocean's grid structure. -! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. - ! This subroutine initializes the layer thicknesses to be uniform. character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -864,7 +853,7 @@ subroutine initialize_thickness_list(h, G, GV, param_file, just_read_params) ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, eta_file, inputdir ! Strings for file/path character(len=72) :: eta_var integer :: i, j, k, is, ie, js, je, nz @@ -937,7 +926,7 @@ end subroutine initialize_thickness_search subroutine convert_thickness(h, G, GV, 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 - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Input eometric layer thicknesses (in H units), !! being converted to layer pressure !! thicknesses (also in H units). @@ -1016,7 +1005,7 @@ end subroutine convert_thickness subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) 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_(G)), & intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) 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 @@ -1119,8 +1108,8 @@ subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) ! Local variables character(len=200) :: mdl = "trim_for_ice" real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface (Pa) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b, T_t, T_b ! Top and bottom edge values for reconstructions - ! of salinity and temperature within each layer. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b ! Top and bottom edge values for reconstructions + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: T_t, T_b ! of salinity and temperature within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor, min_thickness integer :: i, j, k @@ -1264,8 +1253,10 @@ end subroutine cut_off_column_top ! ----------------------------------------------------------------------------- subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1308,8 +1299,10 @@ end subroutine initialize_velocity_from_file ! ----------------------------------------------------------------------------- subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1346,8 +1339,10 @@ end subroutine initialize_velocity_zero ! ----------------------------------------------------------------------------- subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1389,8 +1384,10 @@ end subroutine initialize_velocity_uniform ! ----------------------------------------------------------------------------- subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 - real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to !! parse for modelparameter values. logical, optional, intent(in) :: just_read_params !< If present and true, this call will @@ -1451,8 +1448,8 @@ end subroutine initialize_velocity_circular ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. @@ -1516,7 +1513,8 @@ end subroutine initialize_temp_salt_from_file ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters logical, optional, intent(in) :: just_read_params !< If present and true, this call will !! only read parameters without changing h. @@ -1571,11 +1569,8 @@ end subroutine initialize_temp_salt_from_profile subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref, just_read_params) 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)), & - intent(out) :: T !< The potential temperature that is being - !! initialized. - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), & - intent(out) :: S !< The salinity that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time !! parameters. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the equatio of state. @@ -1669,14 +1664,15 @@ end subroutine initialize_temp_salt_fit ! ----------------------------------------------------------------------------- subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S - type(param_file_type), intent(in) :: param_file !< A structure to parse for - !! run-time parameters - logical, optional, intent(in) :: just_read_params !< If present and true, - !! this call will only read - !! parameters without - !! changing h. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: T !< The potential temperature that is being initialized. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: S !< The salinity that is being initialized. + type(param_file_type), intent(in) :: param_file !< A structure to parse for + !! run-time parameters + logical, optional, intent(in) :: just_read_params !< If present and true, + !! this call will only read + !! parameters without + !! changing h. ! This subroutine initializes linear profiles for T and S according to ! reference surface layer salinity and temperature and a specified range. @@ -2266,7 +2262,8 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) h1(i,j,k) = GV%m_to_H * (zTopOfCell - zBottomOfCell) zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) ! In case data is shallower than model + h1(i,j,kd) = h1(i,j,kd) + GV%m_to_H * max(0., zTopOfCell + G%bathyT(i,j) ) + ! The max here is in case the data data is shallower than model endif ! mask2dT enddo ; enddo deallocate( tmp_mask_in ) @@ -2317,8 +2314,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) endif deallocate( dz_interface ) endif - call ALE_remap_scalar( remapCS, G, GV, nkd, h1, tmpT1dIn, h, tv%T, all_cells=remap_full_column, old_remap=remap_old_alg ) - call ALE_remap_scalar( remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, old_remap=remap_old_alg ) + call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpT1dIn, h, tv%T, all_cells=remap_full_column, & + old_remap=remap_old_alg ) + call ALE_remap_scalar(remapCS, G, GV, nkd, h1, tmpS1dIn, h, tv%S, all_cells=remap_full_column, & + old_remap=remap_old_alg ) deallocate( h1 ) deallocate( tmpT1dIn ) deallocate( tmpS1dIn ) @@ -2452,7 +2451,8 @@ subroutine MOM_state_init_tests(G, GV, tv) S_t(k) = 35.-(0./500.)*e(k) S(k) = 35.+(0./500.)*z(k) S_b(k) = 35.-(0./500.)*e(k+1) - call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), rho(k), tv%eqn_of_state) + call calculate_density(0.5*(T_t(k)+T_b(k)), 0.5*(S_t(k)+S_b(k)), -GV%Rho0*GV%g_Earth*z(k), & + rho(k), tv%eqn_of_state) P_tot = P_tot + GV%g_Earth * rho(k) * h(k) enddo diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index d322e115c9..f60e4ce013 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -259,13 +259,17 @@ subroutine init_oda(Time, G, GV, CS) call set_axes_info(CS%Grid,CS%GV,PF,CS%diag_cs,set_vertical=.true.) do n=1,CS%ensemble_size write(fldnam,'(a,i2.2)') 'temp_prior_',n - CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean potential temperature','degC') + CS%Ocean_prior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean potential temperature','degC') write(fldnam,'(a,i2.2)') 'salt_prior_',n - CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean salinity','psu') + CS%Ocean_prior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean salinity','psu') write(fldnam,'(a,i2.2)') 'temp_posterior_',n - CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean potential temperature','degC') + CS%Ocean_posterior%id_t(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean potential temperature','degC') write(fldnam,'(a,i2.2)') 'salt_posterior_',n - CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time,'ocean salinity','psu') + CS%Ocean_posterior%id_s(n)=register_diag_field('ODA',trim(fldnam),CS%diag_cs%axesTL%handles,Time, & + 'ocean salinity','psu') enddo call mpp_get_data_domain(CS%mpp_domain,isd,ied,jsd,jed) @@ -366,8 +370,10 @@ subroutine set_prior_tracer(Time, G, GV, h, tv, CS) CS%mpp_domain, CS%Ocean_prior%T(:,:,:,m), complete=.true.) call mpp_redistribute(CS%domains(m)%mpp_domain, S,& CS%mpp_domain, CS%Ocean_prior%S(:,:,:,m), complete=.true.) - if (CS%Ocean_prior%id_t(m)>0) used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) - if (CS%Ocean_prior%id_s(m)>0) used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) + if (CS%Ocean_prior%id_t(m)>0) & + used=send_data(CS%Ocean_prior%id_t(m), CS%Ocean_prior%T(isc:iec,jsc:jec,:,m), CS%Time) + if (CS%Ocean_prior%id_s(m)>0) & + used=send_data(CS%Ocean_prior%id_s(m), CS%Ocean_prior%S(isc:iec,jsc:jec,:,m), CS%Time) enddo deallocate(T,S) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9ac56b03c6..10882aed75 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1319,11 +1319,11 @@ end subroutine MEKE_end !! !! \subsection section_MEKE_references References !! -!! Jansen, M. F., A. J. Adcroft, R. Hallberg, and I. M. Held, 2015: Parameterization of eddy fluxes based on a mesoscale energy -!! budget. Ocean Modelling, 92, 28--41, http://doi.org/10.1016/j.ocemod.2015.05.007 . +!! Jansen, M. F., A. J. Adcroft, R. Hallberg, and I. M. Held, 2015: Parameterization of eddy fluxes based on a +!! mesoscale energy budget. Ocean Modelling, 92, 28--41, http://doi.org/10.1016/j.ocemod.2015.05.007 . !! -!! Marshall, D. P., and A. J. Adcroft, 2010: Parameterization of ocean eddies: Potential vorticity mixing, energetics and Arnold -!! first stability theorem. Ocean Modelling, 32, 188--204, http://doi.org/10.1016/j.ocemod.2010.02.001 . +!! Marshall, D. P., and A. J. Adcroft, 2010: Parameterization of ocean eddies: Potential vorticity mixing, energetics +!! and Arnold first stability theorem. Ocean Modelling, 32, 188--204, http://doi.org/10.1016/j.ocemod.2010.02.001 . end module MOM_MEKE diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index fbc78f3bdd..61555090ab 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1053,8 +1053,8 @@ end subroutine VarMix_init !! r(\Delta,L_d) = \frac{1}{1+(\alpha R)^p} !! \f] !! -!! The resolution function can be applied independently to thickness diffusion (module mom_thickness_diffuse), tracer diffusion (mom_tracer_hordiff) -!! lateral viscosity (mom_hor_visc). +!! The resolution function can be applied independently to thickness diffusion (module mom_thickness_diffuse), +!! tracer diffusion (mom_tracer_hordiff) lateral viscosity (mom_hor_visc). !! !! Robert Hallberg, 2013: Using a resolution function to regulate parameterizations of oceanic mesoscale eddy effects. !! Ocean Modelling, 71, pp 92-103. http://dx.doi.org/10.1016/j.ocemod.2013.08.007 @@ -1075,8 +1075,8 @@ end subroutine VarMix_init !! !! \section section_Vicbeck Visbeck diffusivity !! -!! This module also calculates factors used in setting the thickness diffusivity similar to a Visbeck et al., 1997, scheme. -!! The factors are combined in mom_thickness_diffuse::thickness_diffuse() but calculated in this module. +!! This module also calculates factors used in setting the thickness diffusivity similar to a Visbeck et al., 1997, +!! scheme. The factors are combined in mom_thickness_diffuse::thickness_diffuse() but calculated in this module. !! !! \f[ !! \kappa_h = \alpha_s L_s^2 S N @@ -1098,9 +1098,9 @@ end subroutine VarMix_init !! !! \section section_vertical_structure_khth Vertical structure function for KhTh !! -!! The thickness diffusivity can be prescribed a vertical distribution with the shape of the equivalent barotropic velocity mode. -!! The structure function is stored in the control structure for thie module (varmix_cs) but is calculated use subroutines in -!! mom_wave_speed. +!! The thickness diffusivity can be prescribed a vertical distribution with the shape of the equivalent barotropic +!! velocity mode. The structure function is stored in the control structure for thie module (varmix_cs) but is +!! calculated using subroutines in mom_wave_speed. !! !! | Symbol | Module parameter | !! | ------ | --------------- | diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 840a0c3373..ba76c208cc 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -93,7 +93,8 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment (sec) - real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by PBL scheme (H units) + real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the + !! PBL scheme (H units) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure @@ -119,7 +120,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment (sec) - real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by PBL scheme, in m (not H) + real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the + !! PBL scheme, in m (not H) type(VarMix_CS), pointer :: VarMix !< Container for derived fields type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables @@ -215,7 +217,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var enddo ! k-loop do i = is-1, ie+1 MLD_fast(i,j) = CS%MLE_MLD_stretch * MLD_fast(i,j) - if ((MLD_fast(i,j)==0.) .and. (deltaRhoAtK(i) + \alpha_{M} \kappa_{M} \right) r(\Delta x,L_d) !! \f] !! where \f$ S \f$ is the isoneutral slope magnitude, \f$ N \f$ is the square root of Brunt-Vaisala frequency, -!! \f$\kappa_{M}\f$ is the diffusivity calculated by the MEKE parameterization (mom_meke module) and \f$ r(\Delta x,L_d) \f$ is -!! a function of the local resolution (ratio of grid-spacing, \f$\Delta x\f$, to deformation radius, \f$L_d\f$). -!! The length \f$L_s\f$ is provided by the mom_lateral_mixing_coeffs module (enabled with -!! USE_VARIABLE_MIXING=True and the term \f$\f$ is the vertical average slope times Brunt-Vaisala frequency -!! prescribed by Visbeck et al., 1996. +!! \f$\kappa_{M}\f$ is the diffusivity calculated by the MEKE parameterization (mom_meke module) and +!! \f$ r(\Delta x,L_d) \f$ is a function of the local resolution (ratio of grid-spacing, \f$\Delta x\f$, +!! to deformation radius, \f$L_d\f$). The length \f$L_s\f$ is provided by the mom_lateral_mixing_coeffs module +!! (enabled with USE_VARIABLE_MIXING=True and the term \f$\f$ is the vertical average slope +!! times the Brunt-Vaisala frequency prescribed by Visbeck et al., 1996. !! !! The result of the above expression is subsequently bounded by minimum and maximum values, including an upper !! diffusivity consistent with numerical stability (\f$ \kappa_{cfl} \f$ is calculated internally). !! \f[ -!! \kappa_h \leftarrow \min{\left( \kappa_{max}, \kappa_{cfl}, \max{\left( \kappa_{min}, \kappa_h \right)} \right)} f(c_g,z) +!! \kappa_h \leftarrow \min{\left( \kappa_{max}, \kappa_{cfl}, \max{\left( \kappa_{min}, \kappa_h \right)} \right)} +!! f(c_g,z) !! \f] !! !! where \f$f(c_g,z)\f$ is a vertical structure function. !! \f$f(c_g,z)\f$ is calculated in module mom_lateral_mixing_coeffs. -!! If KHTH_USE_EBT_STRUCT=True then \f$f(c_g,z)\f$ is set to look like the equivalent barotropic modal velocity structure. -!! Otherwise \f$f(c_g,z)=1\f$ and the diffusivity is independent of depth. +!! If KHTH_USE_EBT_STRUCT=True then \f$f(c_g,z)\f$ is set to look like the equivalent barotropic +!! modal velocity structure. Otherwise \f$f(c_g,z)=1\f$ and the diffusivity is independent of depth. !! !! In order to calculate meaningful slopes in vanished layers, temporary copies of the thermodynamic variables !! are passed through a vertical smoother, function vert_fill_ts(): diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index f615e988cf..b95dac79e2 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -114,12 +114,14 @@ module MOM_ALE_sponge ! heights. subroutine initialize_ALE_sponge_fixed(Iresttime, G, param_file, CS, data_h, nz_data) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - integer, intent(in) :: nz_data !< The total number of sponge input layers (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control structure for this module (in/out). - real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. (in). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + integer, intent(in) :: nz_data !< The total number of sponge input layers (in). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values (in). + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). + real, dimension(SZI_(G),SZJ_(G),nz_data), intent(in) :: data_h !< The thicknesses of the sponge input layers. ! This include declares and sets the variable "version". @@ -305,10 +307,12 @@ end subroutine initialize_ALE_sponge_fixed ! heights. subroutine initialize_ALE_sponge_varying(Iresttime, G, param_file, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for model parameter values (in). - type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control structure for this module (in/out). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure (in). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Iresttime !< The inverse of the restoring time, in s-1 (in). + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse + !! for model parameter values (in). + type(ALE_sponge_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module (in/out). @@ -483,10 +487,12 @@ end subroutine init_ALE_sponge_diags !> This subroutine stores the reference profile at h points for the variable ! whose address is given by f_ptr. subroutine set_up_ALE_sponge_field_fixed(sp_val, G, f_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZI_(G),SZJ_(G),CS%nz_data), intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, dimension(SZI_(G),SZJ_(G),CS%nz_data), & + intent(in) :: sp_val !< Field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -518,12 +524,13 @@ end subroutine set_up_ALE_sponge_field_fixed !> This subroutine stores the reference profile at h points for the variable ! whose address is given by filename and fieldname. subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, CS) - character(len=*), intent(in) :: filename - character(len=*), intent(in) :: fieldname - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + character(len=*), intent(in) :: filename + character(len=*), intent(in) :: fieldname + type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). real, allocatable, dimension(:,:,:) :: sp_val !< Field to be used in the sponge real, allocatable, dimension(:,:,:) :: mask_z !< Field mask for the sponge data @@ -613,7 +620,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, f_ptr, if (hsrc(k)>0.) nPoints = nPoints + 1 zTopOfCell = zBottomOfCell ! Bottom becomes top for next value of k enddo - hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) ! In case data is deeper than model + ! In case data is deeper than model + hsrc(nz_data) = hsrc(nz_data) + ( zTopOfCell + G%bathyT(CS%col_i(col),CS%col_j(col)) ) CS%Ref_val(CS%fldno)%h(1:nz_data,col) = 0. CS%Ref_val(CS%fldno)%p(1:nz_data,col) = -1.e24 CS%Ref_val(CS%fldno)%h(1:nz_data,col) = hsrc(1:nz_data) @@ -631,12 +639,14 @@ end subroutine set_up_ALE_sponge_field_varying !> This subroutine stores the reference profile at uand v points for the variable ! whose address is given by u_ptr and v_ptr. subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, u_ptr, v_ptr, CS) - type(ocean_grid_type), intent(in) :: G !< Grid structure (in). - type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). - real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZI_(G),SZJB_(G),CS%nz_data), intent(in) :: v_val !< u field to be used in the sponge, it has arbritary number of layers (in). - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped (in). - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped (in). + type(ocean_grid_type), intent(in) :: G !< Grid structure (in). + type(ALE_sponge_CS), pointer :: CS !< Sponge structure (in/out). + real, dimension(SZIB_(G),SZJ_(G),CS%nz_data), & + intent(in) :: u_val !< u field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZI_(G),SZJB_(G),CS%nz_data), & + intent(in) :: v_val !< v field to be used in the sponge, it has arbritary number of layers. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(in) :: u_ptr !< u pointer to the field to be damped + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(in) :: v_ptr !< v pointer to the field to be damped integer :: j, k, col character(len=256) :: mesg ! String for error messages @@ -762,13 +772,15 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u,fieldname_u,filename_v end subroutine set_up_ALE_sponge_vel_field_varying -!> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers for every column where there is damping. +!> This subroutine applies damping to the layers thicknesses, temp, salt and a variety of tracers +!! for every column where there is damping. subroutine apply_ALE_sponge(h, dt, G, CS, Time) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure (in). real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(inout) :: h !< Layer thickness, in m (in) real, intent(in) :: dt !< The amount of time covered by this call, in s (in). - type(ALE_sponge_CS), pointer :: CS !0) then do i=is,ie pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) ! This might change answers at roundoff. + !### This should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This might change answers at roundoff. enddo call calculate_density(tv%T(:,j,k), tv%S(:,j,k), pRef_N2, rhoAtK, is, ie-is+1, tv%eqn_of_state) do i=is,ie @@ -750,7 +753,8 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, dia !### It looks to me like there is bad logic here. - RWH ! Use pressure at the bottom of the upper layer used in calculating d/dz rho pRef_N2(i) = pRef_N2(i) + GV%g_Earth * GV%Rho0 * h(i,j,k) * GV%H_to_m ! Boussinesq approximation!!!! ????? - !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) ! This might change answers at roundoff. + !### This line should be: pRef_N2(i) = pRev_N2(i) + GV%g_Earth * GV%H_to_kg_m2 * h(i,j,k) + !### This might change answers at roundoff. endif if (d1(i)>0. .and. dK(i)-d1(i)>=dz_subML) then subMLN2(i,j) = GV%g_Earth/ GV%Rho0 * (rho1(i)-rhoAtK(i)) / (d1(i) - dK(i)) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index fa9f4eba35..17f363850f 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1681,15 +1681,19 @@ end subroutine diagnose_diabatic_diff_tendency !! in which case we distribute the flux into k > 1 layers. subroutine diagnose_boundary_forcing_tendency(tv, h, temp_old, saln_old, h_old, & dt, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< thickness after boundary flux application (m or kg/m2) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: temp_old !< temperature prior to boundary flux application - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) - real, intent(in) :: dt !< time step (sec) - type(diabatic_CS), pointer :: CS !< module control structure + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(thermo_var_ptrs), intent(in) :: tv !< points to updated thermodynamic fields + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< thickness after boundary flux application (m or kg/m2) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: temp_old !< temperature prior to boundary flux application + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: saln_old !< salinity prior to boundary flux application (PPT) + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_old !< thickness prior to boundary flux application (m or kg/m2) + real, intent(in) :: dt !< time step (sec) + type(diabatic_CS), pointer :: CS !< module control structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: work_3d real, dimension(SZI_(G),SZJ_(G)) :: work_2d @@ -1822,13 +1826,14 @@ end subroutine diagnose_frazil_tendency !! of the diabatic processes to be used. subroutine adiabatic_driver_init(Time, G, param_file, diag, CS, & tracer_flow_CSp, diag_to_Z_CSp) - type(time_type), intent(in) :: Time !< current model time - type(ocean_grid_type), intent(in) :: G !< model grid structure - type(param_file_type), intent(in) :: param_file !< the file to parse for parameter values - type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output - type(diabatic_CS), pointer :: CS !< module control structure - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< points to control structure of tracer flow control module - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to Z-diagnostics control structure + type(time_type), intent(in) :: Time !< current model time + type(ocean_grid_type), intent(in) :: G !< model grid structure + type(param_file_type), intent(in) :: param_file !< the file to parse for parameter values + type(diag_ctrl), target, intent(inout) :: diag !< regulates diagnostic output + type(diabatic_CS), pointer :: CS !< module control structure + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of the + !! tracer flow control module + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to Z-diagnostics control structure ! This "include" declares and sets the variable "version". #include "version_variable.h" @@ -1865,7 +1870,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, !! to enable diagnostics, like energy budgets type(cont_diag_ptrs), intent(inout) :: CDp !< pointers to terms in continuity equations type(diabatic_CS), pointer :: CS !< module control structure - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of tracer flow control module + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp !< pointer to control structure of the + !! tracer flow control module type(sponge_CS), pointer :: sponge_CSp !< pointer to the sponge module control structure type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< pointer to the ALE sponge module control structure type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< pointer to the Z-diagnostics control structure @@ -2203,54 +2209,54 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, CS%diabatic_diff_tendency_diag = .true. endif - CS%id_diabatic_diff_heat_tend = register_diag_field('ocean_model', & - 'diabatic_heat_tendency', diag%axesTL, Time, & - 'Diabatic diffusion heat tendency', & - 'W m-2',cmor_field_name='opottempdiff', & - cmor_standard_name= & - 'tendency_of_sea_water_potential_temperature_expressed_as_heat_content_due_to_parameterized_dianeutral_mixing',& - cmor_long_name = & - 'Tendency of sea water potential temperature expressed as heat content due to parameterized dianeutral mixing',& + CS%id_diabatic_diff_heat_tend = register_diag_field('ocean_model', & + 'diabatic_heat_tendency', diag%axesTL, Time, & + 'Diabatic diffusion heat tendency', & + 'W m-2',cmor_field_name='opottempdiff', & + cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'// & + 'due_to_parameterized_dianeutral_mixing', & + cmor_long_name='Tendency of sea water potential temperature expressed as heat content '// & + 'due to parameterized dianeutral mixing',& v_extensive=.true.) if (CS%id_diabatic_diff_heat_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif - CS%id_diabatic_diff_salt_tend = register_diag_field('ocean_model', & - 'diabatic_salt_tendency', diag%axesTL, Time, & - 'Diabatic diffusion of salt tendency', & - 'kg m-2 s-1',cmor_field_name='osaltdiff', & - cmor_standard_name= & - 'tendency_of_sea_water_salinity_expressed_as_salt_content_due_to_parameterized_dianeutral_mixing', & - cmor_long_name = & - 'Tendency of sea water salinity expressed as salt content due to parameterized dianeutral mixing', & + CS%id_diabatic_diff_salt_tend = register_diag_field('ocean_model', & + 'diabatic_salt_tendency', diag%axesTL, Time, & + 'Diabatic diffusion of salt tendency', & + 'kg m-2 s-1',cmor_field_name='osaltdiff', & + cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & + 'due_to_parameterized_dianeutral_mixing', & + cmor_long_name='Tendency of sea water salinity expressed as salt content '// & + 'due to parameterized dianeutral mixing', & v_extensive=.true.) if (CS%id_diabatic_diff_salt_tend > 0) then CS%diabatic_diff_tendency_diag = .true. endif ! This diagnostic should equal to roundoff if all is working well. - CS%id_diabatic_diff_heat_tend_2d = register_diag_field('ocean_model', & - 'diabatic_heat_tendency_2d', diag%axesT1, Time, & - 'Depth integrated diabatic diffusion heat tendency', & - 'W m-2',cmor_field_name='opottempdiff_2d', & - cmor_standard_name= & - 'tendency_of_sea_water_potential_temperature_expressed_as_heat_content_due_to_parameterized_dianeutral_mixing_depth_integrated',& - cmor_long_name = & - 'Tendency of sea water potential temperature expressed as heat content due to parameterized dianeutral mixing depth integrated') + CS%id_diabatic_diff_heat_tend_2d = register_diag_field('ocean_model', & + 'diabatic_heat_tendency_2d', diag%axesT1, Time, & + 'Depth integrated diabatic diffusion heat tendency', & + 'W m-2',cmor_field_name='opottempdiff_2d', & + cmor_standard_name='tendency_of_sea_water_potential_temperature_expressed_as_heat_content_'//& + 'due_to_parameterized_dianeutral_mixing_depth_integrated', & + cmor_long_name='Tendency of sea water potential temperature expressed as heat content '//& + 'due to parameterized dianeutral mixing depth integrated') if (CS%id_diabatic_diff_heat_tend_2d > 0) then CS%diabatic_diff_tendency_diag = .true. endif ! This diagnostic should equal to roundoff if all is working well. - CS%id_diabatic_diff_salt_tend_2d = register_diag_field('ocean_model', & - 'diabatic_salt_tendency_2d', diag%axesT1, Time, & - 'Depth integrated diabatic diffusion salt tendency', & - 'kg m-2 s-1',cmor_field_name='osaltdiff_2d', & - cmor_standard_name= & - 'tendency_of_sea_water_salinity_expressed_as_salt_content_due_to_parameterized_dianeutral_mixing_depth_integrated',& - cmor_long_name = & - 'Tendency of sea water salinity expressed as salt content due to parameterized dianeutral mixing depth integrated') + CS%id_diabatic_diff_salt_tend_2d = register_diag_field('ocean_model', & + 'diabatic_salt_tendency_2d', diag%axesT1, Time, & + 'Depth integrated diabatic diffusion salt tendency', & + 'kg m-2 s-1',cmor_field_name='osaltdiff_2d', & + cmor_standard_name='tendency_of_sea_water_salinity_expressed_as_salt_content_'// & + 'due_to_parameterized_dianeutral_mixing_depth_integrated', & + cmor_long_name='Tendency of sea water salinity expressed as salt content '// & + 'due to parameterized dianeutral mixing depth integrated') if (CS%id_diabatic_diff_salt_tend_2d > 0) then CS%diabatic_diff_tendency_diag = .true. endif @@ -2369,7 +2375,8 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, endif ! initialize module for setting diffusivities - call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, CS%int_tide_CSp, CS%tidal_mixing_CSp) + call set_diffusivity_init(Time, G, GV, param_file, diag, CS%set_diff_CSp, diag_to_Z_CSp, & + CS%int_tide_CSp, CS%tidal_mixing_CSp) ! set up the clocks for this module diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 7054a90ca4..afdebe4ae5 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -282,8 +282,10 @@ subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & do_print = .false. ; if (present(may_print) .and. present(CS)) do_print = may_print - dPEa_dKd(:) = 0.0 ; dPEa_dKd_est(:) = 0.0 ; dPEa_dKd_err(:) = 0.0 ; dPEa_dKd_err_norm(:) = 0.0 ; dPEa_dKd_trunc(:) = 0.0 - dPEb_dKd(:) = 0.0 ; dPEb_dKd_est(:) = 0.0 ; dPEb_dKd_err(:) = 0.0 ; dPEb_dKd_err_norm(:) = 0.0 ; dPEb_dKd_trunc(:) = 0.0 + dPEa_dKd(:) = 0.0 ; dPEa_dKd_est(:) = 0.0 ; dPEa_dKd_err(:) = 0.0 + dPEa_dKd_err_norm(:) = 0.0 ; dPEa_dKd_trunc(:) = 0.0 + dPEb_dKd(:) = 0.0 ; dPEb_dKd_est(:) = 0.0 ; dPEb_dKd_err(:) = 0.0 + dPEb_dKd_err_norm(:) = 0.0 ; dPEb_dKd_trunc(:) = 0.0 htot = 0.0 ; pres(1) = 0.0 ; Z_int(1) = 0.0 do k=1,nz diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 5524ef074a..9ecf1374ef 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -553,8 +553,10 @@ logical function tidal_mixing_init(Time, G, GV, param_file, diag, diag_to_Z_CSp, 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') - 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') + 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') CS%id_N2_bot = register_diag_field('ocean_model','N2_b',diag%axesT1,Time, & 'Bottom Buoyancy frequency squared', 's-2') @@ -649,7 +651,8 @@ subroutine calculate_CVMix_tidal(h, j, G, GV, CS, N2_int, Kd) real, dimension(SZK_(G)) :: cellHeight !< Height of cell centers (m) integer :: i, k, is, ie real :: dh, hcorr, Simmons_coeff - real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) + real, parameter :: rho_fw = 1000.0 ! fresh water density [kg/m^3] + ! TODO: when coupled, get this from CESM (SHR_CONST_RHOFW) type(tidal_mixing_diags), pointer :: dd is = G%isc ; ie = G%iec @@ -1326,5 +1329,4 @@ subroutine tidal_mixing_end(CS) end subroutine tidal_mixing_end - end module MOM_tidal_mixing diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 80c2cc2c3c..d0163f2804 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -79,8 +79,10 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, & restart_CS) type(hor_index_type), intent(in) :: HI ! This subroutine find the global min and max of either of all !! available tracer concentrations, or of a tracer that is being !! requested specifically, returning the number of tracers it has gone through. - function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, xgmax, ygmax, zgmax , G, CS, names, units) + function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, ygmin, zgmin, & + xgmax, ygmax, zgmax , G, CS, names, units) use mpp_utilities_mod, only: mpp_array_global_min_max - integer, intent(in) :: ind_start - logical, dimension(:), intent(out) :: got_minmax - real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg - !! times concentration units. - real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg - !! times concentration units. - real, dimension(:), intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. - character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. - character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. - integer :: MOM_generic_tracer_min_max !< Return value, the - !! number of tracers done here. + integer, intent(in) :: ind_start + logical, dimension(:), intent(out) :: got_minmax + real, dimension(:), intent(out) :: gmin !< Global minimum of each tracer, in kg + !! times concentration units. + real, dimension(:), intent(out) :: gmax !< Global maximum of each tracer, in kg + !! times concentration units. + real, dimension(:), intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(MOM_generic_tracer_CS), pointer :: CS !< Pointer to the control structure for this module. + character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. + integer :: MOM_generic_tracer_min_max !< Return value, the + !! number of tracers done here. ! Local variables type(g_tracer_type), pointer :: g_tracer, g_tracer_next @@ -709,7 +713,8 @@ function MOM_generic_tracer_min_max(ind_start, got_minmax, gmin, gmax, xgmin, yg call mpp_array_global_min_max(tr_ptr, grid_tmask,isd,jsd,isc,iec,jsc,jec,nk , gmin(m), gmax(m), & - G%geoLonT,G%geoLatT,geo_z,xgmin(m), ygmin(m), zgmin(m), xgmax(m), ygmax(m), zgmax(m)) + G%geoLonT,G%geoLatT,geo_z,xgmin(m), ygmin(m), zgmin(m), & + xgmax(m), ygmax(m), zgmax(m)) got_minmax(m) = .true. diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 5fb99a448b..17a39b290c 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -51,13 +51,17 @@ module MOM_neutral_diffusion ! Positions of neutral surfaces in both the u, v directions real, allocatable, dimension(:,:,:) :: uPoL ! Non-dimensional position with left layer uKoL-1, u-point real, allocatable, dimension(:,:,:) :: uPoR ! Non-dimensional position with right layer uKoR-1, u-point - integer, allocatable, dimension(:,:,:) :: uKoL ! Index of left interface corresponding to neutral surface, u-point - integer, allocatable, dimension(:,:,:) :: uKoR ! Index of right interface corresponding to neutral surface, u-point + integer, allocatable, dimension(:,:,:) :: uKoL ! Index of left interface corresponding to neutral surface, + ! at a u-point + integer, allocatable, dimension(:,:,:) :: uKoR ! Index of right interface corresponding to neutral surface, + ! at a u-point real, allocatable, dimension(:,:,:) :: uHeff ! Effective thickness at u-point (H units) real, allocatable, dimension(:,:,:) :: vPoL ! Non-dimensional position with left layer uKoL-1, v-point real, allocatable, dimension(:,:,:) :: vPoR ! Non-dimensional position with right layer uKoR-1, v-point - integer, allocatable, dimension(:,:,:) :: vKoL ! Index of left interface corresponding to neutral surface, v-point - integer, allocatable, dimension(:,:,:) :: vKoR ! Index of right interface corresponding to neutral surface, v-point + integer, allocatable, dimension(:,:,:) :: vKoL ! Index of left interface corresponding to neutral surface, + ! at a v-point + integer, allocatable, dimension(:,:,:) :: vKoR ! Index of right interface corresponding to neutral surface, + ! at a v-point real, allocatable, dimension(:,:,:) :: vHeff ! Effective thickness at v-point (H units) ! Coefficients of polynomial reconstructions for temperature and salinity real, allocatable, dimension(:,:,:,:) :: ppoly_coeffs_T !< Polynomial coefficients for temperature @@ -74,7 +78,8 @@ module MOM_neutral_diffusion real, allocatable, dimension(:,:,:,:) :: dRdT_i ! dRho/dT (kg/m3/degC) at top edge real, allocatable, dimension(:,:,:,:) :: dRdS_i ! dRho/dS (kg/m3/ppt) at top edge integer, allocatable, dimension(:,:) :: ns ! Number of interfacs in a column - logical, allocatable, dimension(:,:,:) :: stable_cell ! True if the cell is stably stratified wrt to the next cell + logical, allocatable, dimension(:,:,:) :: stable_cell ! True if the cell is stably stratified wrt + ! to the next cell type(diag_ctrl), pointer :: diag ! structure to regulate output integer :: id_uhEff_2d = -1 @@ -372,9 +377,10 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, h, T, S, CS) endif enddo ; enddo - ! Continuous reconstructions calculate hEff as the difference between the pressures of the neutral surfaces which - ! need to be reconverted to thickness units. The discontinuous version calculates hEff from the fraction of the - ! nondimensional fraction of the layer occupied by the + ! Continuous reconstructions calculate hEff as the difference between the pressures of the + ! neutral surfaces which need to be reconverted to thickness units. The discontinuous version + ! calculates hEff from the fraction of the nondimensional fraction of the layer occupied by + ! the... (Please finish this thought. -RWH) if (CS%continuous_reconstruction) then do k = 1, CS%nsurf-1 ; do j = G%jsc, G%jec ; do I = G%isc-1, G%iec if (G%mask2dCu(I,j) > 0.) CS%uhEff(I,j,k) = CS%uhEff(I,j,k) * pa_to_H @@ -408,7 +414,8 @@ subroutine neutral_diffusion(G, GV, h, Coef_x, Coef_y, dt, Reg, CS) real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness (H units) real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Coef_x !< dt * Kh * dy / dx at u-points (m^2) real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Coef_y !< dt * Kh * dx / dy at u-points (m^2) - real, intent(in) :: dt !< Tracer time step * I_numitts (I_numitts in tracer_hordiff) + real, intent(in) :: dt !< Tracer time step * I_numitts + !! (I_numitts in tracer_hordiff) type(tracer_registry_type), pointer :: Reg !< Tracer registry type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure @@ -799,8 +806,8 @@ end function fvlsq_slope !> Returns positions within left/right columns of combined interfaces using continuous reconstructions of T/S -subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdSl, Pr, Tr, Sr, dRdTr, dRdSr, PoL, & - PoR, KoL, KoR, hEff) +subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdSl, Pr, Tr, Sr, & + dRdTr, dRdSr, PoL, PoR, KoL, KoR, hEff) integer, intent(in) :: nk !< Number of levels real, dimension(nk+1), intent(in) :: Pl !< Left-column interface pressure (Pa) real, dimension(nk+1), intent(in) :: Tl !< Left-column interface potential temperature (degC) @@ -812,8 +819,10 @@ subroutine find_neutral_surface_positions_continuous(nk, Pl, Tl, Sl, dRdTl, dRdS real, dimension(nk+1), intent(in) :: Sr !< Right-column interface salinity (ppt) real, dimension(nk+1), intent(in) :: dRdTr !< Left-column dRho/dT (kg/m3/degC) real, dimension(nk+1), intent(in) :: dRdSr !< Left-column dRho/dS (kg/m3/ppt) - real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within layer KoL of left column - real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within layer KoR of right column + real, dimension(2*nk+2), intent(inout) :: PoL !< Fractional position of neutral surface within + !! layer KoL of left column + real, dimension(2*nk+2), intent(inout) :: PoR !< Fractional position of neutral surface within + !! layer KoR of right column integer, dimension(2*nk+2), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(2*nk+2), intent(inout) :: KoR !< Index of first right interface above neutral surface real, dimension(2*nk+1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) @@ -979,10 +988,10 @@ end subroutine find_neutral_surface_positions_continuous !> Higher order version of find_neutral_surface_positions. Returns positions within left/right columns !! of combined interfaces using intracell reconstructions of T/S -subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, & - Pres_l, hcol_l, Tl, Sl, dRdT_l, dRdS_l, stable_l, Pres_r, hcol_r, Tr, Sr, dRdT_r, dRdS_r, stable_r, & +subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, Pres_l, hcol_l, Tl, Sl, & + dRdT_l, dRdS_l, stable_l, Pres_r, hcol_r, Tr, Sr, dRdT_r, dRdS_r, stable_r, & PoL, PoR, KoL, KoR, hEff, ppoly_T_l, ppoly_S_l, ppoly_T_r, ppoly_S_r) - type(neutral_diffusion_CS) :: CS !< Neutral diffusion control structure + type(neutral_diffusion_CS), intent(inout) :: CS !< Neutral diffusion control structure integer, intent(in) :: nk !< Number of levels integer, intent(in) :: ns !< Number of neutral surfaces real, dimension(nk+1), intent(in) :: Pres_l !< Left-column interface pressure (Pa) @@ -1006,10 +1015,14 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, integer, dimension(4*nk), intent(inout) :: KoL !< Index of first left interface above neutral surface integer, dimension(4*nk), intent(inout) :: KoR !< Index of first right interface above neutral surface real, dimension(4*nk-1), intent(inout) :: hEff !< Effective thickness between two neutral surfaces (Pa) - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_T_r !< Right-column coefficients of T reconstruction - real, dimension(nk,CS%deg+1), optional, intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_T_l !< Left-column coefficients of T reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_S_l !< Left-column coefficients of S reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_T_r !< Right-column coefficients of T reconstruction + real, dimension(nk,CS%deg+1), & + optional, intent(in) :: ppoly_S_r !< Right-column coefficients of S reconstruction ! Local variables integer :: k_surface ! Index of neutral surface @@ -1063,10 +1076,11 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, ! Loop over each neutral surface, working from top to bottom neutral_surfaces: do k_surface = 1, ns ! Potential density difference, rho(kr) - rho(kl) - dRho = 0.5 * & - ( ( dRdT_r(kl_right,ki_right) + dRdT_l(kl_left,ki_left) ) * ( Tr(kl_right,ki_right) - Tl(kl_left,ki_left) ) & - + ( dRdS_r(kl_right,ki_right) + dRdS_l(kl_left,ki_left) ) * ( Sr(kl_right,ki_right) - Sl(kl_left,ki_left) ) ) - if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & + dRho = 0.5 * ( ( dRdT_r(kl_right,ki_right) + dRdT_l(kl_left,ki_left) ) * & + ( Tr(kl_right,ki_right) - Tl(kl_left,ki_left) ) & + + ( dRdS_r(kl_right,ki_right) + dRdS_l(kl_left,ki_left) ) * & + ( Sr(kl_right,ki_right) - Sl(kl_left,ki_left) ) ) + if (CS%debug) write(*,'(A,I2,A,E12.4,A,I2,A,I2,A,I2,A,I2)') "k_surface=",k_surface," dRho=",dRho, & "kl_left=",kl_left, " ki_left=",ki_left," kl_right=",kl_right, " ki_right=",ki_right ! Which column has the lighter surface for the current indexes, kr and kl if (.not. reached_bottom) then @@ -1077,7 +1091,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, searching_right_column = .true. searching_left_column = .false. else ! dRho == 0. - if ( ( kl_left == kl_left_0) .and. ( kl_right == kl_right_0 ) .and. (ki_left + ki_right == 2) ) then ! Still at surface + if ( ( kl_left == kl_left_0) .and. ( kl_right == kl_right_0 ) .and. & + (ki_left + ki_right == 2) ) then ! Still at surface searching_left_column = .true. searching_right_column = .false. else ! Not the surface so we simply change direction @@ -1103,7 +1118,7 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, call drho_at_pos(CS%ndiff_aux_CS, T_other, S_other, dRdT_other, dRdS_other, Pres_l(kl_left), & Pres_l(kl_left+1), ppoly_T_l(kl_left,:), ppoly_S_l(kl_left,:), lastP_left, dRhoTop) else - dRhoTop = calc_drho(Tl(kl_left,1), Sl(kl_left,1), dRdT_l(kl_left,1), dRdS_l(kl_left,1), T_other, S_other, & + dRhoTop = calc_drho(Tl(kl_left,1), Sl(kl_left,1), dRdT_l(kl_left,1), dRdS_l(kl_left,1), T_other, S_other, & dRdT_other, dRdS_other) endif ! Potential density difference, rho(kl) - rho(kl_right,ki_right) (will be positive) @@ -1123,8 +1138,9 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, KoR(k_surface) = kl_right ! Set position within the searched column - call search_other_column(dRhoTop, dRhoBot, Pres_l(kl_left), Pres_l(kl_left+1), lastP_left, lastK_left, kl_left, & - kl_left_0, ki_left, top_connected_l, bot_connected_l, PoL(k_surface), KoL(k_surface), search_layer) + call search_other_column(dRhoTop, dRhoBot, Pres_l(kl_left), Pres_l(kl_left+1), & + lastP_left, lastK_left, kl_left, kl_left_0, ki_left, & + top_connected_l, bot_connected_l, PoL(k_surface), KoL(k_surface), search_layer) if ( CS%refine_position .and. search_layer ) then min_bound = 0. @@ -1137,7 +1153,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, endif if (PoL(k_surface) == 0.) top_connected_l(KoL(k_surface)) = .true. if (PoL(k_surface) == 1.) bot_connected_l(KoL(k_surface)) = .true. - call increment_interface(nk, kl_right, ki_right, stable_r, reached_bottom, searching_right_column, searching_left_column) + call increment_interface(nk, kl_right, ki_right, stable_r, reached_bottom, & + searching_right_column, searching_left_column) elseif (searching_right_column) then if (CS%ref_pres>=0.) then @@ -1189,7 +1206,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, endif if (PoR(k_surface) == 0.) top_connected_r(KoR(k_surface)) = .true. if (PoR(k_surface) == 1.) bot_connected_r(KoR(k_surface)) = .true. - call increment_interface(nk, kl_left, ki_left, stable_l, reached_bottom, searching_left_column, searching_right_column) + call increment_interface(nk, kl_left, ki_left, stable_l, reached_bottom, & + searching_left_column, searching_right_column) else stop 'Else what?' @@ -1197,8 +1215,8 @@ subroutine find_neutral_surface_positions_discontinuous(CS, nk, ns, lastK_left = KoL(k_surface) ; lastP_left = PoL(k_surface) lastK_right = KoR(k_surface) ; lastP_right = PoR(k_surface) - if (CS%debug) write(*,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), " KoR:", & - KoR(k_surface), " PoR:", PoR(k_surface) + if (CS%debug) write(*,'(A,I3,A,ES16.6,A,I2,A,ES16.6)') "KoL:", KoL(k_surface), " PoL:", PoL(k_surface), & + " KoR:", KoR(k_surface), " PoR:", PoR(k_surface) ! Effective thickness if (k_surface>1) then ! This is useful as a check to make sure that positions are monotonically increasing @@ -1364,7 +1382,7 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K dT_bottom = T_right_bottom - T_left_bottom dT_ave = 0.5 * ( dT_top + dT_bottom ) dT_layer = T_right_layer - T_left_layer - if (signum(1.,dT_top) * signum(1.,dT_bottom) <= 0. .or. signum(1.,dT_ave) * signum(1.,dT_layer) <= 0. ) then + if (signum(1.,dT_top) * signum(1.,dT_bottom) <= 0. .or. signum(1.,dT_ave) * signum(1.,dT_layer) <= 0.) then dT_ave = 0. else dT_ave = dT_layer @@ -1372,10 +1390,12 @@ subroutine neutral_surface_flux(nk, nsurf, deg, hl, hr, Tl, Tr, PiL, PiR, KoL, K Flx(k_sublayer) = dT_ave * hEff(k_sublayer) else ! Discontinuous reconstruction ! Calculate tracer values on left and right side of the neutral surface - call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoL, PiL, Tl, Tid_l, deg, iMethod, ppoly_r_coeffs_l, & - T_left_top, T_left_bottom, T_left_sub, T_left_top_int, T_left_bot_int, T_left_layer) - call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoR, PiR, Tr, Tid_r, deg, iMethod, ppoly_r_coeffs_r, & - T_right_top, T_right_bottom, T_right_sub, T_right_top_int, T_right_bot_int, T_right_layer) + call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoL, PiL, Tl, Tid_l, deg, iMethod, & + ppoly_r_coeffs_l, T_left_top, T_left_bottom, T_left_sub, & + T_left_top_int, T_left_bot_int, T_left_layer) + call neutral_surface_T_eval(nk, nsurf, k_sublayer, KoR, PiR, Tr, Tid_r, deg, iMethod, & + ppoly_r_coeffs_r, T_right_top, T_right_bottom, T_right_sub, & + T_right_top_int, T_right_bot_int, T_right_layer) dT_top = T_right_top - T_left_top dT_bottom = T_right_bottom - T_left_bottom @@ -2048,9 +2068,11 @@ logical function test_ifndp(verbose, rhoNeg, Pneg, rhoPos, Ppos, Ptrue, title) if (test_ifndp) stdunit = 0 ! In case of wrong results, write to error stream write(stdunit,'(a)') title if (test_ifndp) then - write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' + write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15),x,a)') & + 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue,'WRONG!' else - write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15))') 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue + write(stdunit,'(4(x,a,f20.16),2(x,a,1pe22.15))') & + 'r1=',rhoNeg,'p1=',Pneg,'r2=',rhoPos,'p2=',Ppos,'pRet=',Pret,'pTrue=',Ptrue endif endif @@ -2079,10 +2101,12 @@ logical function test_data1d(verbose, nk, Po, Ptrue, title) do k = 1,nk if (Po(k) /= Ptrue(k)) then test_data1d = .true. - write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15,x,a)') 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k),'WRONG!' + write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15,x,a)') & + 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k),'WRONG!' else if (verbose) & - write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15)') 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k) + write(stdunit,'(a,i2,2(x,a,f20.16),x,a,1pe22.15)') & + 'k=',k,'Po=',Po(k),'Ptrue=',Ptrue(k),'err=',Po(k)-Ptrue(k) endif enddo endif @@ -2122,7 +2146,8 @@ logical function test_data1di(verbose, nk, Po, Ptrue, title) end function test_data1di -!> Returns true if output of find_neutral_surface_positions() does not match correct values, and conditionally writes results to stream +!> Returns true if output of find_neutral_surface_positions() does not match correct values, +!! and conditionally writes results to stream logical function test_nsp(verbose, ns, KoL, KoR, pL, pR, hEff, KoL0, KoR0, pL0, pR0, hEff0, title) logical, intent(in) :: verbose !< If true, write results to stdout integer, intent(in) :: ns !< Number of surfaces diff --git a/src/tracer/MOM_neutral_diffusion_aux.F90 b/src/tracer/MOM_neutral_diffusion_aux.F90 index 09ed0c0e58..ca3435ded0 100644 --- a/src/tracer/MOM_neutral_diffusion_aux.F90 +++ b/src/tracer/MOM_neutral_diffusion_aux.F90 @@ -328,8 +328,10 @@ real function interpolate_for_nondim_position(dRhoNeg, Pneg, dRhoPos, Ppos) else ! dRhoPos - dRhoNeg < 0 interpolate_for_nondim_position = 0.5 endif - if ( interpolate_for_nondim_position < 0. ) stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint < Pneg' - if ( interpolate_for_nondim_position > 1. ) stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint > Ppos' + if ( interpolate_for_nondim_position < 0. ) & + stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint < Pneg' + if ( interpolate_for_nondim_position > 1. ) & + stop 'interpolate_for_nondim_position: Houston, we have a problem! Pint > Ppos' end function interpolate_for_nondim_position !> Use root-finding methods to find where dRho = 0, based on the equation of state and the polynomial @@ -339,8 +341,8 @@ end function interpolate_for_nondim_position !! to see if it it diverges outside the interval. In that case (or in the case that second derivatives are not !! available), Brent's method is used following the implementation found at !! https://people.sc.fsu.edu/~jburkardt/f_src/brent/brent.f90 -real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_top, P_bot, ppoly_T, ppoly_S, drho_top, & - drho_bot, min_bound) +real function refine_nondim_position(CS, T_ref, S_ref, alpha_ref, beta_ref, P_top, P_bot, & + ppoly_T, ppoly_S, drho_top, drho_bot, min_bound) type(ndiff_aux_CS_type), intent(in) :: CS !< Control structure with parameters for this module real, intent(in) :: T_ref !< Temperature of the neutral surface at the searched from interface real, intent(in) :: S_ref !< Salinity of the neutral surface at the searched from interface diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index e68ff0df9e..f8762985c5 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -24,19 +24,24 @@ module MOM_tracer_diabatic subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & sfc_flux, btm_flux, btm_reservoir, sink_rate, convert_flux_in) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< layer thickness before entrainment (m or kg m-2) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< amount of fluid entrained from the layer above (units of h_work) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer below (units of h_work) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration (in concentration units CU) - real, intent(in) :: dt !< amount of time covered by this call (seconds) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer (in CU * kg m-2 s-1) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the tracer, - !! in units of (CU * kg m-2 s-1) - real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir (units of CU kg m-2; formerly CU m) - real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks, in m s-1 - logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs to be integrated in time + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< layer thickness before entrainment (m or kg m-2) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: ea !< amount of fluid entrained from the layer + !! above (units of h_work) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: eb !< amount of fluid entrained from the layer + !! below (units of h_work) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: tr !< tracer concentration (in concentration units CU) + real, intent(in) :: dt !< amount of time covered by this call (seconds) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: sfc_flux !< surface flux of the tracer in units + !! of (CU * kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(in) :: btm_flux !< The (negative upward) bottom flux of the + !! tracer, in units of (CU * kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)), optional,intent(inout) :: btm_reservoir !< amount of tracer in a bottom reservoir + !! (units of CU kg m-2; formerly CU m) + real, optional,intent(in) :: sink_rate !< rate at which the tracer sinks, in m s-1 + logical, optional,intent(in) :: convert_flux_in !< True if the specified sfc_flux needs + !! to be integrated in time real :: sink_dist ! The distance the tracer sinks in a time step, in m or kg m-2. real, dimension(SZI_(G),SZJ_(G)) :: & @@ -227,10 +232,10 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units real, intent(in ) :: evap_CFL_limit real, intent(in ) :: minimum_forcing_depth - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional ! The total time-integrated amount of tracer! - ! that enters with freshwater - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional ! The total time-integrated amount of tracer! - ! that leaves with freshwater + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional !< The total time-integrated + !! amount of tracer that enters with freshwater + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional ! The total time-integrated + !! amount of tracer that leaves with freshwater !< Optional flag to determine whether h should be updated logical, optional, intent(in) :: update_h_opt @@ -245,13 +250,13 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_lim netMassIn, & ! mass entering ocean surface (H units) over a time step netMassOut ! mass leaving ocean surface (H units) over a time step - real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d - real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! - ! that enters with freshwater - real, dimension(SZI_(G),SZJ_(G)) :: out_flux ! The total time-integrated amount of tracer! - ! that leaves with freshwater - real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d - real :: hGrounding(maxGroundings) + real, dimension(SZI_(G), SZK_(G)) :: h2d, Tr2d + real, dimension(SZI_(G),SZJ_(G)) :: in_flux ! The total time-integrated amount of tracer! + ! that enters with freshwater + real, dimension(SZI_(G),SZJ_(G)) :: out_flux ! The total time-integrated amount of tracer! + ! that leaves with freshwater + real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d + real :: hGrounding(maxGroundings) real :: Tr_in logical :: update_h integer :: i, j, is, ie, js, je, k, nz, n, nsw diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index b7a1e1a421..daa2062c81 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -158,10 +158,14 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit real, dimension(:,:,:), optional, pointer :: ad_y !< diagnostic y-advective flux (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: df_x !< diagnostic x-diffusive flux (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: df_y !< diagnostic y-diffusive flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: ad_2d_x !< vert sum of diagnostic x-advect flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: ad_2d_y !< vert sum of diagnostic y-advect flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: df_2d_x !< vert sum of diagnostic x-diffuse flux (CONC m3/s or CONC*kg/s) - real, dimension(:,:), optional, pointer :: df_2d_y !< vert sum of diagnostic y-diffuse flux (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: ad_2d_x !< vert sum of diagnostic x-advect flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: ad_2d_y !< vert sum of diagnostic y-advect flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: df_2d_x !< vert sum of diagnostic x-diffuse flux + !! (CONC m3/s or CONC*kg/s) + real, dimension(:,:), optional, pointer :: df_2d_y !< vert sum of diagnostic y-diffuse flux + !! (CONC m3/s or CONC*kg/s) real, dimension(:,:,:), optional, pointer :: advection_xy !< convergence of lateral advective tracer fluxes logical, optional, intent(in) :: registry_diags !< If present and true, use the registry for @@ -173,12 +177,15 @@ subroutine register_tracer(tr_ptr, Reg, param_file, HI, GV, name, longname, unit character(len=*), optional, intent(in) :: flux_units !< The units for the fluxes of this tracer. real, optional, intent(in) :: flux_scale !< A scaling factor used to convert the fluxes !! of this tracer to its desired units. - character(len=*), optional, intent(in) :: convergence_units !< The units for the flux convergence of this tracer. + character(len=*), optional, intent(in) :: convergence_units !< The units for the flux convergence of + !! this tracer. real, optional, intent(in) :: convergence_scale !< A scaling factor used to convert the flux !! convergence of this tracer to its desired units. - character(len=*), optional, intent(in) :: cmor_tendprefix !< The CMOR name for the layer-integrated tendencies of this tracer. - integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the character - !! string template to use in labeling diagnostics + character(len=*), optional, intent(in) :: cmor_tendprefix !< The CMOR name for the layer-integrated + !! tendencies of this tracer. + integer, optional, intent(in) :: diag_form !< An integer (1 or 2, 1 by default) indicating the + !! character string template to use in + !! labeling diagnostics type(MOM_restart_CS), optional, pointer :: restart_CS !< A pointer to the restart control structure; !! this tracer will be registered for !! restarts if this argument is present diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 03cf06fdfa..ef8abe9bbf 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -67,12 +67,12 @@ module boundary_impulse_tracer !> Read in runtime options and add boundary impulse tracer to tracer registry function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in ) :: HI - type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters - type(boundary_impulse_tracer_CS), pointer, intent(inout) :: CS - type(tracer_registry_type), pointer, intent(inout) :: tr_Reg - type(MOM_restart_CS), pointer, intent(inout) :: restart_CS + type(hor_index_type), intent(in ) :: HI + type(verticalGrid_type), intent(in ) :: GV !< The ocean's vertical grid structure + type(param_file_type), intent(in ) :: param_file !< A structure to parse for run-time parameters + type(boundary_impulse_tracer_CS), pointer :: CS + type(tracer_registry_type), pointer :: tr_Reg + type(MOM_restart_CS), pointer :: restart_CS ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -170,7 +170,8 @@ subroutine initialize_boundary_impulse_tracer(restart, day, G, GV, h, diag, OBC, type(boundary_impulse_tracer_CS), pointer,intent(inout) :: CS type(sponge_CS), pointer, intent(inout) :: sponge_CSp type(diag_to_Z_CS), pointer, intent(inout) :: diag_to_Z_CSp - type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various thermodynamic variables + type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various + !! thermodynamic variables ! This subroutine initializes the CS%ntr tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. @@ -227,16 +228,17 @@ end subroutine initialize_boundary_impulse_tracer ! Apply source or sink at boundary and do vertical diffusion subroutine boundary_impulse_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, tv, debug, & 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)), intent(in ) :: h_old, h_new, ea, eb - type(forcing), intent(in ) :: fluxes - real, intent(in ) :: dt !< The amount of time covered by this call, in s - type(boundary_impulse_tracer_CS), pointer, intent(inout) :: CS - type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various thermodynamic variables - logical, intent(in ) :: debug - real, optional, intent(in ) :: evap_CFL_limit - real, optional, intent(in ) :: 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)), intent(in ) :: h_old, h_new, ea, eb + type(forcing), intent(in ) :: fluxes + real, intent(in ) :: dt !< The amount of time covered by this call, in s + type(boundary_impulse_tracer_CS), pointer :: CS + type(thermo_var_ptrs), intent(in ) :: tv !< A structure pointing to various + !! thermodynamic variables + logical, intent(in ) :: debug + real, optional, intent(in ) :: evap_CFL_limit + real, optional, intent(in ) :: minimum_forcing_depth ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 2f84fc7dfa..8e6443ae4a 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -42,10 +42,11 @@ module BFB_initialization contains +!> This subroutine specifies the vertical coordinate in terms of temperature at the surface and at the bottom. +!! This case is set up in such a way that the temperature of the topmost layer is equal to the SST at the +!! southern edge of the domain. The temperatures are then converted to densities of the top and bottom layers +!! and linearly interpolated for the intermediate layers. subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) -! This subroutine specifies the vertical coordinate in terms of temperature at the surface and at the bottom. This case is set up in -! such a way that the temperature of the topmost layer is equal to the SST at the southern edge of the domain. The temperatures are -! then converted to densities of the top and bottom layers and linearly interpolated for the intermediate layers. real, dimension(NKMEM_), intent(out) :: Rlay, g_prime type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters @@ -83,9 +84,9 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) end subroutine BFB_set_coord +!> This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs +!! within 2 degrees lat of the boundary. The damping linearly decreases northward over the next 2 degrees. subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, CSp, h) -! This subroutine sets up the sponges for the southern bouundary of the domain. Maximum damping occurs within 2 degrees lat of the -! boundary. The damping linearly decreases northward over the next 2 degrees. type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure logical, intent(in) :: use_temperature type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables @@ -129,7 +130,10 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, "The longitudinal length of the domain.", units="degrees") nlat = slat + lenlat do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo -! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo ! Use for meridional thickness profile initialization + + ! Use for meridional thickness profile initialization +! do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz-1) ; enddo + do i=is,ie; do j=js,je if (G%geoLatT(i,j) < slat+2.0) then ; damp = 1.0 elseif (G%geoLatT(i,j) < slat+4.0) then diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index c9b47d595f..b8d46798e4 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -218,7 +218,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_par enddo enddo ; enddo - case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) @@ -552,7 +552,7 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) enddo enddo ; enddo - case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 90d44f7c7c..ed7e726f8e 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -1125,12 +1125,12 @@ end subroutine DHH85_mid ! Do not use. subroutine StokesMixing(G, GV, DT, h, u, v, WAVES ) ! Arguments - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. ! Local variables REAL :: dTauUp, dTauDn, DVel @@ -1200,13 +1200,13 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) ! Work towards an explicit Coriolis Stokes method. ! perhaps not the best way forward, not accessed in the code. ! Arguments - type(ocean_grid_type), intent(in) :: G !< Ocean grid - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid - real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) - type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. + type(ocean_grid_type), intent(in) :: G !< Ocean grid + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid + real, intent(in) :: Dt !< Time step of MOM6 [s] for GOTM turbulence solver + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer/level thicknesses (units of H) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< Velocity i-component (m/s) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< Velocity j-component (m/s) + type(Wave_parameters_CS), pointer :: Waves !< Surface wave related control structure. ! Local variables REAL :: DVel @@ -1215,7 +1215,8 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do k = 1, G%ke do j = G%jscB, G%jecB do i = G%iscB, G%iecB - DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) + DVel = 0.25*(WAVES%us_y(i,j+1,k)+WAVES%us_y(i-1,j+1,k))*G%CoriolisBu(i,j+1) + & + 0.25*(WAVES%us_y(i,j,k)+WAVES%us_y(i-1,j,k))*G%CoriolisBu(i,j) u(i,j,k) = u(i,j,k)+DVEL*DT enddo enddo @@ -1224,7 +1225,8 @@ subroutine CoriolisStokes(G, GV, DT, h, u, v, WAVES) do k = 1, G%ke do j = G%jscB, G%jecB do i = G%iscB, G%iecB - DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) + DVel = 0.25*(WAVES%us_x(i+1,j,k)+WAVES%us_x(i+1,j-1,k))*G%CoriolisBu(i+1,j) + & + 0.25*(WAVES%us_x(i,j,k)+WAVES%us_x(i,j-1,k))*G%CoriolisBu(i,j) v(i,j,k) = v(i,j,k)-DVEL*DT enddo enddo diff --git a/src/user/Neverland_initialization.F90 b/src/user/Neverland_initialization.F90 index d22d7457ab..51c8ab7683 100644 --- a/src/user/Neverland_initialization.F90 +++ b/src/user/Neverland_initialization.F90 @@ -60,15 +60,15 @@ subroutine Neverland_initialize_topography(D, G, param_file, max_depth) ! This sets topography that has a reentrant channel to the south. D(i,j) = 1.0 - (1.2 * spike(x,0.2) + 1.2 * spike(x-1.0,0.2)) * spike(MIN(0.0,y-0.3),0.2) & !< South America - - 1.2 * spike(x-0.5,0.2) * spike(MIN(0.0,y-0.55),0.2) & !< Africa - - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) & !< The great northern wall and Antarctica - - 1.2 * (spike(x,0.12) + spike(x-1,0.12)) * spike(MAX(0.0,y-0.06),0.12) & !< Antarctic Peninsula - - 0.1 * (cosbell(x,0.1) + cosbell(x-1,0.1)) & !< Drake Passage ridge - - 0.5 * cosbell(x-0.16,0.05) * (cosbell(y-0.18,0.13)**0.4) & !< Scotia Arc East - - 0.4 * (cosbell(x-0.09,0.08)**0.4) * cosbell(y-0.26,0.05) & !< Scotia Arc North - - 0.4 * (cosbell(x-0.08,0.08)**0.4) * cosbell(y-0.1,0.05) & !< Scotia Arc South - - nl_roughness_amp * cos(14*PI*x) * sin(14*PI*y) & !< roughness - - nl_roughness_amp * cos(20*PI*x) * cos(20*PI*y) !< roughness + - 1.2 * spike(x-0.5,0.2) * spike(MIN(0.0,y-0.55),0.2) & !< Africa + - 1.1 * spike(y-1,0.12) - 1.1 * spike(y,0.12) & !< The great northern wall and Antarctica + - 1.2 * (spike(x,0.12) + spike(x-1,0.12)) * spike(MAX(0.0,y-0.06),0.12) & !< Antarctic Peninsula + - 0.1 * (cosbell(x,0.1) + cosbell(x-1,0.1)) & !< Drake Passage ridge + - 0.5 * cosbell(x-0.16,0.05) * (cosbell(y-0.18,0.13)**0.4) & !< Scotia Arc East + - 0.4 * (cosbell(x-0.09,0.08)**0.4) * cosbell(y-0.26,0.05) & !< Scotia Arc North + - 0.4 * (cosbell(x-0.08,0.08)**0.4) * cosbell(y-0.1,0.05) & !< Scotia Arc South + - nl_roughness_amp * cos(14*PI*x) * sin(14*PI*y) & !< roughness + - nl_roughness_amp * cos(20*PI*x) * cos(20*PI*y) !< roughness if (D(i,j) < 0.0) D(i,j) = 0.0 D(i,j) = D(i,j) * max_depth diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index acf13d8fd8..88b80e84c6 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -95,7 +95,7 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -138,7 +138,8 @@ subroutine dumbbell_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: S_surf - S_range * z/max_depth = S_light + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: - S_range * z/max_depth = S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range - e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * ( (real(K)-1.5) / real(nz-1) ) ) / S_range + e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & + ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index 80376e67c9..2eeda73243 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -6,7 +6,7 @@ module dumbbell_surface_forcing !* * !* * !* This file contains subroutines for specifying surface dynamic * -!* forcing for the dumbbell case. * +!* forcing for the dumbbell case. * !* * !********+*********+*********+*********+*********+*********+*********+** use MOM_diag_mediator, only : post_data, query_averaging_enabled @@ -230,8 +230,10 @@ subroutine dumbbell_dynamic_forcing(state, fluxes, day, dt, G, CS) ! MODIFY THE CODE IN THE FOLLOWING LOOPS TO SET THE BUOYANCY FORCING TERMS. do j=js,je ; do i=is,ie - fluxes%p_surf(i,j) = CS%forcing_mask(i,j)* CS%slp_amplitude * G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) - fluxes%p_surf_full(i,j) = CS%forcing_mask(i,j) * CS%slp_amplitude * G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) + fluxes%p_surf(i,j) = CS%forcing_mask(i,j)* CS%slp_amplitude * & + G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) + fluxes%p_surf_full(i,j) = CS%forcing_mask(i,j) * CS%slp_amplitude * & + G%mask2dT(i,j) * sin(deg_rad*(rdays/CS%slp_period)) enddo; enddo @@ -251,10 +253,10 @@ subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) end subroutine alloc_if_needed subroutine dumbbell_surface_forcing_init(Time, G, param_file, diag, CS) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag + type(time_type), intent(in) :: Time + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(diag_ctrl), target, intent(in) :: diag type(dumbbell_surface_forcing_CS), pointer :: CS ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 8160a45002..790185d0ee 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -96,7 +96,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate - logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -139,7 +139,8 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_param ! Equating: S_surf - S_range * z/max_depth = S_light + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: - S_range * z/max_depth = S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ! Equating: z/max_depth = - ( S_light - S_surf + (K-3/2)/(nz-1) * (S_dense - S_light) ) / S_range - e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * ( (real(K)-1.5) / real(nz-1) ) ) / S_range + e0(K) = - G%max_depth * ( ( S_light - S_surf ) + ( S_dense - S_light ) * & + ( (real(K)-1.5) / real(nz-1) ) ) / S_range e0(K) = nint(2048.*e0(K))/2048. ! Force round numbers ... the above expression has irrational factors ... e0(K) = min(real(1-K)*GV%Angstrom_z, e0(K)) ! Bound by surface e0(K) = max(-G%max_depth, e0(K)) ! Bound by bottom