From 6bff79ff8be2c9ab68af575a6ebac707f0baac74 Mon Sep 17 00:00:00 2001 From: jedbakerMO Date: Wed, 17 Dec 2025 17:35:10 +0000 Subject: [PATCH 1/6] #192 : merging in fcm branch --- .../algorithm/io_demo_constants_mod.x90 | 9 +- .../driver/multifile_io/multifile_io_mod.F90 | 2 +- .../simple_diffusion_constants_mod.x90 | 9 +- .../algorithm/skeleton_constants_mod.x90 | 9 +- components/driver/source/driver_timer_mod.f90 | 66 ------ .../source/lfric_xios_action_mod.f90 | 18 +- .../algorithm/sci_fem_constants_mod.x90 | 84 +++++--- .../algorithm/sci_geometric_constants_mod.x90 | 79 ++++--- .../algorithm/sci_mapping_constants_mod.x90 | 59 +++--- .../solver/sci_mass_matrix_solver_alg_mod.x90 | 11 +- infrastructure/build/lfric.mk | 17 ++ .../source/utilities/timing_mod.F90 | 199 ++++++++++-------- .../meto/common/suite_config_azspice.cylc | 4 +- .../site/meto/common/suite_config_ex1a.cylc | 4 +- 14 files changed, 301 insertions(+), 269 deletions(-) delete mode 100644 components/driver/source/driver_timer_mod.f90 diff --git a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 index 9bce8269f..04864140f 100644 --- a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 +++ b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 @@ -22,11 +22,11 @@ module io_demo_constants_mod use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Kernels use sci_calc_dA_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type @@ -61,8 +61,9 @@ contains type(mesh_type), pointer, intent(in) :: mesh type(field_type), target, intent(in) :: chi(:) type(field_type), target, intent(in) :: panel_id + integer(tik) :: id - if ( subroutine_timers ) call timer('io_demo_constants_alg') + if ( LPROF ) call start_timing( id, 'io_demo_constants_alg' ) call log_event( "io_demo: creating runtime constants", LOG_LEVEL_TRACE ) !============================= dx_at_w2 setup =============================! @@ -72,7 +73,7 @@ contains call log_event( "io_demo: runtime constants created", LOG_LEVEL_TRACE ) - if ( subroutine_timers ) call timer('io_demo_constants_alg') + if ( LPROF ) call stop_timing( id, 'io_demo_constants_alg' ) call log_event( "io_demo: created FEM constants", LOG_LEVEL_TRACE ) end subroutine create_io_demo_constants diff --git a/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 b/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 index 85be25ac0..87a9fa03f 100644 --- a/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 +++ b/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 @@ -22,7 +22,7 @@ module multifile_io_mod use inventory_by_mesh_mod, only: inventory_by_mesh_type use io_context_collection_mod, only: io_context_collection_type use io_context_mod, only: io_context_type, callback_clock_arg - use io_config_mod, only: use_xios_io, subroutine_timers + use io_config_mod, only: use_xios_io use log_mod, only: log_event, log_level_error, & log_level_trace, log_level_info, & log_scratch_space diff --git a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 index d9f6cef64..98f04c50a 100644 --- a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 +++ b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 @@ -22,11 +22,11 @@ module simple_diffusion_constants_mod use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Kernels use sci_calc_da_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type @@ -61,8 +61,9 @@ contains type(mesh_type), pointer, intent(in) :: mesh type(field_type), target, intent(in) :: chi(:) type(field_type), target, intent(in) :: panel_id + integer(tik) :: id - if ( subroutine_timers ) call timer('simple_diffusion_constants_alg') + if ( LPROF ) call start_timing( id, 'simple_diffusion_constants_alg' ) call log_event( "simple_diffusion: creating runtime constants", LOG_LEVEL_TRACE ) !============================= dx_at_w2 setup =============================! @@ -72,7 +73,7 @@ contains call log_event( "simple_diffusion: runtime constants created", LOG_LEVEL_TRACE ) - if ( subroutine_timers ) call timer('simple_diffusion_constants_alg') + if ( LPROF ) call stop_timing( id, 'simple_diffusion_constants_alg' ) call log_event( "simple_diffusion: created FEM constants", LOG_LEVEL_TRACE ) end subroutine create_simple_diffusion_constants diff --git a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 index 3017c4bb8..4394b259c 100644 --- a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 +++ b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 @@ -22,14 +22,14 @@ module skeleton_constants_mod use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use inventory_by_mesh_mod, only: inventory_by_mesh_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_INFO, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & @@ -109,8 +109,9 @@ contains type(function_space_type), pointer :: w2v_fs => null() type(function_space_type), pointer :: w3_fs => null() type(function_space_type), pointer :: wtheta_fs => null() + integer(tik) :: id - if ( subroutine_timers ) call timer('skeleton_constants_alg') + if ( LPROF ) call start_timing( id, 'skeleton_constants_alg' ) call log_event( "Skeleton: creating runtime constants", LOG_LEVEL_INFO ) !======================== Create quadrature object ========================! @@ -178,7 +179,7 @@ contains mm_w0, mm_w1, mm_w2, mm_w2b, mm_w3, mm_wtheta, grad, curl, div, & broken_div ) - if ( subroutine_timers ) call timer('skeleton_constants_alg') + if ( LPROF ) call stop_timing( id, 'skeleton_constants_alg' ) call log_event( "Skeleton: created FEM constants", LOG_LEVEL_INFO ) end subroutine create_skeleton_constants diff --git a/components/driver/source/driver_timer_mod.f90 b/components/driver/source/driver_timer_mod.f90 deleted file mode 100644 index a78498117..000000000 --- a/components/driver/source/driver_timer_mod.f90 +++ /dev/null @@ -1,66 +0,0 @@ -!----------------------------------------------------------------------------- -! (c) Crown copyright 2023 Met Office. All rights reserved. -! The file LICENCE, distributed with this code, contains details of the terms -! under which the code may be used. -!----------------------------------------------------------------------------- -!> Lifecycle management of the simple timer profiling system. -!> -module driver_timer_mod - - use io_config_mod, only : subroutine_timers, & - timer_output_path - use timer_mod, only : timer, output_timer, init_timer - - implicit none - - private - public :: init_timers, final_timers - -contains - - !> Initialises timers from namelists. - !> - !> As well as initialising the system a "top level" timer is started - !> which will give the time between initialisation and finalisation of - !> the timer system. - !> - !> @param[in] identifier Top level timer name. - !> - subroutine init_timers( identifier ) - - implicit none - - character(*), intent(in) :: identifier - - if (subroutine_timers) then - call init_timer( timer_output_path ) - call timer( identifier ) - end if - - end subroutine init_timers - - !> Shuts down timers. - !> - !> The identifier specified when shutting down should be the same as the one - !> given on initialisation. There is a chance to mismatch the identifiers - !> which will cause problems but it avoids the use of a global variable. - !> - !> @todo Reconsider the existance of the simple timer system once the - !> profiler is integrated. - !> - !> @param[in] identifier Top level timer name. - !> - subroutine final_timers( identifier ) - - implicit none - - character(*), intent(in) :: identifier - - if (subroutine_timers) then - call timer( identifier ) - call output_timer() - end if - - end subroutine final_timers - -end module driver_timer_mod diff --git a/components/lfric-xios/source/lfric_xios_action_mod.f90 b/components/lfric-xios/source/lfric_xios_action_mod.f90 index 5dbc1083a..9b40484dd 100644 --- a/components/lfric-xios/source/lfric_xios_action_mod.f90 +++ b/components/lfric-xios/source/lfric_xios_action_mod.f90 @@ -6,6 +6,7 @@ module lfric_xios_action_mod use constants_mod, only : str_def + use timing_mod, only : start_timing, stop_timing, tik, LPROF implicit none @@ -36,7 +37,6 @@ subroutine advance(context, model_clock) !> is old enough to not have xios_get_current_context forwarded through the !> xios module. use icontext, only : xios_get_current_context - use timer_mod, only : timer use xios, only : xios_context, & xios_set_current_context, & xios_update_calendar @@ -50,6 +50,8 @@ subroutine advance(context, model_clock) type(lfric_xios_file_type), pointer :: file => null() type(xios_context) :: xios_context_handle type(linked_list_type), pointer :: filelist + integer(tik) :: id + logical :: profiling ! Get the handle of the current context (Not necessarily the one passed to this routine). ! This is used to reset the context on return. @@ -76,9 +78,10 @@ subroutine advance(context, model_clock) end if ! Update XIOS calendar - if (context%get_timer_flag()) call timer('xios_update_calendar') + profiling = (context%get_timer_flag() .and. LPROF ) + if ( profiling ) call start_timing( id, 'xios_update_calendar' ) call xios_update_calendar( model_clock%get_step() - model_clock%get_first_step() + 1 ) - if (context%get_timer_flag()) call timer('xios_update_calendar') + if ( profiling ) call stop_timing( id, 'xios_update_calendar' ) ! Read all files that need to be read from filelist => context%get_filelist() @@ -126,7 +129,6 @@ subroutine advance_read_only(context, model_clock) !> is old enough to not have xios_get_current_context forwarded through the !> xios module. use icontext, only : xios_get_current_context - use timer_mod, only : timer use xios, only : xios_context, & xios_date, & xios_set_current_context, & @@ -143,6 +145,8 @@ subroutine advance_read_only(context, model_clock) type(lfric_xios_file_type), pointer :: file => null() type(xios_context) :: xios_context_handle type(linked_list_type), pointer :: filelist + integer(tik) :: id + logical :: profiling ! Get the handle of the current context (Not necessarily the one passed to this routine). ! This is used to reset the context on return. @@ -153,10 +157,10 @@ subroutine advance_read_only(context, model_clock) call context%set_current() call context%tick_context_clock() ! Update XIOS calendar - if (context%get_timer_flag()) call timer('xios_update_calendar') - + profiling = ( context%get_timer_flag() .and. LPROF ) + if ( profiling ) call start_timing( id, 'xios_update_calendar' ) call xios_update_calendar( context%get_context_clock_step() ) - if (context%get_timer_flag()) call timer('xios_update_calendar') + if ( profiling ) call stop_timing( id, 'xios_update_calendar' ) ! Read all files that need to be read from filelist => context%get_filelist() diff --git a/components/science/source/algorithm/sci_fem_constants_mod.x90 b/components/science/source/algorithm/sci_fem_constants_mod.x90 index 6477c64ff..72679babc 100644 --- a/components/science/source/algorithm/sci_fem_constants_mod.x90 +++ b/components/science/source/algorithm/sci_fem_constants_mod.x90 @@ -23,14 +23,14 @@ module sci_fem_constants_mod use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use inventory_by_mesh_mod, only: inventory_by_mesh_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & @@ -228,6 +228,7 @@ contains logical(kind=l_def), parameter :: extend_mesh = .false. type(field_type) :: dummy_field integer(kind=i_def), parameter :: stencil_depth = 1_i_def + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -275,7 +276,7 @@ contains panel_id => get_panel_id(mesh_id) qr_ptr => get_qr_fe() - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) call inventory%add_operator(mm_op, fs, fs, mesh) @@ -306,7 +307,7 @@ contains stencil_depth) ) end if - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -346,6 +347,7 @@ contains logical(kind=l_def), parameter :: extend_mesh = .false. type(field_type) :: dummy_field integer(kind=i_def), parameter :: stencil_depth = 1_i_def + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -387,7 +389,7 @@ contains panel_id => get_panel_id(mesh_id) qr_ptr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_operator(mm_op, fs, fs, mesh) @@ -417,7 +419,7 @@ contains stencil_depth) ) end if - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -444,6 +446,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -489,7 +492,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -497,7 +500,7 @@ contains call invoke ( setval_c(diagonal_mm, 0.0_r_def), & mm_diagonal_kernel_type(diagonal_mm, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -524,6 +527,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -563,14 +567,14 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_field(diagonal_mm, fs, mesh) call invoke ( setval_c(diagonal_mm, 0.0_r_def), & mm_diagonal_kernel_type(diagonal_mm, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -600,6 +604,7 @@ contains type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name integer(kind=i_def), parameter :: i_minus_one = -1_i_def + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -633,7 +638,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -654,7 +659,7 @@ contains ones, mass_matrix), & inc_X_powint_n(mm_linv, i_minus_one) ) end select - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -684,6 +689,7 @@ contains type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name integer(kind=i_def), parameter :: i_minus_one = -1_i_def + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -711,7 +717,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call ones%initialise( fs ) @@ -731,7 +737,7 @@ contains ones, mass_matrix), & inc_X_powint_n(mm_linv, i_minus_one) ) end select - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -758,6 +764,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -791,7 +798,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -800,7 +807,7 @@ contains call invoke( name = "create_inv_mass_matrix_fe", & invert_local_operator_kernel_type(mm_inv, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -827,6 +834,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -854,7 +862,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_operator(mm_inv, fs, fs, mesh) @@ -862,7 +870,7 @@ contains call invoke( name = "create_inv_mass_matrix_fv", & invert_local_operator_kernel_type(mm_inv, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -888,6 +896,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w1_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -914,12 +923,12 @@ contains w1_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W1 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call curl_inventory_fe%add_operator(curl, w2_fs, w1_fs, mesh) call invoke( name='calculate_curl_fe', & compute_curl_operator_kernel_type(curl, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call curl_inventory_fe%get_operator(mesh, curl) @@ -944,6 +953,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w1_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. curl_inventory_fv%is_initialised()) then @@ -962,12 +972,12 @@ contains w2_fs => function_space_collection%get_fs( mesh, 0, 0, W2 ) w1_fs => function_space_collection%get_fs( mesh, 0, 0, W1 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call curl_inventory_fv%add_operator(curl, w2_fs, w1_fs, mesh) call invoke( name='calculate_curl_fv', & compute_curl_operator_kernel_type(curl, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call curl_inventory_fv%get_operator(mesh, curl) @@ -990,6 +1000,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. div_inventory%is_initialised()) then @@ -1010,12 +1021,12 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div_inventory%add_operator(div, w3_fs, w2_fs, mesh) call invoke( name='calculate_div', & compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call div_inventory%get_operator(mesh, div) @@ -1038,6 +1049,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2h_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. div_h_inventory%is_initialised()) then @@ -1058,12 +1070,12 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div_h_inventory%add_operator(div_h, w3_fs, w2h_fs, mesh) call invoke( name='calculate_div_h', & compute_div_operator_kernel_type(div_h, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call div_h_inventory%get_operator(mesh, div_h) @@ -1090,6 +1102,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1117,13 +1130,13 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div%initialise( w3_fs, w2_fs ) call im3_div_inventory_fe%add_operator(im3_div, w3_fs, w2_fs, mesh) call invoke( compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr), & operator_x_times_y_kernel_type(im3_div, mm_w3_inv, div) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call im3_div_inventory_fe%get_operator(mesh, im3_div) @@ -1150,6 +1163,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. im3_div_inventory_fv%is_initialised()) then @@ -1169,13 +1183,13 @@ contains w2_fs => function_space_collection%get_fs( mesh, 0, 0, W2 ) w3_fs => function_space_collection%get_fs( mesh, 0, 0, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div%initialise( w3_fs, w2_fs ) call im3_div_inventory_fv%add_operator(im3_div, w3_fs, w2_fs, mesh) call invoke( compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr), & operator_x_times_y_kernel_type(im3_div, mm_w3_inv, div) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call im3_div_inventory_fv%get_operator(mesh, im3_div) @@ -1201,6 +1215,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1238,7 +1253,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -1253,7 +1268,7 @@ contains multiplicity_kernel_type(nodal_multiplicity), & X_divideby_Y(rmultiplicity, ones, nodal_multiplicity) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -1280,6 +1295,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -1311,7 +1327,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) @@ -1325,7 +1341,7 @@ contains multiplicity_kernel_type(nodal_multiplicity), & X_divideby_Y(rmultiplicity, ones, nodal_multiplicity) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant diff --git a/components/science/source/algorithm/sci_geometric_constants_mod.x90 b/components/science/source/algorithm/sci_geometric_constants_mod.x90 index 744700203..46d3291c3 100644 --- a/components/science/source/algorithm/sci_geometric_constants_mod.x90 +++ b/components/science/source/algorithm/sci_geometric_constants_mod.x90 @@ -24,12 +24,12 @@ module sci_geometric_constants_mod use integer_field_mod, only: integer_field_type use inventory_by_mesh_mod, only: inventory_by_mesh_type use inventory_by_local_mesh_mod, only: inventory_by_local_mesh_type - use io_config_mod, only: subroutine_timers use local_mesh_mod, only: local_mesh_type use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & @@ -164,8 +164,9 @@ contains type(field_type), pointer :: panel_id type(function_space_type), pointer :: twod_fs integer(kind=i_def) :: k_h, k_v + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) if (use_fe) then k_h = element_order_h @@ -190,7 +191,7 @@ contains setval_c(long, f_lon) ) end if - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end subroutine compute_latlon @@ -217,8 +218,9 @@ contains type(integer_field_type) :: face_counter type(function_space_type), pointer :: w2h_2d_fs type(function_space_type), pointer :: w3_2d_fs + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) twod_mesh => mesh_collection%get_mesh(mesh, TWOD) local_mesh => mesh%get_local_mesh() @@ -246,7 +248,7 @@ contains face_selector_ns, & face_counter ) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end subroutine compute_face_selectors @@ -315,6 +317,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: panel_id type(function_space_type), pointer :: wchi_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. extended_chi_inventory%is_initialised()) then @@ -329,7 +332,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) wchi_fs => chi(1)%get_function_space() depth = mesh%get_halo_depth() @@ -347,7 +350,7 @@ contains call invoke( extend_chi_field_kernel_type(extended_chi, chi, & panel_id, depth) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call extended_chi_inventory%get_field_array(mesh, extended_chi) @@ -374,6 +377,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: panel_id type(function_space_type), pointer :: w2_k0_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. dA_at_w2_inventory%is_initialised()) then @@ -388,7 +392,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W2) call dA_at_w2_inventory%add_field(dA_at_w2, w2_k0_fs, mesh) @@ -396,7 +400,7 @@ contains call invoke( setval_c(dA_at_w2, 0.0_r_def), & calc_dA_at_w2_kernel_type(dA_at_w2, chi, panel_id) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call dA_at_w2_inventory%get_field(mesh, dA_at_w2) @@ -434,6 +438,7 @@ contains type(quadrature_xyoz_type) :: qr logical(kind=l_def) :: extended_mesh type(quadrature_rule_gaussian_type) :: quadrature_rule + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -455,7 +460,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, W3) @@ -476,7 +481,7 @@ contains setval_c(detj_at_w3, 0.0_r_def), & mm_diagonal_kernel_type(detj_at_w3, mm_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -513,6 +518,7 @@ contains type(quadrature_xyoz_type) :: qr logical(kind=l_def) :: extended_mesh type(quadrature_rule_gaussian_type) :: quadrature_rule + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w3_inventory_fv%is_initialised()) then @@ -528,7 +534,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) call detj_at_w3_inventory_fv%add_field(detj_at_w3, w3_fs, mesh) @@ -547,7 +553,7 @@ contains setval_c(detj_at_w3, 0.0_r_def), & mm_diagonal_kernel_type(detj_at_w3, mm_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -573,6 +579,7 @@ contains type(field_type), pointer :: panel_id type(field_type) :: multiplicity_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -594,7 +601,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, W2) @@ -608,7 +615,7 @@ contains setval_c(multiplicity_w2, 0.0_r_def), & multiplicity_kernel_type(multiplicity_w2), & inc_X_divideby_Y(detj_at_w2, multiplicity_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -634,6 +641,7 @@ contains type(field_type), pointer :: panel_id type(field_type) :: multiplicity_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w2_inventory_fv%is_initialised()) then @@ -649,7 +657,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_fs => function_space_collection%get_fs(mesh, 0, 0, W2) call multiplicity_w2%initialise( w2_fs ) @@ -662,7 +670,7 @@ contains setval_c(multiplicity_w2, 0.0_r_def), & multiplicity_kernel_type(multiplicity_w2), & inc_X_divideby_Y(detj_at_w2, multiplicity_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -685,6 +693,7 @@ contains logical(kind=l_def) :: constant_exists type(field_type), pointer :: height_w2 type(function_space_type), pointer :: w3_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. dz_w3_inventory%is_initialised()) then @@ -699,14 +708,14 @@ contains ! Get height first to avoid potentially timing twice height_w2 => get_height_fv(W2, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) call dz_w3_inventory%add_field(dz_w3, w3_fs, mesh) call invoke( get_dz_w3_kernel_type(dz_w3, height_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call dz_w3_inventory%get_field(mesh, dz_w3) @@ -730,6 +739,7 @@ contains type(field_type), pointer :: dx_at_w2 type(field_type), pointer :: delta_at_wtheta type(function_space_type), pointer :: wt_k0_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. delta_at_wtheta_inventory%is_initialised()) then @@ -744,13 +754,13 @@ contains wt_k0_fs => function_space_collection%get_fs(mesh, 0, 0, Wtheta) dx_at_w2 => get_dx_at_w2(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call delta_at_wtheta_inventory%add_field(delta_at_wtheta, wt_k0_fs, mesh) call invoke( calc_delta_at_wtheta_kernel_type(delta_at_wtheta, dx_at_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -772,6 +782,7 @@ contains type(field_type), pointer :: detj_at_w2 type(field_type), pointer :: dA_at_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. dx_at_w2_inventory%is_initialised()) then @@ -787,12 +798,12 @@ contains detj_at_w2 => get_detj_at_w2_fv(mesh_id) dA_at_w2 => get_dA_at_w2(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call dx_at_w2_inventory%add_field(dx_at_w2, w2_fs, mesh) call invoke( X_divideby_Y(dx_at_w2, detj_at_w2, dA_at_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -817,6 +828,7 @@ contains type(field_type), pointer :: height_w3 type(field_type), pointer :: height_wth logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Parameters of the cells integer(i_def), parameter :: n_centres = 1_i_def @@ -836,7 +848,7 @@ contains height_w3 => get_height_fv(W3, mesh_id) height_wth => get_height_fv(Wtheta, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) wtheta_k0_fs => function_space_collection%get_fs(mesh, 0, 0, Wtheta) @@ -845,7 +857,7 @@ contains call invoke( calc_dz_face_kernel_type(dz_at_wtheta, height_w3, & height_wth, n_centres, ign_surf) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -875,6 +887,7 @@ contains type(field_type), pointer :: dA_msl_proj type(field_type), pointer :: dA_at_w2 type(function_space_type), pointer :: fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. dA_msl_proj_inventory%is_initialised()) then @@ -893,14 +906,14 @@ contains fs => function_space_collection%get_fs(twod_mesh, 0, 0, W3) dA_at_w2 => get_dA_at_w2(prime_mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call dA_msl_proj_inventory%add_field(dA_msl_proj, fs, local_mesh) call invoke( calc_da_msl_proj_kernel_type(dA_at_w2, dA_msl_proj, & planet_radius, domain_height, & geometry, geometry_spherical) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -1176,6 +1189,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: height character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1217,7 +1231,7 @@ contains ! If this constant doesn't exist, create it chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) space => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space_id) @@ -1225,7 +1239,7 @@ contains call invoke( get_height_kernel_type(height, chi, scaled_radius) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else call inventory%get_field(mesh, height) end if @@ -1252,6 +1266,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: height character(len=str_def) :: inventory_name + integer(tik) :: id ! Determine inventory based on space select case (space_id) @@ -1287,14 +1302,14 @@ contains ! If this constant doesn't exist, create it chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) space => function_space_collection%get_fs(mesh, 0, 0, space_id) call inventory%add_field(height, space, mesh) call invoke( get_height_kernel_type(height, chi, scaled_radius) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else call inventory%get_field(mesh, height) end if diff --git a/components/science/source/algorithm/sci_mapping_constants_mod.x90 b/components/science/source/algorithm/sci_mapping_constants_mod.x90 index 7bcecf0f3..ffa819aa1 100644 --- a/components/science/source/algorithm/sci_mapping_constants_mod.x90 +++ b/components/science/source/algorithm/sci_mapping_constants_mod.x90 @@ -39,12 +39,12 @@ module sci_mapping_constants_mod use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use r_tran_field_mod, only: r_tran_field_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & element_order_v - use io_config_mod, only: subroutine_timers ! Other algorithms use sci_geometric_constants_mod, only: get_coordinates, & @@ -272,6 +272,7 @@ contains type(operator_type), pointer :: u_lon_sample type(operator_type), pointer :: u_lat_sample type(operator_type), pointer :: u_up_sample + integer(tik) :: id if (.not. u_lon_sample_inventory%is_initialised()) then call u_lon_sample_inventory%initialise(name='u_lon_sample') @@ -287,7 +288,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) ! Kernels only work for lowest order spaces so use finite volume w2_fs => function_space_collection%get_fs(mesh, 0, 0, W2) @@ -304,7 +305,7 @@ contains u_up_sample, & chi, panel_id) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_spherical_components_to_w2_sample @@ -330,6 +331,7 @@ contains type(function_space_type), pointer :: fs, coarse_fs, fine_fs type(quadrature_rule_segment_centre_type) :: quadrature_rule_sc type(quadrature_xyoz_type) :: qr + integer(tik) :: id if (.not. scalar_inter_element_order_weights_inventory%is_initialised()) then call scalar_inter_element_order_weights_inventory%initialise( & @@ -337,7 +339,7 @@ contains ) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) k_h = element_order_h k_v = element_order_v @@ -384,7 +386,7 @@ contains dummy_fine, dummy_coarse, weights_high_low, weights_low_high, qr & ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_scalar_inter_element_order_weights @@ -410,6 +412,7 @@ contains type(function_space_type), pointer :: fs, coarse_fs, fine_fs type(quadrature_rule_newton_cotes_type) :: quadrature_rule_newton_cotes type(quadrature_xyoz_type) :: qr + integer(tik) :: id if (.not. w2_inter_element_order_weights_inventory%is_initialised()) then call w2_inter_element_order_weights_inventory%initialise( & @@ -417,7 +420,7 @@ contains ) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) k_h = element_order_h k_v = element_order_v @@ -485,7 +488,7 @@ contains dummy_fine, dummy_coarse, weights_high_low, weights_low_high, qr & ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_w2_inter_element_order_weights @@ -517,6 +520,7 @@ contains type(field_type) :: dummy_theta integer(kind=i_def) :: k logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Check inventory is initialised if (.not. proj_mr_to_sh_rho_inventory%is_initialised()) then @@ -540,7 +544,7 @@ contains double_level_chi => get_coordinates(double_level_mesh%get_id()) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w3_fs => function_space_collection%get_fs(prime_extrusion_mesh, 0, 0, W3) wtheta_fs => function_space_collection%get_fs(prime_extrusion_mesh, 0, 0, Wtheta) @@ -560,7 +564,7 @@ contains dummy_theta, & qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -586,6 +590,7 @@ contains type(field_type) :: dummy_w2_field type(function_space_type), pointer :: fine_w2_fs type(function_space_type), pointer :: coarse_w2_fs + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_w2_inventory%is_initialised()) then @@ -608,7 +613,7 @@ contains call log_event(log_scratch_space, LOG_LEVEL_ERROR) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) coarse_w2_fs => function_space_collection%get_fs(coarse_mesh, 0, 0, W2) fine_w2_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W2) @@ -623,7 +628,7 @@ contains call invoke( setval_c(weights, 0.0_r_def), & weights_prolong_w2_kernel_type(weights, dummy_w2_field) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -651,6 +656,7 @@ contains type(function_space_type), pointer :: coarse_w3_fs type(field_type), pointer :: mm_w3_fine type(field_type), pointer :: mm_w3_coarse + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_rdef_w3_inventory%is_initialised()) then @@ -679,7 +685,7 @@ contains mm_w3_fine => get_mass_matrix_diagonal_fv(W3, fine_mesh%get_id()) mm_w3_coarse => get_mass_matrix_diagonal_fv(W3, coarse_mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) coarse_w3_fs => function_space_collection%get_fs(coarse_mesh, 0, 0, W3) fine_w3_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W3) @@ -692,7 +698,7 @@ contains mm_w3_fine, & mm_w3_coarse) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -717,6 +723,7 @@ contains type(field_type), pointer :: weights_rdef type(r_tran_field_type), pointer :: weights_rtran type(function_space_type), pointer :: fine_w3_fs + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_rtran_w3_inventory%is_initialised()) then @@ -736,7 +743,7 @@ contains ! Create the object as it doesn't exist yet weights_rdef => get_intermesh_weights_w3_rdef(fine_mesh, coarse_mesh) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) fine_w3_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W3) @@ -746,7 +753,7 @@ contains call copy_field(weights_rdef, weights_rtran) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -1017,6 +1024,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: xdirection = 1_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_lon_dot_to_w1_inventory%is_initialised()) then @@ -1034,7 +1042,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1048,7 +1056,7 @@ contains chi, panel_id, & xdirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1073,6 +1081,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: ydirection = 2_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_lat_dot_to_w1_inventory%is_initialised()) then @@ -1090,7 +1099,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1104,7 +1113,7 @@ contains chi, panel_id, & ydirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1129,6 +1138,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: zdirection = 3_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_r_dot_to_w1_inventory%is_initialised()) then @@ -1144,7 +1154,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1158,7 +1168,7 @@ contains chi, panel_id, & zdirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1185,6 +1195,7 @@ contains type(field_type), pointer :: panel_id type(function_space_type), pointer :: w2h_k0_fs type(function_space_type), pointer :: w3_k0_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. w3_to_w2_displacement_inventory%is_initialised()) then @@ -1208,7 +1219,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w2h_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W2H) w3_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1220,7 +1231,7 @@ contains w3_to_w2_displacement_kernel_type(w3_to_w2_displacement, & chi, panel_id, dummy_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if end function get_w3_to_w2_displacement diff --git a/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 b/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 index b21db98bb..20c1246b8 100644 --- a/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 +++ b/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 @@ -43,10 +43,8 @@ module sci_mass_matrix_solver_alg_mod precondition_only_type, & jacobi_type, & chebyshev_type - - - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -119,8 +117,9 @@ contains type(field_vector_type) :: vec_mm_diagonal real(kind=r_def) :: lmin, lmax + integer(tik) :: id - if ( subroutine_timers ) call timer('mass_matrix_solver_alg') + if ( LPROF ) call start_timing( id, 'mass_matrix_solver_alg' ) mesh_id = y%get_mesh_id() @@ -324,7 +323,7 @@ contains deallocate(mass_matrix_solver) end if - if ( subroutine_timers ) call timer('mass_matrix_solver_alg') + if ( LPROF ) call stop_timing( id, 'mass_matrix_solver_alg' ) end subroutine mass_matrix_solver_alg diff --git a/infrastructure/build/lfric.mk b/infrastructure/build/lfric.mk index 9ccd52602..df46ce865 100644 --- a/infrastructure/build/lfric.mk +++ b/infrastructure/build/lfric.mk @@ -96,10 +96,27 @@ ifdef USE_VERNIER export PRE_PROCESS_MACROS += VERNIER endif +ifdef USE_LEGACY_TIMER + export PRE_PROCESS_MACROS += LEGACY_TIMER +endif + ifdef USE_TIMING_WRAPPER export PRE_PROCESS_MACROS += TIMING_ON endif +# Check that only one profiler is requested +ifneq ($(and $(findstring LEGACY_TIMER, $(PRE_PROCESS_MACROS)), \ + $(findstring VERNIER, $(PRE_PROCESS_MACROS))), ) + $(error Multiple profilers specified, limit choice to single profiler.) +endif + +# Check that TIMING ON has been set if any profiler requested. +ifneq ($(or $(findstring LEGACY_TIMER,$(PRE_PROCESS_MACROS)), \ + $(findstring VERNIER, $(PRE_PROCESS_MACROS))), ) +ifndef USE_TIMING_WRAPPER + $(error Conflicting options: Profiler requested with Timing disabled.) +endif +endif # Set the default precision for reals RDEF_PRECISION ?= 64 diff --git a/infrastructure/source/utilities/timing_mod.F90 b/infrastructure/source/utilities/timing_mod.F90 index 7031d6c46..8b489529d 100644 --- a/infrastructure/source/utilities/timing_mod.F90 +++ b/infrastructure/source/utilities/timing_mod.F90 @@ -3,153 +3,186 @@ ! For further details please refer to the file LICENCE which you should have ! received as part of this distribution. !----------------------------------------------------------------------------- -!> @brief Provides wrapper support for Vernier timings +!> @brief Provides wrapper support for profiler timings !> module timing_mod - use log_mod, only: log_event, log_scratch_space, & - LOG_LEVEL_DEBUG, LOG_LEVEL_WARNING - use constants_mod, only: i_def, IMDI + use log_mod, only: log_event, log_scratch_space, & + LOG_LEVEL_DEBUG, LOG_LEVEL_WARNING + use constants_mod, only: i_def, imdi, cmdi, str_def #ifdef VERNIER - !Vernier will only be loaded if the VERNIER environment variable is used - use vernier_mod, only: vernier_init, vernier_start, & - vernier_stop, vernier_write, & - vernier_finalize, vik + use vernier_mod, only: vernier_init, vernier_start, & + vernier_stop, vernier_write, & + vernier_finalize, vik + +#elif defined( LEGACY_TIMER ) + use timer_mod, only: timer, init_timer, output_timer #endif - implicit none + implicit none - public :: init_timing, final_timing, start_timing, stop_timing - public :: tik + public :: init_timing, final_timing, start_timing, stop_timing + public :: tik #ifdef VERNIER - !If Vernier is on then the calliper hash 'tik' is defined as Vernier's hash 'vik' - integer, parameter :: tik = vik + integer, parameter :: tik = vik + integer(tik), private :: global_timing_handle #else - integer, parameter :: tik = i_def + integer, parameter :: tik = i_def #endif -#ifndef TIMING_ON - !If the timing macro is not explicity turned on then the callipers won't be called - logical, public, parameter :: LPROF = .false. +#ifdef TIMING_ON + ! LPROF enables profiler timings. + logical, public, protected :: LPROF = .false. #else - !If the timing macro is defined/ turned on, LPROF will be defined later (by subroutine_timers) - logical, public :: LPROF + ! LPROF enables profiler timings. + ! The logical is declared as a parameter for this build + ! so compilers can easily optimise out the profiler + ! calliper calls from the code. + logical, public, parameter :: LPROF = .false. #endif contains !=============================================================================! -!> @brief Initialize timings -!> @param[in] communicator LFRic mpi communicator +!> @brief Initialise timings and start a global calliper +!> @param[in] communicator LFRic mpi communicator !> @param[in] lsubroutine_timers Runtime logical controlling timer use - subroutine init_timing( communicator, lsubroutine_timers ) - use lfric_mpi_mod, only: lfric_comm_type +!> @param[in] application_name String for the global calliper +!> @param[in] timer_output_path Temporary string used for the legacy timer path + subroutine init_timing( communicator, lsubroutine_timers, application_name, & + timer_output_path ) + use lfric_mpi_mod, only: lfric_comm_type - implicit none + implicit none - logical, intent(in) :: lsubroutine_timers - type( lfric_comm_type ), intent(in) :: communicator + type( lfric_comm_type ), intent(in) :: communicator + logical, intent(in) :: lsubroutine_timers + character(*), intent(in) :: application_name + character(*), intent(in), optional :: timer_output_path #ifdef TIMING_ON - !If timing is on, LPROF will be defined by subroutine_timers - LPROF = lsubroutine_timers + character(str_def) :: name - write(log_scratch_space, '(A)') 'Timing Mod: Runtime timing is turned on' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + ! If timing is on, LPROF will be defined by subroutine_timers + LPROF = lsubroutine_timers + name = cmdi -#ifdef VERNIER - !If Timing and Vernier is on, Vernier will be initialised +#ifdef LEGACY_TIMER + name = 'Timer' + if ( LPROF ) then + if ( present ( timer_output_path ) ) then + call init_timer( timer_output_path ) + else + call init_timer( 'timer.txt' ) + end if - write(log_scratch_space, '(A)') 'Timing Mod: Vernier is turned on' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + call timer( application_name ) - call vernier_init( communicator%get_comm_mpi_val() ) + end if - write(log_scratch_space, '(A)') 'Timing Mod: Vernier initialised' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) -#endif +#elif defined( VERNIER ) + name = 'Vernier' + if ( LPROF ) then + call vernier_init( communicator%get_comm_mpi_val() ) + if ( LPROF ) call vernier_start( global_timing_handle, '__' // & + application_name // '__' ) -#ifndef VERNIER - !If Timing is on but Vernier is not on then a warning will be thrown - write(log_scratch_space, '(A)') 'Timing Mod: Runtime timing is turned on but no profiling tool (such as Vernier) is turned on!' - call log_event(log_scratch_space, LOG_LEVEL_WARNING) -#endif -#endif + end if -#ifndef TIMING_ON -#ifdef VERNIER - write(log_scratch_space, '(A)') 'Timing Mod: Vernier is on but Timing is not!' - call log_event(log_scratch_space, LOG_LEVEL_WARNING) #endif + + if ( LPROF ) then + if (trim( name ) == trim( cmdi )) then + call log_event('Subroutine timings unavailable, no profiler compiled', & + log_level_warning) + else + call log_event( trim( name ) // ' initialised', log_level_debug ) + end if + end if + #endif - end subroutine init_timing + end subroutine init_timing !=============================================================================! -!> @brief Output and finalize timings - subroutine final_timing() - - implicit none +!> @brief Output and finalise timings + subroutine final_timing( application_name ) + implicit none + character(*), intent(in) :: application_name #ifdef TIMING_ON #ifdef VERNIER - !If Vernier is on then it will write to a file and then finalise - call vernier_write() + ! If Vernier is on then it will write to a file and then finalise + if ( LPROF ) call vernier_stop( global_timing_handle ) + call vernier_write() + write(log_scratch_space, '(A)') 'Timing Mod: Vernier has written to file' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - write(log_scratch_space, '(A)') 'Timing Mod: Vernier has written to file' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + call vernier_finalize() + write(log_scratch_space, '(A)') 'Timing Mod: Vernier finalised' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - call vernier_finalize() +#elif defined(LEGACY_TIMER) + call timer ( application_name ) + call output_timer() + + write(log_scratch_space, '(A)') 'Timing Mod: Legacy timing finalised' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - write(log_scratch_space, '(A)') 'Timing Mod: Vernier finalised' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) #endif #endif - - end subroutine final_timing + end subroutine final_timing !=============================================================================! !> @brief Start timings -!> @param[out] timing_section_handle The name of the section that is being timed -!> @param[in] timing_state_name Starting or stopping the given timing, either 'start' or 'stop' - subroutine start_timing( timing_section_handle, timing_section_name ) +!> @param[out] timing_section_handle The integer handle for timed region +!> @param[in] timing_state_name Name of the measured region + subroutine start_timing( timing_section_handle, timing_section_name ) + + implicit none - implicit none + integer(tik), intent(out) :: timing_section_handle + character(*), intent(in) :: timing_section_name - character(*), intent(in) :: timing_section_name - integer(tik), intent(out) :: timing_section_handle + timing_section_handle = imdi #ifdef VERNIER - !If Vernier is on will start a calliper - call vernier_start( timing_section_handle , timing_section_name ) -#else - timing_section_handle = IMDI + ! If Vernier is on will start a calliper + call vernier_start( timing_section_handle , timing_section_name ) + +#elif defined(LEGACY_TIMER) + call timer( timing_section_name ) + #endif - end subroutine start_timing + end subroutine start_timing - !=============================================================================! +!=============================================================================! !> @brief Stop timings -!> @param[in] timing_section_handle The name of the section that is being timed - subroutine stop_timing( timing_section_handle ) - - implicit none +!> @param[in] timing_section_handle The integer handle for timed region +!> @param[in] timing_state_name Optional, name of the measured region + subroutine stop_timing( timing_section_handle, timing_section_name ) + implicit none - integer(tik), intent(in) :: timing_section_handle - !Future callipers may require the section name as well as the handle + integer(tik), optional, intent(in) :: timing_section_handle + character(*), optional, intent(in) :: timing_section_name #ifdef VERNIER - !If Vernier is on will end a calliper - call vernier_stop( timing_section_handle ) + ! If Vernier is on will end a calliper + call vernier_stop( timing_section_handle ) + +#elif defined(LEGACY_TIMER) + call timer( timing_section_name ) + #endif - end subroutine stop_timing + end subroutine stop_timing end module timing_mod diff --git a/rose-stem/site/meto/common/suite_config_azspice.cylc b/rose-stem/site/meto/common/suite_config_azspice.cylc index 41f182ea7..87f954fba 100644 --- a/rose-stem/site/meto/common/suite_config_azspice.cylc +++ b/rose-stem/site/meto/common/suite_config_azspice.cylc @@ -31,8 +31,8 @@ [[AZSPICE_BUILD]] [[[environment]]] - USE_VERNIER = yes - USE_TIMING_WRAPPER=yes + USE_VERNIER=true + USE_TIMING_WRAPPER=true [[[directives]]] --gres=tmp:1024 --export=NONE diff --git a/rose-stem/site/meto/common/suite_config_ex1a.cylc b/rose-stem/site/meto/common/suite_config_ex1a.cylc index 6b6901c31..a3263719e 100644 --- a/rose-stem/site/meto/common/suite_config_ex1a.cylc +++ b/rose-stem/site/meto/common/suite_config_ex1a.cylc @@ -42,8 +42,8 @@ [[EX1A_BUILD]] [[[environment]]] - USE_VERNIER=yes - USE_TIMING_WRAPPER=yes + USE_TIMING_WRAPPER=true + USE_VERNIER=true [[[directives]]] -l tmpsize=12GB From 8d1e308fc3e56814fba090d41a5448faabbc3281 Mon Sep 17 00:00:00 2001 From: jedbakerMO Date: Wed, 17 Dec 2025 17:35:10 +0000 Subject: [PATCH 2/6] #192 : merging in fcm branch --- CONTRIBUTORS.md | 1 + .../algorithm/io_demo_constants_mod.x90 | 9 +- .../driver/multifile_io/multifile_io_mod.F90 | 2 +- .../simple_diffusion_constants_mod.x90 | 9 +- .../algorithm/skeleton_constants_mod.x90 | 9 +- components/driver/source/driver_timer_mod.f90 | 66 ------ .../source/lfric_xios_action_mod.f90 | 18 +- .../algorithm/sci_fem_constants_mod.x90 | 84 +++++--- .../algorithm/sci_geometric_constants_mod.x90 | 79 ++++--- .../algorithm/sci_mapping_constants_mod.x90 | 59 +++--- .../solver/sci_mass_matrix_solver_alg_mod.x90 | 11 +- infrastructure/build/lfric.mk | 17 ++ .../source/utilities/timing_mod.F90 | 199 ++++++++++-------- .../meto/common/suite_config_azspice.cylc | 4 +- .../site/meto/common/suite_config_ex1a.cylc | 4 +- 15 files changed, 302 insertions(+), 269 deletions(-) delete mode 100644 components/driver/source/driver_timer_mod.f90 diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index d0f7ae14d..955bf4286 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -4,3 +4,4 @@ | ----------- | --------- | ----------- | ---- | | james-bruten-mo | James Bruten | Met Office | 2025-12-09 | | jennyhickson | Jenny Hickson | Met Office | 2025-12-10 | +| jedbakerMO | Jed Baker | Met Office | 2025-12-29 | diff --git a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 index 9bce8269f..04864140f 100644 --- a/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 +++ b/applications/io_demo/source/algorithm/io_demo_constants_mod.x90 @@ -22,11 +22,11 @@ module io_demo_constants_mod use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Kernels use sci_calc_dA_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type @@ -61,8 +61,9 @@ contains type(mesh_type), pointer, intent(in) :: mesh type(field_type), target, intent(in) :: chi(:) type(field_type), target, intent(in) :: panel_id + integer(tik) :: id - if ( subroutine_timers ) call timer('io_demo_constants_alg') + if ( LPROF ) call start_timing( id, 'io_demo_constants_alg' ) call log_event( "io_demo: creating runtime constants", LOG_LEVEL_TRACE ) !============================= dx_at_w2 setup =============================! @@ -72,7 +73,7 @@ contains call log_event( "io_demo: runtime constants created", LOG_LEVEL_TRACE ) - if ( subroutine_timers ) call timer('io_demo_constants_alg') + if ( LPROF ) call stop_timing( id, 'io_demo_constants_alg' ) call log_event( "io_demo: created FEM constants", LOG_LEVEL_TRACE ) end subroutine create_io_demo_constants diff --git a/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 b/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 index 85be25ac0..87a9fa03f 100644 --- a/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 +++ b/applications/io_demo/source/driver/multifile_io/multifile_io_mod.F90 @@ -22,7 +22,7 @@ module multifile_io_mod use inventory_by_mesh_mod, only: inventory_by_mesh_type use io_context_collection_mod, only: io_context_collection_type use io_context_mod, only: io_context_type, callback_clock_arg - use io_config_mod, only: use_xios_io, subroutine_timers + use io_config_mod, only: use_xios_io use log_mod, only: log_event, log_level_error, & log_level_trace, log_level_info, & log_scratch_space diff --git a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 index d9f6cef64..98f04c50a 100644 --- a/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 +++ b/applications/simple_diffusion/source/algorithm/simple_diffusion_constants_mod.x90 @@ -22,11 +22,11 @@ module simple_diffusion_constants_mod use fs_continuity_mod, only: W2 use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_TRACE, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Kernels use sci_calc_da_at_w2_kernel_mod, only: calc_dA_at_w2_kernel_type @@ -61,8 +61,9 @@ contains type(mesh_type), pointer, intent(in) :: mesh type(field_type), target, intent(in) :: chi(:) type(field_type), target, intent(in) :: panel_id + integer(tik) :: id - if ( subroutine_timers ) call timer('simple_diffusion_constants_alg') + if ( LPROF ) call start_timing( id, 'simple_diffusion_constants_alg' ) call log_event( "simple_diffusion: creating runtime constants", LOG_LEVEL_TRACE ) !============================= dx_at_w2 setup =============================! @@ -72,7 +73,7 @@ contains call log_event( "simple_diffusion: runtime constants created", LOG_LEVEL_TRACE ) - if ( subroutine_timers ) call timer('simple_diffusion_constants_alg') + if ( LPROF ) call stop_timing( id, 'simple_diffusion_constants_alg' ) call log_event( "simple_diffusion: created FEM constants", LOG_LEVEL_TRACE ) end subroutine create_simple_diffusion_constants diff --git a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 index 3017c4bb8..4394b259c 100644 --- a/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 +++ b/applications/skeleton/source/algorithm/skeleton_constants_mod.x90 @@ -22,14 +22,14 @@ module skeleton_constants_mod use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use inventory_by_mesh_mod, only: inventory_by_mesh_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_INFO, & LOG_LEVEL_ERROR use mesh_mod, only: mesh_type use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & @@ -109,8 +109,9 @@ contains type(function_space_type), pointer :: w2v_fs => null() type(function_space_type), pointer :: w3_fs => null() type(function_space_type), pointer :: wtheta_fs => null() + integer(tik) :: id - if ( subroutine_timers ) call timer('skeleton_constants_alg') + if ( LPROF ) call start_timing( id, 'skeleton_constants_alg' ) call log_event( "Skeleton: creating runtime constants", LOG_LEVEL_INFO ) !======================== Create quadrature object ========================! @@ -178,7 +179,7 @@ contains mm_w0, mm_w1, mm_w2, mm_w2b, mm_w3, mm_wtheta, grad, curl, div, & broken_div ) - if ( subroutine_timers ) call timer('skeleton_constants_alg') + if ( LPROF ) call stop_timing( id, 'skeleton_constants_alg' ) call log_event( "Skeleton: created FEM constants", LOG_LEVEL_INFO ) end subroutine create_skeleton_constants diff --git a/components/driver/source/driver_timer_mod.f90 b/components/driver/source/driver_timer_mod.f90 deleted file mode 100644 index a78498117..000000000 --- a/components/driver/source/driver_timer_mod.f90 +++ /dev/null @@ -1,66 +0,0 @@ -!----------------------------------------------------------------------------- -! (c) Crown copyright 2023 Met Office. All rights reserved. -! The file LICENCE, distributed with this code, contains details of the terms -! under which the code may be used. -!----------------------------------------------------------------------------- -!> Lifecycle management of the simple timer profiling system. -!> -module driver_timer_mod - - use io_config_mod, only : subroutine_timers, & - timer_output_path - use timer_mod, only : timer, output_timer, init_timer - - implicit none - - private - public :: init_timers, final_timers - -contains - - !> Initialises timers from namelists. - !> - !> As well as initialising the system a "top level" timer is started - !> which will give the time between initialisation and finalisation of - !> the timer system. - !> - !> @param[in] identifier Top level timer name. - !> - subroutine init_timers( identifier ) - - implicit none - - character(*), intent(in) :: identifier - - if (subroutine_timers) then - call init_timer( timer_output_path ) - call timer( identifier ) - end if - - end subroutine init_timers - - !> Shuts down timers. - !> - !> The identifier specified when shutting down should be the same as the one - !> given on initialisation. There is a chance to mismatch the identifiers - !> which will cause problems but it avoids the use of a global variable. - !> - !> @todo Reconsider the existance of the simple timer system once the - !> profiler is integrated. - !> - !> @param[in] identifier Top level timer name. - !> - subroutine final_timers( identifier ) - - implicit none - - character(*), intent(in) :: identifier - - if (subroutine_timers) then - call timer( identifier ) - call output_timer() - end if - - end subroutine final_timers - -end module driver_timer_mod diff --git a/components/lfric-xios/source/lfric_xios_action_mod.f90 b/components/lfric-xios/source/lfric_xios_action_mod.f90 index 5dbc1083a..9b40484dd 100644 --- a/components/lfric-xios/source/lfric_xios_action_mod.f90 +++ b/components/lfric-xios/source/lfric_xios_action_mod.f90 @@ -6,6 +6,7 @@ module lfric_xios_action_mod use constants_mod, only : str_def + use timing_mod, only : start_timing, stop_timing, tik, LPROF implicit none @@ -36,7 +37,6 @@ subroutine advance(context, model_clock) !> is old enough to not have xios_get_current_context forwarded through the !> xios module. use icontext, only : xios_get_current_context - use timer_mod, only : timer use xios, only : xios_context, & xios_set_current_context, & xios_update_calendar @@ -50,6 +50,8 @@ subroutine advance(context, model_clock) type(lfric_xios_file_type), pointer :: file => null() type(xios_context) :: xios_context_handle type(linked_list_type), pointer :: filelist + integer(tik) :: id + logical :: profiling ! Get the handle of the current context (Not necessarily the one passed to this routine). ! This is used to reset the context on return. @@ -76,9 +78,10 @@ subroutine advance(context, model_clock) end if ! Update XIOS calendar - if (context%get_timer_flag()) call timer('xios_update_calendar') + profiling = (context%get_timer_flag() .and. LPROF ) + if ( profiling ) call start_timing( id, 'xios_update_calendar' ) call xios_update_calendar( model_clock%get_step() - model_clock%get_first_step() + 1 ) - if (context%get_timer_flag()) call timer('xios_update_calendar') + if ( profiling ) call stop_timing( id, 'xios_update_calendar' ) ! Read all files that need to be read from filelist => context%get_filelist() @@ -126,7 +129,6 @@ subroutine advance_read_only(context, model_clock) !> is old enough to not have xios_get_current_context forwarded through the !> xios module. use icontext, only : xios_get_current_context - use timer_mod, only : timer use xios, only : xios_context, & xios_date, & xios_set_current_context, & @@ -143,6 +145,8 @@ subroutine advance_read_only(context, model_clock) type(lfric_xios_file_type), pointer :: file => null() type(xios_context) :: xios_context_handle type(linked_list_type), pointer :: filelist + integer(tik) :: id + logical :: profiling ! Get the handle of the current context (Not necessarily the one passed to this routine). ! This is used to reset the context on return. @@ -153,10 +157,10 @@ subroutine advance_read_only(context, model_clock) call context%set_current() call context%tick_context_clock() ! Update XIOS calendar - if (context%get_timer_flag()) call timer('xios_update_calendar') - + profiling = ( context%get_timer_flag() .and. LPROF ) + if ( profiling ) call start_timing( id, 'xios_update_calendar' ) call xios_update_calendar( context%get_context_clock_step() ) - if (context%get_timer_flag()) call timer('xios_update_calendar') + if ( profiling ) call stop_timing( id, 'xios_update_calendar' ) ! Read all files that need to be read from filelist => context%get_filelist() diff --git a/components/science/source/algorithm/sci_fem_constants_mod.x90 b/components/science/source/algorithm/sci_fem_constants_mod.x90 index 6477c64ff..72679babc 100644 --- a/components/science/source/algorithm/sci_fem_constants_mod.x90 +++ b/components/science/source/algorithm/sci_fem_constants_mod.x90 @@ -23,14 +23,14 @@ module sci_fem_constants_mod use function_space_collection_mod, only: function_space_collection use function_space_mod, only: function_space_type use inventory_by_mesh_mod, only: inventory_by_mesh_type - use io_config_mod, only: subroutine_timers use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use quadrature_rule_gaussian_mod, only: quadrature_rule_gaussian_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & @@ -228,6 +228,7 @@ contains logical(kind=l_def), parameter :: extend_mesh = .false. type(field_type) :: dummy_field integer(kind=i_def), parameter :: stencil_depth = 1_i_def + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -275,7 +276,7 @@ contains panel_id => get_panel_id(mesh_id) qr_ptr => get_qr_fe() - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) call inventory%add_operator(mm_op, fs, fs, mesh) @@ -306,7 +307,7 @@ contains stencil_depth) ) end if - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -346,6 +347,7 @@ contains logical(kind=l_def), parameter :: extend_mesh = .false. type(field_type) :: dummy_field integer(kind=i_def), parameter :: stencil_depth = 1_i_def + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -387,7 +389,7 @@ contains panel_id => get_panel_id(mesh_id) qr_ptr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_operator(mm_op, fs, fs, mesh) @@ -417,7 +419,7 @@ contains stencil_depth) ) end if - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -444,6 +446,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -489,7 +492,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -497,7 +500,7 @@ contains call invoke ( setval_c(diagonal_mm, 0.0_r_def), & mm_diagonal_kernel_type(diagonal_mm, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -524,6 +527,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -563,14 +567,14 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_field(diagonal_mm, fs, mesh) call invoke ( setval_c(diagonal_mm, 0.0_r_def), & mm_diagonal_kernel_type(diagonal_mm, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -600,6 +604,7 @@ contains type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name integer(kind=i_def), parameter :: i_minus_one = -1_i_def + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -633,7 +638,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -654,7 +659,7 @@ contains ones, mass_matrix), & inc_X_powint_n(mm_linv, i_minus_one) ) end select - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -684,6 +689,7 @@ contains type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name integer(kind=i_def), parameter :: i_minus_one = -1_i_def + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -711,7 +717,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call ones%initialise( fs ) @@ -731,7 +737,7 @@ contains ones, mass_matrix), & inc_X_powint_n(mm_linv, i_minus_one) ) end select - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -758,6 +764,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -791,7 +798,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fe(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -800,7 +807,7 @@ contains call invoke( name = "create_inv_mass_matrix_fe", & invert_local_operator_kernel_type(mm_inv, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -827,6 +834,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -854,7 +862,7 @@ contains ! Create constant if it doesn't already exist mass_matrix => get_mass_matrix_fv(space, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) call inventory%add_operator(mm_inv, fs, fs, mesh) @@ -862,7 +870,7 @@ contains call invoke( name = "create_inv_mass_matrix_fv", & invert_local_operator_kernel_type(mm_inv, mass_matrix) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -888,6 +896,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w1_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -914,12 +923,12 @@ contains w1_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W1 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call curl_inventory_fe%add_operator(curl, w2_fs, w1_fs, mesh) call invoke( name='calculate_curl_fe', & compute_curl_operator_kernel_type(curl, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call curl_inventory_fe%get_operator(mesh, curl) @@ -944,6 +953,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w2_fs type(function_space_type), pointer :: w1_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. curl_inventory_fv%is_initialised()) then @@ -962,12 +972,12 @@ contains w2_fs => function_space_collection%get_fs( mesh, 0, 0, W2 ) w1_fs => function_space_collection%get_fs( mesh, 0, 0, W1 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call curl_inventory_fv%add_operator(curl, w2_fs, w1_fs, mesh) call invoke( name='calculate_curl_fv', & compute_curl_operator_kernel_type(curl, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call curl_inventory_fv%get_operator(mesh, curl) @@ -990,6 +1000,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. div_inventory%is_initialised()) then @@ -1010,12 +1021,12 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div_inventory%add_operator(div, w3_fs, w2_fs, mesh) call invoke( name='calculate_div', & compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call div_inventory%get_operator(mesh, div) @@ -1038,6 +1049,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2h_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. div_h_inventory%is_initialised()) then @@ -1058,12 +1070,12 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div_h_inventory%add_operator(div_h, w3_fs, w2h_fs, mesh) call invoke( name='calculate_div_h', & compute_div_operator_kernel_type(div_h, chi, & panel_id, qr_ptr) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call div_h_inventory%get_operator(mesh, div_h) @@ -1090,6 +1102,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1117,13 +1130,13 @@ contains w3_fs => function_space_collection%get_fs( mesh, element_order_h, & element_order_v, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div%initialise( w3_fs, w2_fs ) call im3_div_inventory_fe%add_operator(im3_div, w3_fs, w2_fs, mesh) call invoke( compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr), & operator_x_times_y_kernel_type(im3_div, mm_w3_inv, div) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call im3_div_inventory_fe%get_operator(mesh, im3_div) @@ -1150,6 +1163,7 @@ contains type(quadrature_xyoz_type), pointer :: qr_ptr type(function_space_type), pointer :: w3_fs type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. im3_div_inventory_fv%is_initialised()) then @@ -1169,13 +1183,13 @@ contains w2_fs => function_space_collection%get_fs( mesh, 0, 0, W2 ) w3_fs => function_space_collection%get_fs( mesh, 0, 0, W3 ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) call div%initialise( w3_fs, w2_fs ) call im3_div_inventory_fv%add_operator(im3_div, w3_fs, w2_fs, mesh) call invoke( compute_div_operator_kernel_type(div, chi, & panel_id, qr_ptr), & operator_x_times_y_kernel_type(im3_div, mm_w3_inv, div) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if call im3_div_inventory_fv%get_operator(mesh, im3_div) @@ -1201,6 +1215,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1238,7 +1253,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space) @@ -1253,7 +1268,7 @@ contains multiplicity_kernel_type(nodal_multiplicity), & X_divideby_Y(rmultiplicity, ones, nodal_multiplicity) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant @@ -1280,6 +1295,7 @@ contains type(function_space_type), pointer :: fs type(inventory_by_mesh_type), pointer :: inventory character(len=str_def) :: inventory_name + integer(tik) :: id ! Point to appropriate inventory for this space select case (space) @@ -1311,7 +1327,7 @@ contains if (.not. constant_exists) then ! Create constant if it doesn't already exist - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call start_timing( id, 'runtime_constants.fem' ) fs => function_space_collection%get_fs(mesh, 0, 0, space) @@ -1325,7 +1341,7 @@ contains multiplicity_kernel_type(nodal_multiplicity), & X_divideby_Y(rmultiplicity, ones, nodal_multiplicity) ) - if ( subroutine_timers ) call timer('runtime_constants.fem') + if ( LPROF ) call stop_timing( id, 'runtime_constants.fem' ) end if ! Return existing constant diff --git a/components/science/source/algorithm/sci_geometric_constants_mod.x90 b/components/science/source/algorithm/sci_geometric_constants_mod.x90 index 744700203..46d3291c3 100644 --- a/components/science/source/algorithm/sci_geometric_constants_mod.x90 +++ b/components/science/source/algorithm/sci_geometric_constants_mod.x90 @@ -24,12 +24,12 @@ module sci_geometric_constants_mod use integer_field_mod, only: integer_field_type use inventory_by_mesh_mod, only: inventory_by_mesh_type use inventory_by_local_mesh_mod, only: inventory_by_local_mesh_type - use io_config_mod, only: subroutine_timers use local_mesh_mod, only: local_mesh_type use log_mod, only: log_event, LOG_LEVEL_ERROR use mesh_collection_mod, only: mesh_collection use mesh_mod, only: mesh_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & @@ -164,8 +164,9 @@ contains type(field_type), pointer :: panel_id type(function_space_type), pointer :: twod_fs integer(kind=i_def) :: k_h, k_v + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) if (use_fe) then k_h = element_order_h @@ -190,7 +191,7 @@ contains setval_c(long, f_lon) ) end if - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end subroutine compute_latlon @@ -217,8 +218,9 @@ contains type(integer_field_type) :: face_counter type(function_space_type), pointer :: w2h_2d_fs type(function_space_type), pointer :: w3_2d_fs + integer(tik) :: id - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) twod_mesh => mesh_collection%get_mesh(mesh, TWOD) local_mesh => mesh%get_local_mesh() @@ -246,7 +248,7 @@ contains face_selector_ns, & face_counter ) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end subroutine compute_face_selectors @@ -315,6 +317,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: panel_id type(function_space_type), pointer :: wchi_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. extended_chi_inventory%is_initialised()) then @@ -329,7 +332,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) wchi_fs => chi(1)%get_function_space() depth = mesh%get_halo_depth() @@ -347,7 +350,7 @@ contains call invoke( extend_chi_field_kernel_type(extended_chi, chi, & panel_id, depth) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call extended_chi_inventory%get_field_array(mesh, extended_chi) @@ -374,6 +377,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: panel_id type(function_space_type), pointer :: w2_k0_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. dA_at_w2_inventory%is_initialised()) then @@ -388,7 +392,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W2) call dA_at_w2_inventory%add_field(dA_at_w2, w2_k0_fs, mesh) @@ -396,7 +400,7 @@ contains call invoke( setval_c(dA_at_w2, 0.0_r_def), & calc_dA_at_w2_kernel_type(dA_at_w2, chi, panel_id) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call dA_at_w2_inventory%get_field(mesh, dA_at_w2) @@ -434,6 +438,7 @@ contains type(quadrature_xyoz_type) :: qr logical(kind=l_def) :: extended_mesh type(quadrature_rule_gaussian_type) :: quadrature_rule + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -455,7 +460,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, W3) @@ -476,7 +481,7 @@ contains setval_c(detj_at_w3, 0.0_r_def), & mm_diagonal_kernel_type(detj_at_w3, mm_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -513,6 +518,7 @@ contains type(quadrature_xyoz_type) :: qr logical(kind=l_def) :: extended_mesh type(quadrature_rule_gaussian_type) :: quadrature_rule + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w3_inventory_fv%is_initialised()) then @@ -528,7 +534,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) call detj_at_w3_inventory_fv%add_field(detj_at_w3, w3_fs, mesh) @@ -547,7 +553,7 @@ contains setval_c(detj_at_w3, 0.0_r_def), & mm_diagonal_kernel_type(detj_at_w3, mm_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -573,6 +579,7 @@ contains type(field_type), pointer :: panel_id type(field_type) :: multiplicity_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -594,7 +601,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_fs => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, W2) @@ -608,7 +615,7 @@ contains setval_c(multiplicity_w2, 0.0_r_def), & multiplicity_kernel_type(multiplicity_w2), & inc_X_divideby_Y(detj_at_w2, multiplicity_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -634,6 +641,7 @@ contains type(field_type), pointer :: panel_id type(field_type) :: multiplicity_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Check inventory is initialised if (.not. detj_at_w2_inventory_fv%is_initialised()) then @@ -649,7 +657,7 @@ contains panel_id => get_panel_id(mesh_id) ! Create the object as it doesn't exist yet - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w2_fs => function_space_collection%get_fs(mesh, 0, 0, W2) call multiplicity_w2%initialise( w2_fs ) @@ -662,7 +670,7 @@ contains setval_c(multiplicity_w2, 0.0_r_def), & multiplicity_kernel_type(multiplicity_w2), & inc_X_divideby_Y(detj_at_w2, multiplicity_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Get existing constant @@ -685,6 +693,7 @@ contains logical(kind=l_def) :: constant_exists type(field_type), pointer :: height_w2 type(function_space_type), pointer :: w3_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. dz_w3_inventory%is_initialised()) then @@ -699,14 +708,14 @@ contains ! Get height first to avoid potentially timing twice height_w2 => get_height_fv(W2, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) call dz_w3_inventory%add_field(dz_w3, w3_fs, mesh) call invoke( get_dz_w3_kernel_type(dz_w3, height_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else ! Otherwise, return existing constant call dz_w3_inventory%get_field(mesh, dz_w3) @@ -730,6 +739,7 @@ contains type(field_type), pointer :: dx_at_w2 type(field_type), pointer :: delta_at_wtheta type(function_space_type), pointer :: wt_k0_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. delta_at_wtheta_inventory%is_initialised()) then @@ -744,13 +754,13 @@ contains wt_k0_fs => function_space_collection%get_fs(mesh, 0, 0, Wtheta) dx_at_w2 => get_dx_at_w2(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call delta_at_wtheta_inventory%add_field(delta_at_wtheta, wt_k0_fs, mesh) call invoke( calc_delta_at_wtheta_kernel_type(delta_at_wtheta, dx_at_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -772,6 +782,7 @@ contains type(field_type), pointer :: detj_at_w2 type(field_type), pointer :: dA_at_w2 type(function_space_type), pointer :: w2_fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. dx_at_w2_inventory%is_initialised()) then @@ -787,12 +798,12 @@ contains detj_at_w2 => get_detj_at_w2_fv(mesh_id) dA_at_w2 => get_dA_at_w2(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call dx_at_w2_inventory%add_field(dx_at_w2, w2_fs, mesh) call invoke( X_divideby_Y(dx_at_w2, detj_at_w2, dA_at_w2) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -817,6 +828,7 @@ contains type(field_type), pointer :: height_w3 type(field_type), pointer :: height_wth logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Parameters of the cells integer(i_def), parameter :: n_centres = 1_i_def @@ -836,7 +848,7 @@ contains height_w3 => get_height_fv(W3, mesh_id) height_wth => get_height_fv(Wtheta, mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) wtheta_k0_fs => function_space_collection%get_fs(mesh, 0, 0, Wtheta) @@ -845,7 +857,7 @@ contains call invoke( calc_dz_face_kernel_type(dz_at_wtheta, height_w3, & height_wth, n_centres, ign_surf) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -875,6 +887,7 @@ contains type(field_type), pointer :: dA_msl_proj type(field_type), pointer :: dA_at_w2 type(function_space_type), pointer :: fs + integer(tik) :: id ! Initialise inventory if it hasn't been done so already if (.not. dA_msl_proj_inventory%is_initialised()) then @@ -893,14 +906,14 @@ contains fs => function_space_collection%get_fs(twod_mesh, 0, 0, W3) dA_at_w2 => get_dA_at_w2(prime_mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) call dA_msl_proj_inventory%add_field(dA_msl_proj, fs, local_mesh) call invoke( calc_da_msl_proj_kernel_type(dA_at_w2, dA_msl_proj, & planet_radius, domain_height, & geometry, geometry_spherical) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) end if ! Return constant @@ -1176,6 +1189,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: height character(len=str_def) :: inventory_name + integer(tik) :: id ! If running at lowest order, use finite volume if (element_order_h == 0 .and. element_order_v == 0) then @@ -1217,7 +1231,7 @@ contains ! If this constant doesn't exist, create it chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) space => function_space_collection%get_fs(mesh, element_order_h, & element_order_v, space_id) @@ -1225,7 +1239,7 @@ contains call invoke( get_height_kernel_type(height, chi, scaled_radius) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else call inventory%get_field(mesh, height) end if @@ -1252,6 +1266,7 @@ contains type(field_type), pointer :: chi(:) type(field_type), pointer :: height character(len=str_def) :: inventory_name + integer(tik) :: id ! Determine inventory based on space select case (space_id) @@ -1287,14 +1302,14 @@ contains ! If this constant doesn't exist, create it chi => get_coordinates(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call start_timing( id, 'runtime_constants.geometric' ) space => function_space_collection%get_fs(mesh, 0, 0, space_id) call inventory%add_field(height, space, mesh) call invoke( get_height_kernel_type(height, chi, scaled_radius) ) - if ( subroutine_timers ) call timer('runtime_constants.geometric') + if ( LPROF ) call stop_timing( id, 'runtime_constants.geometric' ) else call inventory%get_field(mesh, height) end if diff --git a/components/science/source/algorithm/sci_mapping_constants_mod.x90 b/components/science/source/algorithm/sci_mapping_constants_mod.x90 index 7bcecf0f3..ffa819aa1 100644 --- a/components/science/source/algorithm/sci_mapping_constants_mod.x90 +++ b/components/science/source/algorithm/sci_mapping_constants_mod.x90 @@ -39,12 +39,12 @@ module sci_mapping_constants_mod use operator_mod, only: operator_type use quadrature_xyoz_mod, only: quadrature_xyoz_type use r_tran_field_mod, only: r_tran_field_type - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF ! Configuration use finite_element_config_mod, only: element_order_h, & element_order_v - use io_config_mod, only: subroutine_timers ! Other algorithms use sci_geometric_constants_mod, only: get_coordinates, & @@ -272,6 +272,7 @@ contains type(operator_type), pointer :: u_lon_sample type(operator_type), pointer :: u_lat_sample type(operator_type), pointer :: u_up_sample + integer(tik) :: id if (.not. u_lon_sample_inventory%is_initialised()) then call u_lon_sample_inventory%initialise(name='u_lon_sample') @@ -287,7 +288,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) ! Kernels only work for lowest order spaces so use finite volume w2_fs => function_space_collection%get_fs(mesh, 0, 0, W2) @@ -304,7 +305,7 @@ contains u_up_sample, & chi, panel_id) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_spherical_components_to_w2_sample @@ -330,6 +331,7 @@ contains type(function_space_type), pointer :: fs, coarse_fs, fine_fs type(quadrature_rule_segment_centre_type) :: quadrature_rule_sc type(quadrature_xyoz_type) :: qr + integer(tik) :: id if (.not. scalar_inter_element_order_weights_inventory%is_initialised()) then call scalar_inter_element_order_weights_inventory%initialise( & @@ -337,7 +339,7 @@ contains ) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) k_h = element_order_h k_v = element_order_v @@ -384,7 +386,7 @@ contains dummy_fine, dummy_coarse, weights_high_low, weights_low_high, qr & ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_scalar_inter_element_order_weights @@ -410,6 +412,7 @@ contains type(function_space_type), pointer :: fs, coarse_fs, fine_fs type(quadrature_rule_newton_cotes_type) :: quadrature_rule_newton_cotes type(quadrature_xyoz_type) :: qr + integer(tik) :: id if (.not. w2_inter_element_order_weights_inventory%is_initialised()) then call w2_inter_element_order_weights_inventory%initialise( & @@ -417,7 +420,7 @@ contains ) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) k_h = element_order_h k_v = element_order_v @@ -485,7 +488,7 @@ contains dummy_fine, dummy_coarse, weights_high_low, weights_low_high, qr & ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end subroutine create_w2_inter_element_order_weights @@ -517,6 +520,7 @@ contains type(field_type) :: dummy_theta integer(kind=i_def) :: k logical(kind=l_def) :: constant_exists + integer(tik) :: id ! Check inventory is initialised if (.not. proj_mr_to_sh_rho_inventory%is_initialised()) then @@ -540,7 +544,7 @@ contains double_level_chi => get_coordinates(double_level_mesh%get_id()) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w3_fs => function_space_collection%get_fs(prime_extrusion_mesh, 0, 0, W3) wtheta_fs => function_space_collection%get_fs(prime_extrusion_mesh, 0, 0, Wtheta) @@ -560,7 +564,7 @@ contains dummy_theta, & qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -586,6 +590,7 @@ contains type(field_type) :: dummy_w2_field type(function_space_type), pointer :: fine_w2_fs type(function_space_type), pointer :: coarse_w2_fs + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_w2_inventory%is_initialised()) then @@ -608,7 +613,7 @@ contains call log_event(log_scratch_space, LOG_LEVEL_ERROR) end if - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) coarse_w2_fs => function_space_collection%get_fs(coarse_mesh, 0, 0, W2) fine_w2_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W2) @@ -623,7 +628,7 @@ contains call invoke( setval_c(weights, 0.0_r_def), & weights_prolong_w2_kernel_type(weights, dummy_w2_field) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -651,6 +656,7 @@ contains type(function_space_type), pointer :: coarse_w3_fs type(field_type), pointer :: mm_w3_fine type(field_type), pointer :: mm_w3_coarse + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_rdef_w3_inventory%is_initialised()) then @@ -679,7 +685,7 @@ contains mm_w3_fine => get_mass_matrix_diagonal_fv(W3, fine_mesh%get_id()) mm_w3_coarse => get_mass_matrix_diagonal_fv(W3, coarse_mesh%get_id()) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) coarse_w3_fs => function_space_collection%get_fs(coarse_mesh, 0, 0, W3) fine_w3_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W3) @@ -692,7 +698,7 @@ contains mm_w3_fine, & mm_w3_coarse) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -717,6 +723,7 @@ contains type(field_type), pointer :: weights_rdef type(r_tran_field_type), pointer :: weights_rtran type(function_space_type), pointer :: fine_w3_fs + integer(tik) :: id ! Check inventory is initialised if (.not. intermesh_wghts_rtran_w3_inventory%is_initialised()) then @@ -736,7 +743,7 @@ contains ! Create the object as it doesn't exist yet weights_rdef => get_intermesh_weights_w3_rdef(fine_mesh, coarse_mesh) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) fine_w3_fs => function_space_collection%get_fs(fine_mesh, 0, 0, W3) @@ -746,7 +753,7 @@ contains call copy_field(weights_rdef, weights_rtran) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Get existing constant @@ -1017,6 +1024,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: xdirection = 1_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_lon_dot_to_w1_inventory%is_initialised()) then @@ -1034,7 +1042,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1048,7 +1056,7 @@ contains chi, panel_id, & xdirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1073,6 +1081,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: ydirection = 2_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_lat_dot_to_w1_inventory%is_initialised()) then @@ -1090,7 +1099,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1104,7 +1113,7 @@ contains chi, panel_id, & ydirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1129,6 +1138,7 @@ contains type(field_type), pointer :: panel_id type(quadrature_xyoz_type), pointer :: qr integer(kind=i_def), parameter :: zdirection = 3_i_def + integer(tik) :: id ! Check inventory is initialised if (.not. project_r_dot_to_w1_inventory%is_initialised()) then @@ -1144,7 +1154,7 @@ contains panel_id => get_panel_id(mesh_id) qr => get_qr_fv() - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w1_fs => function_space_collection%get_fs(mesh, 0, 0, W1) w3_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1158,7 +1168,7 @@ contains chi, panel_id, & zdirection, qr) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if ! Return constant @@ -1185,6 +1195,7 @@ contains type(field_type), pointer :: panel_id type(function_space_type), pointer :: w2h_k0_fs type(function_space_type), pointer :: w3_k0_fs + integer(tik) :: id ! Initialise inventory if this is the first time getting this constant if (.not. w3_to_w2_displacement_inventory%is_initialised()) then @@ -1208,7 +1219,7 @@ contains chi => get_coordinates(mesh_id) panel_id => get_panel_id(mesh_id) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call start_timing( id, 'runtime_constants.mapping' ) w2h_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W2H) w3_k0_fs => function_space_collection%get_fs(mesh, 0, 0, W3) @@ -1220,7 +1231,7 @@ contains w3_to_w2_displacement_kernel_type(w3_to_w2_displacement, & chi, panel_id, dummy_w3) ) - if ( subroutine_timers ) call timer('runtime_constants.mapping') + if ( LPROF ) call stop_timing( id, 'runtime_constants.mapping' ) end if end function get_w3_to_w2_displacement diff --git a/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 b/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 index b21db98bb..20c1246b8 100644 --- a/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 +++ b/components/science/source/algorithm/solver/sci_mass_matrix_solver_alg_mod.x90 @@ -43,10 +43,8 @@ module sci_mass_matrix_solver_alg_mod precondition_only_type, & jacobi_type, & chebyshev_type - - - use io_config_mod, only: subroutine_timers - use timer_mod, only: timer + use timing_mod, only: start_timing, stop_timing, & + tik, LPROF implicit none @@ -119,8 +117,9 @@ contains type(field_vector_type) :: vec_mm_diagonal real(kind=r_def) :: lmin, lmax + integer(tik) :: id - if ( subroutine_timers ) call timer('mass_matrix_solver_alg') + if ( LPROF ) call start_timing( id, 'mass_matrix_solver_alg' ) mesh_id = y%get_mesh_id() @@ -324,7 +323,7 @@ contains deallocate(mass_matrix_solver) end if - if ( subroutine_timers ) call timer('mass_matrix_solver_alg') + if ( LPROF ) call stop_timing( id, 'mass_matrix_solver_alg' ) end subroutine mass_matrix_solver_alg diff --git a/infrastructure/build/lfric.mk b/infrastructure/build/lfric.mk index ab0ca4d9c..2cd391177 100644 --- a/infrastructure/build/lfric.mk +++ b/infrastructure/build/lfric.mk @@ -96,10 +96,27 @@ ifdef USE_VERNIER export PRE_PROCESS_MACROS += VERNIER endif +ifdef USE_LEGACY_TIMER + export PRE_PROCESS_MACROS += LEGACY_TIMER +endif + ifdef USE_TIMING_WRAPPER export PRE_PROCESS_MACROS += TIMING_ON endif +# Check that only one profiler is requested +ifneq ($(and $(findstring LEGACY_TIMER, $(PRE_PROCESS_MACROS)), \ + $(findstring VERNIER, $(PRE_PROCESS_MACROS))), ) + $(error Multiple profilers specified, limit choice to single profiler.) +endif + +# Check that TIMING ON has been set if any profiler requested. +ifneq ($(or $(findstring LEGACY_TIMER,$(PRE_PROCESS_MACROS)), \ + $(findstring VERNIER, $(PRE_PROCESS_MACROS))), ) +ifndef USE_TIMING_WRAPPER + $(error Conflicting options: Profiler requested with Timing disabled.) +endif +endif # Set the default precision for reals RDEF_PRECISION ?= 64 diff --git a/infrastructure/source/utilities/timing_mod.F90 b/infrastructure/source/utilities/timing_mod.F90 index 7031d6c46..8b489529d 100644 --- a/infrastructure/source/utilities/timing_mod.F90 +++ b/infrastructure/source/utilities/timing_mod.F90 @@ -3,153 +3,186 @@ ! For further details please refer to the file LICENCE which you should have ! received as part of this distribution. !----------------------------------------------------------------------------- -!> @brief Provides wrapper support for Vernier timings +!> @brief Provides wrapper support for profiler timings !> module timing_mod - use log_mod, only: log_event, log_scratch_space, & - LOG_LEVEL_DEBUG, LOG_LEVEL_WARNING - use constants_mod, only: i_def, IMDI + use log_mod, only: log_event, log_scratch_space, & + LOG_LEVEL_DEBUG, LOG_LEVEL_WARNING + use constants_mod, only: i_def, imdi, cmdi, str_def #ifdef VERNIER - !Vernier will only be loaded if the VERNIER environment variable is used - use vernier_mod, only: vernier_init, vernier_start, & - vernier_stop, vernier_write, & - vernier_finalize, vik + use vernier_mod, only: vernier_init, vernier_start, & + vernier_stop, vernier_write, & + vernier_finalize, vik + +#elif defined( LEGACY_TIMER ) + use timer_mod, only: timer, init_timer, output_timer #endif - implicit none + implicit none - public :: init_timing, final_timing, start_timing, stop_timing - public :: tik + public :: init_timing, final_timing, start_timing, stop_timing + public :: tik #ifdef VERNIER - !If Vernier is on then the calliper hash 'tik' is defined as Vernier's hash 'vik' - integer, parameter :: tik = vik + integer, parameter :: tik = vik + integer(tik), private :: global_timing_handle #else - integer, parameter :: tik = i_def + integer, parameter :: tik = i_def #endif -#ifndef TIMING_ON - !If the timing macro is not explicity turned on then the callipers won't be called - logical, public, parameter :: LPROF = .false. +#ifdef TIMING_ON + ! LPROF enables profiler timings. + logical, public, protected :: LPROF = .false. #else - !If the timing macro is defined/ turned on, LPROF will be defined later (by subroutine_timers) - logical, public :: LPROF + ! LPROF enables profiler timings. + ! The logical is declared as a parameter for this build + ! so compilers can easily optimise out the profiler + ! calliper calls from the code. + logical, public, parameter :: LPROF = .false. #endif contains !=============================================================================! -!> @brief Initialize timings -!> @param[in] communicator LFRic mpi communicator +!> @brief Initialise timings and start a global calliper +!> @param[in] communicator LFRic mpi communicator !> @param[in] lsubroutine_timers Runtime logical controlling timer use - subroutine init_timing( communicator, lsubroutine_timers ) - use lfric_mpi_mod, only: lfric_comm_type +!> @param[in] application_name String for the global calliper +!> @param[in] timer_output_path Temporary string used for the legacy timer path + subroutine init_timing( communicator, lsubroutine_timers, application_name, & + timer_output_path ) + use lfric_mpi_mod, only: lfric_comm_type - implicit none + implicit none - logical, intent(in) :: lsubroutine_timers - type( lfric_comm_type ), intent(in) :: communicator + type( lfric_comm_type ), intent(in) :: communicator + logical, intent(in) :: lsubroutine_timers + character(*), intent(in) :: application_name + character(*), intent(in), optional :: timer_output_path #ifdef TIMING_ON - !If timing is on, LPROF will be defined by subroutine_timers - LPROF = lsubroutine_timers + character(str_def) :: name - write(log_scratch_space, '(A)') 'Timing Mod: Runtime timing is turned on' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + ! If timing is on, LPROF will be defined by subroutine_timers + LPROF = lsubroutine_timers + name = cmdi -#ifdef VERNIER - !If Timing and Vernier is on, Vernier will be initialised +#ifdef LEGACY_TIMER + name = 'Timer' + if ( LPROF ) then + if ( present ( timer_output_path ) ) then + call init_timer( timer_output_path ) + else + call init_timer( 'timer.txt' ) + end if - write(log_scratch_space, '(A)') 'Timing Mod: Vernier is turned on' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + call timer( application_name ) - call vernier_init( communicator%get_comm_mpi_val() ) + end if - write(log_scratch_space, '(A)') 'Timing Mod: Vernier initialised' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) -#endif +#elif defined( VERNIER ) + name = 'Vernier' + if ( LPROF ) then + call vernier_init( communicator%get_comm_mpi_val() ) + if ( LPROF ) call vernier_start( global_timing_handle, '__' // & + application_name // '__' ) -#ifndef VERNIER - !If Timing is on but Vernier is not on then a warning will be thrown - write(log_scratch_space, '(A)') 'Timing Mod: Runtime timing is turned on but no profiling tool (such as Vernier) is turned on!' - call log_event(log_scratch_space, LOG_LEVEL_WARNING) -#endif -#endif + end if -#ifndef TIMING_ON -#ifdef VERNIER - write(log_scratch_space, '(A)') 'Timing Mod: Vernier is on but Timing is not!' - call log_event(log_scratch_space, LOG_LEVEL_WARNING) #endif + + if ( LPROF ) then + if (trim( name ) == trim( cmdi )) then + call log_event('Subroutine timings unavailable, no profiler compiled', & + log_level_warning) + else + call log_event( trim( name ) // ' initialised', log_level_debug ) + end if + end if + #endif - end subroutine init_timing + end subroutine init_timing !=============================================================================! -!> @brief Output and finalize timings - subroutine final_timing() - - implicit none +!> @brief Output and finalise timings + subroutine final_timing( application_name ) + implicit none + character(*), intent(in) :: application_name #ifdef TIMING_ON #ifdef VERNIER - !If Vernier is on then it will write to a file and then finalise - call vernier_write() + ! If Vernier is on then it will write to a file and then finalise + if ( LPROF ) call vernier_stop( global_timing_handle ) + call vernier_write() + write(log_scratch_space, '(A)') 'Timing Mod: Vernier has written to file' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - write(log_scratch_space, '(A)') 'Timing Mod: Vernier has written to file' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + call vernier_finalize() + write(log_scratch_space, '(A)') 'Timing Mod: Vernier finalised' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - call vernier_finalize() +#elif defined(LEGACY_TIMER) + call timer ( application_name ) + call output_timer() + + write(log_scratch_space, '(A)') 'Timing Mod: Legacy timing finalised' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - write(log_scratch_space, '(A)') 'Timing Mod: Vernier finalised' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) #endif #endif - - end subroutine final_timing + end subroutine final_timing !=============================================================================! !> @brief Start timings -!> @param[out] timing_section_handle The name of the section that is being timed -!> @param[in] timing_state_name Starting or stopping the given timing, either 'start' or 'stop' - subroutine start_timing( timing_section_handle, timing_section_name ) +!> @param[out] timing_section_handle The integer handle for timed region +!> @param[in] timing_state_name Name of the measured region + subroutine start_timing( timing_section_handle, timing_section_name ) + + implicit none - implicit none + integer(tik), intent(out) :: timing_section_handle + character(*), intent(in) :: timing_section_name - character(*), intent(in) :: timing_section_name - integer(tik), intent(out) :: timing_section_handle + timing_section_handle = imdi #ifdef VERNIER - !If Vernier is on will start a calliper - call vernier_start( timing_section_handle , timing_section_name ) -#else - timing_section_handle = IMDI + ! If Vernier is on will start a calliper + call vernier_start( timing_section_handle , timing_section_name ) + +#elif defined(LEGACY_TIMER) + call timer( timing_section_name ) + #endif - end subroutine start_timing + end subroutine start_timing - !=============================================================================! +!=============================================================================! !> @brief Stop timings -!> @param[in] timing_section_handle The name of the section that is being timed - subroutine stop_timing( timing_section_handle ) - - implicit none +!> @param[in] timing_section_handle The integer handle for timed region +!> @param[in] timing_state_name Optional, name of the measured region + subroutine stop_timing( timing_section_handle, timing_section_name ) + implicit none - integer(tik), intent(in) :: timing_section_handle - !Future callipers may require the section name as well as the handle + integer(tik), optional, intent(in) :: timing_section_handle + character(*), optional, intent(in) :: timing_section_name #ifdef VERNIER - !If Vernier is on will end a calliper - call vernier_stop( timing_section_handle ) + ! If Vernier is on will end a calliper + call vernier_stop( timing_section_handle ) + +#elif defined(LEGACY_TIMER) + call timer( timing_section_name ) + #endif - end subroutine stop_timing + end subroutine stop_timing end module timing_mod diff --git a/rose-stem/site/meto/common/suite_config_azspice.cylc b/rose-stem/site/meto/common/suite_config_azspice.cylc index 41f182ea7..87f954fba 100644 --- a/rose-stem/site/meto/common/suite_config_azspice.cylc +++ b/rose-stem/site/meto/common/suite_config_azspice.cylc @@ -31,8 +31,8 @@ [[AZSPICE_BUILD]] [[[environment]]] - USE_VERNIER = yes - USE_TIMING_WRAPPER=yes + USE_VERNIER=true + USE_TIMING_WRAPPER=true [[[directives]]] --gres=tmp:1024 --export=NONE diff --git a/rose-stem/site/meto/common/suite_config_ex1a.cylc b/rose-stem/site/meto/common/suite_config_ex1a.cylc index 6b6901c31..a3263719e 100644 --- a/rose-stem/site/meto/common/suite_config_ex1a.cylc +++ b/rose-stem/site/meto/common/suite_config_ex1a.cylc @@ -42,8 +42,8 @@ [[EX1A_BUILD]] [[[environment]]] - USE_VERNIER=yes - USE_TIMING_WRAPPER=yes + USE_TIMING_WRAPPER=true + USE_VERNIER=true [[[directives]]] -l tmpsize=12GB From 307e9a8c09948113778fd889f2d0639a0e169aee Mon Sep 17 00:00:00 2001 From: Jed Baker Date: Thu, 15 Jan 2026 16:36:04 +0000 Subject: [PATCH 3/6] Reordering contributor name Moved contributor name entry in CONTRIBUTORS.md to be alphabetical according to github username. --- CONTRIBUTORS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 3f0d95f87..436d64205 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -4,8 +4,9 @@ | --------------- | ---------------- | ----------- | ---------- | | andrewcoughtrie | Andrew Coughtrie | Met Office | 2025.12.12 | | james-bruten-mo | James Bruten | Met Office | 2025-12-09 | +| jedbakerMO | Jed Baker | Met Office | 2025-12-29 | | jennyhickson | Jenny Hickson | Met Office | 2025-12-10 | | mo-marqh | Mark Hedley | Met Office | 2025-12-11 | | MatthewHambley | Matthew Hambley | Met Office | 2025-12-15 | | yaswant | Yaswant Pradhan | Met Office | 2025-12-16 | -| jedbakerMO | Jed Baker | Met Office | 2025-12-29 | + From 74a890fef28f563ce047c47ee1c2350bd9b1b0b6 Mon Sep 17 00:00:00 2001 From: Jed Baker Date: Thu, 15 Jan 2026 16:36:49 +0000 Subject: [PATCH 4/6] Remove empty line in CONTRIBUTORS.md --- CONTRIBUTORS.md | 1 - 1 file changed, 1 deletion(-) diff --git a/CONTRIBUTORS.md b/CONTRIBUTORS.md index 436d64205..3b262d0fe 100644 --- a/CONTRIBUTORS.md +++ b/CONTRIBUTORS.md @@ -9,4 +9,3 @@ | mo-marqh | Mark Hedley | Met Office | 2025-12-11 | | MatthewHambley | Matthew Hambley | Met Office | 2025-12-15 | | yaswant | Yaswant Pradhan | Met Office | 2025-12-16 | - From 4a84135f7959d57123ede6cc46f4f1c87caff49b Mon Sep 17 00:00:00 2001 From: jedbakerMO Date: Thu, 15 Jan 2026 19:39:14 +0000 Subject: [PATCH 5/6] Adding timing options to io_demo to ensure Vernier changes are tested --- applications/io_demo/source/io_demo.f90 | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/applications/io_demo/source/io_demo.f90 b/applications/io_demo/source/io_demo.f90 index b83c5f3e8..5f2e492c0 100644 --- a/applications/io_demo/source/io_demo.f90 +++ b/applications/io_demo/source/io_demo.f90 @@ -21,16 +21,21 @@ program io_demo log_level_trace, & log_scratch_space use random_number_generator_mod, only : random_number_generator_type - use io_demo_mod, only : io_demo_required_namelists - use io_demo_driver_mod, only : initialise, step, finalise + use io_demo_mod, only : io_demo_required_namelists + use io_demo_driver_mod, only : initialise, step, finalise + use timing_mod, only : init_timing, final_timing + use io_config_mod, only : timer_output_path + use namelist_mod, only : namelist_type implicit none ! The technical and scientific state - type(modeldb_type) :: modeldb - character(*), parameter :: program_name = "io_demo" - character(:), allocatable :: filename - integer, parameter :: default_seed = 123456789 + type(modeldb_type) :: modeldb + character(*), parameter :: program_name = "io_demo" + character(:), allocatable :: filename + type(namelist_type), pointer :: io_nml + logical :: lsubroutine_timers + integer, parameter :: default_seed = 123456789 type(random_number_generator_type), pointer :: rng call modeldb%values%initialise() @@ -49,6 +54,10 @@ program io_demo deallocate( filename ) call init_logger( modeldb%mpi%get_comm(), program_name ) + io_nml => modeldb%configuration%get_namelist('io') + call io_nml%get_value('subroutine_timers', lsubroutine_timers) + call init_timing( modeldb%mpi%get_comm(), lsubroutine_timers, program_name, timer_output_path ) + nullify( io_nml ) call init_collections() call init_time(modeldb) @@ -70,6 +79,7 @@ program io_demo call finalise( program_name, modeldb ) call final_time(modeldb) call final_collections() + call final_timing( program_name ) call final_logger( program_name ) call final_config() call final_comm( modeldb ) From 41e2fc1b7973f12e5e64724a741896f5654eea57 Mon Sep 17 00:00:00 2001 From: jedbakerMO Date: Thu, 15 Jan 2026 20:56:52 +0000 Subject: [PATCH 6/6] Turning on timing in io_demo and fixing issue with subroutine timers off --- .../source/utilities/timing_mod.F90 | 28 +++++++++++-------- rose-stem/app/io_demo/rose-app.conf | 2 +- 2 files changed, 17 insertions(+), 13 deletions(-) diff --git a/infrastructure/source/utilities/timing_mod.F90 b/infrastructure/source/utilities/timing_mod.F90 index 8b489529d..506ee681e 100644 --- a/infrastructure/source/utilities/timing_mod.F90 +++ b/infrastructure/source/utilities/timing_mod.F90 @@ -120,21 +120,25 @@ subroutine final_timing( application_name ) #ifdef TIMING_ON #ifdef VERNIER ! If Vernier is on then it will write to a file and then finalise - if ( LPROF ) call vernier_stop( global_timing_handle ) - call vernier_write() - write(log_scratch_space, '(A)') 'Timing Mod: Vernier has written to file' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) - - call vernier_finalize() - write(log_scratch_space, '(A)') 'Timing Mod: Vernier finalised' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + if ( LPROF ) then + call vernier_stop( global_timing_handle ) + call vernier_write() + write(log_scratch_space, '(A)') 'Timing Mod: Vernier has written to file' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + + call vernier_finalize() + write(log_scratch_space, '(A)') 'Timing Mod: Vernier finalised' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + end if #elif defined(LEGACY_TIMER) - call timer ( application_name ) - call output_timer() + if ( LPROF ) then + call timer ( application_name ) + call output_timer() - write(log_scratch_space, '(A)') 'Timing Mod: Legacy timing finalised' - call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + write(log_scratch_space, '(A)') 'Timing Mod: Legacy timing finalised' + call log_event(log_scratch_space, LOG_LEVEL_DEBUG) + end if #endif #endif diff --git a/rose-stem/app/io_demo/rose-app.conf b/rose-stem/app/io_demo/rose-app.conf index e92bdb229..af4844708 100644 --- a/rose-stem/app/io_demo/rose-app.conf +++ b/rose-stem/app/io_demo/rose-app.conf @@ -64,7 +64,7 @@ file_convention='UGRID' multifile_io=.false. !!nodal_output_on_w3=.false. subroutine_counters=.false. -subroutine_timers=.false. +subroutine_timers=.true. timer_output_path='timer.txt' use_xios_io=.true. write_diag=.false.